;;; structs
(defstruct item 
  "define an item"
  key (value 0))

(defstruct node 
  "define a tree of items"
  item l r (count 1) (N 1))

;;; accessor macros 
(defmacro node-key (h) 
  "join item to key"
  `(item-key (node-item ,h)))

(defmacro node-value (h) 
  "join item to value"
  `(item-value (node-item ,h)))
 
;;; accessor functions 
;; tree accessors
(defun r-key (h)
  "return right sub-tree's key or nil"
  (let ((r  (node-r h))) (if r (node-key r))))

(defun l-key (h)
  "return left sub-tree's key or nil"
  (let ((l (node-l h))) (if l (node-key l))))

(defun bst-min (bst)
  "return left most item"
  (and bst (or (bst-min (node-l bst)) bst)))

(defun bst-max (bst)
  "return right most item"
  (and bst (or (bst-max (node-r bst)) bst)))

;; general value accessors
(defmacro o (x) 
  "print a named value;
   e.g. (let ((a 22)) (o a)) ==>  [a]=[22]"
  `(progn (format t "[~a]=[~a]~%" (quote ,x) ,x) ,x))

(defmacro oo (&rest l)
  "print a list of names values;
   e.g. (let ((aa 22) (b 33)) (oo a b)) ==> [a]=22;[b]=[33]"
  `(progn ,@(mapcar #'(lambda(x) `(o ,x)) l)))

;;; tree reports
(defun btreep (h &optional (less nil) (more nil) (< #'<) (verbose nil))
  "is this a binary search tree?"
   (if (null h) ; tree may be nil
	t
	(and    ; otherwise, the keys have to be in order
	 (lessthan less more verbose <)
	 (btreep (node-l  h) (l-key    h) (node-key h) <)
	 (btreep (node-r  h) (node-key h) (r-key    h) <)
	 )))

(defun lessthan (x y verbose <)
  (or (lessthan1 x y <)
      (progn
	(if verbose
	    (format verbose "~a not less than ~a" x y))
	nil)))

(defun lessthan1 (x y <)
  (if (and x y) 
      (funcall < x y)
      t))

(defun bst-print (bst &optional (s t) (prefix "") (offset 0))
  "print a tree"
  (when bst
    (dotimes (i offset)
      (format s "|  "))
    (format  s "~a#~a = ~a~%" prefix 
	     (node-item bst) 
	     (node-N bst))
    (bst-print (node-l bst) s "<" (+ 1 offset))
    (bst-print (node-r bst) s ">" (+ 1 offset))))

;;; tree manipulation 
(defun rotR (h)
  "rotate right"
  (let ((x (node-l h))) 
    (setf (node-l h) (node-r x))
    (setf (node-r x) h)
    x))

(defun rotL (h)
  "rotate left"
  (let ((x (node-r h)))
    (setf (node-r h) (node-l x))
    (setf (node-l x) h)
    x))

(defun insertH (h x <)
  "insert item x into random binary search tree h"
  (cond  ((null h)
	  (make-node :item x))
	 ((< (random 1.0) (/ 1 (+ 1 (node-N h))))
	  (insertRoot h x <)) ; sometimes, insert at Root
	 (t
	  (incf (node-N h))
	  (cond  ((funcall < (item-key x) (node-key h))
		  (setf (node-l h) (insertH (node-l h) x <)))
		 ((eql (item-key x) (node-key h))
		  t
		  )
		 (t
		  (setf (node-r h) (insertH (node-r h) x <))))
	  
	  h)))

(defun insertRoot (h x <)
  "insert item x at top of tree h"
  (if (null h) 
      (make-node :item x)
      (cond ((funcall < (item-key x) (node-key h))
	     (setf (node-l h ) (insertRoot (node-l h) x <))
	     (setf h           (rotR h))
	     h)
	    ((eql (item-key x) (node-key h))
	     h
	     )
	    (t
	     (setf (node-r h) (insertRoot (node-r h) x <))
	     (setf h          (rotL h))
	     h))))

;;; demos
(defun demo1 (&optional (repeats 50) (max 10))
  "repeats timesDo: insert an item (with key 1..max) into tree"
  (let ((rbst nil))
    (dotimes (i repeats rbst)
      (let* ((n (random max))
	     (item (make-item :key n)))
	;(format t  "~a " n)
	(setf rbst (insertH rbst item #'<))))))

(defun demo2 (&optional quiet (repeats 50) (max 10))
  "print some randomly generated trees"
  (unless quiet
    (bst-print (demo1 repeats max))))

(defun demo3 ()
  "1000 times, check that our trees are binary trees"
  (dotimes (i 1000) (prin1 (if (btreep (demo1  50 20)) 0 i))))

(defun demo4a ()
  " 1 2 3"
  #S(NODE :ITEM #S(ITEM :KEY 2 :VALUE 0)
	  :L #S(NODE :ITEM #S(ITEM :KEY 1 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 1)
	  :R #S(NODE :ITEM #S(ITEM :KEY 3 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 3) :COUNT 1 :N 10))
(defun demo4b ()
  " 10 2 3"
  #S(NODE :ITEM #S(ITEM :KEY 2 :VALUE 0)
	  :L #S(NODE :ITEM #S(ITEM :KEY 10 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 1)
	  :R #S(NODE :ITEM #S(ITEM :KEY 3 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 3) :COUNT 1 :N 10))
(defun demo4c ()
  " 10 20 1"
  #S(NODE :ITEM #S(ITEM :KEY 20 :VALUE 0)
	  :L #S(NODE :ITEM #S(ITEM :KEY 10 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 1)
	  :R #S(NODE :ITEM #S(ITEM :KEY 1 :VALUE 0) 
		     :L NIL :R NIL :COUNT 1 :N 3) :COUNT 1 :N 10))
(defun demo4 ()
  (and      
   (btreep (demo4a))
   (not (btreep (demo4b)))
   (not (btreep (demo4c)))))


;;; culled stuff
;; (defun bst-insert (obj bst <)
;;   "
;;   (if (null bst)
;;       (setf bst (make-node :elt obj))
;;       (let ((elt (node-elt bst)))
;;         (if (eql obj elt)
;;             (incf (node-count bst))
;;             (if (funcall < obj elt)
;;                 (setf (node-l bst)
;; 		      (bst-insert obj (node-l bst) <))
;; 		(setf (node-r bst)
;; 		      (bst-insert obj (node-r bst) <))))))
;;   bst)