How to generate all the permutations of elements i

问题:

I already have the code to generate all the permutations for a list of elements. However, I realized that if I want to manipulate the lists that are generated, I would need to traverse this list. This list can be potentially massive and therefore expensive to keep. I wanted to know if there was a way to generate the permutations by each call so that I can check if the list matches with what I need and if not I will generate the next permutation. (Each time the function will return a list one at a time.)

My code:

(defun allPermutations (list) 
  (cond
     ((null list)  nil) 
     ((null (cdr list))  (list list)) 
     (t  (loop for element in list 
               append (mapcar (lambda (l) (cons element l))
                              (allPermutations (remove element list))))))) 

回答1:

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 lifetime (dynamic extent) of the callback.

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.

回答2:

Here's a way (following the code structure by @coredump from their answer; runs about 4x faster on tio.run):

(defun permutations (list callback)
  (when list
    (let* ((all (cons 'head (copy-list list)))           ; head sentinel FTW!
           (perm (make-array (length list))))
      (labels ((g (p i &aux (q (cdr p)))
                (cond
                  ((null (cdr q))   
                     (setf (svref perm i) (car q))       ; the last item
                     (funcall callback perm))
                  (T (loop while q do 
                        (setf (svref perm i) (car q))    ; pick the item
                        (rplacd p (cdr q))               ; pluck it out
                        (g all (1+ i))                   ; recurse!
                        (rplacd p q)                     ; heal the list back
                        (pop p)  
                        (pop q))))))                     ; advance the pointers
        (g all 0))))) 

; > (permutations '(1 2 3) #'princ)
; #(1 2 3)#(1 3 2)#(2 1 3)#(2 3 1)#(3 1 2)#(3 2 1)

This uses recursion to build an n nested loops structure for the n-long input list, at run time, with the fixed i = 0, 1, ..., n-1 in each nested loop being the position in the result-holding permutation array to put the picked item into. And when all the n positions in the array are filled, in the innermost loop (which isn't even a loop anymore as it has just one element left to process), the user-supplied callback is called.

Implements the "shrinking domains" paradigm as in this pseudocode:

for item1 in list:
   domain2 = remove item1 from list by position
   for item2 in domain2:
      domain3 = remove item2 domain2 by position
      for item3 in domain3:
             ......
             ......
             (callback (list item1 item2 ... item_n))

but in the real code we do away with all the quadratic interim storage used by this pseudocode, completely, by surgically manipulating the list structure. About the only advantage of the linked lists is their O(1) node removal capability; we might as well use it!

update: special-casing the last two elements of a permutation as well gives about ~ 1.5x additional speedup.