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

"

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