Listing permutations of a list of objects is a useful thing. However, the space complexity is \(n!\approx n^n\) which is worse than exponential. One way getting around this problem is to find a way of generating the list in a sequential manner by using a total order on all permutations. Today, I am going to write a common lisp program that gives the list of all permutations of a list using such a total order.
One can order all permutations using the lexicographical ordering. If we use this order, then given a permutation we know what the next one is going to be. So, here is the algorithm in pseudo-code
Algorithm NextPermutation
Input: A permutation sigma = a(1), ..., a(n)
Output: The next permutation sigma' = b(1), ..., b(n) in the lexicographical order
Begin
i <- max { k | a(k-1) <= a(k) }
If i > 0
j <- max { k | a(k+i) > a(i-1) }
Swap a(i-1) and a(i+j-1)
Return a(1), ..., a(i-1), a(n), a(n-1), ..., a(i)
Else
Return NIL
End If
End
The algorithm and the pseudo-code I use here is a modified version I saw in here.
First, I need two utility functions:
(defun take-until (pred xs &optional (c 0))
(if (funcall pred xs)
c
(take-until pred (cdr xs) (incf c))))
TAKE-UNTIL
This function processes a list of objects until a predicate is satisfied. It returns the index at which the predicate is satisfied. Next, we have:
(defun iterate-until (pred fn val &optional carry)
(let ((next (funcall fn val)))
(if (funcall pred next)
(reverse (cons val carry))
(iterate-until pred fn next (cons val carry)))))
ITERATE-UNTIL
This function iterates a function until a predicate is satisfied. It returns the list of values in the iteration as a list.
Now, the main function:
(defun next-permutation (xs)
(let ((i (- (length xs) 1 (take-until (lambda (ys)
(or (null ys)
(null (cdr ys))
(> (car ys) (cadr ys))))
(reverse xs)))))
(if (> i 0)
(let* ((x (elt xs (1- i)))
(j (take-until (lambda (ys)
(or (null ys)
(<= (car ys) x)))
(subseq xs i)))
(zs (copy-list xs)))
(setf (elt zs (1- i)) (elt xs (+ i j -1))
(elt zs (+ i j -1)) (elt xs (1- i)))
(append (subseq zs 0 i) (reverse (subseq zs i)))))))
NEXT-PERMUTATION
This function takes a permutation of elements and then returns the next permutation in the lexicographical ordering. Let us check:
(iterate-until #'null #'next-permutation '(0 1 1 2 2 2))
((0 1 1 2 2 2) (0 1 2 1 2 2) (0 1 2 2 1 2) (0 1 2 2 2 1) (0 2 1 1 2 2)
(0 2 1 2 1 2) (0 2 1 2 2 1) (0 2 2 1 1 2) (0 2 2 1 2 1) (0 2 2 2 1 1)
(1 0 1 2 2 2) (1 0 2 1 2 2) (1 0 2 2 1 2) (1 0 2 2 2 1) (1 1 0 2 2 2)
(1 1 2 0 2 2) (1 1 2 2 0 2) (1 1 2 2 2 0) (1 2 0 1 2 2) (1 2 0 2 1 2)
(1 2 0 2 2 1) (1 2 1 0 2 2) (1 2 1 2 0 2) (1 2 1 2 2 0) (1 2 2 0 1 2)
(1 2 2 0 2 1) (1 2 2 1 0 2) (1 2 2 1 2 0) (1 2 2 2 0 1) (1 2 2 2 1 0)
(2 0 1 1 2 2) (2 0 1 2 1 2) (2 0 1 2 2 1) (2 0 2 1 1 2) (2 0 2 1 2 1)
(2 0 2 2 1 1) (2 1 0 1 2 2) (2 1 0 2 1 2) (2 1 0 2 2 1) (2 1 1 0 2 2)
(2 1 1 2 0 2) (2 1 1 2 2 0) (2 1 2 0 1 2) (2 1 2 0 2 1) (2 1 2 1 0 2)
(2 1 2 1 2 0) (2 1 2 2 0 1) (2 1 2 2 1 0) (2 2 0 1 1 2) (2 2 0 1 2 1)
(2 2 0 2 1 1) (2 2 1 0 1 2) (2 2 1 0 2 1) (2 2 1 1 0 2) (2 2 1 1 2 0)
(2 2 1 2 0 1) (2 2 1 2 1 0) (2 2 2 0 1 1) (2 2 2 1 0 1) (2 2 2 1 1 0))