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

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12906
  • 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: 12906
  • 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: 1569
  • 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))
 

Lee Mac

  • Seagull
  • Posts: 12906
  • 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: 1569
  • 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)
 )
)

VovKa

  • Water Moccasin
  • Posts: 1626
  • 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: 12906
  • 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: 12906
  • 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: 1569
  • 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))

Lee Mac

  • Seagull
  • Posts: 12906
  • 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: 12906
  • 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: 12906
  • 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.