;; For Clisp
;; A library of functionals that are not built into Lisp.
;; Version: 2003 October 20

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Binding a parameter of a binary function to a fixed value, thereby creating
;; a function of one argument.  It is also called currying from the
;; mathematician Curry who developed the idea.  The effect to convert a
;; binary function to a unary function.
;;
;; For example (bu '+ 3) creates a function to add 3.
              ;; Thus we could define an operator 3+ as follows.
;;      (defun 3+ (x) (funcall (bu '+ 3) x))
;;      (3+ 8) = 11
;;
;; Or a function to cons 3 to a value.
;;      (defun cons3 (x) (funcall (bu 'cons 3) x))
;;      (cons3 'a) = (3 . a)

;; Require: f(x,y) is a binary function
;;          x is a valid first parameter for f
;; Ensure: Result is the unary function g(y) where g(y) = f(x,y)

(defun bu (f x)
 (function (lambda (y) (funcall f x y))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The functional rev is used to reverse the order of the paramters to a
;; function.
;;
;; For example in the above (cons3 'a) = (3 . a).  Suppose you want (a . 3).
;; Try the following to reverse the expected order of arguments to cons.
;;      (defun rcons3 (x) (funcall (bu (rev 'cons) 3) x))
;;
;; Notice funcall is only needed at the "outer level" of the definition for
;; bu but not for rev which is an "inner call".

;; Require: f(x,y) is a binary function
;; Ensure: Result is the function f(y,x)

(defun rev (f)
 (function (lambda (x y) (funcall f y x))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; General purpose curry macro that creates an n-1 parameter function
;; from an n parameter function by fixing the parameter at position pos
;; with the given value.
;;
;; Example that curries the first paramter of a binary - with 3.
;;    (mapcar (curry '- 1 2 3) '(1 2 3 4)) ==> (2 1 0 -1)
;; The previous expression is equivalent to the following expression
;; as in each case the first parameter is curried.
;;    (mapcar (bu '- 3) '(1 2 3 4))
;; The following example curries the second parameter of -
;;    (mapcar (curry '- 2 2 3) '(1 2 3 4)) ==> (-2 -1 0 1)
;; The previous expression is equivalent to the following expression
;; as in each case the second parameter is curried.
;;    (mapcar (bu (rev '-) 3) '(1 2 3 4))

;; Require: func(x_1, ..., x_parm-cnt) is a parm-cnt parameter function
;;          1 <= pos <= parm-cnt
;;          value is a valid parameter for func in position pos
;; Ensure: Result is a (param-cnt - 1) parameter function g where g = f
;;         with value in place of parameter pos.
 
(defmacro curry (func pos parm-cnt value)
 (let ((parm (mapcar 'gensym (range 1 parm-cnt))))
  (let ((first-parms (prefix (1- pos) parm))
        (last-parms (suffix (1+ pos) parm)))
   (list 'function
    (list 'lambda (append first-parms last-parms)
           (append (list 'funcall) (list func)
                   first-parms (list value) last-parms)))
)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; comp  defines a function as being the composition of a pair of unary
;; functions.
;;
;; For example an expensive donothing to add one and then subtract one.
;;      (defun donothing (x) (funcall (comp '1- '1+) x))

;; Require: f and g are unary functions such that the result of g(x) is a valid
;;          argument for f.
;; Ensure: Result is the function f o g

(defun comp (f g)
  (function (lambda (x) (funcall f ( funcall g x)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; compl defines a function as being the composition of a list of unary
;; functions.
;;
;; The previous example can be constructed using compl as follows.
;;      (defun donothing2 (x) (funcall (compl '1- '1+) x))
;; Now do a plus 7 using 3+ and 1+.
;;      (defun 7+ (x) (funcall (compl '3+ '3+ '1+) x))

;; Require: funclist is a list of functions f_1 .. f_n such that
;;    n = length(funclist)
;;    forall j : 2.. length(funclist) :: result of f_j is a valid argument f_j-1
;; Ensure: Result = f_1 o ... o f_n

(defun compl (&rest funclist)
  (function (lambda (x) (compbody x funclist))))

(defun compbody (x funclist)
  (cond ((null funclist) x)
        (t (funcall (car funclist) (compbody x (cdr funclist))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Manipulating lists to get them into the right shape for functions is
;; also required.  Here are three such operations with variations on
;; implementation to give you an idea of the different ways in which functions
;; can be written.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; trans -- transpose a two-dimensional matrix.
;;
;; (trans '((1 2 3)             ((1 4 7 10)
;;          (4 5 6)        =     (2 5 8 11)
;;          (7 8 9)              (3 6 9 12))
;;        (10 11 12)))

;; Require: matrix is a list of lists
;;          forall i, j : matrix :: length(i) = length(j)
;; Ensure: Result is a list of lists
;;         forall i, j : Result :: length(i) = length(j)
;;         length(Result) = length(first(matrix))
;;         length(first(Result)) = length (matrix)
;;         forall r : 1.. length(matrix)
;;           :: (forall c : 1.. length(first(matrix))
;;                :: matrix[r,c] = Result[c,r] )

(defun trans (matrix) (apply 'mapcar 'list matrix))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Distribute left distributes the first parameter to the left of each of the
;; items in the second parameter.
;;
;; (distl 'a '(1 2 3)) = ((a 1) (a 2) (a 3))
;;
;; DISTLR is the distribute left recursive version.
;; DISTL  is the functional two parameter version.
;; DISTL1 is the functional one parameter version.

(defun distlr (x b)
 (cond ((null b) nil)
       (t (cons (list x (car b)) (distl x (cdr b))))))

(defun distl (x b)
  (mapcar (function (lambda (y) (list x y))) b))

(defun distl1 (x-b)
  (mapcar (function (lambda (y) (list (first x-b) y))) (second x-b)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Distribute right distributes the first parameter to the right of each of
;; the items in the second parameter.
;;
;; (distr 'a '(1 2 3)) = ((1 a) (2 a) (3 a))
;
;; DISTRR is the distribute right recursive version.
;; DISTR  is the functional two parameter version.
;; DISTR1 is the functional one parameter version.

(defun distrr (x b)
 (cond ((null b) nil)
       (t (cons (list (car b) x) (distrr x (cdr b))))))

(defun distr (x b)
  (mapcar (function (lambda (y) (list y x))) b))

(defun distr1 (x-b)
  (mapcar (function (lambda (y) (list y (first x-b)))) (second x-b)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All pairs functional versions
;;
;; Require: a and b are lists
;; Ensure: Result = { i : a ; j : b }

;; First list order
;; ((a b c) (1 2 3)) ==>
;; ((a 1) (a 2) (a 3)
;;  (b 1) (b 2) (b 3)
;;  (c 1) (c 2) (c 3))

(defun allPairs-1 (a b)
  (reduce 'append (mapcar 'distl1 (distr1 (list b a)))))

;; First list order swapped arguments
;; (a b c) (1 2 3) ==>
;; ((1 a) (2 a) (3 a)
;;  (1 b) (2 b) (3 b)
;;  (1 c) (2 c) (3 c))

(defun allPairs-1s (a b)
  (reduce 'append (mapcar 'distr1 (distr1 (list b a)))))

;; Second list order
;; (a b c) (1 2 3) ==>
;; ((a 1) (b 1) (c 1)
;;  (a 2) (b 2) (c 2)
;;  (a 3) (b 3) (c 3))

(defun allPairs-2 (a b)
  (reduce 'append (mapcar 'distr1 (distr1 (list a b)))))

;; Second list order swapped arguments
;; (a b c) (1 2 3) ==>
;;  ((1 a) (1 b) (1 c)
;;  (2 a) (2 b) (2 c)
;;  (3 a) (3 b) (3 c))

(defun allPairs-2s (a b)
  (reduce 'append (mapcar 'distl1 (distr1 (list a b)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reduce is defined in Clisp.  Renamed here to distinquish this version from
;; the Clisp version.
;;
;; The optional base is useful when the input list could be empty
;; and a non-nil value is needed.   For example using (reduce '* list)
;; where if the list could be empty it would be better to use
;; (reduce '* list 1) as 1 is the zero for multiplication.
;;
;; Two versions of reduce are given -- one from front to back the other from
;; back to front.   For commutative operators the same result is obtained.  For
;; non-cummutative operators different results are obtained.


(defun reduce-pl (func theList &optional base)
  (cond ((null theList) base)
        ((null (cdr theList)) (car theList))
        ((null (cddr theList)) (apply func theList))
        (t (funcall func (reduce-pl func (butlast theList))
                         (car (last theList))))
))

;; Reduce for 1-parameter functions.  The function is applied to a
;; pair of values as a list.

(defun reduce1 (func theList &optional base)
 (cond ((null theList) base)
       ((null (cdr theList)) (car theList))
       ((null (cddr theList)) (funcall func theList))
       (t (funcall func (cons (reduce1 func (butlast theList))
                              (last theList))))
))

;; reduce from back to front

(defun reduceb (func theList &optional (base nil bflag))
  (cond (bflag
           (cond ((null theList) base)
                 (t (funcall func (car theList) (reduceb func (cdr theList) base)))))
        (t (cond ((null theList) base)
                 ((null (cdr theList)) (car theList))
                 ((null (cddr theList)) (apply func theList))
                 (t (funcall func (car theList) (reduceb func (cdr theList))))))
))

;; Reduce for 1-parameter functions.  The function is applied to a
;; pair of values as a list.

(defun reduceb1 (func theList &optional (base nil bflag))
  (cond (bflag
           (cond ((null theList) base)
                 (t (funcall func (list (car theList)
                                        (reduceb func (cdr theList) base))))))
        (t (cond ((null theList) base)
                 ((null (cdr theList)) (car theList))
                 ((null (cddr theList)) (funcall func theList))
                 (t (funcall func (list (car theList)
                                        (reduceb1 func (cdr theList)))))))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Range gives a list of integers in the range lowerBound to upperBound
;; inclusive.

;; Require: True
;; Ensure: lowerBound > upperBound --> Result = nil
;;         lowerBound <= upperBound --> Result = (lowerBound .. upperBound)

(defun range (lowerBound upperBound)
 (cond ((> lowerBound upperBound) nil)
       (t (cons lowerBound (range (1+ lowerBound) upperBound)))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Filter a list.  Keep items that satisfy the predicate.
;;  (/ append) o (apply predicate)

(defun filter (predicate list)
 (reduce 'append (mapcar #'(lambda (item)
                         (cond ((funcall predicate item) (list item)))) list)
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Math function - sigma
;; Add a function of the integers between lowerBound and upperBound
;; inclusive but the function can involve real numbers and return real
;; numbers.
;;   (/+) o (apply func) o range

(defun sigma (lowerBound upperBound func)
 (reduce '+ (mapcar func (range lowerBound upperBound)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generate a list from start using next of size length
;;
;; start is the first item in the list
;; next is a one parameter function that generates the second
;;      item in the list from the starting item
;; length is the length of the list to generate
;;
;; An example that is equivalent to (range -10 14)
;;    (genlist -10 '1+ 25)

(defun genlist (start next length)
 (cond ((= length 0) nil)
       (t (cons start (genlist (funcall next start) next (1- length) )))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Iterate a function for a count number of times
;; Similar to genlist, except only the final result is kept.

(defun iter (count func state)
 (cond ((= count 0) state)
       (t (iter (1- count) func (funcall func state)))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; For i = k to n by p do func(state, i)

(defun for (k n p func state)
 (cond ((> k n) state)
       (t (for (+ k p) n p func (funcall func state k)))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; while cond(state) do func(state)

(defun while (condition func state)
 (cond ((funcall condition state)
           (while condition func (funcall func state)))
       (t state)
))
