;; C311 Programming Languages 
;; 10/31/2007
;; Dana Vrajitoru
;; Defining a binary tree in Lisp and writing a tree traversal
;; function both recursively and non-recursively.

; Returns the root of the tree
(defun root (T) 
  "The root of the tree."
  (if T (car T)))

; Returns the left subtree, the whole structure. The left child would
; be the root of this subtree.
(defun left_subtree (T) 
  "The left child, also a list."
  (if (and T (cdr T))
      (car (cdr T)))) ; (cadr T)

; Returns the right subtree.
(defun right-subtree (T) 
  "The right child, also a list."
  (if (> (length T) 2)
      (car (cdr (cdr T))))) ; (caddr T)

; The tree from the class handouts
(setq S '(23 (51 (18) (33 (5))) (7 () (10))))

; Testing the functions above
(root S)
23

(root (left_subtree S))
51
(left_subtree (left_subtree S))
(18)
(root (left_subtree (right-subtree (left_subtree S))))
5
(right-subtree (right-subtree S))
(10)
(left_subtree (right-subtree S))
nil
(root (left_subtree (right-subtree S)))
nil

(left_subtree (left_subtree (left_subtree S)))
nil

; The nice printing function that takes as many arguments as we want.
(defun my-print (&rest L)
  (mapc 'princ L))

; Printing the tree in pre-order
(defun print-preorder (T)
  "Prints the tree in preorder. Root - L - R"
  (if T
      (progn 
	(my-print (root T) " ")
	(print-preorder (left_subtree T))
	(print-preorder (right-subtree T)))))

(print-preorder S)
23 51 18 33 5 7 10 nil

S
(23 (51 (18) (33 (5))) (7 nil (10)))

; The first iterative version with the states stored on the stack
; along with the tree.
(defun print-preor (T)
  "Prints the list in preorder without recursion."
  (let ((stackT nil) (locT nil) (frame nil) (state nil))
    (push (cons T 'root) stackT)
    (while stackT
      (setq frame (pop stackT))
      (setq locT (car frame) state (cdr frame))
      (if locT
	  (cond ((eq state 'root)
		 (my-print (root locT) " ")
		 (push (cons locT 'left) stackT))
		((eq state 'left)
		 (push (cons locT 'right) stackT)
		 (push (cons (left_subtree locT) 'root) stackT))
		((eq state 'right)
		 (push (cons (right-subtree locT) 'root) stackT)))))))

(print-preor S)
23 51 18 33 5 7 10 nil

; The optimization that eliminates the states.
(defun print-preord (T)
  "An optimization of the function above."
  (let ((stackT ()) (locT T))
    (while locT
      (my-print (root locT) " ")
      (push locT stackT)
      (setq locT (left_subtree locT)))
    (while stackT
      (setq locT (pop stackT))
      (setq locT (right-subtree locT))
      (while locT
	(my-print (root locT) " ")
	(push locT stackT)
	(setq locT (left_subtree locT))))))

(print-preord S)
23 51 18 33 5 7 10 nil