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