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