```#-(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
(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