;;; This file contains solutions to  programming assignment 1 for
;;; CISC681 in Spring 2008

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the following functions use the (node left right) representation
;; of a binary tree.  node is an integer, left is a representation of the
;; left subtree, and right is the representation of the right subtree

(defun left-subtree (bt)
"takes a b-tree and returns the left subtree"
(cadr bt))

(defun right-subtree (bt)
"takes a b-tree and returns the right subtree"
(caddr bt))

(defun is-in-tree? (n bt)
"takes a number and an ordered binary tree, bt, and
 returns non-nil if n is in the tree"
(cond ((null bt) nil)
      ((equal n (car bt)) t)
      ((< n (car bt)) (is-in-tree? n (left-subtree bt)))
      ((is-in-tree? n (right-subtree bt)))))

(defun insert (n bt)
"takes an integer, n, and a binary tree, bt, and returns a 
 new binary tree with n inserted in the correct position"
(cond ((null bt) (list n nil nil))
      ((<= n (car bt)) (list (car bt)
			    (insert n (left-subtree bt))
			    (right-subtree bt)))
      ((list (car bt)
	     (left-subtree bt)
	     (insert n (right-subtree bt))))))


(defun insert-list (list-of-integers bt)
"takes a list of integers and inserts them into the
 ordered binary tree bt"
(cond ((null list-of-integers) bt)
      ((insert-list (cdr list-of-integers) 
		    (insert (car list-of-integers) bt)))))

