;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; 
;;; 
;;; List vs Append
;;; 

;; list returns a list of the arguments passed
(list 'a 'b 'c)     ;; gives (a b c)

;; append returns a combined list of elements contained in the lists
;; passed to append
(append 'a 'b)  ;; gives an error because 'a and 'b are not lists.

(append '(a) '(b))  ;; gives (a b)

;; important rule: nils are empty lists and hence are removed by append

(append '(a) nil '(b) nil)  ;; still gives (a b)


;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; 
;;; 
;;; Logical operators
;;; 

;; as in most languages: OR will try each argument
;; until the first success is found.  AND will try
;; until the first failure is found.  This is 
;; true for Icon and C/C++ as well as Lisp

(or 'dog 'cat)
;; gives DOG since it is the first success in an OR

(and 'dog 'cat)
;; gives CAT since it is waiting for a failure and never finds one.
;; CAT is the value of the last expression.

(not 'dog)
;; gives NIL since DOG is the equivalent of true so not of true is NIL


;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; 
;;; 
;;; Cond
;;; 

;; this says the type of its argument
;; notice the form of a cond is a list of tests
(defun say-type (x)
   (cond ((null x) "It is nil")
         ((numberp x) "It is a number")
         ((atom x) "It is an atom")
         ((listp x) "It is a list")
   )
)

;; When a condition is found that succeeds then the rest of
;; the expressions are evaluated in the list.  In
;; the following expression if x=0 then z is set to 1, w to 46 and
;; a list with value of x inside is returned as the value of the cond.
   (cond ((zerop x) (setq z 1) (setq w 46) (list x))
         ((listp x) (setq z 3) (setq w 53) (car x))
   )



;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; 
;;; 
;;; Defun
;;; 

;; a define function for two arguments takes the form, where
;; some of the arguments in the body of the function may be
;; further function calls
(defun function-name (arg1 arg2)
	(func1 arg1 arg2 arg3 ... )
	(func2 arg1 arg2 arg3 ... )
	(func3 arg1 arg2 arg3 ... )
	etc.
)

;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; 
;;; 
;;; Recursion
;;; 

;; a function that performs the same as member
(defun newmember (x l)
  (cond ((atom l) nil)
	((listp l) (cond ((equal x (car l)) l)
			 ((newmember x (cdr l)))
                   )
        )
  ))

;; tests for the newmember function
(newmember 'x '(x a b))
(newmember 'x '(a x b))
(newmember 'x '(a b))
(newmember 'x 'x)
(newmember 'x nil)
(newmember nil '(a b))

;; a factorial function
(defun fact (n)
    (cond ((< n 2) 1)
	  (t (* n (fact (- n 1))))
))

;; recursion: build on way up
(defun countdown (n)
  (cond ((zerop n) nil)
	( t (cons n (countdown (- n 1))))
)
)

;; recursion: build on way up
;; append does lots of excess consing
(defun countup (n)
  (cond ((zerop n) nil)
	(t (append (countup (- n 1)) (list n)))
))


;; auxillary function technique
;; 2 part build on way up
(defun countup2 (n) (countup2aux n 1))
(defun countup2aux (n cnt)
  (cond ((> cnt n) nil)
	( t (cons cnt (countup2aux n (+ 1 cnt))))
))


;; 2 part tail recursion build on way down
(defun countupt (n) (countuptaux nil n))
(defun countuptaux (l n)
  (cond ((zerop n) l)
	(t (countuptaux (cons n l) (- n 1)))
))


;; 2 part tail recursion of reverse
(defun recrev (l) (recrevaux l nil))
(defun recrevaux (shrink grow)
  (cond ((null shrink) grow)
	( t (recrevaux (cdr shrink) (cons (car shrink) grow)))
))


;; structural recursion
;; find atom a anywhere in l
(defun findatom (a l)
  (cond
     ((atom l) (equal a l))
     (t (or (findatom a (car l))   ;; can remove t
	  (findatom a (cdr l))
      ))
))


;; find any list or atom anywhere in l
(defun findany (a l)
  (print l)
  (cond
     ((equal a l) t)  ;; t not needed
     ((atom l) nil)
     (t (or (findany a (car l))   ;; can remove t
	  (findany a (cdr l))
      ))
))

;; structural recursion
;; substitute a for b anywhere in l
(defun subst (a b l)
  (cond
     ((equal b l) a)
     ((atom l) l)
     ((cons (subst a b (car l)) 
	    (subst a b (cdr l))
      ))
))

;; test for subst function
(subst 'x '(a (b)) '(z ((a (b)) z (a b))))

(load "clisp.l")


;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  apply and funcall
;;;

;; apply takes a list of arguments
(apply 'list '((1) (2) (3)))
;; ((1) (2) (3))

(apply 'append '((1) (2) (3)))
;; (1 2 3)

;; funcall is followed by a list of arguments
(funcall 'list '(1) '(2) '(3))
;; ((1) (2) (3))

(funcall 'append '(1) '(2) '(3))
;; (1 2 3)

;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  member
;;;

;; member searches through the second argument which is a list.  It
;; returns from the first occurance of the first argument 
;; to the end of the list.  The first argument needs to be an atom.
;;

(member 'x '(a b c d x e f g x))
;;(X E F G X)

;; member only works at the top level
(member 'x '(a (x) b x c d))
;;(X C D)

;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  alists (association lists) and the assoc function
;;;

;; create the animals association list.  It associates animals
;; with their sounds.  (haven't seen this since first grade, eh? :-) )
(setq animals '((dog bark)
                (cat meow)
                (horse neigh)
                (cow moo)
                )
)
;;((DOG BARK) (CAT MEOW) (HORSE NEIGH) (COW MOO))

;; find the noise a cow makes
(assoc 'cow animals)
;; (COW MOO)

;; find the noise a cat makes
(assoc 'cat animals)
;; (CAT MEOW)

;; find the noise a meerkat makes
(assoc 'meerkat animals)
;; NIL





;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  The map functions
;;;

;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;              car        cdr
;;; list         mapcar     maplist
;;; append       mapcan     mapcon
;;;

;; set a test value z
(setq z '(1 2 3))

(mapcar '(lambda (x) (list x)) z)
;; ((1) (2) (3))

(mapcan '(lambda (x) (list x)) z)
;; (1 2 3)

(maplist '(lambda (x) (list x)) z)
;; (((1 2 3)) ((2 3)) ((3)))

(mapcon '(lambda (x) (list x)) z)
;; ((1 2 3) (2 3) (3))

(maplist #'(lambda (x) (apply '+ x)) '(1 1 1 1 1))
;; (5 4 3 2 1)



;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  Combining mapcan and recursion
;;;

;; this function will flatten a list containing sublists
;; by using the append nature of mapcan
(defun flat (x)
  (mapcan #'(lambda (x) (cond ((listp x) (flat x))
			      (t (list x))
			      ))
          x
  )
)
(flat '((a) b (((c)) (d))))
;; (A B C D)

;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  Reducing with reduce
;;;

(reduce 'list '(a b c d e))
;; ((((A B) C) D) E)

(right-reduce 'list '(a b c d e))
;; (A (B (C (D E))))

;; returns the minimum element in a list.  Note reduce always uses 
;; a function that takes two parms
(defun minlist (l)
    (reduce '(lambda (x y) (if (< x y) x y)) l)
)
(minlist '(3 1 4 1 5 9 2 6))
;; 1




;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  Remove and select examples
;;;

(remove 'dog '(cat (dog) dog cat dog))
;; (CAT (DOG) CAT)

(select 'dog '(cat (dog) dog cat dog))
;; (DOG DOG)

(remove-if  #'(lambda (x) (listp x)) '(cat (dog) dog cat nil (cat)))
;; (CAT DOG CAT)

(select-if  #'(lambda (x) (listp x)) '(cat (dog) dog cat nil (cat)))
;; ((DOG) NIL (CAT))
 


;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; 
;;;
;;;  Set operations
;;;
;;;
;;; NOTE: these are binary operators and compare atoms 
;;; but not lists in each list
;;;

(union '(dog cat fox hog) '(owl dog pig fox))
;; (DOG CAT FOX HOG OWL PIG)

(intersection  '(dog cat fox hog) '(owl dog pig fox))
;; (DOG FOX)

(setdifference  '(dog cat fox hog) '(owl dog pig fox))
;; (CAT HOG)



;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;;  ;; ;;  ;; ;; 
;;;
;;;  The cities distance example from class
;;;

;; load the common lisp feature library
(load "clisp.l")

;; set up the cities data base as nested alists
(setq cities '(

   (moscow ((spokane 90)
            (colfax 20)
            (lewiston 30))
   )

   (spokane ((moscow 90)
             (colfax 70)
             (lewiston 120))
   )

))

;; return the keys of an alist
(defun alist-keys (x)
     (mapcar 'car x)
)

;; return all the city names
(defun all-cities () (alist-keys cities))


;; return the routes from a given city x
(defun city-routes (x)
      (second (assoc x cities))
)

;; return the distance from city x to y
(defun dist (x y)
      (second (assoc y (city-routes x)))
)

;; list all cities within miles miles of x
;; do as a separate function first
(defun within (miles x)
      (mapcan #'(lambda (y) (if (<= (second y) miles) (list (first y)) nil))
	      (city-routes x)
      )
)


;; return the alist entry with the smallest value
;; done using mapcar.  Perhaps not the best choice for this problem.
(defun smallest (x)
    (let ((min (first x)))
	 (mapcar #'(lambda (y) (if (< (second y) (second min))
				    (setq min y)
			       ))	
  	  x
	 )
         min
    )
)

(smallest '((a 2) (b 3) (c 1) (d 8)))
;; (C 1)


;; return the alist entry with the smallest value using reduce
;; a better idea.
(defun smallestr (x)
    (reduce #'(lambda (x y) (if (< (second x) (second y)) x y)) x)
)
;; (C 1)