Added laid out tree drawing function, and implemented p66.
Pascal J. Bourguignon [2011-01-10 09:12]
Added laid out tree drawing function, and implemented p66.
diff --git a/index.html b/index.html
index 3991219..545db32 100644
--- a/index.html
+++ b/index.html
@@ -158,15 +158,6 @@ P60 (**) Construct height-balanced binary trees with a given number of nodes
Find out how many height-balanced trees exist for N = 15.
-P66 (***) Layout a binary tree (3)
- [p66]
- Yet another layout strategy is shown in the illustration opposite. The method yields a very compact layout while maintaining a certain symmetry in every node. Find out the rules and write the corresponding Prolog predicate. Hint:
- Consider the horizontal distance between a node and its successor nodes. How tight can you pack together two subtrees to construct the combined binary tree?
-
- Use the same conventions as in problem P64 and P65 and test your predicate in an appropriate way. Note: This is a difficult problem. Don't give up too early!
-
- Which layout do you like most?
-
P67 (**) A string representation of binary trees
[p67]
diff --git a/p54a.lisp b/p54a.lisp
index e86c567..bc91b0f 100644
--- a/p54a.lisp
+++ b/p54a.lisp
@@ -62,6 +62,13 @@ P54A (*) Check whether a given term represents a binary tree
;; (binary-tree-p (binary-tree-from-sexp '(a (b (d nil nil) (e nil nil)) (c nil nil))))
+(defun binary-tree-height (tree)
+ (if (binary-tree-empty-p tree)
+ 0
+ (+ 1 (max (binary-tree-height (binary-tree-left tree))
+ (binary-tree-height (binary-tree-right tree))))))
+
+
(defparameter *tree-0* 'nil)
diff --git a/p64.lisp b/p64.lisp
index 02e1498..00da85f 100644
--- a/p64.lisp
+++ b/p64.lisp
@@ -105,6 +105,49 @@ Returns the last abscissa used.
+(defun binary-tree-rightmost-node (tree)
+ (unless (binary-tree-empty-p tree)
+ (if (binary-tree-empty-p (binary-tree-right tree))
+ tree
+ (binary-tree-rightmost-node (binary-tree-right tree)))))
+
+
+(defun draw-laid-out-node (node picture)
+ (let* ((label (princ-to-string (binary-tree-label node)))
+ (lab (case (length label)
+ ((0) " . ")
+ ((1) (format nil " ~A " label))
+ ((2) (format nil " ~A" label))
+ ((3) label)
+ (otherwise (subseq label 0 3))))
+ (height (com.informatimago.common-lisp.picture.picture:height picture))
+ (2x (* 2 (layout-binary-tree-x node)))
+ (2y (- height (* 2 (layout-binary-tree-y node)))))
+ (com.informatimago.common-lisp.picture.picture:draw-string
+ picture (1- 2x) 2y lab)
+ (when (binary-tree-left node)
+ (com.informatimago.common-lisp.picture.picture:draw-string
+ picture (1- 2x) (1- 2y) "/")
+ (draw-laid-out-node (binary-tree-left node) picture))
+ (when (binary-tree-right node)
+ (com.informatimago.common-lisp.picture.picture:draw-string
+ picture (1+ 2x) (1- 2y) "\\")
+ (draw-laid-out-node (binary-tree-right node) picture))
+ picture))
+
+
+(defun draw-laid-out-tree (tree)
+ (let* ((height (* 2 (binary-tree-height tree)))
+ (rightmost (binary-tree-rightmost-node tree))
+ (width (* 4 (1+ (layout-binary-tree-x rightmost))))
+ ;; N
+ ;; / \
+ ;; K U
+ (picture (make-instance 'com.informatimago.common-lisp.picture.picture:picture
+ :width width :height height)))
+ (draw-laid-out-node tree picture)))
+
+
(assert (equal (layout-binary-tree-p64 (complete-binary-tree 7))
'(1
(2 (4 NIL NIL 1 3) (5 NIL NIL 3 3) 2 2)
@@ -140,5 +183,43 @@ Returns the last abscissa used.
NIL 11 2)
8 1)))
+;; (list
+;; (draw-laid-out-tree (layout-binary-tree-p64 (complete-binary-tree 7)))
+;; (draw-laid-out-tree (layout-binary-tree-p64 (construct '(n k c a e d g m u p q) (function string<))))
+;; (draw-laid-out-tree (layout-binary-tree-p64 (construct '(n k c a h g e m u p s q) (function string<)))))
+;;
+;; (
+;; 1
+;; / \
+;; 2 3
+;; / \ / \
+;; 4 5 6 7
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A E Q
+;; / \
+;; D G
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A H S
+;; / /
+;; G Q
+;; /
+;; E
+;; )
+
+
;;;; THE END ;;;;
diff --git a/p65.lisp b/p65.lisp
index c7780e1..c6cff5d 100644
--- a/p65.lisp
+++ b/p65.lisp
@@ -24,11 +24,6 @@ P65 (**) Layout a binary tree (2)
(load "p54a")
-(defun binary-tree-height (tree)
- (if (binary-tree-empty-p tree)
- 0
- (+ 1 (max (binary-tree-height (binary-tree-left tree))
- (binary-tree-height (binary-tree-right tree))))))
(defun binary-tree-count-leftmosts (tree)
(if (binary-tree-empty-p tree)
@@ -80,5 +75,41 @@ The abscissa of the children is offset by (expt 2 height).
NIL 23 2) 15 1)))
+;; (list
+;; (draw-laid-out-tree (layout-binary-tree-p65 (complete-binary-tree 7)))
+;; (draw-laid-out-tree (layout-binary-tree-p65 (construct '(n k c a e d g m u p q) (function string<))))
+;; (draw-laid-out-tree (layout-binary-tree-p65 (construct '(n k c a h g e m u p s q) (function string<)))))
+;;
+;; (
+;; 1
+;; / \
+;; 2 3
+;; / \ / \
+;; 4 5 6 7
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A E Q
+;; / \
+;; D G
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A H S
+;; / /
+;; G Q
+;; /
+;; E
+;; )
;;;; THE END ;;;;
diff --git a/p66.lisp b/p66.lisp
new file mode 100644
index 0000000..da4930a
--- /dev/null
+++ b/p66.lisp
@@ -0,0 +1,228 @@
+#-(and) "
+
+P66 (***) Layout a binary tree (3)
+
+ Yet another layout strategy is shown in the illustration
+ opposite. The method yields a very compact layout while
+ maintaining a certain symmetry in every node. Find out the rules
+ and write the corresponding Prolog predicate. Hint:
+
+ Consider the horizontal distance between a node and its successor
+ nodes. How tight can you pack together two subtrees to construct
+ the combined binary tree?
+
+ Use the same conventions as in problem P64 and P65 and test your
+ predicate in an appropriate way. Note: This is a difficult
+ problem. Don't give up too early!
+
+ Which layout do you like most?
+
+"
+
+
+;; 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 at least
+;; one unit, more to accumodate the width of the subtrees, with the
+;; constraint that two nodes (possibly of different subtrees) be
+;; spaced by two units.
+;;
+;; 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.
+
+
+
+
+;; to let subtrees come as close the possible one to the other, we
+;; will keep the left and right offsets for all levels below the node.
+;; The offsets are kept in a list from the child down to the leaves,
+;; relative to the node abscissa.
+
+(defstruct (jagged-layout-binary-tree (:include layout-binary-tree)
+ (:type list))
+ left-offsets right-offsets)
+
+
+
+(defun jag-layout-binary-tree (tree depth)
+ "
+Builds a jagged-layout-binary-tree homologue to TREE, with offsets
+computed to let subtrees be as close as possible.
+"
+ (if (binary-tree-empty-p tree)
+ (make-empty-binary-tree)
+ (if (binary-tree-empty-p (binary-tree-left tree))
+ (if (binary-tree-empty-p (binary-tree-right tree))
+ ;; leaf
+ (make-jagged-layout-binary-tree
+ :label (binary-tree-label tree)
+ :x 0
+ :y depth
+ :left-offsets '()
+ :right-offsets '())
+ ;; only right child.
+ (let ((right (jag-layout-binary-tree (binary-tree-right tree) (1+ depth))))
+ (make-jagged-layout-binary-tree
+ :label (binary-tree-label tree)
+ :x 0
+ :y depth
+ :right right
+ :left-offsets (cons 1 (mapcar (function 1+) (jagged-layout-binary-tree-left-offsets right)))
+ :right-offsets (cons 1 (mapcar (function 1+) (jagged-layout-binary-tree-right-offsets right))))))
+ (if (binary-tree-empty-p (binary-tree-right tree))
+ ;; only left child.
+ (let ((left (jag-layout-binary-tree (binary-tree-left tree) (1+ depth))))
+ (make-jagged-layout-binary-tree
+ :label (binary-tree-label tree)
+ :x 0
+ :y depth
+ :left left
+ :left-offsets (cons -1 (mapcar (function 1-) (jagged-layout-binary-tree-left-offsets left)))
+ :right-offsets (cons -1 (mapcar (function 1-) (jagged-layout-binary-tree-right-offsets left)))))
+ ;; both left and right children.
+ (let* ((left (jag-layout-binary-tree (binary-tree-left tree) (1+ depth)))
+ (right (jag-layout-binary-tree (binary-tree-right tree) (1+ depth)))
+ ;; 0 0
+ ;; \ /
+ ;; right 2 left
+ (offset (/ (+ 2 (reduce (function max)
+ (mapcar (function -)
+ (jagged-layout-binary-tree-right-offsets left)
+ (jagged-layout-binary-tree-left-offsets right))
+ :initial-value 0))
+ 2)))
+ (make-jagged-layout-binary-tree
+ :label (binary-tree-label tree)
+ :x 0
+ :y depth
+ :left left
+ :right right
+ :left-offsets (cons (- offset) (mapcar (lambda (x) (- x offset))
+ (jagged-layout-binary-tree-left-offsets left)))
+ :right-offsets (cons (+ offset) (mapcar (lambda (x) (+ x offset))
+ (jagged-layout-binary-tree-right-offsets right)))))))))
+
+
+(defun jagged-layout-binary-tree-complete-layout (tree offset)
+ (unless (binary-tree-empty-p tree)
+ (incf (layout-binary-tree-x tree) offset)
+ (when (binary-tree-left tree)
+ (jagged-layout-binary-tree-complete-layout
+ (binary-tree-left tree)
+ (+ offset (car (jagged-layout-binary-tree-left-offsets tree)))))
+ (when (binary-tree-right tree)
+ (jagged-layout-binary-tree-complete-layout
+ (binary-tree-right tree)
+ (+ offset (car (jagged-layout-binary-tree-right-offsets tree)))))
+ tree))
+
+
+
+(defun layout-binary-tree-p66 (tree)
+ (let ((jtree (jag-layout-binary-tree tree 1)))
+ (jagged-layout-binary-tree-complete-layout jtree (- (reduce (function min)
+ (jagged-layout-binary-tree-left-offsets jtree))))
+ jtree))
+
+
+;; (list
+;; (draw-laid-out-tree (layout-binary-tree-p66 (complete-binary-tree 7)))
+;; (draw-laid-out-tree (layout-binary-tree-p66 (construct '(n k c a e d g m u p q) (function string<))))
+;; (draw-laid-out-tree (layout-binary-tree-p66 (construct '(n k c a h g e m u p s q) (function string<)))))
+;;
+;; (
+;; 1
+;; / \
+;; 2 3
+;; / \ / \
+;; 4 5 6 7
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A E Q
+;; / \
+;; D G
+;;
+;;
+;; N
+;; / \
+;; K U
+;; / \ /
+;; C M P
+;; / \ \
+;; A H S
+;; / /
+;; G Q
+;; /
+;; E
+;; )
+
+
+
+;; I prefer draw-tree, which uses nice unicode characters, and rotates
+;; the tree 90 degree so that it can draw wider trees. :-)
+;;
+;; (draw-tree (construct '(n k c a h g e m u p s q) (function string<)))
+;;
+;;
+;; ┌─── nil
+;; ╔═╧═╗
+;; ┌───╢ U ║
+;; │ ╚═╤═╝
+;; │ │ ┌─── nil
+;; │ │ ╔═╧═╗
+;; │ │ ┌───╢ S ║
+;; │ │ │ ╚═╤═╝ ┌─── nil
+;; │ │ │ │ ╔═╧═╗
+;; │ │ │ └───╢ Q ║
+;; │ │ │ ╚═╤═╝
+;; │ │ │ └─── nil
+;; │ │ ╔═╧═╗
+;; │ └───╢ P ║
+;; │ ╚═╤═╝
+;; │ └─── nil
+;; ╔═╧═╗
+;; ╢ N ║
+;; ╚═╤═╝
+;; │ ┌─── nil
+;; │ ╔═╧═╗
+;; │ ┌───╢ M ║
+;; │ │ ╚═╤═╝
+;; │ ╔═╧═╗ └─── nil
+;; └───╢ K ║
+;; ╚═╤═╝
+;; │ ┌─── nil
+;; │ ╔═╧═╗
+;; │ ┌───╢ H ║
+;; │ │ ╚═╤═╝ ┌─── nil
+;; │ │ │ ╔═╧═╗
+;; │ │ └───╢ G ║
+;; │ │ ╚═╤═╝ ┌─── nil
+;; │ │ │ ╔═╧═╗
+;; │ │ └───╢ E ║
+;; │ │ ╚═╤═╝
+;; │ │ └─── nil
+;; │ │
+;; │ ╔═╧═╗
+;; └───╢ C ║
+;; ╚═╤═╝ ┌─── nil
+;; │ ╔═╧═╗
+;; └───╢ A ║
+;; ╚═╤═╝
+;; └─── nil
+
+
+
+;; No, really p66 is nice a compact layout, but it has the problem
+;; that it doesn't accomodate wider labels (and neither do p64, and
+;; p65). Since draw-tree draws the labels perpendicularly, it doesn't
+;; have any problem with longer labels .
+
+
+;;;; THE END ;;;;