#-(and) "
P64 (**) Layout a binary tree (1)
Given a binary tree as the usual Prolog term t(X,L,R) (or nil). As
a preparation for drawing the tree, a layout algorithm is required
to determine the position of each node in a rectangular
grid. Several layout methods are conceivable, one of them is shown
in the illustration below.
[p64]
In this layout strategy, the position of a node v is obtained by the following two rules:
□ x(v) is equal to the position of the node v in the inorder sequence
□ y(v) is equal to the depth of the node v in the tree
In order to store the position of the nodes, we extend the Prolog
term representing a node (and its successors) as follows:
% nil represents the empty tree (as usual)
% t(W,X,Y,L,R) represents a (non-empty) binary tree with root W
% \"positioned\" at (X,Y), and subtrees L and R
Write a predicate layout-binary-tree/2 with the following specification:
% layout-binary-tree(T,PT) :- PT is the \"positioned\" binary tree
% obtained from the binary tree T. (+,?)
Test your predicate in an appropriate way.
"
(load "p54a")
;; 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
;; we don't use true structures, but lists, so the new fields are
;; added at the end of the lists, compared to the included list
;; structures).
(defstruct (layout-binary-tree (:include binary-tree)
(:type list))
x y)
(defun binary-tree-to-layout-binary-tree (tree)
"
Return a layout-binary-tree homologue to node.
"
(if (binary-tree-empty-p tree)
(make-empty-binary-tree)
(make-layout-binary-tree
:label (binary-tree-label tree)
:left (binary-tree-to-layout-binary-tree (binary-tree-left tree))
:right (binary-tree-to-layout-binary-tree (binary-tree-right tree)))))
;; To layout the binary tree, we will do it in two steps. First we
;; make the layout tree, and setting the y field to the depth of each
;; node. Then we execute a infix walk of the new tree updating the x
;; field of each node.
(defun layout-node-depth (node depth)
"
Return a layout-binary-tree homologue to node, with the ordinates of
each node set to their depth.
"
(if (binary-tree-empty-p node)
(make-empty-binary-tree)
(make-layout-binary-tree
:label (binary-tree-label node)
:y depth
:left (layout-node-depth (binary-tree-left node) (1+ depth))
:right (layout-node-depth (binary-tree-right node) (1+ depth)))))
;; Note, incf is a prefix increment, it returns the new-value.
;; Therefore it is easier to start with the predecessor of the first
;; value, and to finally return the last value used. One could define
;; a postfix increment operator to easily write the code using the
;; other convention.
(defun layout-node-abscissa/inorder (node abscissa)
"
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.
"
(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))
(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)
(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)))
;; (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 ;;;;