Author Topic: -={ Challenge }=- Get Permutations  (Read 6256 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
-={ Challenge }=- Get Permutations
« on: July 12, 2010, 09:36:10 AM »
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

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #1 on: July 12, 2010, 09:37:08 AM »
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)
)
« Last Edit: February 19, 2013, 12:39:48 PM by Lee Mac »

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: -={ Challenge }=- Get Permutations
« Reply #2 on: July 12, 2010, 09:43:02 AM »
(GetPermutations '(a b))
;=>>
'((a b)(b a))
or
'((a a) (a b) (b a) (b b))
 
Stay home. Stay safe. Save lives.

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #3 on: July 12, 2010, 09:44:15 AM »
With no repeats:

Code: [Select]
(GetPermutations '(a b))

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


ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: -={ Challenge }=- Get Permutations
« Reply #4 on: July 12, 2010, 09:58:06 AM »
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)
 )
)
Stay home. Stay safe. Save lives.

VovKa

  • Swamp Rat
  • Posts: 1230
  • Ukraine
Re: -={ Challenge }=- Get Permutations
« Reply #5 on: July 12, 2010, 11:01:39 AM »
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

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #6 on: July 12, 2010, 11:04:35 AM »
Lee, maybe you'll find something interesting here
http://www.theswamp.org/index.php?topic=14831.15

Thanks VovKa - that's an interesting twist!  8-)

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #7 on: July 12, 2010, 11:06:29 AM »
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))
« Last Edit: February 19, 2013, 12:43:29 PM by Lee Mac »

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: -={ Challenge }=- Get Permutations
« Reply #8 on: July 13, 2010, 01:04:49 PM »
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))
Stay home. Stay safe. Save lives.

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #9 on: July 13, 2010, 01:37:46 PM »
Nice one Evgeniy! Great idea with the 't2' function  :lol:

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: -={ Challenge }=- Get Permutations
« Reply #10 on: February 17, 2013, 09:23:29 AM »
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))))
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #11 on: February 19, 2013, 11:34:34 AM »
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))
« Last Edit: February 19, 2013, 11:57:35 AM by Lee Mac »

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: -={ Challenge }=- Get Permutations
« Reply #12 on: February 20, 2013, 01:29:29 AM »
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.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #13 on: February 20, 2013, 06:01:04 AM »
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

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: -={ Challenge }=- Get Permutations
« Reply #14 on: February 23, 2013, 12:45:59 AM »
Definitely messes my mind up royally!  :lmao: 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).
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

ribarm

  • Water Moccasin
  • Posts: 2357
  • Marko Ribar, architect
Re: -={ Challenge }=- Get Permutations
« Reply #15 on: February 23, 2013, 02:50:38 AM »
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?
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2357
  • Marko Ribar, architect
Re: -={ Challenge }=- Get Permutations
« Reply #16 on: February 23, 2013, 04:29:20 AM »
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.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #17 on: February 23, 2013, 11:25:10 AM »
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
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #18 on: February 23, 2013, 11:31:40 AM »

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')
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #19 on: February 23, 2013, 11:49:21 AM »
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 kn

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?
« Last Edit: February 23, 2013, 12:09:27 PM by Lee Mac »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #20 on: February 23, 2013, 11:54:54 AM »

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 ..
« Last Edit: February 23, 2013, 11:59:55 AM by Kerry »
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #21 on: February 23, 2013, 12:03:27 PM »
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.

:-D

« Last Edit: February 23, 2013, 12:08:52 PM by Lee Mac »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #22 on: February 23, 2013, 12:58:47 PM »
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
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #23 on: February 23, 2013, 01:10:57 PM »
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

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #24 on: February 23, 2013, 01:40:05 PM »
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.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #25 on: February 23, 2013, 01:53:35 PM »
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

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #26 on: February 23, 2013, 01:59:39 PM »

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


Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #27 on: February 23, 2013, 06:51:53 PM »
The whole itertools library is huge!
There's some great inspiration for future AutoLISP challenges  :evil:

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

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #28 on: February 23, 2013, 07:38:51 PM »

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


Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Gasty

  • Newt
  • Posts: 90
