How to generate all the permutations of elements in a list one at a time in Lisp?

General principle

Suppose you have the following range function:

(defun range (start end &optional (step 1))
  (loop for x from start below end by step collect x))

You can accept another parameter, a function, and call it for each element:

(defun range-generator (callback start end &optional (step 1))
  (loop for x from start below end by step do (funcall callback x)))

This gives the caller control over the iteration process:

(block root
  (range-generator (lambda (v)
                     (print v)
                     (when (>= v 10)
                       (return-from root)))
                   0 300))


0 
1 
2 
3 
4 
5 
6 
7 
8 
9 
10

See RETURN, BLOCK.

Permutations

If you want to avoid allocating too much memory, you can arrange for your code to allocate intermediate data-structures once and reuse them for each call to the callback. Here is an annotated example:

(defun permutations% (list callback)
  (when list
    (let* (;; Size of input list
           (size (length list))

           ;; EMPTY is a sentinel value which is guaranteed to
           ;; never be equal to any element from LIST.
           (empty (gensym "SENTINEL"))

           ;; Working vector containing elements from LIST, or
           ;; EMPTY. This vector is mutated to remember which
           ;; element from the input LIST was already added to the
           ;; permutation.
           (items (make-array size :initial-contents list))

           ;; Working vector containing the current
           ;; permutation. It contains a FILL-POINTER so that we
           ;; can easily call VECTOR-PUSH and VECTOR-POP to
           ;; add/remove elements.
           (permutation (make-array (length items) :fill-pointer 0)))

      ;; Define a local recursive function named POPULATE, which
      ;; accepts a COUNT argument. The count starts at SIZE and
      ;; decreases at each recursive invocation, allowing the
      ;; function to know when it should end.
      (labels ((populate (count)
                 (if (plusp count)
                     ;; Loop over ITEMS by index
                     (dotimes (item-index size)
                       (let ((item (svref items item-index)))
                         ;; We found an ITEM which is not yet
                         ;; present in PERMUTATION.
                         (unless (eq item empty)
                           ;; Push that element
                           (vector-push item permutation)
                           ;; Replace current value in ITEMS by EMPTY
                           (setf (svref items item-index) empty)

                           ;; POPULATE will recursively populate
                           ;; the remaining elements in
                           ;; PERMUTATION and call CALLBACK. Once
                           ;; it is done, it will return here.
                           (populate (1- count))

                           ;; There are other items to process in
                           ;; current loop. Reset the state to how
                           ;; it was before calling POPULATE.

                           ;; Replace the EMPTY value by the
                           ;; original ITEM at current index.
                           (setf (svref items item-index) item)

                           ;; Remove ITEM from PERMUTATION.
                           (vector-pop permutation))))

                     ;; We filled PERMUTATION with SIZE elements.
                     ;; Call CALLBACK with PERMUTATION. Note: the
                     ;; callback function is always given the same
                     ;; vector, but its content changes over
                     ;; time. The value passed to CALLBACK is thus
                     ;; valid only during the time we are
                     ;; executing CALLBACK. If the caller needs to
                     ;; keep a copy of the current permutation, it
                     ;; should COPY-LIST the value.
                     (funcall callback permutation))))

        ;; Initiate recursive function with current SIZE.
        (populate size)))))

The function accepts a list and a callback, which is a function accepting one parameter, the current permutation. Note that this parameter is valid only during the dynamic extent of the call, because once the call returns, the same data-structure that was passed to the callback is modified.

As explained above, you can call any function, in particular closure which refers to other variable in the lexical environment. Here, the anonymous lambda increment the count variable, which allows to count the number of permutations, without storing them in a list and getting the size of the list:

(time
 (let ((count 0))
   (permutations% '(a b c d e f g h i j k) (lambda (p) (incf count)))
   count))
=> 39916800

Evaluation took:
  6.455 seconds of real time
  6.438200 seconds of total run time (6.437584 user, 0.000616 system)
  99.74% CPU
  17,506,444,509 processor cycles
  0 bytes consed

In the above report, 0 bytes consed represents the approximate number of memory allocated (not counting stack allocation).
You can also offer a safer version of the function which copies each permutation before sending it to the callback function.

(defun permutations (list callback)
  (permutations% list (lambda (permutation)
                        (funcall callback (coerce permutation 'list)))))

See also

See also the answer from Will Ness, which manages to handle the set of remaining elements with a list, thus avoiding the need to filter through EMPTY elements.

Leave a Comment