Filename | |
---|---|

draw-tree.lisp | |

figure-p64.png | |

figure-p65.png | |

figure-p66.png | |

figure-p67.png | |

index.html | |

p58.lisp | |

p61.lisp | |

p61a.lisp | |

p62.lisp | |

p62a.lisp | |

p63.lisp | |

p64.lisp | |

p65.lisp |

diff --git a/draw-tree.lisp b/draw-tree.lisp index acc60ce..a3092b5 100644 --- a/draw-tree.lisp +++ b/draw-tree.lisp @@ -1,5 +1,9 @@ ;;;; -*- coding:utf-8 -*- +(asdf:oos 'asdf:load-op :com.informatimago.common-lisp.cesarum) +(asdf:oos 'asdf:load-op :com.informatimago.common-lisp.picture) + + ;; ─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ ┠ ┡ ;; ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ ╀ ╁ ╂ ╃ ;; ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ ╠ ╡ ╢ ╣ ╤ ╥ diff --git a/figure-p64.png b/figure-p64.png new file mode 100644 index 0000000..7bc6547 Binary files /dev/null and b/figure-p64.png differ diff --git a/figure-p65.png b/figure-p65.png new file mode 100644 index 0000000..430fc3e Binary files /dev/null and b/figure-p65.png differ diff --git a/figure-p66.png b/figure-p66.png new file mode 100644 index 0000000..dc05307 Binary files /dev/null and b/figure-p66.png differ diff --git a/figure-p67.png b/figure-p67.png new file mode 100644 index 0000000..ac053bf Binary files /dev/null and b/figure-p67.png differ diff --git a/index.html b/index.html index 808506c..3991219 100644 --- a/index.html +++ b/index.html @@ -8,7 +8,8 @@ <p>Here are solutions to the <a href="http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html"> -L-99: Nintey-Nine Lisp Problems</a>, (which themselves are derived from a list of prolog problems).</p> +L-99: Nintey-Nine Lisp Problems</a>, (which themselves are derived from +<a href="http://www.scribd.com/doc/18339544/99-prolog-problems">a list of prolog problems</a>).</p> <h2>Working with lists</h2> <ul> @@ -126,7 +127,6 @@ L-99: Nintey-Nine Lisp Problems</a>, (which themselves are derived from a list o <!-- grep -n 'TO BE DONE' *.lisp p38.lisp:11:;; TO BE DONE. - P59 (**) Construct height-balanced binary trees @@ -157,69 +157,6 @@ P60 (**) Construct height-balanced binary trees with a given number of nodes Find out how many height-balanced trees exist for N = 15. -P61 (*) Count the leaves of a binary tree - A leaf is a node with no successors. Write a predicate count-leaves/2 to count them. - - % count-leaves(T,N) :- the binary tree T has N leaves - -P61A (*) Collect the leaves of a binary tree in a list - A leaf is a node with no successors. Write a predicate leaves/2 to collect them in a list. - - % leaves(T,S) :- S is the list of all leaves of the binary tree T - -P62 (*) Collect the internal nodes of a binary tree in a list - An internal node of a binary tree has either one or two non-empty successors. Write a predicate internals/2 to collect them in a list. - - % internals(T,S) :- S is the list of internal nodes of the binary tree T. - -P62B (*) Collect the nodes at a given level in a list - A node of a binary tree is at level N if the path from the root to the node has length N-1. The root node is at level 1. Write a predicate atlevel/3 to collect all nodes at a given level in a list. - - % atlevel(T,L,S) :- S is the list of nodes of the binary tree T at level L - - Using atlevel/3 it is easy to construct a predicate levelorder/2 which creates the level-order sequence of the nodes. However, there are more efficient ways to do that. - -P63 (**) Construct a complete binary tree - A complete binary tree with height H is defined as follows: The levels 1,2,3,...,H-1 contain the maximum number of nodes (i.e 2**(i-1) at the level i, note that we start counting the levels from 1 at the root). In level H, which - may contain less than the maximum possible number of nodes, all the nodes are "left-adjusted". This means that in a levelorder tree traversal all internal nodes come first, the leaves come second, and empty successors (the nil's - which are not really nodes!) come last. - - Particularly, complete binary trees are used as data structures (or addressing schemes) for heaps. - - We can assign an address number to each node in a complete binary tree by enumerating the nodes in levelorder, starting at the root with number 1. In doing so, we realize that for every node X with address A the following property - holds: The address of X's left and right successors are 2*A and 2*A+1, respectively, supposed the successors do exist. This fact can be used to elegantly construct a complete binary tree structure. Write a predicate - complete-binary-tree/2 with the following specification: - - % complete-binary-tree(N,T) :- T is a complete binary tree with N nodes. (+,?) - - Test your predicate in an appropriate way. - -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. - -P65 (**) Layout a binary tree (2) - [p65] - An alternative layout method is depicted in the illustration opposite. Find out the rules and write the corresponding Prolog predicate. Hint: On a given level, the horizontal distance between neighboring nodes is constant. - - Use the same conventions as in problem P64 and test your predicate in an appropriate way. P66 (***) Layout a binary tree (3) [p66] diff --git a/p58.lisp b/p58.lisp index e0d5cf7..2814ec4 100644 --- a/p58.lisp +++ b/p58.lisp @@ -18,9 +18,16 @@ P58 (**) Generate-and-test paradigm (load "p54a") (load "p55") +(load "p56") (load "p57") + (load "memoize") (use-package :org.tfeb.hax.memoize) +(import 'alexandria:nconcf) + +(load "draw-tree") ; to dump trees in nice ASCII-ART. + + (defun generate-balanced-binary-trees-of-height (height next-label) ;; When next-label is a constant function, @@ -54,6 +61,18 @@ P58 (**) Generate-and-test paradigm h-1)) h-2)))))) +(memoize-function 'generate-balanced-binary-trees-of-height) + + + + +;; The following function generates all the binary trees with a given +;; number of nodes. Even when memoized, this function is still O(e^n). +;; +;; It can be used to filter the wanted trees, but only with a number +;; of node much less than 57: for 17 nodes it takes on the order of +;; 10 minutes, much more for 18 nodes. + (defun generate-binary-trees-of-nodes (number-of-nodes next-label) ;; When next-label is a constant function, ;; generate-binary-trees-of-nodes could be memoized. @@ -77,15 +96,30 @@ P58 (**) Generate-and-test paradigm (aref subtrees right))) (aref subtrees left))))))) -(memoize-function 'generate-balanced-binary-trees-of-height) (memoize-function 'generate-binary-trees-of-nodes) +(defun sym-cbal-trees (n) + (remove-if-not (lambda (tree) + (and (binary-tree-symetric-p tree) + (binary-tree-balanced-p tree))) + (generate-binary-trees-of-nodes n (constantly 'x)))) + + + + -(load "draw-tree") #-(and) (mapcar 'draw-tree (generate-binary-trees-of-nodes 5 (let ((n 0)) (lambda () (incf n))))) +#-(and) +(progn + (defparameter *box* *ascii-box*) + (defparameter *line* *ascii-line*)) +(progn + (defparameter *box* *unicode-box*) + (defparameter *line* *unicode-line*)) + #-(and) " CL-USER> (mapcar 'draw-tree (generate-binary-trees-of-nodes 3 (let ((n 0)) (lambda () (incf n))))) @@ -167,169 +201,212 @@ CL-USER> (mapcar 'draw-tree " -(defun sym-cbal-trees (n) - (remove-if-not (lambda (tree) - (and (binary-tree-symetric-p tree) - (binary-tree-balanced-p tree))) - (generate-binary-trees-of-nodes n (constantly 'x)))) +;; (loop for i below 18 collect (cons i (length (generate-binary-trees-of-nodes i (constantly 'x))))) +;; ((0 . 1) +;; (1 . 1) +;; (2 . 2) +;; (3 . 5) +;; (4 . 14) +;; (5 . 42) +;; (6 . 132) +;; (7 . 429) +;; (8 . 1430) +;; (9 . 4862) +;; (10 . 16796) +;; (11 . 58786) +;; (12 . 208012) +;; (13 . 742900) +;; (14 . 2674440) +;; (15 . 9694845) +;; (16 . 35357670) +;; (17 . 129644790)) + + + #-(and)" -CL-USER> (mapcar 'draw-tree (sym-cbal-trees 7)) -( - ┌─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ ┌─── nil - │ │ ╔═╧═╗ - │ └───╢ X ║ - │ ╚═╤═╝ ┌─── nil - │ │ ╔═╧═╗ - │ └───╢ X ║ - │ ╚═╤═╝ - │ └─── nil - │ -╔═╧═╗ -╢ X ║ -╚═╤═╝ - │ - │ ┌─── nil - │ ╔═╧═╗ - │ ┌───╢ X ║ - │ │ ╚═╤═╝ - │ ╔═╧═╗ └─── nil - │ ┌───╢ X ║ - │ │ ╚═╤═╝ - │ ╔═╧═╗ └─── nil - └───╢ X ║ - ╚═╤═╝ - └─── nil - - - - ┌─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ - │ │ ┌─── nil - │ │ ╔═╧═╗ - │ │ ┌───╢ X ║ - │ │ │ ╚═╤═╝ - │ │ ╔═╧═╗ └─── nil - │ └───╢ X ║ - │ ╚═╤═╝ - │ └─── nil -╔═╧═╗ -╢ X ║ -╚═╤═╝ - │ ┌─── nil - │ ╔═╧═╗ - │ ┌───╢ X ║ - │ │ ╚═╤═╝ ┌─── nil - │ │ │ ╔═╧═╗ - │ │ └───╢ X ║ - │ │ ╚═╤═╝ - │ │ └─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ - └─── nil - +CL-USER> (mapcar 'draw-tree (sym-cbal-trees 5)) +( + + ┌─── nil + ╔═╧═╗ + ┌───╢ X ║ + │ ╚═╤═╝ ┌─── nil + │ │ ╔═╧═╗ + │ └───╢ X ║ + │ ╚═╤═╝ + │ └─── nil +╔═╧═╗ +╢ X ║ +╚═╤═╝ + │ ┌─── nil + │ ╔═╧═╗ + │ ┌───╢ X ║ + │ │ ╚═╤═╝ + │ ╔═╧═╗ └─── nil + └───╢ X ║ + ╚═╤═╝ + └─── nil + + + + + + ┌─── nil + ╔═╧═╗ + ┌───╢ X ║ + │ ╚═╤═╝ + ╔═╧═╗ └─── nil + ┌───╢ X ║ + │ ╚═╤═╝ +╔═╧═╗ └─── nil +╢ X ║ +╚═╤═╝ ┌─── nil + │ ╔═╧═╗ + └───╢ X ║ + ╚═╤═╝ ┌─── nil + │ ╔═╧═╗ + └───╢ X ║ + ╚═╤═╝ + └─── nil + - - ┌─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ - ╔═╧═╗ └─── nil - ┌───╢ X ║ - │ ╚═╤═╝ ┌─── nil - │ │ ╔═╧═╗ - │ └───╢ X ║ - │ ╚═╤═╝ - │ └─── nil -╔═╧═╗ -╢ X ║ -╚═╤═╝ - │ ┌─── nil - │ ╔═╧═╗ - │ ┌───╢ X ║ - │ │ ╚═╤═╝ - │ ╔═╧═╗ └─── nil - └───╢ X ║ - ╚═╤═╝ ┌─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ - └─── nil - - - - - - ┌─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ ┌─── nil - │ │ ╔═╧═╗ - │ └───╢ X ║ - │ ╚═╤═╝ - │ └─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ -╔═╧═╗ └─── nil -╢ X ║ -╚═╤═╝ ┌─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ - │ ┌─── nil - │ ╔═╧═╗ - │ ┌───╢ X ║ - │ │ ╚═╤═╝ - │ ╔═╧═╗ └─── nil - └───╢ X ║ - ╚═╤═╝ - └─── nil - - - - - - - ┌─── nil - ╔═╧═╗ - ┌───╢ X ║ - │ ╚═╤═╝ - ╔═╧═╗ └─── nil - ┌───╢ X ║ - │ ╚═╤═╝ - ╔═╧═╗ └─── nil - ┌───╢ X ║ - │ ╚═╤═╝ -╔═╧═╗ └─── nil -╢ X ║ -╚═╤═╝ ┌─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ ┌─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ ┌─── nil - │ ╔═╧═╗ - └───╢ X ║ - ╚═╤═╝ - └─── nil - - - ) CL-USER> " -;; (length (sym-cbal-trees 57)) + + + + +(defun generate-balanced-binary-trees-of-height (height next-label) + ;; When next-label is a constant function, + ;; generate-balanced-binary-trees-of-height could be memoized. + (case height + (0 (list (make-empty-binary-tree))) + (1 (list (make-binary-tree :label (funcall next-label)))) + (otherwise + (let ((h-2 (generate-balanced-binary-trees-of-height (- height 2) next-label)) + (h-1 (generate-balanced-binary-trees-of-height (- height 1) next-label))) + (nconc + (mapcan (lambda (left) + (mapcar (lambda (right) + (make-binary-tree :label (funcall next-label) + :left left + :right right)) + h-1)) + h-1) + (mapcan (lambda (left) + (mapcar (lambda (right) + (make-binary-tree :label (funcall next-label) + :left left + :right right)) + h-1)) + h-2) + (mapcan (lambda (right) + (mapcar (lambda (left) + (make-binary-tree :label (funcall next-label) + :left left + :right right)) + h-1)) + h-2)))))) + + + +(defun safe-aref (vector index) + (and (<= 0 index (1- (length vector))) (aref vector index))) + +(declaim (inline safe-aref)) + + + (defun generate-balanced-binary-trees-of-nodes (number-of-nodes next-label) + "Returns all the balanced binary trees that have NUMBER-OF-NODES nodes, +in an vector indexed by the height. +" + ;; When next-label is a constant function, + ;; generate-balanced-binary-trees-of-nodes could be memoized. + (case number-of-nodes + (0 (vector (list (make-empty-binary-tree)))) + (1 (vector '() (list (make-binary-tree :label (funcall next-label))))) + (otherwise + + ;; First we get the balanced binary trees with all the number of + ;; nodes from 0 to (1- number-of-nodes). + ;; + ;; Then we will combine two of them each such that the sums of + ;; number of nodes (plus one for the root) is number-of-nodes, + ;; but taking care of the balancing. + + (let ((subtrees (loop + :with subtrees = (make-array number-of-nodes) + :for i :from 0 :below number-of-nodes + :do (setf (aref subtrees i) + (generate-balanced-binary-trees-of-nodes i next-label)) + :finally (return subtrees))) + ;; The results will be collected in this vector: + (byheight (make-array (1+ number-of-nodes) :initial-element '()))) + (loop + :for left :from 0 :below number-of-nodes + :for right = (- number-of-nodes left 1) + + :for left-byheight = (aref subtrees left) + :for right-byheight = (aref subtrees right) + + :do (assert (= (+ left right 1) number-of-nodes)) + + ;; Note, we could be smarter here, since given a number of + ;; nodes, there are minimum and maximum heights of tree you + ;; can build with them. For now, we just loop over the + ;; heights, and check each time the existance of the + ;; subtrees: + + :do (loop + :for left-height :from 0 + :for left-subtrees :across left-byheight + :when left-subtrees + ;; Find right-subtrees of about the same height as + ;; the left ones, and compute their cross product: + :do (let ((above (safe-aref right-byheight (1+ left-height))) + (level (safe-aref right-byheight left-height)) + (below (safe-aref right-byheight (1- left-height)))) + (when (< (+ left-height 2) (length byheight)) + (nconcf (aref byheight (+ left-height 2)) + (mapcan (lambda (right-subtree) + (mapcar (lambda (left-subtree) + (make-binary-tree :label (funcall next-label) + :left left-subtree + :right right-subtree)) + left-subtrees)) + above))) + (nconcf (aref byheight (+ left-height 1)) + (mapcan (lambda (right-subtree) + (mapcar (lambda (left-subtree) + (make-binary-tree :label (funcall next-label) + :left left-subtree + :right right-subtree)) + left-subtrees)) + (append level below)))))) + byheight)))) + +(memoize-function 'generate-balanced-binary-trees-of-nodes) + +;; (map nil (lambda (l) (print l) (mapcar (lambda (n) (princ (draw-tree n)) (terpri)) l)) +;; (generate-balanced-binary-trees-of-nodes 4 (constantly 'x))) + +(defun sym-cbal-trees (n) + (remove-if-not (lambda (tree) + (and (binary-tree-symetric-p tree) + (binary-tree-balanced-p tree))) + (coerce + (reduce (function nconc) + (generate-balanced-binary-trees-of-nodes n (constantly 'x))) + 'list))) + +;; (loop :for i :below 58 :collect (time (cons i (length (sym-cbal-trees i))))) + + ;;;; THE END ;;;; diff --git a/p61.lisp b/p61.lisp new file mode 100644 index 0000000..d0ad38f --- /dev/null +++ b/p61.lisp @@ -0,0 +1,48 @@ +#-(and) " + +P61 (*) Count the leaves of a binary tree + A leaf is a node with no successors. Write a predicate count-leaves/2 to count them. + + % count-leaves(T,N) :- the binary tree T has N leaves + +" + +(load "p54a") +(load "p55") +(load "p56") +(load "p57") + + +(defun binary-tree-leaf-p (node) + (and (binary-tree-p node) + (binary-tree-empty-p (binary-tree-left node)) + (binary-tree-empty-p (binary-tree-right node)))) + + +;; Simple recursive solution: + +(defun count-leaves (tree) + (cond + ((binary-tree-empty-p tree) 0) + ((binary-tree-leaf-p tree) 1) + (t (+ (count-leaves (binary-tree-left tree)) + (count-leaves (binary-tree-right tree)))))) + + +;; For very deep trees, here is a solution avoiding stack use: + +(defun count-leaves (tree) + (if (binary-tree-empty-p tree) + 0 + (loop + :with stack = (list tree) + :for node = (pop stack) :then (if (binary-tree-empty-p (binary-tree-left node)) + (pop stack) + (binary-tree-left node)) + :while node + :unless (binary-tree-empty-p (binary-tree-right node)) + :do (push (binary-tree-right node) stack) + :when (binary-tree-leaf-p node) :count 1))) + + +;;;; THE END ;;;; diff --git a/p61a.lisp b/p61a.lisp new file mode 100644 index 0000000..32a4ff1 --- /dev/null +++ b/p61a.lisp @@ -0,0 +1,100 @@ +#-(and) " + + +P61A (*) Collect the leaves of a binary tree in a list + A leaf is a node with no successors. Write a predicate leaves/2 to collect them in a list. + + % leaves(T,S) :- S is the list of all leaves of the binary tree T + +" + +(load "p61") + + +;; Simple recursive solution: + +(defun collect-leaves (tree) + (cond + ((binary-tree-empty-p tree) '()) + ((binary-tree-leaf-p tree) (list tree)) + (t (append (collect-leaves (binary-tree-left tree)) + (collect-leaves (binary-tree-right tree)))))) + + +;; For very deep trees, here is a solution avoiding stack use: + +(defun collect-leaves (tree) + (if (binary-tree-empty-p tree) + '() + (loop + :with stack = (list tree) + :for node = (pop stack) :then (if (binary-tree-empty-p (binary-tree-left node)) + (pop stack) + (binary-tree-left node)) + :while node + :unless (binary-tree-empty-p (binary-tree-right node)) + :do (push (binary-tree-right node) stack) + :when (binary-tree-leaf-p node) :collect node))) + + + +;; Doesn't the comparison of p61 and p61a make cry? +;; Here is a parameterized simple recursive solution: + +(defun reduce-tree (fun-node fun-leaf tree &key empty-tree-value) + (cond + ((binary-tree-empty-p tree) empty-tree-value) + ((binary-tree-leaf-p tree) (funcall fun-leaf tree)) + (t (funcall fun-node + tree + (reduce-tree fun-node fun-leaf (binary-tree-left tree) + :empty-tree-value empty-tree-value) + (reduce-tree fun-node fun-leaf (binary-tree-right tree) + :empty-tree-value empty-tree-value))))) + +(defun count-leaves (tree) + (reduce-tree (lambda (node left right) (declare (ignore node)) (+ left right)) + (lambda (leaf) (declare (ignore leaf)) 1) + tree + :empty-tree-value 0)) + +(defun collect-leaves (tree) + (reduce-tree (lambda (node left right) (declare (ignore node)) (append left right)) + (function list) + tree + :empty-tree-value '())) + + +;; And similarly, for very deep trees, here is a parameterized +;; solution avoiding stack use: + +(defun reduce-leaves-of-tree (fun-leaf tree &key initial-value) + (if (binary-tree-empty-p tree) + initial-value + (loop + :with result = initial-value + :with stack = (list tree) + :for node = (pop stack) :then (if (binary-tree-empty-p (binary-tree-left node)) + (pop stack) + (binary-tree-left node)) + :while node + :unless (binary-tree-empty-p (binary-tree-right node)) + :do (push (binary-tree-right node) stack) + :when (binary-tree-leaf-p node) + :do (setf result (funcall fun-leaf node result)) + :finally (return result)))) + + +(defun count-leaves (tree) + (reduce-leaves-of-tree (lambda (leaf result) (+ 1 result)) tree :initial-value 0)) + + +(defun collect-leaves (tree) + (reverse (reduce-leaves-of-tree (function cons) tree :initial-value '()))) + + +;; By the way, notice how the initial recursive solution leads to a +;; more general reduce-tree function. + + +;;;; THE END ;;;; diff --git a/p62.lisp b/p62.lisp new file mode 100644 index 0000000..5a69282 --- /dev/null +++ b/p62.lisp @@ -0,0 +1,21 @@ +#-(and) " + +P62 (*) Collect the internal nodes of a binary tree in a list + + An internal node of a binary tree has either one or two non-empty + successors. Write a predicate internals/2 to collect them in a + list. + + % internals(T,S) :- S is the list of internal nodes of the binary tree T. +" + +(load "p61a") + +;; Simple (trivial!) solution using reduce-tree defined in p61a: + +(defun collect-internal-nodes (tree) + (reduce-tree (lambda (node left right) (cons node (append left right))) + (constantly '()) tree :empty-tree-value '())) + +;;;; THE END ;;;; + diff --git a/p62a.lisp b/p62a.lisp new file mode 100644 index 0000000..1faca1a --- /dev/null +++ b/p62a.lisp @@ -0,0 +1,35 @@ +#-(and) " + +P62B (*) Collect the nodes at a given level in a list + + A node of a binary tree is at level N if the path from the root to + the node has length N-1. The root node is at level 1. Write a + predicate atlevel/3 to collect all nodes at a given level in a + list. + + % atlevel(T,L,S) :- S is the list of nodes of the binary tree T at level L + + Using atlevel/3 it is easy to construct a predicate levelorder/2 + which creates the level-order sequence of the nodes. However, + there are more efficient ways to do that. +" + +;; Simple recursive solution: + +;; Notice the above definition use a 1-based index for the level. +;; As always, this is a bad choice, hence the use of (= 1 level) instead of (zerop level). +;; http://www.cs.utexas.edu/users/EWD/ewd08xx/EWD831.PDF + + +(defun collect-nodes-at-level (tree level) + (cond + ((binary-tree-empty-p tree) '()) + ((= 1 level) (list tree)) + (t (append (collect-nodes-at-level (binary-tree-left tree) (1- level)) + (collect-nodes-at-level (binary-tree-right tree) (1- level)))))) + +;; Note: nconc could be used instead of append, since all the lists +;; returned by collect-nodes-at-level are newly allocated lists. + + +;;;; THE END ;;;; diff --git a/p63.lisp b/p63.lisp new file mode 100644 index 0000000..fd14a73 --- /dev/null +++ b/p63.lisp @@ -0,0 +1,50 @@ +#-(and) " + +P63 (**) Construct a complete binary tree + + A complete binary tree with height H is defined as follows: The + levels 1,2,3,...,H-1 contain the maximum number of nodes (i.e + 2**(i-1) at the level i, note that we start counting the levels + from 1 at the root). In level H, which may contain less than the + maximum possible number of nodes, all the nodes are + \"left-adjusted\". This means that in a levelorder tree traversal + all internal nodes come first, the leaves come second, and empty + successors (the nil's which are not really nodes!) come last. + + Particularly, complete binary trees are used as data structures + (or addressing schemes) for heaps. + + We can assign an address number to each node in a complete binary + tree by enumerating the nodes in levelorder, starting at the root + with number 1. In doing so, we realize that for every node X with + address A the following property holds: The address of X's left + and right successors are 2*A and 2*A+1, respectively, supposed the + successors do exist. This fact can be used to elegantly construct + a complete binary tree structure. Write a predicate + complete-binary-tree/2 with the following specification: + + % complete-binary-tree(N,T) :- T is a complete binary tree with N nodes. (+,?) + + Test your predicate in an appropriate way. + +" +(load "p54a") + +(defun complete-binary-tree-upto (a n) + (make-binary-tree :label a + :left (if (<= (* 2 a) n) + (complete-binary-tree-upto (* 2 a) n) + (make-empty-binary-tree)) + :right (if (<= (1+ (* 2 a)) n) + (complete-binary-tree-upto (1+ (* 2 a)) n) + (make-empty-binary-tree)))) + + +(defun complete-binary-tree (n) + (complete-binary-tree-upto 1 n)) + + +;; (loop :for n :to 7 :do (princ (draw-tree (complete-binary-tree n)))) + + +;;;; THE END ;;;; diff --git a/p64.lisp b/p64.lisp new file mode 100644 index 0000000..fdadf63 --- /dev/null +++ b/p64.lisp @@ -0,0 +1,117 @@ +#-(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 coordinate, 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. +" + (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))) + (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)) + + +;;;; THE END ;;;; + diff --git a/p65.lisp b/p65.lisp new file mode 100644 index 0000000..0f340f7 --- /dev/null +++ b/p65.lisp @@ -0,0 +1,54 @@ +#+(and) " +P65 (**) Layout a binary tree (2) + [p65] + + An alternative layout method is depicted in the illustration + opposite. Find out the rules and write the corresponding Prolog + predicate. Hint: On a given level, the horizontal distance between + neighboring nodes is constant. + + Use the same conventions as in problem P64 and test your predicate in an appropriate way. + +" + +(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) + 0 + (+ 1 (binary-tree-count-leftmosts (binary-tree-left tree))))) + + +(defun layout-node-p65 (node abscissa depth height) + " +The abscissa of the NODE is given by ABSCISSA, and the ordinate by DEPTH. +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))) + (unless (binary-tree-empty-p (binary-tree-left node)) + (layout-node-p65 (binary-tree-left node) + (- abscissa offset) + (1+ depth) + (1- height))) + (unless (binary-tree-empty-p (binary-tree-right node)) + (layout-node-p65 (binary-tree-right node) + (+ abscissa offset) + (1+ depth) + (1- height)))) + 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))) + +;;;; THE END ;;;;