Permutations

[marqrdt]

I find the permute function very useful, but I've some across the need to work with a very large number of permutations (all possible 12-note rows, but other situations as well). I think it would be great to have a companion function, something like nth-permutation, that returns the nth permutation of a list, as we know there will be (setq num-perms (factorial (length my-list))) permutations, and they can be traversed in a simple (loop from i upto num-perms (do-stuff (nth-permutation i))). For numbers beyond 10, the list is too large to store in memory. The Wikipedia article on permutations has some excellent strategies on cycling through all permutations one at a time and even offers some pseudo-code. I'm working on one in Common Lisp but I'm pretty much of a newbie. I'll gladly share it if I can get it working.

 

Thanks!

 

Paul

[opmo]

If you are looking for few permutations:

(gen-eval 12 '(rnd-order '(0 1 2 3 4 5 6 7 8 9 10 11)))

 

[LdBeth]

you can work with Common Lisp arrays to reduce memory usage.

 

Here's a very direct translation of Algorithm T from http://www.kcats.org/csci/464/doc/knuth/fascicles/fasc2b.pdf which precomputes the permutation table of n distinct elements.

 

;; We needs to use the factorial function
(defun factorial (x)
  ...)

(defun algorithm-t (n &aux (num (factorial n)))
  ;; The `(integer 1 ,n) declaration will make sure CCL allocates far less memory
  ;; then using 'integer or 'fixnum.
  (let ((table (make-array num :element-type `(integer 1 ,n) :initial-element 0))
        (m 2)
        j k d)
    (setf d (floor num 2)
          (aref table d) 1)
    (loop until (= m n)
          do (progn (incf m)
                    (setf d (floor d m))
                    (setf k 0)
                    (prog ()
                     t3
                       (setf k (+ k d)
                             j (- m 1))
                       (loop while (> j 0)
                            do (setf (aref table k) j
                                     j (1- j)
                                     k (+ k d)))
                      (incf (aref table k))
                      (setf k (+ k d))
                      (loop while (< j (1- m))
                            do (progn
                                 (incf j)
                                 (setf (aref table k) j
                                       k (+ k d))))
                      (if (< k num)
                          (go t3)))
                    )
          finally (return table))))
          
;; CL-USER> (algorithm-t 4)
;; #(0 3 2 1 3 1 2 3 1 3 2 1 3 1 2 3 1 3 2 1 3 1 2 3)
;; Since Knuth uses 1 as index origin but CL uses 0, there's one extra element in the computated array.

;; here's a warper
(defun n-th-permutation (n array table &aux tmp (array (copy-seq array)))
  (loop for k from 1 to n
        do (setf tmp (aref array (1- (aref table k)))
                 (aref array (1- (aref table k))) (aref array (aref table k))
                 (aref array (aref table k)) tmp)
        finally (return array)))
        
;; usage:  for a list of 5 pitchs '(c4 e4 f4 d4 g4)

;; first converts to a array

> (setf tmp (coerce '(c4 e4 f4 d4 g4) 'array))
#(C4 E4 F4 D4 G4)

;; compute the permutation table, it could take a while for a "big" value such as 12
> (setf n-table (algorithm-t 5))
#(0 4 3 2 1 4 1 2 3 4 ...



;; then apply the n-th-permutation
> (loop for i from 1 to 15 by 2
               collect (n-th-permutation i tmp n-table))
;Compiler warnings :
;   In an anonymous lambda form: Undeclared free variable TMP
;   In an anonymous lambda form: Undeclared free variable N-TABLE
(#(C4 E4 F4 G4 D4) #(C4 G4 E4 F4 D4) #(G4 C4 E4 D4 F4) #(C4 E4 G4 D4 F4)
 #(C4 E4 D4 F4 G4) #(C4 D4 E4 G4 F4) #(C4 G4 D4 E4 F4) #(G4 D4 C4 E4 F4))