Flatten a list using common lisp

Question

I was reading the book On Lisp by Paul Graham. In Chapter 4, Utility Functions, he gives examples of small functions that operate on lists, which would be helpful while writing a larger program.

One of them is flatten. Given a nested list at any arbitrary level as argument, flatten will remove all the nested elements and put them on the top level.

Below is my attempt at implementing flatten:

(defun flatten (lst)
  (labels ((rflatten (lst1 acc)
                     (dolist (el lst1)
                       (if (listp el)
                         (rflatten el acc)
                         (push el acc)))
                     acc))
    (reverse (rflatten lst nil))))

But the above function does not flatten lists properly.

; returns (1) instead of (1 2)
(print (flatten '(1 (2))))
(1)

Calling the function with (1 (2)) returns (1) instead of (1 2).

I cannot find what's wrong with my implementation of flatten. Is it the way I am using labels? Or is it the the way I am using the dolist macro? The dolist macro always returns nil. But that should not matter as I am using an accumulator acc to store the flattened list.

Answer 1

push changes the symbol binding in scope. Thus the recursion (rflatten el acc) has it's own acc which is the result there but you don't do anything with the returned result and it doesn't alter the callee acc.

Perhaps a (setf acc (rflatten el acc)) would fix that:

(defun flatten (lst)
  (labels ((rflatten (lst1 acc)
             (dolist (el lst1)
               (if (listp el)
                   (setf acc (rflatten el acc))
                   (push el acc)))
             acc))
    (reverse (rflatten lst nil))))

Answer 2

You're actually very close. As Sylwester mentions, the issue is that (push el acc) only modifies the local binding of el (of which there's a new one for each call to rflatten. As Rainer mentions, it's not really an accumulator in the traditional sense, so I'm going not going to call it acc, but result. Since you're already defining a local function, there's no reason not to define result in a wider scope:

(defun flatten (lst)
  (let ((result '()))
    (labels ((rflatten (lst1)
               (dolist (el lst1)
                 (if (listp el)
                   (rflatten el)
                   (push el result)))))
      (rflatten lst)
      (nreverse result))))

There are actually a few ways to clean this up, too. The first is a matter of style and taste, but I'd use an &aux variable to bind result, so

(defun flatten (lst &aux (result '()))
  ...)

The next is that dolist can take a third argument, a form to evaluate as for the return value. This is often used in a "push to create a list, then reverse for the return value" idiom, e.g.,

(let ((result '()))
  (dolist (x list (nreverse result))
    ...
    (push ... result)))

You don't want to reverse after every dolist, but you can still return result from the dolist, and thus from rflatten. Then you can simply call nreverse with the result of rflatten:

(defun flatten (lst &aux (result '()))
  (labels ((rflatten (lst1)
             (dolist (el lst1 result)
               (if (listp el)
                 (rflatten el)
                 (push el result)))))
      (nreverse (rflatten lst))))

Answer 3

A non-recursive code which builds the result by conses, following comments and starting from a code by user:Sylwester:

(defun flatten (lst &optional back acc)
  (loop
     (cond 
        ((consp lst) (psetq lst (cdr lst)              ; parallel assignment
                           back (cons (car lst) back)))
        (back
                  (if (consp (car back))  
                    (psetq lst (cdar back)
                          back (cons (caar back) (cdr back)))
                    (psetq acc (if (car back) (cons (car back) acc) acc)
                          back (cdr back))))
        (t     
               (return acc)))))                        ; the result

It's not pretty, but it seems to work. Parallel assignment PSETQ is used to simulate tail-recursive call frame update without worrying about precise sequencing.

Implements the same process as the one encoded nicely by

(defun flatten2 (l z)
    (cond
        ((endp l) z)
        ((listp (car l)) (flatten2 (car l) (flatten2 (cdr l) z)))
        ((atom (car l)) (cons (car l) (flatten2 (cdr l) z)))))

(defun flatten (l)
   (flatten2 l nil))

with implicit stack operations explicated as list structure manipulations among the variables.

Answer 4

I discovered a solution which does not use helper functions or variable assignment, and constructs the list in a forward manner, which I think is easier to understand.

(defun flatten (lst &aux (re '()))
  (cond
    ((null lst) '())
    ((listp (car lst))
     (append (flatten (car lst))
             (append (flatten (cdr lst))
                     re)))
    (t (cons (car lst)
             (append (flatten (cdr lst)) re)))))

And we can easily adapt it to control the depth of the flattening!

(defun flatten* (lst depth &aux (re '()))
  (cond
    ((null lst) '())
    ((listp (car lst))
     (append (cond
               ((= 0 depth)             ; flatten none
                (list (car lst)))
               ((< 0 depth)             ; flatten down
                (flatten* (car lst) (- depth 1)))
               ((= -1 depth)            ; flatten all
                (flatten* (car lst) depth))
               ((< depth -1)            ; flatten up
                (list (flatten* (car lst) (+ depth 1)))))
             (append (flatten* (cdr lst) depth)
                     re)))
    (t (cons (car lst)
             (append (flatten* (cdr lst) depth) re)))))