Print Page - -={ Challenge }=- Get Permutations

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Lee Mac on July 12, 2010, 09:36:10 AM

Title: -={ Challenge }=- Get Permutations
Post by: Lee Mac on July 12, 2010, 09:36:10 AM

The Challenge:

To return all permutations of a list.

Example:

(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!

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac 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)
)

Title: Re: -={ Challenge }=- Get Permutations
Post by: ElpanovEvgeniy on July 12, 2010, 09:43:02 AM

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on July 12, 2010, 09:44:15 AM

With no repeats:

Code: [Select]

(GetPermutations '(a b))

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: ElpanovEvgeniy 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)
 )
)

Title: Re: -={ Challenge }=- Get Permutations
Post by: VovKa 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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on July 12, 2010, 11:04:35 AM

Quote from: VovKa on July 12, 2010, 11:01:39 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-)

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac 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))

Title: Re: -={ Challenge }=- Get Permutations
Post by: ElpanovEvgeniy 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))

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on July 13, 2010, 01:37:46 PM

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: irneb 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]

(setq lst (0 1 2 3 4 5 6 7 8 9))
(permute-n lst 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])
((0) (0 0) (0 0 0) (0 1) (0 2) ... (0 9) (0 1 0) ... (0 1 9) (0 2 0) ... (0 9 9) ...
 (1) (1 1) ...
 (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]

(defun permute-n  (lst n / f1)
  (defun f1  (l / calc)
    (if (< (length l) n)
      (progn (foreach item lst (setq calc (cons (cons item l) calc)))
             (apply 'append (cons (cons l calc) (mapcar 'f1 calc))))
      (list l)))
  (apply 'append (mapcar 'f1 (mapcar 'list lst))))

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 19, 2013, 11:34:34 AM

Quote from: irneb on February 17, 2013, 09:23:29 AM

Code - Auto/Visual Lisp: [Select]
(defun permute-n
< ... >
)

I think this function yields a few too many duplicates:

Code - Auto/Visual Lisp: [Select]

_$ (permute-n '(0 1) 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]

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

Here is an 'nPr' function (I also wrote an 'nCr' function (http://www.theswamp.org/index.php?topic=2694.msg471000#msg471000) a little while back), though, it's by no means efficient:

Code - Auto/Visual Lisp: [Select]

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

Code - Auto/Visual Lisp: [Select]

_$ (nPr '(0 1) 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]

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

Code - Auto/Visual Lisp: [Select]

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

Or, instead use:

Code - Auto/Visual Lisp: [Select]

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

Code - Auto/Visual Lisp: [Select]

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: irneb 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.

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 20, 2013, 06:01:04 AM

Quote from: irneb 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.

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: irneb 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).

Title: Re: -={ Challenge }=- Get Permutations
Post by: ribarm 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?

Title: Re: -={ Challenge }=- Get Permutations
Post by: ribarm on February 23, 2013, 04:29:20 AM

I answered my question :

n!

Code - Auto/Visual Lisp: [Select]

;;; N! ;;;
;;; number of Permutations wihout repetition of elements ;;;
(defun nP ( n )
  (if (> n 1) (* n (nP (1- n))) 1)
)
 

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry 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]

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

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry on February 23, 2013, 11:31:40 AM

So the original post problem result would be :

Code - Python: [Select]

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

Code - Text: [Select]

('a', 'b', 'c')
('a', 'c', 'b')
('b', 'a', 'c')
('b', 'c', 'a')
('c', 'a', 'b')
('c', 'b', 'a')

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 23, 2013, 11:49:21 AM

Quote from: Kerry 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]
import itertools
set_size = 4
data_set = (108, 99, 112, 118, 100, 102, 96, 101)

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]

_$ (nPr '(0 1) 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]

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

Code - Auto/Visual Lisp: [Select]

_$ (nPr '(0 1) 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?

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry on February 23, 2013, 11:54:54 AM

Quote from: Lee Mac on February 23, 2013, 11:49:21 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 ..

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac 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)!]

Quote from: Kerry on February 23, 2013, 11:54:54 AM

It's a great tool for solving anagrams.

:-D

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry 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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 23, 2013, 01:10:57 PM

Quote from: Kerry on February 23, 2013, 12:58:47 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 (http://www.theswamp.org/index.php?topic=2694)

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry 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]

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

Code - Text: [Select]

('a', 'b')
('a', 'c')
('b', 'c')

interesting discussion.

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 23, 2013, 01:53:35 PM

Quote from: Kerry on February 23, 2013, 01:40:05 PM

This would do combinations for me this week
Code - Python: [Select]
import itertools
set_size = 2
data_set = [ 'a', 'b', 'c' ]
result = list(itertools.combinations(data_set, set_size))
for d in result:
print d

Python certainly reduces the amount of work & code!

Quote from: Kerry on February 23, 2013, 01:40:05 PM

interesting discussion.

Definitely :-)

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry 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]

