Pascal J. Bourguignon [2011-01-11 15:34]
```Added p67-p69.
```
Filename
index.html
p54a.lisp
p67.lisp
p68.lisp
p69.lisp
```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.
+
+"
+
+(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)
+
+;; (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)
+               (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 ;;;;```
ViewGit