A little over a year ago, my friend John Warren and I developed an algorithm which computes the k-permutations of a multiset (k is at most the size of the multiset). John does not program in Lisp, but I do and the algorithm can be clearly and concisely expressed in Lisp. Here it is:
(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))))))))
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!
Here it is in action:
> (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))
Here’s a version of the same function in newlisp (followed by the necessary helper function remove1).
(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))
