Topic: -={ Challenge }=- Get Permutations

[Lee Mac]

The Challenge:

To return all permutations of a list.

Example:

Code: [Select]

(GetPermutations '(a b c))

==>  ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
Hence for a list of length 'n' we are looking for n! (n factorial) permutations.

Have fun!

[Lee Mac]

To kick us off:

Code: [Select]

(defun LM:GetPermutations ( l / f1 f2 )
    (defun f1 ( l )
        (if (cdr l)
            (apply 'append (mapcar 'f2 l))
            (list l)
        )
    )
    (defun f2 ( a )
        (mapcar '(lambda ( b ) (cons a b)) (f1 (vl-remove a l)))
    )
    (f1 l)
)

[ElpanovEvgeniy]

(GetPermutations '(a b))
;=>>
'((a b)(b a))
or
'((a a) (a b) (b a) (b b))
 

[Lee Mac]

With no repeats:

Code: [Select]

(GetPermutations '(a b))

==> ((a b) (b a))


[ElpanovEvgeniy]

Code: [Select]

(defun test (l)
 (if (cdr l)
  (apply 'append
         (mapcar '(lambda (a) (mapcar '(lambda (b) (cons a b)) (test (vl-remove a l)))) l)
  )
  (list l)
 )
)

[VovKa]

i will not post mine because it's the same as yours', guys
http://www.theswamp.org/index.php?topic=30434.msg360831#msg360831

Lee, maybe you'll find something interesting here
http://www.theswamp.org/index.php?topic=14831.15

[Lee Mac]

Lee, maybe you'll find something interesting here
http://www.theswamp.org/index.php?topic=14831.15

Thanks VovKa - that's an interesting twist! 

[Lee Mac]

Another refinement, to allow for duplicates within the original list, (won't be too quick though  )

Code: [Select]

(defun LM:GetPermutations2 ( l / f1 f2 f3 f4 )
    (defun f1 ( l )
        (if (cdr l)
            (apply 'append (mapcar 'f2 l))
            (list l)
        )
    )
    (defun f2 ( a )
        (mapcar '(lambda ( b ) (cons a b)) (f1 (f3 a l)))
    )
    (defun f3 ( x l )
        (if l
            (if (equal x (car l))
                (cdr l)
                (cons (car l) (f3 x (cdr l)))
            )
        )
    )
    (defun f4 ( l )
        (if l (cons (car l) (f4 (vl-remove (car l) l))))
    )
    (f4 (f1 l))
)

Code: [Select]

(LM:GetPermutations2 '(A A B))

==> ((A A B) (A B A) (B A A))

[ElpanovEvgeniy]

my variant:

Code: [Select]

(defun t1 (l)
 (if (cdr l)
  (t3 (apply 'append
             (mapcar '(lambda (a b) (mapcar '(lambda (b) (cons a b)) (t1 b))) l (t2 nil l))
      ) ;_  apply
  ) ;_  t3
  (list l)
 ) ;_  if
) ;_  defun
(defun t2 (a b)
 (if b
  (cons (append a (cdr b)) (t2 (append a (list (car b))) (cdr b)))
 ) ;_  if
) ;_  defun
(defun t3 (l)
 (if l
  (cons (car l) (t3 (vl-remove (car l) (cdr l))))
 ) ;_  if
) ;_  defun
test:

Code: [Select]

(t1 '(1 2 3));=>> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
(t1 '(1 1 1 2));=>> ((1 1 1 2) (1 1 2 1) (1 2 1 1) (2 1 1 1))

[Lee Mac]

Nice one Evgeniy! Great idea with the 't2' function 

[irneb]

Sorry for reviving this old thread, but I'm trying to figure this one out for myself. The permutations in the previous code is not exactly what I'm after. Say I've got a list of 10 elements, and I want all possible permutations from 1 to 3 in length (duplicates allowed - i.e. permutations and not combinations, but not the same permutations).

E.g.

Code - Auto/Visual Lisp: [Select]

1. (setq lst (0 1 2 3 4 5 6 7 8 9))
2. (permute-n lst 3)
3. ;; Results in (main order not important, but internal order is important [0 1 2] /= [0 2 1], but [0 1 2] may be before or after [0 2 1])
4. ((0) (0 0) (0 0 0) (0 1) (0 2) ... (0 9) (0 1 0) ... (0 1 9) (0 2 0) ... (0 9 9) ...
5.  (1) (1 1) ...
6.  (9) ... (9 9 9))

I think I've got it, but not too sure if there might be a much faster method:

Code - Auto/Visual Lisp: [Select]

1. (defun permute-n  (lst n / f1)
2.   (defun f1  (l / calc)
3.     (if (< (length l) n)
4.       (progn (foreach item lst (setq calc (cons (cons item l) calc)))
5.              (apply 'append (cons (cons l calc) (mapcar 'f1 calc))))
6.       (list l)))
7.   (apply 'append (mapcar 'f1 (mapcar 'list lst))))

[Lee Mac]

Code - Auto/Visual Lisp: [Select]

1. (defun permute-n
2.     < ... >
3. )

I think this function yields a few too many duplicates:

Code - Auto/Visual Lisp: [Select]

1. _$ (permute-n '(0 1) 2)
2. ((0) (1 0) (0 0) (1 0) (0 0) (1) (1 1) (0 1) (1 1) (0 1))

In my mind, this should be:

Code - Auto/Visual Lisp: [Select]

1. _$ (permute-n '(0 1) 2)
2. ((0) (1 0) (0 0) (1) (1 1) (0 1))

Here is an 'nPr' function (I also wrote an 'nCr' function a little while back), though, it's by no means efficient:

Code - Auto/Visual Lisp: [Select]

1. (defun nPr ( l r )
2.     (if (< r 2)
3.         (mapcar 'list l)
4.         (apply 'append (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (cons a b)) (nPr l (1- r)))) l))
5.     )
6. )

Code - Auto/Visual Lisp: [Select]

1. _$ (nPr '(0 1) 2)
2. ((0 0) (0 1) (1 0) (1 1))

Since you also require permutations for all values 1 to r, you could call the above function with:

Code - Auto/Visual Lisp: [Select]

1. (defun nPr< ( l r )
2.     (if (< 0 r) (append (nPr< l (1- r)) (nPr l r)))
3. )

Code - Auto/Visual Lisp: [Select]

1. _$ (nPr< '(0 1) 2)
2. ((0) (1) (0 0) (0 1) (1 0) (1 1))

Or, instead use:

Code - Auto/Visual Lisp: [Select]

1. (defun nPr2 ( l r )
2.     (if (< r 2)
3.         (mapcar 'list l)
4.         (apply 'append (mapcar '(lambda ( a ) (cons (list a) (mapcar '(lambda ( b ) (cons a b)) (nPr2 l (1- r))))) l))
5.     )
6. )

Code - Auto/Visual Lisp: [Select]

1. _$ (nPr2 '(0 1) 2)
2. ((0) (0 0) (0 1) (1) (1 0) (1 1))

[irneb]

Thanks Lee. You're right about my function giving duplicates - that's one of the reasons I was searching for a solution. At the time my mind wasn't working  :-[ , but your codes have given me some new ideas - thanks again.

[Lee Mac]

Thanks Lee. You're right about my function giving duplicates - that's one of the reasons I was searching for a solution. At the time my mind wasn't working  :-[ , but your codes have given me some new ideas - thanks again.

You're welcome Irné; I find these types of functions very interesting and sometimes challenging to write, this arrangment of recursion can mess with the mind

[irneb]

Definitely messes my mind up royally!  I guess there's no efficient permuting idea, permuting simply is not efficient inherently.  :realmad: Will have to ignore this path of the "solution" I've been working on, it simply runs way too long to be of use - the last test-run crashed my PC after 5 hours (length of list makes for exponentially long run times and RAM usage).

[ribarm]

I don't have any math book, so just wondering, is there formula to get number of permutations - not to evaluate them all, just to find out the number?

[ribarm]

I answered my question :

n!

Code - Auto/Visual Lisp: [Select]

1. ;;; N! ;;;
2. ;;; number of Permutations wihout repetition of elements ;;;
3. (defun nP ( n )
4.   (if (> n 1) (* n (nP (1- n))) 1)
5. )
6.  

[Kerry]

I thought a permutation set was based on  ALL items in the base set and produced sets based on the item index in the original list rather than the uniqueness of the item. ... but I could be wrong.

Code - Python: [Select]

1. import itertools
2. set_size = 4
3. data_set = (108, 99, 112, 118, 100, 102, 96, 101)
4.  
5. result = list(itertools.permutations(data_set, set_size))

result will be 1680 set lists based on the data-set

[Kerry]

So the original post problem result would be  :

Code - Python: [Select]

1. result = list(itertools.permutations(('a', 'b', 'c')))
2. for d in result:
3.     print d

Code - Text: [Select]

1. ('a', 'b', 'c')
2. ('a', 'c', 'b')
3. ('b', 'a', 'c')
4. ('b', 'c', 'a')
5. ('c', 'a', 'b')
6. ('c', 'b', 'a')

[Lee Mac]

I thought a permutation set was based on  ALL items in the base set and produced sets based on the item index in the original list rather than the uniqueness of the item. ... but I could be wrong.

Code - Python: [Select]

1. import itertools
2. set_size = 4
3. data_set = (108, 99, 112, 118, 100, 102, 96, 101)
4.  
5. result = list(itertools.permutations(data_set, set_size))

result will be 1680 set lists based on the data-set

I'm not sure which post you are responding to, but my earlier post was in response to Irneb's specific request for a function to return a list of lists where the items in the source set may be used more than once, e.g.:

Code - Auto/Visual Lisp: [Select]

1. _$ (nPr '(0 1) 2)
2. ((0 0) (0 1) (1 0) (1 1))

Here, for k items chosen from a set of n items, this will produce a list of length kⁿ

For your example where items in the source list are used only once, the function could be written:

Code - Auto/Visual Lisp: [Select]

1. (defun nPr ( l r )
2.    (if (< r 2)
3.        (mapcar 'list l)
4.        (apply 'append (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (cons a b)) (nPr (vl-remove a l) (1- r)))) l))
5.    )
6. )

Code - Auto/Visual Lisp: [Select]

1. _$ (nPr '(0 1) 2)
2. ((0 1) (1 0))

Now, for k items selected from a set of n items, this will produce a list of length n!/(n-k)!
Hence for your example of selecting 4 items from a list of 8 items, you would receive a list of 8!/4! = 1680

Or have I misunderstood your post?

[Kerry]

Now, for k items selected from a set of n items, this will produce a list of length n!/k!
Hence for your example of selected 4 items from a list of 8 items, you would receive a list of 8!/4! = 1680

Or have I misread your post?

Exactly.

It's a great tool for solving anagrams.

added:
Sorry about introducing python into the mix ... it's what my head is full of this month.
.. at least it has lambda and map functionality ..

[Lee Mac]

Sorry I was mistaken, the number of permutations is n!/(n-k)!, not n!/k!
Then for combinations you have n!/[k!(n-k)!]

It's a great tool for solving anagrams.

[Kerry]

Lee,
I agree with
 n! for full permutations
ie
n = 3 ; result is 6 sets
n = 5 ; results in 120 sets

and
 n!/(n-k)! for a divided set
ie
n = 8, k = 4 ; results in 1680 sets.
n = 8, k = 2 ; results in 56 sets

But I can't place your last calc  n!/[k!(n-k)!]   in the scheme of things. ( what you call combinations)
using n = 8, k=4 result would be 70 sets

[Lee Mac]

But I can't place your last calc  n!/[k!(n-k)!]   in the scheme of things. ( what you call combinations)
using n = 8, k=4 result would be 70 sets

My understanding was that combinations differ from permutations in that the order of the elements in each subset does not matter for combinations.

Example: choose 2 items from (A B C):

Permutations [n!/(n-k)!] = 3!/1! = 6

Code: [Select]

((A B) (A C) (B A) (B C) (C A) (C B))
Combinations [n!/k!(n-k)!] = 3!/(2!1!) = 3

Code: [Select]

((A B) (A C) (B C))Hence where combinations are concerned, the subset (A B) == (B A), whereas these are distinct permutations.

Related thread on combinations:
www.theswamp.org/index.php?topic=2694

[Kerry]

OK, I had a fixation on permutations


This would do combinations for me this week

Code - Python: [Select]

1. import itertools
2. set_size = 2
3. data_set = [ 'a', 'b', 'c' ]
4. result = list(itertools.combinations(data_set, set_size))
5. for d in result:
6.     print d

Code - Text: [Select]

1. ('a', 'b')
2. ('a', 'c')
3. ('b', 'c')

interesting discussion.

[Lee Mac]

This would do combinations for me this week

Code - Python: [Select]

1. import itertools
2. set_size = 2
3. data_set = [ 'a', 'b', 'c' ]
4. result = list(itertools.combinations(data_set, set_size))
5. for d in result:
6.     print d

Python certainly reduces the amount of work & code!

interesting discussion.

Definitely

[Kerry]

Python certainly reduces the amount of work & code!

It does have some excellent libraries

The equivalent code in raw python instead of using the c++ library would be something like :

Code - Python: [Select]

1. def combinations(iterable, r):
2.     # combinations('ABCD', 2) --> AB AC AD BC BD CD
3.     # combinations(range(4), 3) --> 012 013 023 123
4.     pool = tuple(iterable)
5.     n = len(pool)
6.     if r > n:
7.         return
8.     indices = range(r)
9.     yield tuple(pool[i] for i in indices)
10.     while True:
11.         for i in reversed(range(r)):
12.             if indices[i] != i + n - r:
13.                 break
14.         else:
15.             return
16.         indices[i] += 1
17.         for j in range(i+1, r):
18.             indices[j] = indices[j-1] + 1
19.         yield tuple(pool[i] for i in indices)

I posted that simply because I know you'll enjoy it

[Lee Mac]

The whole itertools library is huge!
There's some great inspiration for future AutoLISP challenges 

I guess my earlier function written for Irneb is the equivalent to the product Iterator.

[Kerry]

It makes a difference when you CAN name your algorithm
.. rather than just have a description for it.

[Gasty]

Hi,

There is a very neat way to obtain the k-th permutation or combination in a lexicographic order, so you can pick exactly the item you want, without calculating all the data. The following piece of code use the factoradic and combinadic aproach to do that. Be careful as has very minimal error checking, and sure there is a lot to optimize.


A little explanation here:http://irenes-coding-blog.blogspot.com/2012/07/factorial-base-numbers-and-permutations.html

Code: [Select]


;;Example of using factoradics and combinadics to obtain the list of combinations and permutations in lexicographic order
;;Based on an article of Dr. James McCaffrey in MSDN Magazine
;;Gaston Nunez


;This will get the k-th element of a combination of k items over n    
(defun Element(n k m / ans a b x y i)
  (setq ans (vlax-make-safearray vlax-vbInteger (cons 0 (- k 1))))
  (setq a n)
  (setq b k)
  (setq x (dual m n k))
  (setq i 0)
  (while (< i k)
    (setq y (vlax-safearray-put-element ans i (largestV a b x)))
    (setq x (- x (Choose y b)))
    (setq a y)
    (setq b (- b 1))
    (setq i (+ i 1))
  )
  (setq i 0)
  (while (< i k)
    (setq z (- (- n 1)(vlax-safearray-get-element ans i)))
    (vlax-safearray-put-element ans i z)
    (setq i (+ i 1))
  ) 
  (vlax-safearray->list ans)
)

(defun dual(m n k)
 (- (- (choose n k) 1) m)
)

(defun LargestV(n k m / v)
  (setq v (- n 1))
  (while (> (Choose v k) m)
    (setq v (- v 1))
  )
  v
)

 ;;Calculate  n over k without explicit calling to factorials   
(defun Choose(n k / delta iMax i)
  (cond ((< n k) (setq ret 0))
((= n k) (setq ret 1))
((> n k)
        (if (< k (- n k))
  (progn
    (setq delta (- n k))
    (setq iMax k)
  )
  (progn
    (setq delta k)
    (setq iMax (- n k))
  )
)
(setq ret (+ delta 1))
(setq i 2)
(while (<= i iMax)
  (setq ret (/ (* ret (+ delta i)) i))
  (setq i (+ i 1))
)))
  ret
)



;;get de factoradic decomposition of a number k for groups of n elements
(defun getfactors(order k / j n factors m)
  (setq factors  (vlax-make-safearray vlax-vbInteger (cons 0 (- order 1))))
  (setq m (- order 1))
  (setq j 1)
  (setq n k)
  (while (<= j order)
    (vlax-safearray-put-element factors (- order j) (rem n j))
    (setq n (/ n j))
    (setq j (+ j 1))
  )
 (vlax-safearray->list factors)
) 


;;Get the kth-permutation for a list of integer of length order
(defun get_nth_permut(order k / base i factors permuts index val)
  (setq base '())
  (setq i 0)
  (while (<= i (- order 1))
    (setq base (cons i base))
    (setq i (+ i 1))
  )
  (setq base (reverse base))
  (setq factors (getfactors order k))
  (setq permuts '())
  (setq i 0)
  (while (< i order)
    (setq index (nth i factors))
    (setq val (nth index base))
    (setq permuts (cons val permuts))
    (setq base (vl-remove val base))
    (setq i (+ i 1))
  )
  (reverse permuts)
) 


(defun fact(n / ret i)
  (setq ret 1)
  (if (= n 0) ret
    (progn
      (setq i n)
      (while (>= i 1)
(setq ret (* ret i))
(setq i (- i 1))
      )
     )
   )
  ret
)


;;List all the permutations of a given list of integers, tipically (0 1 2 3...)
(defun ListPermutations(order / nperm i)
  (setq nperm (fact order))
  (setq i 0)
  (while (< i nperm)
    (print (get_nth_permut order i))
    (setq i (+ i 1))
  )
  (princ)
) 
   

List all the combinations n over k of a list of integer (0 1 2 ...) in goups of k elements
(defun ListCombinations(n k / l i)
  (setq l (choose n k))
  (setq i 0)
  (while (< i l)
    (print (element n k i))
    (setq i (+ i 1))
  )
 (princ)
)


;;An example of how to obtain all the strings combinations for a string list.
(defun ListStringComb(strList k / n m i indexlist)
 (setq n (length strList))
 (setq m (choose n k))
 (setq i 0)
 (while (< i m)
   (setq indexList (element n k i))
   (print (getStrList indexList strList))
   (setq i (+ i 1))
 )
(princ)
)

(defun getStrList(indexlist strlist / x ret)
  (setq ret '())
  (foreach x indexlist
    (setq ret (cons (nth x strlist) ret))
  )
  (reverse ret)
) 

Gaston Nunez

[irneb]

As usual, some of the greats were already where we're only starting  :
http://autocad.xarch.at/stdlib/COMBINATIONS.LSP

[Kerry]

Yep, Reini has a lot of people standing on his shoulders

[Lee Mac]

There is a very neat way to obtain the k-th permutation or combination in a lexicographic order, so you can pick exactly the item you want, without calculating all the data.

A little explanation here:http://irenes-coding-blog.blogspot.com/2012/07/factorial-base-numbers-and-permutations.html

Absolutely fantastic article Gaston, thank you for sharing that!
I had never encountered 'factoradic numbers' before, but the number system is certainly incredibly useful when applied to permutations!

Here is my code for the 'nth-permutation' function as described in that article:

Code - Auto/Visual Lisp: [Select]

1. ;; Nth Permutation  -  Lee Mac
2. ;; Returns the nth lexicographic permutation of a given list
3. ;; e.g. (nth-permutation 4 '(0 1 2)) -> (2 0 1)
4.  
5. (defun nth-permutation ( n l / i )
6.     (setq i (dec->fac n))
7.     (repeat (- (length l) (length i))
8.         (setq i (cons 0 i))
9.     )
10.     (mapcar '(lambda ( n / x ) (setq x (nth n l) l (vl-remove x l)) x) i)
11. )
12.  
13. ;; Decimal to Factoradic  -  Lee Mac
14. ;; Converts an integer to a list of factoradic digits
15. ;; e.g. (dec->fac 81) -> (3 1 1 1 0)
16.  
17. (defun dec->fac ( n / f )
18.     (defun f ( n b )
19.         (if (< n b)
20.             (list n)
21.             (append (f (/ n b) (1+ b)) (f (rem n b) b))
22.         )
23.     )
24.     (f n 1)
25. )

Now to solve the related Project Euler problem:

Code - Auto/Visual Lisp: [Select]

1. _$ (nth-permutation 999999 '(0 1 2 3 4 5 6 7 8 9))
2. (2 7 8 3 9 1 5 4 6 0)

I very much enjoyed reading that article and writing those functions, thanks!

[ribarm]

Hi there, recently at cadtutor user named Jonathan H. asked a question how to solve problems with recursive routine that operates with large lists - there was an error throwing similar to hard error stack limit reached... If I can recall I stated that each function can be translated from recursive to iterative and opposite... Now this sub is tricky... So my challenge : All subs here posted are recursive and mine too - the task : Can this (permutate) sub be written only iterative in its entirety... My version is half iterative-half recursive and I don't know how to tackle this problem in another way to avoid recursion...

Code - Auto/Visual Lisp: [Select]

1. ;; Permutations, Marko Ribar, d.i.a. (permutate '(0 1 2)) ; (permutate '(0 1 1))
2. (defun permutate ( l / t1 t2 )
3.  
4.   (defun t1 ( l )
5.     (list
6.       (list (car l) (cadr l))
7.       (list (cadr l) (car l))
8.     )
9.   )
10.  
11.   (defun t2 ( l / al ll )
12.     (cond
13.       ( (null l)
14.         nil
15.       )
16.       ( (= (length l) 1)
17.         (list l)
18.       )
19.       ( (= (length l) 2)
20.         (t1 l)
21.       )
22.       ( (= (length l) 3)
23.         (append
24.           (mapcar (function (lambda ( x ) (cons (car l) x))) (t1 (cdr l)))
25.           (mapcar (function (lambda ( x ) (cons (cadr l) x))) (t1 (list (car l) (caddr l))))
26.           (mapcar (function (lambda ( x ) (cons (caddr l) x))) (t1 (list (car l) (cadr l))))
27.         )
28.       )
29.       ( (> (length l) 3)
30.         (apply (function append) (mapcar (function (lambda ( x ) (setq al (cons x al) ll (if (null ll) (cdr l) (cdr ll))) (mapcar (function (lambda ( y ) (cons x y))) (t2 (append (reverse (cdr al)) ll))))) l))
31.       )
32.     )
33.   )
34.  
35.   (t2 l)
36. )
37.  

I didn't wanted to start another topic as this one is also fine and it's also ---={Challenge}=---
Let's see if someone can solve it... I suppose MP would do it, but who knows, maybe my statement was false after all - it's just that I believe that it could be done differently, but I can't think a good way for now...

M.R.

[EDIT : Shorter version added...]

Code - Auto/Visual Lisp: [Select]

1. ;; Permutations, Marko Ribar, d.i.a. (permutate '(0 1 2)) ; (permutate '(0 1 1))
2. (defun permutate ( l / al ll )
3.   (cond
4.     ( (null l)
5.       nil
6.     )
7.     ( (= (length l) 1)
8.       (list l)
9.     )
10.     ( (> (length l) 1)
11.       (apply (function append) (mapcar (function (lambda ( x ) (setq al (cons x al) ll (if (null ll) (cdr l) (cdr ll))) (mapcar (function (lambda ( y ) (cons x y))) (permutate (append (reverse (cdr al)) ll))))) l))
12.     )
13.   )
14. )
15.  

[ribarm]

I solved and iterative approach... So I was right - every function can be written in both ways - iterative or recursive...
Just don't laugh - it looks too complex, but it works well...

Code - Auto/Visual Lisp: [Select]

1. (defun permutate-iterative ( l / factorial kk rr )
2.  
3.   (defun factorial ( n / r nn ) ; n - real number
4.     (setq nn 0 r 1.0)
5.     (while (<= (setq nn (1+ nn)) n)
6.       (setq r (* r nn))
7.     )
8.     (cond
9.       ( (null n)
10.         nil
11.       )
12.       ( (not (numberp n))
13.         nil
14.       )
15.       ( (minusp n)
16.         nil
17.       )
18.       ( (zerop n)
19.         0.0
20.       )
21.       ( t r )
22.     )
23.   )
24.  
25.   (defun permutate-2 ( l / r k n x xx al ll )
26.     (setq r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
27.     (setq k nil)
28.     (setq n (factorial (length l)))
29.     (while (/= (length r) n)
30.       (setq x (car r))
31.       (if (equal r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
32.         (setq r nil)
33.       )
34.       (setq k nil)
35.       (while (setq xx (car x))
36.         (setq al (cons xx al))
37.         (setq x (cdr x))
38.         (setq ll (append (reverse (cdr al)) x))
39.         (setq r (cons (cons xx ll) r))
40.       )
41.       (setq al nil ll nil)
42.     )
43.     (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (nth y l))) x))) (vl-sort r (function (lambda ( a b ) (< (atoi (apply (function strcat) (mapcar (function (lambda ( x ) (itoa x))) a))) (atoi (apply (function strcat) (mapcar (function (lambda ( x ) (itoa x))) b))))))))
44.   )
45.  
46.   (setq kk 2)
47.   (repeat (- (length l) 2)
48.     (setq kk (1+ kk))
49.     (eval
50.       (list
51.         'defun (read (strcat "permutate-" (itoa kk)))
52.         '( l / r k n x xx al ll lll )
53.         '(setq r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
54.         '(setq k nil)
55.         '(setq n (factorial (length l)))
56.         '(while (/= (length r) n)
57.           (setq x (car r))
58.           (if (equal r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
59.             (setq r nil)
60.           )
61.           (setq k nil)
62.           (while (setq xx (car x))
63.             (setq al (cons xx al))
64.             (setq x (cdr x))
65.             (setq ll (append (reverse (cdr al)) x))
66.             (while (vl-position (cons xx ll) r)
67.               (setq lll ((eval (read (strcat "permutate-" (itoa (1- kk))))) ll))
68.               (while (vl-position (cons xx (setq ll (car lll))) r)
69.                 (setq lll (cdr lll))
70.               )
71.             )
72.             (setq r (cons (cons xx ll) r))
73.           )
74.           (setq al nil ll nil)
75.         )
76.         '(mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (nth y l))) x))) (vl-sort r (function (lambda ( a b ) (< (atoi (apply (function strcat) (mapcar (function (lambda ( x ) (itoa x))) a))) (atoi (apply (function strcat) (mapcar (function (lambda ( x ) (itoa x))) b))))))))
77.       )
78.     )
79.   )
80.  
81.   (setq kk (length l))
82.   (cond
83.     ( (= kk 1)
84.       (setq rr (list l))
85.     )
86.     ( (> kk 1)
87.       (setq rr ((eval (read (strcat "permutate-" (itoa kk)))) l))
88.     )
89.   )
90.  
91.   (setq kk 1)
92.   (repeat (- (length l) 1)
93.     (setq kk (1+ kk))
94.     (set (read (strcat "permutate-" (itoa kk))) nil)
95.   )
96.   rr
97. )
98.  

M.R.

[MP]

Back in 1999+/-  (not a typ0) Reni Urban posted a challenge on comp.cad.autocad (iirc) to create a function that would take a list of items and return all the permutations. I wrote a function that used integer bit twiddling to arrange the permutations. It was not very speedy for lists sporting more than a dozen items if memory serves. That said, can't remember if it was recursive or iterative. If I wasn't tired I'd revisit - always fun to bash these out - but alas - being 62 isn't what it used to be ...

[JohnK]

If you can find that text make a challenge post from it. Sounds fun.

[MP]

OMG

I found the thread -- 21 years ago -- July 29, 1999 -- combinations -- not permutations -- iterative.

Link

[Lee Mac]

I wrote a function that used integer bit twiddling to arrange the permutations. It was not very speedy for lists sporting more than a dozen items if memory serves. That said, can't remember if it was recursive or iterative. If I wasn't tired I'd revisit - always fun to bash these out - but alas - being 62 isn't what it used to be ...

I think you posted a similar function here.

[Stefan]

Here is an iterative function.

Code - Auto/Visual Lisp: [Select]

1. (defun perm (l n / a b c d f i v s)
2.   (repeat (setq i n)
3.     (setq f (cons (read (strcat "p" (itoa i))) f)
4.           i (1- i)
5.     )
6.   )
7.   (setq f (list 'setq 's (list 'cons (cons 'list f) 's)))
8.   (repeat n
9.     (setq a (read (strcat "p" (itoa n)))
10.           c (read (strcat "l" (itoa n)))
11.           b (read (strcat "p" (itoa (setq n (1- n)))))
12.           d (read (strcat "l" (itoa n)))
13.           v (cons c v)
14.     )
15.     (setq f (list 'foreach a (if (zerop n) '(setq l1 l) (list 'setq c (list 'vl-remove b d))) f))
16.   )
17.   (eval (list 'defun 'f (cons '/ v) f))
18.   (f)
19.   (reverse s)
20. )

Code - Auto/Visual Lisp: [Select]

1. _$ (perm '(1 2 3) 3)
2. ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
3. _$ (perm '(1 2 3) 2)
4. ((1 2) (1 3) (2 1) (2 3) (3 1) (3 2))

Of course, because of vl-remove, the input list cannot contain duplicates. I usually don't use this function directly, but on 0...n-1 list, then apply nth of permutation on the original list.
Also, because the results gets bigger with increasing n, I usually send each permutation to a test function, without store it into s list.
For small n, I prefer this recursive function:

Code - Auto/Visual Lisp: [Select]

1. (defun perm (l n / f s)
2.   (defun f (l n r / l1)
3.     (if
4.       (= (length r) n)
5.       (setq s (cons (reverse r) s))
6.       (foreach x l (f (vl-remove x l) n (cons x r)))
7.     )
8.   )
9.   (f (reverse l) n nil)
10.   s
11. )

[MP]

I think you posted a similar function here.

It's bothersome I didn't recall that thread until you pointed it out.



I'll play my "That's what happens when you have > 17000 posts." card (all I have).

[VovKa]

being 62 isn't what it used to be ...

now we know the reason for your vast vocabulary... sir

[MP]

now we know the reason for your vast vocabulary... sir

(not worthy or sarcasm?) Thanks!

[VovKa]

(not worthy or sarcasm?) Thanks!

i guess i am not the only one who loves the way you write (both languages of course)

[MP]

i guess i am the only one who loves the way you write (both languages of course)

Fixed me thinks.