Using reduce over a tree in Lisp

问题:

To fold a flat list in Lisp you use reduce:

* (reduce #'+ '(1 2 3 4 5))
15

But what if I have an arbitrarily complex tree, and I want to apply a function over each of the element? So that fold over '(1 (2) (3 (4) 5)) would still give 15? I tried to use reduce, but I had to provide a custom function, which kinda defeats the purpose:

(defun tree+ (a b)
  (cond ((null b) 0)
        ((atom b) (+ a b))
        (t (+ (tree+ a (car b))
              (tree+ 0 (cdr b))))))

(reduce #'tree+ '(1 (2) (3 (4) 5)) :initial-value 0) ; returns 15

Of course I could flatten the list first, but reduce is a general function, sometimes you must preserve the structure and order of the original sequence. For example, map and filter can be implemented with reduce. What if I wanted to write an implementation of my-map, based on reduce, so that:

(my-map '1+ '(1 (2 (3) 4) 5)) ; outputs '(2 (3 (4) 5) 6)

How to use reduce over a tree structure? What is the most generic way to apply a binary function over a tree?

回答1:

I've provided an implementation of a treeduce function in Counting elements of a list and sublists, and although it's for Scheme, the same principles apply here. Wikipedia, in the Fold (higher-order function), says:

In functional programming, fold – also known variously as reduce, accumulate, aggregate, compress, or inject – refers to a family of higher-order functions that analyze a recursive data structure and recombine through use of a given combining operation the results of recursively processing its constituent parts, building up a return value. Typically, a fold is presented with a combining function, a top node of a data structure, and possibly some default values to be used under certain conditions. The fold then proceeds to combine elements of the data structure's hierarchy, using the function in a systematic way.

The list data structure can be described as an algebraic datatype:

List ::= Cons(Object, List)
       | Nil

When we call reduce with a function a list, we're essentially turning each use of Cons into an application of the function, and each use of Nil with some constant value. That is, we take the list

Cons(x,Cons(y,Cons(z,Nil)))

and turn it into

Fn(x,Fn(y,Fn(z,init)))

Alternatively, you can imagine Nil and init as as a zero-argument functions, in which case the list is turned into

Fn(x,Fn(y,Fn(z,init())))

For trees, we can do the same thing, but it's a little bit more complex. For a tree, the algebraic datatype is:

Tree ::= Node(Tree,Tree)
       | Leaf(Object)

To do a reduce for a tree, then, we need two functions: one to replace Node and one to replace Leaf. The definition is pretty straightforward, though:

TreeReduce(nodeFn,leafFn,tree) =
  case tree of 
    Node(left,right) => nodeFn(TreeReduce(nodeFn,leafFn,left),TreeReduce(nodeFn,leafFn,right)
    Leaf(object) => leafFn(object)

In Common Lisp, that's simply:

(defun tree-reduce (node-fn leaf-fn tree)
  (if (consp tree)
      (funcall node-fn 
               (tree-reduce node-fn leaf-fn (car tree))
               (tree-reduce node-fn leaf-fn (cdr tree)))
      (funcall leaf-fn 
               tree)))

(tree-reduce 'cons
             (lambda (x) 
               (if (numberp x) (1+ x) x))
             '(1 (2 3) (4 5 6)))
;=> (2 (3 4) (5 6 7))

We can use tree-reduce to compute the sum that you asked about:

(tree-reduce '+
             (lambda (x)
               (if (null x) 0 x))
             '(1 (2) (3 (4) 5)))
;=> 15

The reason that we need all of these null guards is that when we're viewing a cons-based structure as a tree, nil isn't really anything special. That is, we could consider the tree (1 (2 . 3) 4 . 5) as well as (1 (2 3) 4 (5)) (which is the same as (1 (2 3 . nil) 4 (5 . nil) . nil), of course).

回答2:

Common Lisp does not have tree versions of map or reduce. In fact, the only tree functions I can remember off-hand are tree-equal and subst.

However, it should not be too hard to do something like:

(defun reduce-tree (function tree &key (key #'identity))
  (if (atom tree)
      (funcall key tree)
      (funcall function
               (reduce-tree function (car tree) :key key)
               (reduce-tree function (cdr tree) :key key))))

try it:

> (reduce-tree #'+ '(1 . ((2 . 3) . ((4 . 5) . 6))))
==> 21
> (reduce-tree #'+ '(1 (2) (3 (4) 5)) :key (lambda (x) (or x 0)))
==> 15

回答3:

In addition to developing a tree-reduce, a useful exercise is to try to repair your existing code so that it is more generally applicable.

That is, we take what you have:

(defun tree+ (a b)
  (cond ((null b) 0)
        ((atom b) (+ a b))
        (t (+ (tree+ a (car b))
              (tree+ 0 (cdr b))))))

(reduce #'tree+ '(1 (2) (3 (4) 5)) :initial-value 0)

Note how we are just passing #'tree+ into reduce, and tree+ is hard-coded for addition. The obvious fix is is to curry the + function as a functional argument.

To achieve this, we can very simply transform the bulk your tree+ into a function that returns a function.

We don't use lambda, because then we would need a Y-combinator or other silly hack to handle the recursion, which is much more easily achieved by using labels to our function a local name:

(defun tree-reducer (binary-func &optional initial-val)
  (labels ((tr-red (a b)
             (cond ((null b) initial-val) 
                   ((atom b) (funcall binary-func a b))
                   (t (+ (tr-red a (car b))
                         (tr-red initial-val (cdr b)))))))
     #'tr-red))

Now this is used like this:

(reduce (tree-reducer #'+ 0) '(1 (2) (3 (4) 5)) :initial-value 0)  -> 15

Unfortunately, the initial value is specified twice, the reason for this being that the function returned by tree-reducer takes on some of the responsibility of carrying out the reduce logic! Note that when we add a level of nesting to the tree and call:

(reduce (tree-reducer #'+ 0) '((1 (2) (3 (4) 5))) :initial-value 0) -> 15

who is doing the work of producing 15? Not the reduce function! All it does is call the function once, with the arguments ((1 (2) ...))) and 0, which then does all the work.

Also, the initial-value argument of tree-reducer will seriously misbehave if it is not the identity element for the given function (like zero to addition).

(reduce (tree-reducer #'+ 0) '(1 (2) (3 (4) 5)) :initial-value 1) -> 16  ;; OK

(reduce (tree-reducer #'+ 1) '(1 (2) (3 (4) 5)) :initial-value 0) -> 20  ;; Whoa!