permutation

[Janusz Podrazik <jpod@mrac.demon.co.uk>]

Thanks,

The problem is to permute, were repeated elements are treated as identical.

(permute '(a a b b))
; -> ((a a b b) (a b a b) (a b b a) (b a a b) (b a b a) (b b a a))

Janusz

From: "Doug Currie, Flavors Technology, Inc." <e@flavors.com>

#| my first try...
(defun permute (ls)
  (if (null ls)
    nil
    (if (null (cdr ls))
      (list ls)
      (mapcan #'(lambda (x)
                  (mapcar #'(lambda (y) (cons x y))
                    (permute (remove x ls)))) ls))))
|#
;; Duncan Smith's improvement...

(defun permute (ls)
  (if (null ls)
    nil
    (if (null (cdr ls))
      (list ls)
      (mapcon
       #'(lambda (x)
           (mapcar
            #'(lambda (y)
                (cons (car x) y))
            (permute (nconc (ldiff ls x) (cdr x)))))
       ls))))

e


From: ethan+@pitt.edu

One of the things that I love about Lisp is that encourages recursion.
It may not be efficient in every case but it is elegantly simple and
fun to write!

Here's a recursive solution (I've written it to be easy to understand
rather than compact or efficient):

(defun permute (list)
  (if (= 1 (length list))
    (list list)
    (do ((n 0 (1+ n))
         (permuted-list '())
         item
         sublist)
        ((= n (length list)) permuted-list)

      ; remove each item, one at a time,  and tack it on the front of
      ; every permutation of the remaining items.
      (setf item (nth n list)
            sublist (append (subseq list 0 n)
                            (subseq list (1+ n))))

      (dolist (permuted-sublist (permute sublist))
        (push (append (list item) permuted-sublist)
              permuted-list)))))

If you really need the whole permutation (and it isn't too big) this
probably isn't a bad approach.  If you only need part of it or if it
is big (original list longer than say 8 or so) then you should
probably generate each permutation as you need it rather than
calculating them all at once.  That isn't nearly as fun so I haven't
done it, but it would be much more space-efficient.  Off the top of my
head I would probably try making a vector of integers as long as the
list and then generate each permutation by altering the vector so that
its contents describe how to reorder the initial list.  There may be
something helpful in CLtl2 under the sections on Series or Generators
and Gatherers (neither part of CL) but it shouldn't be too hard.

Remember you're dealing with a factorial explosion:
===================
? (time (length (permute '(a b c d e))))
(LENGTH (PERMUTE '(A B C D E))) took 93 milliseconds (0.093 seconds)
to run.
Of that, 25 milliseconds (0.025 seconds) were spent in The Cooperative
Multitasking Experience.
 16320 bytes of memory allocated.
120

? (time (length (permute '(a b c d e f))))
(LENGTH (PERMUTE '(A B C D E F))) took 136 milliseconds (0.136
seconds) to run.
Of that, 1 milliseconds (0.001 seconds) were spent in The Cooperative
Multitasking Experience.
 115560 bytes of memory allocated.
720

? (time (length (permute '(a b c d e f g))))
(LENGTH (PERMUTE '(A B C D E F G))) took 1030 milliseconds (1.030
seconds) to run.
Of that, 14 milliseconds (0.014 seconds) were spent in The Cooperative
Multitasking Experience.
 930384 bytes of memory allocated.
5040

etc.....


Ethan Benatan
ethan+@pitt.edu

From: miller@cs.rochester.edu

here are some helpful functions from CL-LIB (on ftp.cs.rochester.edu,
and Mark K's CMU library, access both from
http://www.cs.rochester.edu/u/miller/alu.html)

Mark Kantrowitz was the original author of the following functions.

(defun cartesian-product (set1 set2)
  "Returns the cross product of two sets."
  (let ((result ()))
    (dolist (elt1 set1)
      (dolist (elt2 set2)
        (push (cons elt1 elt2) result)))
    result))

(defun cross-product (&rest lists)
  "Returns the cross product of a set of lists."
  (labels ((cross-product-internal (lists)
             (if (null (cdr lists))
                 (mapcar #'list (car lists))
                 (let ((cross-product (cross-product-internal (cdr lists)))
                       (result '()))
                   (dolist (elt-1 (car lists))
                     (dolist (elt-2 cross-product)
                       (push (cons elt-1 elt-2) result)))
                   result))))
    (cross-product-internal lists)))

(defun permutations (items)
  "Given a list of items, returns all possible permutations of the list."
  (let ((result nil))
    (if (null items)
        '(nil)
        (dolist (item items result)
          (dolist (permutation (permutations (remove item items)))
            (push (cons item permutation) result))))))

(defun powerset (list)
  "Given a set, returns the set of all subsets of the set."
  (let ((result (list nil)))
    (dolist (item list result)
      (dolist (subset result)
        (push (cons item subset) result)))))