def combinations(iterable, r):
    # combinations('ABCD', 2) --> AB AC AD BC BD CD
    # combinations(range(4), 3) --> 012 013 023 123
    pool = tuple(iterable)
    n = len(pool)
    if r > n:
        return
    indices = range(r)
    yield tuple(pool[i] for i in indices)
    while True:
        for i in reversed(range(r)):
            if indices[i] != i + n - r:
                break
        else:
            return
        indices[i] += 1
        for j in range(i+1, r):
            indices[j] = indices[j-1] + 1
        yield tuple(pool[i] for i in indices)

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 23, 2013, 06:51:53 PM

The whole itertools library (http://docs.python.org/2/library/itertools.html) 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 (http://docs.python.org/2/library/itertools.html#itertools.product) Iterator.

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry 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.

Title: Re: -={ Challenge }=- Get Permutations
Post by: Gasty 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 (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

Title: Re: -={ Challenge }=- Get Permutations
Post by: irneb 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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Kerry on February 25, 2013, 03:24:19 AM

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on February 25, 2013, 09:25:34 AM

Quote from: Gasty on February 24, 2013, 03:51:50 PM

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 (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]

;; Nth Permutation  -  Lee Mac
;; Returns the nth lexicographic permutation of a given list
;; e.g. (nth-permutation 4 '(0 1 2)) -> (2 0 1)
 
(defun nth-permutation ( n l / i )
    (setq i (dec->fac n))
    (repeat (- (length l) (length i))
        (setq i (cons 0 i))
    )
    (mapcar '(lambda ( n / x ) (setq x (nth n l) l (vl-remove x l)) x) i)
)
 
;; Decimal to Factoradic  -  Lee Mac
;; Converts an integer to a list of factoradic digits
;; e.g. (dec->fac 81) -> (3 1 1 1 0)
 
(defun dec->fac ( n / f )
    (defun f ( n b )
        (if (< n b)
            (list n)
            (append (f (/ n b) (1+ b)) (f (rem n b) b))
        )
    )
    (f n 1)
)

Now to solve the related Project Euler problem (http://projecteuler.net/problem=24):

Code - Auto/Visual Lisp: [Select]

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

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: ribarm 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]

;; Permutations, Marko Ribar, d.i.a. (permutate '(0 1 2)) ; (permutate '(0 1 1))
(defun permutate ( l / t1 t2 )
 
  (defun t1 ( l )
    (list
      (list (car l) (cadr l))
      (list (cadr l) (car l))
    )
  )
 
  (defun t2 ( l / al ll )
    (cond
      ( (null l)
        nil
      )
      ( (= (length l) 1)
        (list l)
      )
      ( (= (length l) 2)
        (t1 l)
      )
      ( (= (length l) 3)
        (append
          (mapcar (function (lambda ( x ) (cons (car l) x))) (t1 (cdr l)))
          (mapcar (function (lambda ( x ) (cons (cadr l) x))) (t1 (list (car l) (caddr l))))
          (mapcar (function (lambda ( x ) (cons (caddr l) x))) (t1 (list (car l) (cadr l))))
        )
      )
      ( (> (length l) 3)
        (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))
      )
    )
  )
 
  (t2 l)
)
 

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]

;; Permutations, Marko Ribar, d.i.a. (permutate '(0 1 2)) ; (permutate '(0 1 1))
(defun permutate ( l / al ll )
  (cond
    ( (null l)
      nil
    )
    ( (= (length l) 1)
      (list l)
    )
    ( (> (length l) 1)
      (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))
    )
  )
)
 

Title: Re: -={ Challenge }=- Get Permutations
Post by: ribarm 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]