Re: -={ Challenge }=- Get Permutations
« Reply #29 on: February 24, 2013, 03:51:50 PM »
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

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: -={ Challenge }=- Get Permutations
« Reply #30 on: February 25, 2013, 12:14:15 AM »
As usual, some of the greats were already where we're only starting  ;) :
http://autocad.xarch.at/stdlib/COMBINATIONS.LSP
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Get Permutations
« Reply #31 on: February 25, 2013, 03:24:19 AM »

Yep, Reini has a lot of people standing on his shoulders :)
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #32 on: February 25, 2013, 09:25:34 AM »
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

  • Water Moccasin
  • Posts: 2357
  • Marko Ribar, architect
Re: -={ Challenge }=- Get Permutations
« Reply #33 on: June 19, 2020, 08:47:46 AM »
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.  
« Last Edit: June 19, 2020, 10:12:45 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2357
  • Marko Ribar, architect
Re: -={ Challenge }=- Get Permutations
« Reply #34 on: June 19, 2020, 07:27:11 PM »
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.
« Last Edit: June 24, 2020, 11:32:10 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

MP

  • Seagull
  • Posts: 17653
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Get Permutations
« Reply #35 on: June 19, 2020, 07:32:40 PM »
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 ...
Engineering Technologist • Programmer Analyst • CAD Specialist
Multi-Discipline • Design • Drafting • Document Control • Automation.
cadanalyst@gmail.com • www.linkedin.com/in/cadanalyst

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9459
Re: -={ Challenge }=- Get Permutations
« Reply #36 on: June 19, 2020, 08:48:54 PM »
If you can find that text make a challenge post from it. Sounds fun.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

MP

  • Seagull
  • Posts: 17653
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Get Permutations
« Reply #37 on: June 20, 2020, 12:43:01 AM »
OMG :-o

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

Link
Engineering Technologist • Programmer Analyst • CAD Specialist
Multi-Discipline • Design • Drafting • Document Control • Automation.
cadanalyst@gmail.com • www.linkedin.com/in/cadanalyst

Lee Mac

  • Seagull
  • Posts: 12379
  • London, England
Re: -={ Challenge }=- Get Permutations
« Reply #38 on: June 20, 2020, 08:36:57 AM »
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

  • Bull Frog
  • Posts: 230
Re: -={ Challenge }=- Get Permutations
« Reply #39 on: June 20, 2020, 09:12:14 AM »
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

  • Seagull
  • Posts: 17653
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Get Permutations
« Reply #40 on: June 21, 2020, 12:39:12 PM »
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).
Engineering Technologist • Programmer Analyst • CAD Specialist
Multi-Discipline • Design • Drafting • Document Control • Automation.
cadanalyst@gmail.com • www.linkedin.com/in/cadanalyst

VovKa

  • Swamp Rat
  • Posts: 1230
  • Ukraine
Re: -={ Challenge }=- Get Permutations
« Reply #41 on: June 21, 2020, 03:33:25 PM »
being 62 isn't what it used to be ...
now we know the reason for your vast vocabulary... sir ;)
« Last Edit: June 21, 2020, 03:36:41 PM by VovKa »

MP

  • Seagull
  • Posts: 17653
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Get Permutations
« Reply #42 on: June 22, 2020, 02:11:08 PM »
now we know the reason for your vast vocabulary... sir ;)

(not worthy or sarcasm?) Thanks! :laugh:
Engineering Technologist • Programmer Analyst • CAD Specialist
Multi-Discipline • Design • Drafting • Document Control • Automation.
cadanalyst@gmail.com • www.linkedin.com/in/cadanalyst

VovKa

  • Swamp Rat
  • Posts: 1230
  • Ukraine
Re: -={ Challenge }=- Get Permutations
« Reply #43 on: June 22, 2020, 04:08:38 PM »
(not worthy or sarcasm?) Thanks! :laugh:
i guess i am not the only one who loves the way you write (both languages of course)

MP

  • Seagull
  • Posts: 17653
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Get Permutations
« Reply #44 on: June 22, 2020, 05:43:42 PM »
i guess i am the only one who loves the way you write (both languages of course)

Fixed me thinks. :)
Engineering Technologist • Programmer Analyst • CAD Specialist
Multi-Discipline • Design • Drafting • Document Control • Automation.
cadanalyst@gmail.com • www.linkedin.com/in/cadanalyst