marqrdt Posted December 27, 2016 Share Posted December 27, 2016 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 Quote Link to comment Share on other sites More sharing options...

opmo Posted December 28, 2016 Share Posted December 28, 2016 If you are looking for few permutations: (gen-eval 12 '(rnd-order '(0 1 2 3 4 5 6 7 8 9 10 11))) Quote Link to comment Share on other sites More sharing options...

LdBeth Posted April 12, 2020 Share Posted April 12, 2020 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)) opmo 1 Quote Link to comment Share on other sites More sharing options...

## Recommended Posts

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.