[alexandria-devel] Fold operators on lists and trees in Alexandria?

[Heka Treep]

Hi.

I was found that there is no effective fold operators on lists or trees in
CL. I know that `reduce' can do this (as an article in Wikipedia sayz) but
`reduce' is not very effective. As stated in the Graham Hutton's article
``fold is a standard operator that encapsulates a simple pattern of
recursion for processing lists'', also catamorphism at some ADT plays the
same role. So I thought that if we introduce an effective fold operators, it
becomes possible to express many functions through its shortly and
effectively (in fact, almost any function on that ADT).

Take for example the `flatten' function that is defined in Alexandria as
follows:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ok, TCO recursion:
;;
(defun flatten (tree)
  (let (list)
    (labels ((traverse (subtree)
               (when subtree
                 (if (consp subtree)
                     (progn
                       (traverse (car subtree))
                       (traverse (cdr subtree)))
                     (push subtree list)))))
      (traverse tree))
    (nreverse list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

We need an ADT for the trees, but in the first approximation we can use
nested lists.

When expressed in terms of reduce:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun flatten/reduce (list)
  (reduce #'(lambda (e rest)
                  (typecase e
                    (atom (cons e rest))
                    (list (append (flatten/reduce e) rest))))
          list
          :initial-value nil
          :from-end t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Now if we translate pure functional operator (here is `reduce') to the
instructions for tagbody/go "state machine":

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fold-left f '(a b c) i
;;;
;;;       f
;;;      /\
;;;     f  c
;;;    /\
;;;   f  b
;;;  /\
;;; i  a
;;;
;;; foldl f z []     = z
;;; foldl f z (x:xs) = foldl f (f z x) xs

(defun fold-left (function list &optional initial-value)
  (let ((result initial-value))
    (tagbody
     :start
     (unless (endp list)
       (setq result (funcall function result (car list)))
       (setq list (cdr list))
       (go :start)))
    result))

;;; fold-rigth f '(a b c) i
;;;
;;;   f
;;;  /\
;;; a  f
;;;    /\
;;;   b  f
;;;      /\
;;;     c  i
;;;
;;; foldr f z []     = z
;;; foldr f z (x:xs) = f x (foldr f z xs)

(defun fold-rigth (function list &optional initial-value)
  (let ((result initial-value)
        (list (nreverse list)))
    (tagbody
     :start
     (unless (endp list)
       (setq result (funcall function (car list) result))
       (setq list (cdr list))
       (go :start)))
    result))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Then `flatten' can be written as:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun flatten/fold-rigth (list)
  (fold-rigth #'(lambda (e rest)
                  (typecase e
                    (atom (cons e rest))
                    (list (append (flatten e) rest))))
              list nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

I try to benchmarc (this three functions) and has the following results:

flatten/fold-rigth

X time
Y memory

alexandria:flatten

10 * X time
23 * Y memory

flatten/reduce

42 * X time
83 * Y memory

So, its look resonable to use folders there.



((sorry for my english - I just using google.translate :))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/alexandria-devel/attachments/20100808/ddc4e617/attachment.html>