Jump to content

Recommended Posts

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.





Link to post
Share on other sites
  • 3 years later...

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



Link to post
Share on other sites

Join the conversation

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

Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Create New...

Important Information

Terms of Use Privacy Policy