Jump to content

Featured Replies

Posted

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

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

 

 

Create an account or sign in to comment


Copyright © 2014-2025 Opusmodus™ Ltd. All rights reserved.
Product features, specifications, system requirements and availability are subject to change without notice.
Opusmodus, the Opusmodus logo, and other Opusmodus trademarks are either registered trademarks or trademarks of Opusmodus Ltd.
All other trademarks contained herein are the property of their respective owners.

Powered by Invision Community

Important Information

Terms of Use Privacy Policy