(defun permutate-iterative ( l / factorial kk rr )
 
  (defun factorial ( n / r nn ) ; n - real number
    (setq nn 0 r 1.0)
    (while (<= (setq nn (1+ nn)) n)
      (setq r (* r nn))
    )
    (cond
      ( (null n)
        nil
      )
      ( (not (numberp n))
        nil
      )
      ( (minusp n)
        nil
      )
      ( (zerop n)
        0.0
      )
      ( t r )
    )
  )
 
  (defun permutate-2 ( l / r k n x xx al ll )
    (setq r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
    (setq k nil)
    (setq n (factorial (length l)))
    (while (/= (length r) n)
      (setq x (car r))
      (if (equal r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
        (setq r nil)
      )
      (setq k nil)
      (while (setq xx (car x))
        (setq al (cons xx al))
        (setq x (cdr x))
        (setq ll (append (reverse (cdr al)) x))
        (setq r (cons (cons xx ll) r))
      )
      (setq al nil ll nil)
    )
    (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)))))))) 
  )
 
  (setq kk 2)
  (repeat (- (length l) 2)
    (setq kk (1+ kk))
    (eval
      (list
        'defun (read (strcat "permutate-" (itoa kk)))
        '( l / r k n x xx al ll lll )
        '(setq r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
        '(setq k nil)
        '(setq n (factorial (length l)))
        '(while (/= (length r) n)
          (setq x (car r))
          (if (equal r (list (mapcar (function (lambda ( x ) (setq k (if (null k) 0 (1+ k))))) l)))
            (setq r nil)
          )
          (setq k nil)
          (while (setq xx (car x))
            (setq al (cons xx al))
            (setq x (cdr x))
            (setq ll (append (reverse (cdr al)) x))
            (while (vl-position (cons xx ll) r)
              (setq lll ((eval (read (strcat "permutate-" (itoa (1- kk))))) ll))
              (while (vl-position (cons xx (setq ll (car lll))) r)
                (setq lll (cdr lll))
              )
            )
            (setq r (cons (cons xx ll) r))
          )
          (setq al nil ll nil)
        )
        '(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)))))))) 
      )
    )
  )
  
  (setq kk (length l))
  (cond
    ( (= kk 1)
      (setq rr (list l))
    )
    ( (> kk 1)
      (setq rr ((eval (read (strcat "permutate-" (itoa kk)))) l))
    )
  )
 
  (setq kk 1)
  (repeat (- (length l) 1)
    (setq kk (1+ kk))
    (set (read (strcat "permutate-" (itoa kk))) nil)
  )
  rr
)
 

M.R.

Title: Re: -={ Challenge }=- Get Permutations
Post by: MP 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 ...

Title: Re: -={ Challenge }=- Get Permutations
Post by: JohnK on June 19, 2020, 08:48:54 PM

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: MP 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 (http://groups.google.com/forum/#!searchin/comp.cad.autocad/puckett|sort:date/comp.cad.autocad/47w9SkuC0HU/EXDH2vGK3jAJ)

Title: Re: -={ Challenge }=- Get Permutations
Post by: Lee Mac on June 20, 2020, 08:36:57 AM

Quote from: MP on June 19, 2020, 07:32:40 PM

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 (https://www.theswamp.org/index.php?topic=2694.0).

Title: Re: -={ Challenge }=- Get Permutations
Post by: Stefan on June 20, 2020, 09:12:14 AM

Here is an iterative function.

Code - Auto/Visual Lisp: [Select]

(defun perm (l n / a b c d f i v s)
  (repeat (setq i n)
    (setq f (cons (read (strcat "p" (itoa i))) f)
          i (1- i)
    )
  )
  (setq f (list 'setq 's (list 'cons (cons 'list f) 's)))
  (repeat n
    (setq a (read (strcat "p" (itoa n)))
          c (read (strcat "l" (itoa n)))
          b (read (strcat "p" (itoa (setq n (1- n)))))
          d (read (strcat "l" (itoa n)))
          v (cons c v)
    )
    (setq f (list 'foreach a (if (zerop n) '(setq l1 l) (list 'setq c (list 'vl-remove b d))) f))
  )
  (eval (list 'defun 'f (cons '/ v) f))
  (f)
  (reverse s)
)

Code - Auto/Visual Lisp: [Select]

_$ (perm '(1 2 3) 3)
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
_$ (perm '(1 2 3) 2)
((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]

(defun perm (l n / f s)
  (defun f (l n r / l1)
    (if
      (= (length r) n)
      (setq s (cons (reverse r) s))
      (foreach x l (f (vl-remove x l) n (cons x r)))
    )
  )
  (f (reverse l) n nil)
  s
)

Title: Re: -={ Challenge }=- Get Permutations
Post by: MP on June 21, 2020, 12:39:12 PM

Quote from: Lee Mac on June 20, 2020, 08:36:57 AM

I think you posted a similar function here (https://www.theswamp.org/index.php?topic=2694.0).

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

(http://memegenerator.net/img/instances/37542728/i-may-have-alzheimers-but-at-least-i-dont-have-alzheimers.jpg)

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: VovKa on June 21, 2020, 03:33:25 PM

Quote from: MP on June 19, 2020, 07:32:40 PM

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

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

Title: Re: -={ Challenge }=- Get Permutations
Post by: MP on June 22, 2020, 02:11:08 PM

Quote from: VovKa on June 21, 2020, 03:33:25 PM

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

(not worthy or sarcasm?) Thanks! :laugh:

Title: Re: -={ Challenge }=- Get Permutations
Post by: VovKa on June 22, 2020, 04:08:38 PM

Quote from: MP on June 22, 2020, 02:11:08 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)

Title: Re: -={ Challenge }=- Get Permutations
Post by: MP on June 22, 2020, 05:43:42 PM

Quote from: VovKa on June 22, 2020, 04:08:38 PM

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

Fixed me thinks. :)

TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Lee Mac on July 12, 2010, 09:36:10 AM