Corrected tree layout functions.

Pascal J. Bourguignon [2011-01-09 20:00]
Corrected tree layout functions.
Filename
p57.lisp
p64.lisp
p65.lisp
diff --git a/p57.lisp b/p57.lisp
index 420d4de..11b2946 100644
--- a/p57.lisp
+++ b/p57.lisp
@@ -129,12 +129,32 @@ Modifies the TREE, adding a new leaf labelled with the ITEM, ordered by LESSP."
       (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 <)))
+
+(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 ;;;;
diff --git a/p64.lisp b/p64.lisp
index fdadf63..02e1498 100644
--- a/p64.lisp
+++ b/p64.lisp
@@ -32,7 +32,7 @@ P64 (**) Layout a binary tree (1)
 (load "p54a")


-;; To add the coordinate, we create a new structure, which inherits
+;; To add the coordinates, we create a new structure, which inherits
 ;; from the binary-tree structure, so we can reuse that abstraction.
 ;; However, including structures will make the new fields added at the
 ;; end of it.  The order of the fields should be immaterial (only that
@@ -90,28 +90,55 @@ Sets the abscissa of each node in the subtree NODE to a sequence of
 values starting from (1+ ABSCISSA) for the left-most node.
 Returns the last abscissa used.
 "
-  (cond
-    ((binary-tree-empty-p (binary-tree-left node))
-     (setf (layout-binary-tree-x node) (incf abscissa)))
-    ((binary-tree-empty-p (binary-tree-right node))
-     (setf (layout-binary-tree-x node)
-           (layout-node-abscissa/inorder (binary-tree-left node)
-                                         abscissa)))
-    (t
-     (layout-node-abscissa/inorder (binary-tree-right node)
-                                   (1+ (setf (layout-binary-tree-x node)
-                                             (layout-node-abscissa/inorder (binary-tree-left node)
-                                                                           abscissa)))))))
-
-(defun layout-binary-tree/inorder/depth (tree)
-  ""
-  (let ((lobt (layout-node-depth tree 0)))
+  (when (binary-tree-left node)
+    (setf abscissa (layout-node-abscissa/inorder (binary-tree-left node) abscissa)))
+  (setf (layout-binary-tree-x node) (incf abscissa))
+  (when (binary-tree-right node)
+    (setf abscissa (layout-node-abscissa/inorder (binary-tree-right node) abscissa)))
+  abscissa)
+
+
+(defun layout-binary-tree-p64 (tree)
+  (let ((lobt (layout-node-depth tree 1)))
     (layout-node-abscissa/inorder lobt 0) ; starts from 1; use -1 to start from 0.
     lobt))


-;; (layout-binary-tree/inorder/depth  (complete-binary-tree 5))

+(assert (equal (layout-binary-tree-p64  (complete-binary-tree 7))
+               '(1
+                 (2 (4 NIL NIL 1 3) (5 NIL NIL 3 3) 2 2)
+                 (3 (6 NIL NIL 5 3) (7 NIL NIL 7 3) 6 2)
+                 4 1)))
+
+(assert (equal (layout-binary-tree-p64   (construct '(n k c a h g e m u p s q) (function string<)))
+               '(N (K (C (A NIL NIL 1 4)
+                       (H (G (E NIL NIL 3 6)
+                             NIL 4 5)
+                          NIL 5 4)
+                       2 3)
+                    (M NIL NIL 7 3)
+                    6 2)
+                 (U (P NIL
+                       (S (Q NIL NIL 10 5)
+                          NIL 11 4)
+                       9 3)
+                    NIL 12 2)
+                 8 1)))
+
+(assert (equal (layout-binary-tree-p64   (construct '(n k c a e d g m u p q) (function string<)))
+               '(N (K (C (A NIL NIL 1 4)
+                       (E (D NIL NIL 3 5)
+                          (G NIL NIL 5 5)
+                          4 4)
+                       2 3)
+                    (M NIL NIL 7 3)
+                    6 2)
+                 (U (P NIL
+                       (Q NIL NIL 10 4)
+                       9 3)
+                    NIL 11 2)
+                 8 1)))

 ;;;; THE END ;;;;

diff --git a/p65.lisp b/p65.lisp
index 0f340f7..c7780e1 100644
--- a/p65.lisp
+++ b/p65.lisp
@@ -11,6 +11,19 @@ P65 (**) Layout a binary tree (2)

 "

+
+;; The rule seems to be that the ordinate is the depth of the node,
+;; and the abscissa of a node is offset from the parent by 2^height of the node.
+;;
+;; The abscissa of the leftmost node is fixed to 1,
+;; and the ordinate of the root is fixed to 1.
+;;
+;; height of the tree = depth of node + height of node.
+
+
+(load "p54a")
+
+
 (defun binary-tree-height (tree)
   (if (binary-tree-empty-p tree)
       0
@@ -30,25 +43,42 @@ The abscissa of the children is offset by (expt 2 height).
 "
   (setf (layout-binary-tree-x node) abscissa
         (layout-binary-tree-y node) depth)
-  (let ((offset (expt 2 height)))
+  (let* ((height-1 (1- height))
+         (depth+1  (1+ depth))
+         (offset   (expt 2 height-1)))
     (unless (binary-tree-empty-p (binary-tree-left node))
       (layout-node-p65 (binary-tree-left node)
                        (- abscissa offset)
-                       (1+ depth)
-                       (1- height)))
+                       depth+1
+                       height-1))
     (unless (binary-tree-empty-p (binary-tree-right node))
       (layout-node-p65 (binary-tree-right node)
                        (+ abscissa offset)
-                       (1+ depth)
-                       (1- height))))
+                       depth+1
+                       height-1)))
   node)


 (defun layout-binary-tree-p65 (tree)
   (let ((height (binary-tree-height tree)))
     (layout-node-p65 (binary-tree-to-layout-binary-tree tree)
-                     (expt 2  height)
-                     0
-                     height)))
+                     (1+ (- (expt 2 (1- height))
+                            (expt 2 (- height (binary-tree-count-leftmosts tree)))))
+                     1
+                     (1- height))))
+
+
+(assert (= 4 (binary-tree-count-leftmosts (construct '(n k c a e d g m u p q) (function string<)))))
+(assert (= 5 (binary-tree-height          (construct '(n k c a e d g m u p q) (function string<)))))
+(assert (equal (layout-binary-tree-p65    (construct '(n k c a e d g m u p q) (function string<)))
+               '(N (K (C (A NIL NIL 1 4)
+                       (E (D NIL NIL 4 5)
+                          (G NIL NIL 6 5) 5 4) 3 3)
+                    (M NIL NIL 11 3) 7 2)
+                 (U (P NIL
+                       (Q NIL NIL 21 4) 19 3)
+                    NIL 23 2) 15 1)))
+
+

 ;;;; THE END ;;;;
ViewGit