;;;Setting up Allegro Common Lisp on the College of Computing Unix machines
;
;1) Put the following in your .emacs file
;     (setq inferior-lisp-program "/usr/local/allegrocl/alisp")
;     Note if you are doing this on your own machine (or in Windows) you
;     will need to specify where the lisp binary is.
; 
;2) M-x run-lisp
;     This command will start an *inferior-lisp* buffer that you can
;     type commands to
;
; I would suggest creating another file mylisp.lisp or some such.
; Emacs should enter lisp mode (if not M-x lisp-mode).  C-c C-e
; when typed in a function will evaluate it in the *inferior-lisp* buffer

;Note to Thad: should do more on recursion here

;;;operations
(+ 4 5)
(/ 3 9) 
(/ 9 4)
(/ 3 0) 
(/ 0 0)
(numberp 1)
(numberp 'a)
(= 3 2)
(= 3 3)
;;cons cell
(cons 1 2)
(car (cons 1 2))
(cdr (cons 1 2))
(cons 1 nil)
(cons 3 (cons 2 (cons 1 nil)))
(car (cons 3 (cons 2 (cons 1 nil))))
(cdr (cons 3 (cons 2 (cons 1 nil))))
(list 4 5 6)
'(1 2 3)
(cons 3 (list 4 5 6))
(car (list 1 2 3 4 5 6))
(cdr (list 1 2 3 4 5 6))
(cadr (list 1 2 3 4 5 6))
(caddr (list 1 2 3 4 5 6))
(cons '(1 2 3)  (list 4 5 6))
(car (cons '(1 2 3)  (list 4 5 6)))
(cdr (cons '(1 2 3)  (list 4 5 6)))
(caar (cons '(1 2 3)  (list 4 5 6)))
(cadr (cons '(1 2 3)  (list 4 5 6)))
(cdar (cons '(1 2 3)  (list 4 5 6)))
(cadar (cons '(1 2 3)  (list 4 5 6)))
'(a b c d e)
(list 'a 'b 'c 'd 'e)
(reverse (list 'r 'e 'd 'r 'u 'm))
(append '(a b c) 'd)
(append '(a b c) '(d))
(first (list 'a 'b 'c 'd 'e))
(second (list 'a 'b 'c 'd 'e))
(third (list 'a 'b 'c 'd 'e))
(nth 0 (list 'a 'b 'c 'd 'e))
(nth 1 (list 'a 'b 'c 'd 'e))
(nthcdr  1 (list 'a 'b 'c 'd 'e))
(nthcdr 2 (list 'a 'b 'c 'd 'e))
(nthcdr 0 (list 'a 'b 'c 'd 'e))
(list 'c 'v 'i 'l 'd 'c 'a 'd)
(subst 'e 'c (list 'c 'v 'i 'l 'd 'c 'a 'd))
(union (list 'i 'l 'b 'u 's) (list  'l 'i 'm 'i 'n 'a 'l))
(intersection (list 'i 'l 'b 'u 's) (list  'l 'i 'm 'i 'n 'a 'l))
(member 'i (list  'c 'r 'i 'm 'i 'n 'a 'l)))
(every 'numberp (list 1 2 'a 3))
(every 'numberp (list 1 2 3))
(setq testlist1 '(a b c))
(setq testlist2 '(a b c))
(equal testlist1 testlist2)
(eql testlist1 testlist2)
(setq testlist1 testlist2)
(equal testlist1 testlist2)
(eql testlist1 testlist2)
(setq foo 'bar)
foo
(list foo 'foo)
(boundp 'foo)
(boundp 'bar)
(setq words (list (list 'one 'ein) (list 'two 'zwei) (list 'three 'drei)))
(assoc 'two words)
(cadr (assoc 'two words))
;; helping yourself
(describe 'first)
(apropos 'first)
;;printing
(print "hello")
(print "hello~%")
(format nil "~d" 1)
(format nil "~d ~a" 1 "hello")
(format nil "~d ~a~%" 1 "hello")
;;functions
(apropos 'addd)
(defun addd (x y )  (+ x y 1 1))
(addd 3 5)
(apropos 'addd)
;;  conditionals and return values
(if (= 3 2) (print "hi") (print "bye"))
(stringp (if (= 3 2) (print "hi") (print "bye")))
(defun manycases (x)
  (cond ((= x 1) (print "first"))
	((= x 2) (print "second"))
	((= x 3) (print "third"))
	((= x 4) (print "fourth"))
	(t (print "any remaining cases"))))
(manycases 1)
(manycases 2)
(manycases 3)
(manycases 4)
(manycases 5)
;;;; recursion + timing 
(defun factorial (x)
       (if (zerop x) 
           1
           (* x (factorial (1- x)))))
(factorial 3)
(factorial 10)
(trace factorial)
(factorial 3)
(factorial 10)
(untrace factorial)
(time (factorial 250))
(compile 'factorial)
(time (factorial 250))
(apropos 'factorial)
(describe 'factorial)

(defun mymax (nums)                      ;; finds the largest
  (cond ((= (length nums) 1) (car nums)) ;; termination
        ((> (car nums) (cadr nums))      ;; first > second so
         (mymax (cons (car nums) 
                      (cddr nums))))     ;; get rid of second
        (t (mymax (cdr nums)))))         ;; else dump first
(trace mymax)
(mymax '(1 3 412 43 1 1 3412 53 43 43 54))
(untrace mymax)
(time (mymax '(1 3 412 43 1 1 3412 53 43 43 54)))
(compile 'mymax)
(time (mymax '(1 3 412 43 1 1 3412 53 43 43 54)))
(setq x
      (make-array '(4 3) 
            :initial-contents 
            '((a b c)
             (1 2 3)
             (d e f)
             (3 1 2))))       
(aref x 0 0)
(aref x 1 0)
(aref x 0 1)
(setq y (make-array 3 :initial-contents '(a b c)))
(setf (aref y 0) 'd)
y
(mapcar '+ '(1 2 3) '(4 5 6)) 
(mapcar '(lambda (x y) (+ x y 3))  '(1 2 3) '(4 5 6)) 
(apropos 'map)
(every '(lambda (x)  (> x 3))  '(4 5 6)) 
(apply '+ (list 10 2 3))
(apply '* (list 10 2 3))
(sort (list 2 1 3) '>)
(sort (list 2 1 3) '<)
(list (list 'b 2) (list 'a 1) (list 'c 3))
(sort (list (list 'b 2) (list 'a 1) (list 'c 3)) '<  :key 'cadr))
(sort (list (list 'b 2) (list 'a 1) (list 'c 3)) '>  :key 'cadr))

(setf h (make-hash-table)) ;; default is eql
(setf (gethash 'a h) 1)
(setf (gethash 'b h) 2)
(gethash 'c h)
(setf (gethash 'c h) t)
(gethash 'c h)
(gethash 'a h)

(load "towers-of-hanoi.lisp")
(Towers 4 1 3)
(time (Towers 5 1 3))
(compile-file "towers-of-hanoi.lisp")
(compile 'Towers)
(time (Towers 5 1 3))

;; For amusement, in Emacs type
;;M-x hanoi
;;C-u 5 M-x hanoi

;local variables
; let

(setq inside-var-1 999)
(let ((inside-var-1 10)
      (inside-var-2 5))
  (print inside-var-1)
  (print inside-var-2))
(print inside-var-1)

(defun distance (p1 p2)
  (let ((xdiff (- (car p1) (car p2)))
	(ydiff (- (car (cdr p1)) (car (cdr p2)))))
    (sqrt (+ (* xdiff xdiff) (* ydiff ydiff)))))

(distance (list 1 1) (list 5 5))
;;progn

(progn
  (print 1)
  (print 2)
  (print 3)
  (cons 1 2))

;; iterations  do and loop macro
(defun make-ascending-list (n)
  (do ((i n (- i 1))     ;internal variable i starts at n and counts down
       (lst '()          ;internal variable lst starts at nil and cons 
	    (cons i lst))) ;together i's 
      ((zerop i)         ;end condition is when i is zero 
       lst)))            ;at the end, return lst 

(make-ascending-list 10)

; printing to a file/reading from a file

(setq *thadz-stream* (open "thad" :direction :output))
(format *thadz-stream* "Print the following stream: ~%~%~S~%" "my string to print")
(close *thadz-stream*)

(setq *thadz-stream* (open "thad" :direction :input))
(setq *myvariable* (read *thadz-stream* nil *thadz-stream*))
(close *thadz-stream*)
;signalling errors
(error "oops")
(break)
;step

; macros
(defvar *name-list* (list (list "george" "burdell" "georgia tech") (list  "jack" "florey" "mit")))

(defmacro first-name (x) (list 'car x))
(defmacro last-name (x) `(cadr ,x))  ; an alternative way of doing it
(defmacro affiliation (x) (list 'caddr x))
(first-name (nth 0  *name-list*))
(last-name (nth 0  *name-list*))
(affiliation (nth 0  *name-list*))
(macroexpand '(affiliation (nth 0  *name-list*)))

;the loop macro: macros gone wild!

(loop for i in (list 1 2 3) do
      (print i))

(loop for i from 3.0 downto 1.0 by 0.5 do (print i))
(loop for i from 1 to 3 when (oddp i) do (print i))
(loop for i from 1 to 3 for x = (* i i) do (print x))
(loop for i from 1 to 3 sum (* i i))
(loop for i from 1 to 3 append (list i i))
(loop for i from 1 to 3 until (< 2 i) do (print i))
(loop for i from 1 to 3 while (< i 2) do (print i))

(setf h (make-hash-table))
(setf (gethash 'a h) 1)
(setf (gethash 'b h) 2)
(loop for k being the hash-key of h do (print k))
(loop for v being the hash-value of h do (print v))
(loop for k being the hash-key using (hash-value v) of h do (format t "~a ~a~%" k v))

;; Common Lisp Object System (CLOS)

(defclass person ()
  ((name :accessor person-name
         :initform 'bill
         :initarg :name)
   (age :accessor person-age
        :initform 10
        :initarg :age)))

(setq p1 (make-instance 'person :name 'jill :age 100))
(person-name p1)
(person-age p1)
(setf (person-age p1) 101)
(person-age p1)
(describe p1)

;CLOS example of defining classes and methods

(defclass food () ())

(defmethod cook :before ((f food))
  (print "A food is about to be cooked."))

(defmethod cook :after ((f food))
  (print "A food has been cooked."))

(defclass pie (food)
  ((filling :accessor pie-filling 
	        :initarg :filling
		    :initform 'apple)))

(defmethod cook ((p pie))
  (print "Cooking a pie.")
  (setf (pie-filling p) (list 'cooked (pie-filling p))))

(defmethod cook :before ((p pie))
  (print "A pie is about to be cooked."))

(defmethod cook :after ((p pie))
  (print "A pie has been cooked."))

(setq pie-1 (make-instance 'pie :filling 'apple))

(cook pie-1)

;making CLOS multi-methods using default classes
;more specific classes override more general ones (superclasses)

(defmethod test ((x number) (y number))
  '(num num))

(defmethod test ((i integer) (y number))
  '(int num))

(defmethod test ((x number) (j integer))
  '(num int))

(test 1 1) 
(test 1 1/2) 
(test 1/2 1) 
(test 1/2 1/2)

;; Lisp Style & Design [Miller and Benson]


;(break "You got here with arguments: ~:S." '(FOO 37 A))