Pascal J. Bourguignon [2011-01-11 15:34]
diff --git a/index.html b/index.html
index 545db32..046108a 100644
--- a/index.html
+++ b/index.html
@@ -158,39 +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.
-P67 (**) A string representation of binary trees
- [p67]
-
- Somebody represents binary trees as strings of the following type (see example opposite):
-
- a(b(d,e),c(,f(g,)))
-
- a) Write a Prolog predicate which generates this string representation, if the tree is given as usual (as nil or t(X,L,R) term). Then write a predicate which does this inverse; i.e. given the string representation, construct the
- tree in the usual form. Finally, combine the two predicates in a single predicate tree-string/2 which can be used in both directions.
-
- b) Write the same predicate tree-string/2 using difference lists and a single predicate tree-dlist/2 which does the conversion between a tree and a difference list in both directions.
-
- For simplicity, suppose the information in the nodes is a single letter and there are no spaces in the string.
-
-P68 (**) Preorder and inorder sequences of binary trees
- We consider binary trees with nodes that are identified by single lower-case letters, as in the example of problem P67.
-
- a) Write predicates preorder/2 and inorder/2 that construct the preorder and inorder sequence of a given binary tree, respectively. The results should be atoms, e.g. 'abdecfg' for the preorder sequence of the example in problem
- P67.
-
- b) Can you use preorder/2 from problem part a) in the reverse direction; i.e. given a preorder sequence, construct a corresponding tree? If not, make the necessary arrangements.
-
- c) If both the preorder sequence and the inorder sequence of the nodes of a binary tree are given, then the tree is determined unambiguously. Write a predicate pre-in-tree/3 that does the job.
-
- d) Solve problems a) to c) using difference lists. Cool! Use the predefined predicate time/1 to compare the solutions.
-
- What happens if the same character appears in more than one node. Try for instance pre-in-tree(aba,baa,T).
-
-P69 (**) Dotstring representation of binary trees
- We consider again binary trees with nodes that are identified by single lower-case letters, as in the example of problem P67. Such a tree can be represented by the preorder sequence of its nodes in which dots (.) are inserted where
- an empty subtree (nil) is encountered during the tree traversal. For example, the tree shown in problem P67 is represented as 'abd..e..c.fg...'. First, try to establish a syntax (BNF or syntax diagrams) and then write a predicate
- tree-dotstring/2 which does the conversion in both directions. Use difference lists.
-
Multiway Trees
A multiway tree is composed of a root element and a (possibly empty) set of successors which are multiway trees themselves. A multiway tree is never empty. The set of successor trees is sometimes called a forest.
diff --git a/p54a.lisp b/p54a.lisp
index bc91b0f..ba8df7b 100644
--- a/p54a.lisp
+++ b/p54a.lisp
@@ -30,9 +30,22 @@ P54A (*) Check whether a given term represents a binary tree
;; Notice that there are a lot of ways to represent trees.
;; Therefore it important to use a functional abstraction, to avoid
;; writing code dependant on a specific representation.
-
-
-(defstruct (binary-tree (:type list))
+;;
+;; Also, in the following problems, references to prolog terms are not
+;; translated to lisp, and terms for trees are given as:
+;;
+;; T = t(x, t(x, nil, nil), t(x, nil, t(x, nil, nil)))
+;;
+;; We could translate this as having the symbol BINARY-TREE prefixing the
+;; lists representing tree nodes:
+;;
+;; (BINARY-TREE a (BINARY-TREE b nil nil) (BINARY-TREE c nil (BINARY-TREE f nil)))
+;;
+;; This can be trivially implemented by adding the :NAMED option to defstruct, in which
+;; case an implementation of BINARY-TREE-P is provided by destruct.
+
+
+(defstruct (binary-tree (:type list) :named)
label left right)
;; This defstruct defines the following functional abstraction:
;; (make-binary-tree :label label :left left :right right)
diff --git a/p67.lisp b/p67.lisp
new file mode 100644
index 0000000..dd33e1c
--- /dev/null
+++ b/p67.lisp
@@ -0,0 +1,125 @@
+#-(and) "
+P67 (**) A string representation of binary trees
+ [p67]
+
+ Somebody represents binary trees as strings of the following type
+ (see example opposite):
+
+ a(b(d,e),c(,f(g,)))
+
+ a) Write a Prolog predicate which generates this string
+ representation, if the tree is given as usual (as nil or t(X,L,R)
+ term). Then write a predicate which does this inverse; i.e. given
+ the string representation, construct the tree in the usual
+ form. Finally, combine the two predicates in a single predicate
+ tree-string/2 which can be used in both directions.
+
+ b) Write the same predicate tree-string/2 using difference lists
+ and a single predicate tree-dlist/2 which does the conversion
+ between a tree and a difference list in both directions.
+
+ For simplicity, suppose the information in the nodes is a single
+ letter and there are no spaces in the string.
+
+"
+
+(load "rdp")
+(use-package "COM.INFORMATIMAGO.RDP")
+
+
+;; This is not funny...
+
+
+;; Badass solution. In lisp, we can just use print and read to
+;; serialize and deserialize printable readably lisp objects:
+
+(defun binary-tree-to-string (tree)
+ (prin1-to-string tree))
+
+(defun binary-tree-from-string (string)
+ (read-from-string string))
+
+;; (binary-tree-to-string (construct '(n k c a h g e m u p s q) (function string<)))
+;; --> "(N (K (C (A NIL NIL) (H (G (E NIL NIL) NIL) NIL)) (M NIL NIL)) (U (P NIL (S (Q NIL NIL) NIL)) NIL))"
+;;
+;; (binary-tree-from-string "(N (K (C (A NIL NIL) (H (G (E NIL NIL) NIL) NIL)) (M NIL NIL)) (U (P NIL (S (Q NIL NIL) NIL)) NIL))")
+;; --> (N (K (C (A NIL NIL) (H (G (E NIL NIL) NIL) NIL)) (M NIL NIL)) (U (P NIL (S (Q NIL NIL) NIL)) NIL))
+;; 99
+
+
+
+
+;; Solution p67 a). Generating a string is trivial:
+
+(defun binary-tree-to-string (tree)
+ (cond
+ ((binary-tree-empty-p tree)
+ "")
+ ;; Since the wanted syntax is irregular,
+ ;; [it wants a(b,c) instead of a(b(,),c(,))],
+ ;; we need to add this special case:
+ ((and (binary-tree-empty-p (binary-tree-left tree))
+ (binary-tree-empty-p (binary-tree-right tree)))
+ (prin1-to-string (binary-tree-label tree)))
+ (t
+ (format nil "~A(~A,~A)"
+ (binary-tree-label tree)
+ (binary-tree-to-string (binary-tree-left tree))
+ (binary-tree-to-string (binary-tree-right tree))))))
+
+
+;; as is parsing one.
+
+(defgrammar binary-tree
+ :terminals ((label "[^(),][^(),]*"))
+ :start tree
+ :rules ((--> tree
+ (opt node)
+ :action (if (null $1)
+ (make-empty-binary-tree)
+ $1)) ; it's identity, but make-empty-binary-tree
+ ; could be defined otherwise.
+ (--> node
+ label (opt children)
+ :action (make-binary-tree :label (read-from-string (second $1))
+ :left (first $2) :right (second $2)))
+ (--> children
+ "(" tree "," tree ")"
+ :action (list $2 $4))))
+
+
+(defun binary-tree-from-string (string)
+ (parse-binary-tree string))
+
+;; (binary-tree-to-string (binary-tree-from-string "a(b(d,e),c(,f(g,)))"))
+;; --> "A(B(D,E),C(,F(G,)))"
+
+
+
+;; Solution p67 b):
+
+;; There's no point to do something like this in lisp. Difference lists
+;; are a useful trick in prolog to be used with unification, but
+;; generating the string from a dlist is nothing more than what we've
+;; done so far:
+;;
+;; (defun list-to-string (tree)
+;; (cond
+;; ((null tree)
+;; "")
+;; ;; Since the wanted syntax is irregular,
+;; ;; [it wants a(b,c) instead of a(b(,),c(,))],
+;; ;; we need to add this special case:
+;; ((and (null (second tree))
+;; (null (third tree)))
+;; (prin1-to-string (first tree)))
+;; (t
+;; (format nil "~A(~A,~A)"
+;; (first tree)
+;; (binary-tree-to-string (second tree))
+;; (binary-tree-to-string (third tree))))))
+;;
+;; And of course, converting our binary trees to list is a No-Op, since
+;; our trees are already implemented as lists.
+
+;;;; THE END ;;;;
diff --git a/p68.lisp b/p68.lisp
new file mode 100644
index 0000000..9898385
--- /dev/null
+++ b/p68.lisp
@@ -0,0 +1,173 @@
+#-(and) "
+
+ P68 (**) Preorder and inorder sequences of binary trees
+
+ We consider binary trees with nodes that are identified by single
+ lower-case letters, as in the example of problem P67.
+
+ a) Write predicates preorder/2 and inorder/2 that construct the
+ preorder and inorder sequence of a given binary tree,
+ respectively. The results should be atoms, e.g. 'abdecfg' for the
+ preorder sequence of the example in problem P67.
+
+ b) Can you use preorder/2 from problem part a) in the reverse
+ direction; i.e. given a preorder sequence, construct a
+ corresponding tree? If not, make the necessary arrangements.
+
+ c) If both the preorder sequence and the inorder sequence of the
+ nodes of a binary tree are given, then the tree is determined
+ unambiguously. Write a predicate pre-in-tree/3 that does the job.
+
+ d) Solve problems a) to c) using difference lists. Cool! Use the
+ predefined predicate time/1 to compare the solutions.
+
+ What happens if the same character appears in more than one
+ node. Try for instance pre-in-tree(aba,baa,T).
+
+"
+
+
+;;; Solution p68 a):
+
+
+(defun inorder (tree)
+ (labels ((inorder-string (tree)
+ (if (binary-tree-empty-p tree)
+ ""
+ (format nil "~A~A~A"
+ (inorder-string (binary-tree-left tree))
+ (binary-tree-label tree)
+ (inorder-string (binary-tree-right tree))))))
+ (intern (inorder-string tree))))
+
+
+(defun preorder (tree)
+ (labels ((preorder-string (tree)
+ (if (binary-tree-empty-p tree)
+ ""
+ (format nil "~A~A~A" (binary-tree-label tree)
+ (preorder-string (binary-tree-left tree))
+ (preorder-string (binary-tree-right tree))))))
+ (intern (preorder-string tree))))
+
+;; (inorder '(A (B (D NIL NIL) (E NIL NIL)) (C NIL (F (G NIL NIL) NIL))))
+;; --> DBEACGF
+;;
+;; (preorder '(A (B (D NIL NIL) (E NIL NIL)) (C NIL (F (G NIL NIL) NIL))))
+;; --> ABDECFG
+
+
+
+
+
+;;; Solution p68 b):
+
+;; It is not possible because there are different trees having the same preorder:
+;;
+;; (eql (preorder '(A (B (C (D nil nil) NIL) nil) nil))
+;; (preorder '(A nil (B nil (C nil (D nil nil)))))) --> T
+;;
+;; We can change this by generating a token for an empty tree, eg. a dash.
+
+
+
+(defun full-preorder (tree)
+ (labels ((preorder-string (tree)
+ (if (binary-tree-empty-p tree)
+ "."
+ (format nil "~A~A~A" (binary-tree-label tree)
+ (preorder-string (binary-tree-left tree))
+ (preorder-string (binary-tree-right tree))))))
+ (intern (preorder-string tree))))
+
+;; (full-preorder '(A (B (D NIL NIL) (E NIL NIL)) (C NIL (F (G NIL NIL) NIL))))
+;; --> ABD..E..C.FG...
+;;
+;; (full-preorder '(A (B (C (D nil nil) NIL) nil) nil)) --> ABCD.....
+;; (full-preorder '(A nil (B nil (C nil (D nil nil))))) --> A.B.C.D..
+
+;; Then we can write the inverse function:
+
+(defun binary-tree-from-full-preorder (preorder)
+ (labels ((inverse (stream)
+ (let ((ch (read-char stream)))
+ (if (char= #\. ch)
+ (make-empty-binary-tree)
+ (make-binary-tree :label (intern (string ch))
+ :left (inverse stream)
+ :right (inverse stream))))))
+ (with-input-from-string (stream (string preorder))
+ (inverse stream))))
+
+
+(dolist (tree '((a (b (c (d nil nil) NIL) nil) nil)
+ (A nil (B nil (C nil (D nil nil))))
+ (A (B (D NIL NIL) (E NIL NIL)) (C NIL (F (G NIL NIL) NIL)))))
+ (assert (equalp tree (binary-tree-from-full-preorder (full-preorder tree)))))
+
+
+
+
+;;; Solution p68 c):
+
+
+(defun split-list (separator list)
+ (loop
+ :until (or (endp list) (eql separator (first list)))
+ :collect (pop list) :into left
+ :finally (return (values left (rest list)))))
+
+
+;; We use the pre-order list to split the in-order list into the
+;; in-order of the left subtree and of the right subtree, and
+;; recursively.
+
+(defun pre-in-order-lists (pre in)
+ "
+PRE: the list of node labels in pre-order.
+IN: the list of node labels in in-order.
+RETURN: the tree and the rest of PRE.
+"
+ (if (endp in)
+ (values (make-empty-binary-tree)
+ pre)
+ (multiple-value-bind (left-in right-in) (split-list (first pre) in)
+ (multiple-value-bind (left rest-of-pre) (pre-in-order-lists (rest pre) left-in)
+ (multiple-value-bind (right rest-of-pre) (pre-in-order-lists rest-of-pre right-in)
+ (values (make-binary-tree :label (first pre)
+ :left left
+ :right right)
+ rest-of-pre))))))
+
+
+(defun pre-in-tree (pre in)
+ (pre-in-order-lists (map 'list (lambda (x) (intern (string x))) (string pre))
+ (map 'list (lambda (x) (intern (string x))) (string in))))
+
+
+(dolist (tree '((a (b (c (d nil nil) NIL) nil) nil)
+ (A nil (B nil (C nil (D nil nil))))
+ (A (B (D NIL NIL) (E NIL NIL)) (C NIL (F (G NIL NIL) NIL)))
+ (A (B NIL NIL) (A NIL NIL))
+ (A NIL (A NIL (B NIL NIL)))))
+ (assert (equalp tree (pre-in-tree (preorder tree) (inorder tree)))
+ () "Tree = ~S~%preorder = ~S~%inorder = ~S~% pre-in-tree ~S~%"
+ tree (preorder tree) (inorder tree)
+ (pre-in-tree (preorder tree) (inorder tree))))
+
+
+;; With our lisp function, there's no problem to evaluate:
+;; (pre-in-order 'aba 'baa)
+;; --> (A (B NIL NIL) (A NIL NIL))
+;;
+;; On the other hand, both (A NIL (A NIL (B NIL NIL))) and (A (A NIL NIL) (B NIL NIL))
+;; have the same pre and in order:
+;;
+;; (mapcar (lambda (tree) (list (preorder tree) (inorder tree)))
+;; '((A NIL (A NIL (B NIL NIL)))
+;; (A (A NIL NIL) (B NIL NIL))))
+;; --> ((AAB AAB) (AAB AAB))
+
+
+;;;; THE END ;;;;
+
diff --git a/p69.lisp b/p69.lisp
new file mode 100644
index 0000000..5bf8a3a
--- /dev/null
+++ b/p69.lisp
@@ -0,0 +1,18 @@
+#-(and) "
+
+P69 (**) Dotstring representation of binary trees
+
+ We consider again binary trees with nodes that are identified by
+ single lower-case letters, as in the example of problem P67. Such
+ a tree can be represented by the preorder sequence of its nodes in
+ which dots (.) are inserted where an empty subtree (nil) is
+ encountered during the tree traversal. For example, the tree shown
+ in problem P67 is represented as 'abd..e..c.fg...'. First, try to
+ establish a syntax (BNF or syntax diagrams) and then write a
+ predicate tree-dotstring/2 which does the conversion in both
+ directions. Use difference lists.
+"
+
+;; See full-preorder and binary-tree-from-full-preorder in p68.lisp.
+
+;;;; THE END ;;;;