; (comment) ; for old times sake

; Swinging from trees
; CMSC421 Project 2
; Don Hopkins

; Macro that takes a node-name, search-value, argument-list, and function.
; Applies the function to the argument-list to get the index-value.
; Puts the search-value and index-value on the node-name as properties.
; Adds the node to the tree in *TREE*.
(defmacro == (name search arg func)
  `((lambda (name search index)
     (putprop name search 'search-value)
     (putprop name index 'index-value)
     (grow *TREE* name index))
    ',name ',search (apply ',func ',arg)))

; Grabs the name out of a node.
(defun node-name (node)
  (caar node))

; Obtains the node search value from the node's property list.
(defun node-search-value (node)
  (get (node-name node) 'search-value))

; Absconds with the index value of a node from its property list.
(defun node-index-value (node)
  (get (node-name node) 'index-value))

; Return the left child of a node.
(defun left-node (node)
  (cadar node))

; Return the socially acceptable child of a node.
(defun straight-node (node)
  (caddar node))

; Return the right child of a node.
(defun right-node (node)
  (cadddar node))

; Predicate returning true if a node is terminal, i.e. (nil).
(defun terminal-node-p (node)
  (null (car node)))

; Add a node to the tree in *TREE*, in the appropriate place.
(defun grow (tree name index)
  (cond
   ((terminal-node-p tree) ; We've reach the tip, so insert the node here
    (rplaca tree ; Danger Will Robinson! Watch where you point that cons!
	    (list ; replace the nil node in the tree with a new node
	     name ; name of the new node
	     (ncons nil) (ncons nil) (ncons nil)))) ; create terminal children
   ((lessp index (node-index-value tree)) ; This node belongs to the left.
    (grow (left-node tree) name index)) ; Pour it down the left subtree.
   ((greaterp index (node-index-value tree)) ; This node belongs to the right.
    (grow (right-node tree) name index)) ; Donate it to the right subtree.
   (t (grow (straight-node tree) name index)))) ; Goes in the straight subtree.

; Visit the nodes in depth-first order.
(defun depth-first (tree)
  (depth-first-traverse tree 0))

; The real depth first work gets done here.
(defun depth-first-traverse (tree level)
  (cond
   ((terminal-node-p tree) ; Bottomed out.
    (msg (B level) "[]" N)) ; Print pretty brackets.
   (t
    (msg (B level) (node-name tree) ; Announce where we're visiting.
	 ", Search value: " (node-search-value tree)
	 ", Index value: " (node-index-value tree)
	 N)
    (cond
     ((and ; Are all 3 child nodes terminal?
       (terminal-node-p (left-node tree))
       (terminal-node-p (straight-node tree))
       (terminal-node-p (right-node tree)))
      (ncons (node-name tree))) ; OK, return a list of our name.
     (t
      (append ; Return a list of the names of the nodes visited.
       (ncons (node-name tree))
       (depth-first-traverse (left-node tree) (+ level 1))
       (depth-first-traverse (straight-node tree) (+ level 1))
       (depth-first-traverse (right-node tree) (+ level 1))))))))

; Visit the nodes in breadth-first order.
(defun breadth-first (tree)
  (breadth-first-traverse (ncons tree)))

; Takes a list of nodes and recursivly expands each one to its children.
(defun breadth-first-traverse (trees)
  (cond
   ((null trees) ; None left: return
    nil)
   (t
    (mapcar #'(lambda (tree) ; Print out the nodes at this level.
		(cond ((terminal-node-p tree) (princ "[] "))
		      (t (princ (node-name tree))
			 (princ " "))))
	    trees)
    (terpri)
    (append ; return a list of nodes visited.
     (mapcan #'(lambda (tree) ; Nodes at this level
		 (cond ((terminal-node-p tree) nil)
		       (t (ncons (node-name tree)))))
	     trees)
     (breadth-first-traverse ; Nodes at the lower levels
      (mapcan #'(lambda (tree) ; Recursivly expand child nodes.
		  (cond ((terminal-node-p tree) nil)
			(t (list (left-node tree)
				 (straight-node tree)
				 (right-node tree)))))
	      trees))))))


; Visit the nodes in best-first order, according to the node search-values.
(defun best-first (tree)
  (best-first-traverse nil tree nil nil))

; And here's the interesting poop.
(defun best-first-traverse (trees left straight right)
  (let ((nodes-to-open ; Make a list of non-terminal child nodes.
	 (mapcan #'(lambda (tree)
		     (and (not (terminal-node-p tree))
			  (ncons tree)))
		 (list left straight right))))
    (mapcar #'(lambda (tree) ; Report on the ones opened.
		(msg "  Opening node: " (node-name tree) N))
	    nodes-to-open)
    (setq trees (sort (append nodes-to-open trees) ; Sort so best is first.
		      'test-search-value))
    (cond
     ((null trees) ; Anything left?
    nil)
   (t ; Close the first node on the list, and recurse, opening any children.
    (msg "Closing " ; Give the user an indication of what's going on.
	 (node-name (car trees))
	 " Value = "
	 (node-search-value (car trees)) N)
    (cons ; Return a list of the nodes visited.
     (node-name (car trees))
     (best-first-traverse (cdr trees) ; Go visit the rest.
			  (left-node (car trees))
			  (straight-node (car trees))
			  (right-node (car trees))))))))

; Compares the search-values of two nodes. True of n1 < n2.
(defun test-search-value (n1 n2)
  (lessp (node-search-value n1) (node-search-value n2)))