#-(and) "
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.
[p70]
In Prolog we represent a multiway tree by a term t(X,F), where X
denotes the root node and F denotes the forest of successor trees (a
Prolog list). The example tree depicted opposite is therefore
represented by the following Prolog term:
T = t(a,[t(f,[t(g,[])]),t(c,[]),t(b,[t(d,[]),t(e,[])])])
"
;; In lisp we could represent a multiway tree in multiple ways.
;; Let's just abstract it away using defstruct.
(defstruct (multiway-tree
(:predicate non-empty-multiway-tree-p))
label
children)
;; Again, if lists are wanted instead of structures, (:type list) can
;; be used; if vectors, then (:type vector). In both cases, if the
;; list or vector must start with the symbol MULTIWAY-TREE, the :named
;; option can be added.
(defun make-empty-multiway-tree ()
'nil)
(defun empty-multiway-tree-p (tree)
(null tree))
(defun multiway-tree-p (tree)
(or (empty-multiway-tree-p tree)
(non-empty-multiway-tree-p tree)))
#-(and) "
P70B (*) Check whether a given term represents a multiway tree
Write a predicate istree/1 which succeeds if and only if its
argument is a Prolog term representing a multiway tree.
Example:
* istree(t(a,[t(f,[t(g,[])]),t(c,[]),t(b,[t(d,[]),t(e,[])])])).
Yes
"
;; Badass solution:
(defun istree (tree)
(multiway-tree-p tree))
;; In practice, nothing more than the badass solution is needed. For
;; the exercise, we may check that the children are multiway trees
;; too.
(defun istree (tree)
(cond
((empty-multiway-tree-p tree) t)
((non-empty-multiway-tree-p tree)
(every (function istree) (multiway-tree-children tree)))))
;; Actually, in presence of circular structures, the above istree may
;; not terminate. Since those exercices are boring, we'll implement
;; an istree that checks for circular structures too:
(defun istree (tree)
(let ((nodes (make-hash-table)))
(labels ((multiway-node-p (node)
(cond
((empty-multiway-tree-p node) t)
((not (non-empty-multiway-tree-p node))
(return-from istree (values nil :non-tree node))) ; short circuit exit
((gethash node nodes)
(return-from istree (values nil :circular node))) ; short circuit exit
(t
(setf (gethash node nodes) t)
(every (function multiway-node-p) (multiway-tree-children node))))))
(multiway-node-p tree))))
(let* ((child (make-multiway-tree :label 'child))
(root (make-multiway-tree :label 'root :children (list child))))
(setf (multiway-tree-children child) (list root))
(assert (equal (list nil :circular root) (multiple-value-list (istree root)))))
(let* ((child (make-multiway-tree :label 'child :children '(a b c)))
(root (make-multiway-tree :label 'root :children (list child))))
(assert (equal '(nil :non-tree a) (multiple-value-list (istree root)))))
(let* ((child (make-multiway-tree
:label 'child
:children (list (make-multiway-tree :label 'a)
(make-multiway-tree :label 'b)
(make-multiway-tree :label 'c))))
(root (make-multiway-tree :label 'root :children (list child))))
(assert (istree root)))
;; Notice that CL provides for each structure a printer function
;; producing a readable form of the structure:
;;
;; (let* ((child (make-multiway-tree
;; :label 'child
;; :children (list (make-multiway-tree :label 'a)
;; (make-multiway-tree :label 'b)
;; (make-multiway-tree :label 'c))))
;; (root (make-multiway-tree :label 'root :children (list child))))
;; root)
;; --> #S(MULTIWAY-TREE
;; :LABEL ROOT
;; :CHILDREN (#S(MULTIWAY-TREE
;; :LABEL CHILD
;; :CHILDREN (#S(MULTIWAY-TREE :LABEL A :CHILDREN NIL)
;; #S(MULTIWAY-TREE :LABEL B :CHILDREN NIL)
;; #S(MULTIWAY-TREE :LABEL C :CHILDREN NIL)))))
;;
;;
;;
;; So we can also write literal multiway-trees as:
;;
;; #S(multiway-tree :label example :children (#S(multiway-tree :label a) #S(multiway-tree :label b)))
;; --> #S(MULTIWAY-TREE :LABEL EXAMPLE
;; :CHILDREN (#S(MULTIWAY-TREE :LABEL A :CHILDREN NIL)
;; #S(MULTIWAY-TREE :LABEL B :CHILDREN NIL)))
;;;; END ;;;;