Next Permutation in the Lexicographical Ordering

Description of the problem

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.

Some theory

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.

The code

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))