#-(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 ;;;;