Functional tree iteration in Common Lisp

Question

I'm adding some functionality to an existing library of data structures in Common Lisp, with a view to asking the original author if I can take over maintenance and development of it. While the original code is very well-organized, one of the features it didn't have was a way to iterate over the contents of a tree, successively returning all the key-value pairs. I wrote the following code to address that. The only public functions are traversal-done-p, traversal-first, traversal-rest and traverse.

Traversal code

I added functionality to traverse a tree either depth- or breadth-first from the root, or in either increasing or decreasing order by key. In order to do that, I tried to use generics to share as much code as possible between implementations; the depth-first and ordered traversals all use a stack so they can share the implementation of traversal-done-p and traversal-first, etc.

(defgeneric traversal-done-p (traversal))
(defgeneric traversal-first (traversal))
(defgeneric traversal-rest (traversal))

;; Traversing trees depth-first

(defclass depth-first-traversal ()
  ((stack :initarg :stack
          :initform (make-stack)
          :reader traversal-stack))
  (:documentation "Store the state of a tree traversal which successively
returns all key/value pairs."))

(defmethod traversal-done-p ((traversal depth-first-traversal))
  (stack-empty-p (traversal-stack traversal)))

(defmethod traversal-first ((traversal depth-first-traversal))
  (let ((tree (stack-top (traversal-stack traversal))))
    (values (bt-key tree) (bt-value tree))))

(defun push-tree (tree stack)
  (if (tree-empty-p tree) stack (stack-push stack tree)))

(defmethod traversal-rest ((traversal depth-first-traversal))
  (let* ((stack (traversal-stack traversal))
         (tree (stack-top stack)))
    (make-instance 'depth-first-traversal
                   :stack (push-tree (bt-left tree)
                                     (push-tree (bt-right tree)
                                                (stack-pop stack))))))


;; Traversing trees in order by the keys

(defclass ordered-traversal (depth-first-traversal)
  ((side :initarg :side
         :initform :left
         :reader traversal-side))
  (:documentation "Store the state of a tree traversal which successively
returns key/value pairs in either increasing or decreasing order by key."))

(defun start-ordered-traversal (tree stack side)
  (let ((child (if (eql side :left) #'bt-left #'bt-right)))
    (labels ((f (tree stack)
               (if (tree-empty-p tree)
                   stack
                   (f (funcall child tree)
                      (stack-push stack tree)))))
      (make-instance 'ordered-traversal
                     :stack (f tree stack)
                     :side side))))

(defmethod traversal-rest ((traversal ordered-traversal))
  (let ((side (traversal-side traversal)))
    (let ((child (if (eql side :left) #'bt-right #'bt-left))
          (stack (traversal-stack traversal)))
      (start-ordered-traversal (funcall child (stack-top stack))
                               (stack-pop stack)
                               side))))


;; Traversing trees one level at a time

(defclass breadth-first-traversal ()
  ((q :initarg :queue
      :initform (make-queue)
      :reader traversal-queue))
  (:documentation "Store the state of a level-order tree traversal"))

(defmethod traversal-done-p ((traversal breadth-first-traversal))
  (queue-empty-p (traversal-queue traversal)))

(defmethod traversal-first ((traversal breadth-first-traversal))
  (let ((tree (queue-first (traversal-queue traversal))))
    (values (bt-key tree) (bt-value tree))))

(defun enqueue-tree (tree queue)
  (if (tree-empty-p tree) queue (enqueue queue tree)))

(defmethod traversal-rest ((traversal breadth-first-traversal))
  (let* ((q (traversal-queue traversal))
         (tree (queue-first q)))
    (make-instance 'breadth-first-traversal
                   :queue (enqueue-tree (bt-left tree)
                                        (enqueue-tree (bt-right tree)
                                                      (dequeue q))))))


;; Return a traversal according to a keyword

(defun traverse (tree &optional (order :forward))
  (cond
    ((or (eql order :forward) (eql order :backward))
     (start-ordered-traversal tree
                              (make-stack)
                              (if (eql order :forward) :left :right)))
    ((eql order :level)
     (make-instance 'breadth-first-traversal
                    :queue (enqueue (make-queue) tree)))
    (t
     (make-instance 'depth-first-traversal
                    :stack (push-tree tree (make-stack))))))

Usage

The purpose of all of this is so that I can easily define a function to do reductions on all key/value pairs in the tree:

(defun tree-reduce (tree func &key from-end initial-value)
  (labels ((redux (traversal r)
             (if (traversal-done-p traversal)
                 r
                 (multiple-value-bind (k v) (traversal-first traversal)
                   (redux (traversal-rest traversal)
                          (funcall func r k v))))))
    (redux (traverse tree from-end) initial-value)))

For example, to turn the tree tree into an association list, I could write

(tree-reduce tree
             (lambda (alst k v)
               (cons (cons k v) alst)))

and to add up all the values stored in the tree I could write

(tree-reduce tree
             (lambda (r _ v)
               (declare (ignore _))
               (+ r v))
             :initial-value 0)

Depending on the reduction operation, it may or may not be important to traverse the tree in a particular order. For some reductions, like converting the contents of the tree to another data structure, space efficiency in the traversal doesn't really matter. On the other hand, for other reductions, like adding up all the tree values, using O(n) space is pretty wasteful.

Questions

• Function names; I thought of calling it tree-traversal, tree-walk, tree-iterate. What's the clearest and shortest name that I should give to these functions?

• Are the generics overkill? I like how they can hide messy/annoying conditional logic.

• Approach; I've often seen tree iteration code in functional languages work by just successively returning trees with a key/value pair removed. However, if the tree is self-balancing, as it is in the library I'm trying to extend, I would think that this approach incurs more than the usual log(n) storage penalty.

Answer 1

The names are fine. In general CL names tend to be a bit more descriptive, so these fit right in. If you want more inspiration, the cl-containers library is probably a good starting point for a similar approach, although I don't think it's used that much.

Which fits right right in with the next question, as yes, generics can be a bit overkill for iteration, also I'd probably not expect classes for the little state that's stored. That said, there isn't really a agreed upon standard for iterators either and since every library rolls their own ad hoc thing again the code looks fine.

Regarding the general approach, that's hard to say; personally I'd probably not use more complicated code when I could just use a few cons cells instead; I'd also rather have less memory allocations than functional purity (by which I mean that all the MAKE-INSTANCE calls in TRAVERSAL-REST will add up at some point).

A few notes on the code itself:

• I'd probably add a docstring to the three generics just make clear what the calling convention is. E.g. at the moment you have to read the individual methods to see that two values are returned.
• When comparing symbols EQ is enough and therefore preferable.
• TRAVERSE has an ORDER parameter, but it's called from TREE-REDUCE using the FROM-END parameter - that seems wrong, as I'm assuming that FROM-END follows the usual convention, so it's a boolean parameter, rather than FORWARD or BACKWARD.