#-(and) "

P57 (**) Binary search trees (dictionaries)

    Use the predicate add/3, developed in chapter 4 of the course, to
    write a predicate to construct a binary search tree from a list of
    integer numbers.

    Example:
    * construct([3,2,5,7,1],T).
    T = t(3, t(2, t(1, nil, nil), nil), t(5, nil, t(7, nil, nil)))

    Then use this predicate to test the solution of the problem P56.
    Example:
    * test-symmetric([5,3,18,1,4,12,21]).
    Yes
    * test-symmetric([3,2,5,7,1]).
    No
"



;; Functional solution: we build a new tree, that may refer to subtrees in the old tree.

(defun binary-tree-add-child (tree child leftp)
  "
Returns a new tree like TREE, but where the CHILD in a new leaf tree
either on the left or right of the TREE.  The TREE tree must not have
previously a child in that position.
"
  (assert (not (binary-tree-empty-p tree)))
  (assert (binary-tree-empty-p (if leftp
                                   (binary-tree-left  tree)
                                   (binary-tree-right tree))))
  (make-binary-tree :label (binary-tree-label tree)
                    :left  (if leftp
                               (make-binary-tree :label child)
                               (binary-tree-left  tree))
                    :right (if leftp
                               (binary-tree-right  tree)
                               (make-binary-tree :label child))))


(defun binary-tree-add-item (tree item lessp)
  (if (funcall lessp item (binary-tree-label tree))
      ;; add on the left:
      (if (binary-tree-empty-p (binary-tree-left tree))
          (binary-tree-add-child tree item t)
          (make-binary-tree :label (binary-tree-label tree)
                            :left (binary-tree-add-item (binary-tree-left tree) item lessp)
                            :right (binary-tree-right tree)))
      ;; add on the right:
      (if (binary-tree-empty-p (binary-tree-right tree))
          (binary-tree-add-child tree item nil)
          (make-binary-tree :label (binary-tree-label tree)
                            :left (binary-tree-left tree)
                            :right (binary-tree-add-item (binary-tree-right tree) item lessp)))))

(defun binary-tree-add-items (tree items lessp)
  (if (endp items)
      tree
      (binary-tree-add-items (binary-tree-add-item tree (first items) lessp)
                             (rest items) lessp)))


(defun construct (data lessp)
  (if (endp data)
      (make-empty-binary-tree)
      (binary-tree-add-items (make-binary-tree :label (first data)) (rest data) lessp)))


;; (construct '(3 2 5 7 1) (function <))
;; --> (3 (2 (1 NIL NIL) NIL) (5 NIL (7 NIL NIL)))
;; (binary-tree-symetric-p (construct '(5 3 18 1 4 12 21) (function <)))
;; --> T
;; (binary-tree-symetric-p (construct '(3 2 5 7 1) (function <)))
;; --> T
;; (binary-tree-symetric-p (construct '(1 2 3 4 5) (function <)))
;; --> NIL



;; Procedural solution: the tree is modified in place.

(defun binary-tree-add-child (tree child leftp)
  "
Returns tree.
The tree is modified, with child being set either as a new leaf child, left or right.
either on the left or right of the TREE.  The TREE tree must not have
previously a child in that position.
"
  (assert (not (binary-tree-empty-p tree)))
  (assert (binary-tree-empty-p (if leftp
                                   (binary-tree-left  tree)
                                   (binary-tree-right tree))))

  (if leftp
      (setf (binary-tree-left  tree) (make-binary-tree :label child))
      (setf (binary-tree-right tree) (make-binary-tree :label child)))
  tree)


(defun binary-tree-add-item (tree item lessp)
  "
Returns tree.
Modifies the TREE, adding a new leaf labelled with the ITEM, ordered by LESSP."
  (if (funcall lessp item (binary-tree-label tree))
      ;; add on the left:
      (if (binary-tree-empty-p (binary-tree-left tree))
          (binary-tree-add-child tree item t)
          (binary-tree-add-item (binary-tree-left tree) item lessp))
      ;; add on the right:
      (if (binary-tree-empty-p (binary-tree-right tree))
          (binary-tree-add-child tree item nil)
          (binary-tree-add-item (binary-tree-right tree) item lessp)))
  tree)


(defun binary-tree-add-items (tree items lessp)
  (loop
     :for item :in items
     :do (binary-tree-add-item tree item lessp))
  tree)


(defun construct (data lessp)
  (if (endp data)
      (make-empty-binary-tree)
      (binary-tree-add-items (make-binary-tree :label (first data)) (rest data) lessp)))



(assert (equal (construct '(3 2 5 7 1) (function <))
               '(3 (2 (1 NIL NIL) NIL) (5 NIL (7 NIL NIL)))))
(assert (binary-tree-symetric-p (construct '(5 3 18 1 4 12 21) (function <))))
(assert (binary-tree-symetric-p (construct '(3 2 5 7 1) (function <))))
(assert (binary-tree-symetric-p (construct '(1 2 3 4 5) (function <))))

(assert (equal
         (construct '(n k c a e d g m u p q) (function string<))

         (make-binary-tree
          :label 'n
          :left  (make-binary-tree
                  :label 'k
                  :left  (make-binary-tree
                          :label 'c
                          :left  (make-binary-tree :label 'a)
                          :right (make-binary-tree
                                  :label 'e
                                  :left  (make-binary-tree :label 'd)
                                  :right (make-binary-tree :label 'g)))
                  :right (make-binary-tree :label 'm))
          :right (make-binary-tree
                  :label 'u
                  :left (make-binary-tree
                         :label 'p
                         :right (make-binary-tree :label 'q))))))

;;;; THE END ;;;;
ViewGit