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