[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

*To*: info-mcl@digitool.com*Subject*: permutation*From*: Janusz Podrazik <jpod@mrac.demon.co.uk>*Date*: Thu, 26 Jan 1995 18:34:08 -0800*Sender*: owner-info-mcl@digitool.com

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

- Prev by Date:
**Re: Speech-Manager.lisp contributed code** - Next by Date:
**Re: MacHTTP, Applescript and MCL** - Previous by thread:
**Re: Speech-Manager.lisp contributed code (shame on me)** - Next by thread:
**graphic version of Common Music** - Index(es):