Page 1 of 1
Combinations and Permutations
Posted: Wed Mar 02, 2005 7:58 pm
by Jeremy Dunn
Has anyone written any programs that will take a list of items and return the list of lists of the combinations/permutations of n items taken r at a time?
Posted: Fri Apr 15, 2005 5:41 pm
by rickyboy
Hello Jeremy,
This reply is a little dated since I really only just joined this group recently.
How about some code for k-permutations of a multi-set? It's in Common Lisp, not newLISP (but you could translate it).
Code: Select all
;;
;; Warren-Hanson algorithm for generating permutations of
;; multisets.
;;
> (defun make-k-permutations (k multiset)
(let ((pivots (remove-duplicates multiset)))
(if (= k 1)
(mapcar #'list pivots)
(let ((acc '()))
(dolist (p pivots acc)
(let ((sub-multiset (remove p multiset :count 1)))
(dolist (sub-perm (make-k-permutations
(1- k)
sub-multiset))
(push (cons p sub-perm) acc))))))))
MAKE-K-PERMUTATIONS
> (setq M1 '(93 4 42 93 5 7 8 10 8 8 10 42 4))
(93 4 42 93 5 7 8 10 8 8 10 42 4)
> (make-k-permutations 2 M1)
((4 4) (4 42) (4 10) (4 8) (4 7) (4 5) (4 93) (42 4) (42 42)
(42 10) (42 8) (42 7) (42 5) (42 93) (10 4) (10 42) (10 10)
(10 8) (10 7) (10 5) (10 93) (8 4) (8 42) (8 10) (8 8) (8 7)
(8 5) (8 93) (7 4) (7 42) (7 10) (7 8) (7 5) (7 93) (5 4) (5 42)
(5 10) (5 8) (5 7) (5 93) (93 4) (93 42) (93 10) (93 8) (93 7)
(93 5) (93 93))
How this works is you first make a list of pivots which are just the unique entries in the given multiset. For each pivot p, remove p from the original multiset, yielding a multiset like the original except minus one occurrence of p. Then recursively, compute the (k-1)-permutations of this new multiset. Now, cons the pivot p onto each of these (k-1)-permutations, accumulating them in 'acc'. After you do this for every pivot p, you have the answer!
I hope this helps. Sorry for the delay (you may already have had an answer!). If you've found a better solution, please let me (us) know.
Regards, --Ricky
P.S. -- The function 'make-k-permutations' is not really formally known as the Warren-Hanson algorithm. :-) This is a joke -- my friend John Warren and I collaborated on its development, hence the endearing name.
Posted: Fri Apr 15, 2005 9:41 pm
by Lutz
I tried a quick translation into newLISP. Seems to work but haven't checked it extensively:
Code: Select all
;;
;; Warren-Hanson algorithm for generating permutations of
;; multisets. - modified for newLISP
;;
;;
(define (make-k-p k multiset)
(let ((pivots (unique multiset)))
(if (= k 1)
(map list pivots)
(let ((acc '()))
(dolist (p pivots)
(let ((sub-multiset (replace p multiset)))
(dolist (sub-perm (make-k-p (- k 1) sub-multiset))
(push (cons p sub-perm) acc)))) acc) )))
Lutz
ps: will put this in the Code Snippets file int the 'Tips and Tricks' section with your permission?
ps: corrected (rest muiltiset) => (replace p multiset), now its almost identical to the original!
Posted: Sat Apr 16, 2005 5:34 am
by rickyboy
He, he, he. Of course, you may use the code in "Tips and Tricks"! I'm just sorry I can't contribute code on the order that others have -- I just flat out don't have the time. :-(
BTW, there is a subtle bug in the newLISP version of 'make-k-permutations'. Say you have a multiset M given by
Code: Select all
(setq M '(93 4 42 93 5 7 8 10 8 8 10 42 4))
Then, when you compute the 2-permutations of M, your first pivot p will be 93. In this case, if you then remove all 93s from M (thereby yielding 'sub-multiset') and compute the (k-1)-permutations of 'sub-multiset' (which are all singletons in this case), you'll never get back the singleton '(93)' which you would expect because of the second occurrence of 93 in M. Which means that the final answer won't have the 2-permutation '(93 93)', namely.
The answer is to remove
only one occurrence of any pivot in the multiset yielding 'sub-multiset' and indeed this is why the Common Lisp version has the call to 'remove' with the ':count 1' keyword argument. We would need to mimick this behavior, as in the following.
Code: Select all
(define (make-k-permutations k multiset)
(let ((pivots (unique multiset)))
(if (= k 1)
(map list pivots)
(let ((acc '()))
(dolist (p pivots)
(let ((sub-multiset (remove1 p multiset)))
(dolist (sub-perm
(make-k-permutations (- k 1) sub-multiset))
(push (cons p sub-perm) acc))))
acc))))
(define (remove1 elt lst)
(let ((elt-pos (find elt lst)))
(if elt-pos (pop lst elt-pos))
lst))
Posted: Sat Apr 16, 2005 1:00 pm
by Lutz
Thanks Rick, the corrected version will be in 'Code Snippets' this weekend.
Lutz