;;; TRAINEX: Ilog Talk training session examples.
;;;
;;; Copy pieces of this file into a module of your own, in
;;; ~/talk-play/src, and compile that module.



;;; Example for show-memory-delta.

;;; N-ary string concatenation, using the binary function catenate.

;;; show-memory-delta shows that naive-catenate-0 has a problem.

(defun naive-catenate-0 (rest: strings)
  ;; allocates too many conses and strings
  (let ((result (make-string 0 0)))
    ;; Why (make-string 0 0) instead of ""? Because we want a fresh
    ;; string to be returned even in case no string was passed (so
    ;; that caller can legally free-row the result).
    (for ((string in: strings))
      (setf result (catenate result string)))
    result))

;;; show-memory-delta shows that naive-catenate-1 has a problem, but
;;; tough to get rid off.

(defun naive-catenate-1 (multiple: strings)
  ;; allocates too many strings
  (let ((result (make-string 0 0)))
    (for ((string in-multiple: strings))
      (setf result (catenate result string)))
    result))

;;; show-memory-delta shows that naive-catenate-2 is perfect.  timeq
;;; tells a different story, though: the algorithm is still quadratic!

(defun naive-catenate-2 (multiple: strings)
  ;; allocates just the result string
  (let ((result (make-string 0 0)))
    (for ((string in-multiple: strings))
      (let ((prev result))
	(setf result (catenate result string))
	(free-row prev)))
    result))



;;; Example of arithmetic

;; Factorial function

(defun ! (n)
  ;; Generic factorial. Roughly quadratic for large values, as
  ;; complexity of <big-int> multiplication grows by the value --
  ;; "(/(timeq(! n)(* n n)))" is interesting to plot.
  (let ((result 1))
    (for ((i from: 2 to: n))
      (setf result (* result i)))
    result))

(defun i! (n)
  ;; <int> factorial. Linear and fast -- but 13! overflows.
  (let ((result 1))
    (for ((i from: 2 to: n))
      (setf result (i* result i)))
    result))

(defun f! (n)
  ;; <int> factorial. Linear -- but just an approximation.
  (let ((result 1.))
    (for ((i from: 2 to: n))
      (setf result (f* result (float i))))
    result))


;;; An sprin which allows for implicit package.

(defun my-sprin (x optional: (package ()))
  (assert (or (symbolp package)
	      (null package)))
  (let ((string-stream (make-string-stream)))
    (setf (stream-package string-stream) package)
    (fprintf string-stream "%A" x)
    (string-stream-contents string-stream)))



;;; Example of hash-table

;;; Prime factors, using Eratostenes' seive.

;;; Standard implementation, given as reference.

(defun .seive-aux (n)
  ;; Use a non-exported (packaged) function to minmize cost of
  ;; recursive call.
  (block loop
    (for ((i from: 2 to: (i/ n 2)))
      (when (eq (i* (i/ n i) i) n)
	(return-from loop (cons i (.seive-aux (i/ n i))))))
    (list n)))

(defun seive (n)
  (.seive-aux n))

;;; Cached implementation: a cache miss triggers the computation of
;;; the unknown number prime factors: find the smallest prime factor,
;;; and read the cache for the quotient. Bad performance when little
;;; used, but pretty fast when used intensively. Performance in time
;;; and space is interesting to watch improve over test series.

(defun .fill-seive-cache (seive-cache n)
  (let ((result
	 (block loop
	   (for ((i from: 2 to: (i/ n 2)))
	     (when (eq (i* (i/ n i) i) n)
	       (return-from loop
		 (cons
		  ;; i is n's smallest prime factor
		  i
		  ;; look for n/i's prime factors in cache.
		  (htref seive-cache (i/ n i))))))
	   ;; n is a prime, return.
	   (list n))))
    (setf (htref seive-cache n) result)
    result))

(defglobal .seive-cache (make-hash-table 1 #'.fill-seive-cache))

(defun cached-seive (n)
  (htref .seive-cache n))