(defun make-bt (list-of-integers)
"takes a list of integers and forms an ordered binary tree"
(cond ((null list-of-integers) nil)
      ((insert-list (cdr list-of-integers) 
		    (list (car list-of-integers) nil nil)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rep-seq (int-lst)
  "Takes a list of positive integers and returns a list of sublists -- 
   one for each positive integer in int-list repeated that integer
   number of times"
  (cond ((null int-lst) nil)
        ((cons (rep (car int-lst) (car int-lst))
               (rep-seq (cdr int-lst))))))

(defun rep (ele num)
  "Takes an s-exp, ele, and a positive integer, num.
   Returns a lisst containing ele repeated num times"
  (cond ((zerop num) nil)
        ((cons ele (rep ele (1- num))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sum-numbers (emb-list)
"takes an arbitrarily complex list and returns the sum of the numbers
 that occur anywhere in the list"
(cond ((null emb-list) 0)
      ((numberp (car emb-list)) (+ (car emb-list)
				   (sum-numbers (cdr emb-list))))
      ((atom (car emb-list)) (sum-numbers (cdr emb-list)))
      ((+ (sum-numbers (car emb-list))
	  (sum-numbers (cdr emb-list))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun typer (s-exp)
  "takes an arbitrarily complex s-expression and returns a new 
one with the same ``shape'' but with only symbols NUMBER and SYMBOL
corresponding to the type of the original atoms in the list."
  (cond ((null s-exp) nil)
	((numberp (car s-exp)) (cons 'number
				     (typer (cdr s-exp))))
	((atom (car s-exp)) (cons 'symbol
				  (typer (cdr s-exp))))
	((cons (typer (car s-exp)) (typer (cdr s-exp))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun count-cells (s-exp)
  "Takes an arbitrafy s-expression and returns the number of list cells
   the s-expression uses"
  (cond ((atom s-exp) 0) ;nil is an atom
        ((+ 1 
            (count-cells (car s-exp))
            (count-cells (cdr s-exp))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pfeval (exp)
"takes a list containing a valid postfix expression consisting of
 numbers or the lisp-named binary operators -- the expression is
 evaluated and the number representing the value is returned"
(pfeval-stack (list (car exp)) (cdr exp)))

(defun pfeval-stack (stack rem-exp)
"takes as input a stack used in the evaluation of a valid postfix
 expression and the portion of the expression remaining -- evaluates
 the postfix expression returning a number"
(cond ((null rem-exp)
       ;;; only thing left in stack is a number which should be
       ;;; returned
       (car stack))
      ((numberp (car rem-exp))
       (pfeval-stack (cons (car rem-exp) stack) (cdr rem-exp)))
      ( t ;;; rem-exp is an operand with the two operands in 
	  ;;; top of stack
	(pfeval-stack (cons (eval (list (car rem-exp)
					(cadr stack)
					(car stack)))
			    (cddr stack))
		      (cdr rem-exp)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The following function uses a representation of a mobile. We can
;;; define a particularly simple type of mobile recursively as either
;;; a suspended object, or a beam with a sub-mobile hanging from each
;;; end. If we assume that each beam is suspend from its midpoint,
;;; then in order for the mobile to be balanced, the two submobiles
;;; hanging from a beam must have the same weight. 
 
;;; We can represent such a mobile as a binary tree. Single suspended
;;; objects are represented by numbers equal to their weight, while
;;; more complicated mobiles can be represented by a three-element
;;; list. The first element is a number equal to the weight of the
;;; beam, while the other two elements represent sub-mobiles attached
;;; at the two ends of the beam.

(defun mobilep (mobile)
"takes a mobile as input (as described above).  It determines whether
 or not the mobile is balanced.  If so, it returns the total weight.
 Nil is returned if the mobile is not balanced"
(cond ((numberp mobile) mobile)
      ((let ((left-weight (mobilep (cadr mobile)))
	     (right-weight (mobilep (caddr mobile))))
	 (cond ((or (null left-weight) (null right-weight)) nil)
	       ((equal left-weight right-weight)
		(+ (car mobile) left-weight right-weight)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chomper (lst)
  "takes a input a list containing 0's and 1's and a representation
   of an animal which eats 1's.  The animal may be in one of 3 states.
   V indicates the animal isn't moving -- in this state the animal
   should starting moving left if there is food there, if not it should
   start moving right if there is food there, if not it should quit
   printing out a message.  
   > indicates the animal is moving left and should continue to do so
   as long as there is food to the left, change to V otherwise.
   < indicates the animal is moving right and should continue to do so
   as long as there is food to the right, change to V otherwise.
   Each change should print out the current state of affairs."
  (let ((cleft (list-left-of-chomper lst))
        (chomper (get-chomper lst))
        (cright (list-right-of-chomper lst)))
    (cond ((equal chomper 'V)
           (cond ((member 1 cleft)
                  (print (append cleft (list '>) cright))
                  (chomper (append cleft (list '>) cright)))
                 ((member 1 cright)
                  (print (append cleft (list '<) cright))
                  (chomper (append cleft (list '<) cright)))
                 (t (terpri)
                    (princ "That's all, folks!")
                    (terpri))))
          ((and (equal chomper '>)(member 1 cleft))
           (print (append (butlast cleft) 
                          (list '>) 
                          (cons 0 cright)))
           (chomper (append (butlast cleft) 
                            (list '>) 
                            (cons 0 cright))))
          ((and (equal chomper '<)(member 1 cright))
           (print (append (append cleft (list 0))
                          (list '<) 
                          (cdr cright)))
           (chomper (append (append cleft (list 0))
                            (list '<) 
                            (cdr cright))))
          ((print (append cleft (list 'V) cright))
           (chomper (append cleft (list 'V) cright))))))

(defun list-left-of-chomper (lst)
  "takes a chomper list and returns a list consisting of the
   elements to the left of the chomper animal"
  (cond ((or (equal (car lst) 1)
             (equal (car lst) 0))
         (cons (car lst) (list-left-of-chomper (cdr lst))))
        (nil)))

(defun get-chomper (lst)
  "takes a chomper list and returns a list consisting of the
   chomper animal itself"
  (cond ((or (equal (car lst) 1)
             (equal (car lst) 0))
         (get-chomper (cdr lst)))
        ((car lst))))

(defun list-right-of-chomper (lst)
  "takes a chomper list and returns a list consisting of the
   elements to the right of the chomper animal"
  (cond ((or (equal (car lst) 1)
             (equal (car lst) 0))
         (list-right-of-chomper (cdr lst)))
        ((cdr lst))))