TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ElpanovEvgeniy on February 02, 2007, 03:32:23 AM
-
Yesterday, I have received the letter:
14:17 Evgeniy hello :-)
If there is time, help my, to make something beautiful
I had perfectly a good time!
I suggest you to write program TEST
Example 1:
(setq l '(((11))
((21) (22))
((31))
)
)
(test l)
; ==>>
'(((11) (21) (31))
((11) (22) (31)))
Example 2:
(setq l '(((11) (12))
((21))
((31) (32))
((41) (42))
)
)
(test l)
; ==>>
'(((11) (21) (31) (41))
((11) (21) (31) (42))
((11) (21) (32) (41))
((11) (21) (32) (42))
((12) (21) (31) (41))
((12) (21) (31) (42))
((12) (21) (32) (41))
((12) (21) (32) (42)))
Example 3:
(setq l '((11)
(21 22)
(31 32 33)
)
)
(test l)
; ==>>
'((11 21 31)
(11 21 32)
(11 21 33)
(11 22 31)
(11 22 32)
(11 22 33))
-
On Monday, at this time, I shall show my variant...
Have a good time!
-
I am surprised!
Nobody wishes to show the code, for the decision of this problem...
Probably I have badly explained the task?
Tell to me, in what complexity...
PS. This task is not interesting?
-
Sorry Evgeniy,
I am still trying to understand the problem. (complex.)
Can you explain again?
-
(setq lst '((11 12) (21) (31 32)))
It is necessary to find all variants of the transposed list without repetitions
(test lst)
==
((11 21 31) (11 21 32) (12 21 31) (12 21 32))
-
(setq lst '((11 12) (21) (31 32)))
11,12,21,31,32 = atom or list...
(length lst) = any
(length (car lst)) = any
-
...
It is necessary to find all variants of the transposed list without repetitions
...
Ahh!! Very good!! Thank you.
-
Sorry Evgeniy,
I am still trying to understand the problem. (complex.)
Can you explain again?
No problem!
The problem for a long time is solved, I wished to enable to have a good time to you...
It is a little to knead brains. :-)
-
I wish to explain the task once again... :?
(test '((11 12) (21 22)))
Returns:
(([11 or 12] [21 or 22]) ([11 or 12] [21 or 22])....)
(test '((11 12 13) (21 22) (31 32 33)))
Returns:
(([11 or 12 or 13] [21 or 22] [31 or 32 or 33])....)
(test '((11) (21 22) (31 32 33)))
Returns:
(([only 11] [21 or 22] [31 or 32 or 33])....)
-
I believe Evgeniy has give us a challenge involving ``Permutations and Combinations''
This will be a lot of fun!
-
Hi,
Here's my contribution.
EDIT: I'm sorry there was a little mistake (sub1 instead of sub).
(defun test (l / sub)
(defun sub (e l)
(if l
(cons (append e (list (car l)))
(sub e (cdr l))
)
)
)
(setq l (cons (mapcar 'list (car l)) (cdr l)))
(while (cadr l)
(setq l (cons
(apply 'append
(mapcar '(lambda (x)
(sub x (cadr l))
)
(car l)
)
)
(cddr l)
)
)
)
(car l)
)
-
Greetings gile
At you it has very well turned out!
-
hi,evgeniy, I use recursive method to do it
(defun ab (lst1 lst2 / res)
(foreach x lst1
(foreach y lst2
(if (atom y)
(setq y (list y))
)
(setq res (append
res
(list (cons x y))
)
)
)
)
res
)
(defun test (lst / res)
(if (= (cdr lst) nil)
(setq res (car lst))
(setq res (ab (car lst) (test (cdr lst))))
)
)
(setq l (list (list 1 2 3) (list 4 5 ) (list 6 7 8 9) (list 10 11)))
(test l)=>
((1 4 6 10) (1 4 6 11) (1 4 7 10) (1 4 7 11) (1 4 8 10) (1 4 8 11) (1 4 9 10) (1 4 9 11) (1 5 6 10) (1 5 6 11) (1 5 7 10) (1 5 7 11) (1 5 8 10) (1 5 8 11) (1 5 9 10) (1 5 9 11) (2 4 6 10) (2 4 6 11) (2 4 7 10) (2 4 7 11) (2 4 8 10) (2 4 8 11) (2 4 9 10) (2 4 9 11) (2 5 6 10) (2 5 6 11) (2 5 7 10) (2 5 7 11) (2 5 8 10) (2 5 8 11) (2 5 9 10) (2 5 9 11) (3 4 6 10) (3 4 6 11) (3 4 7 10) (3 4 7 11) (3 4 8 10) (3 4 8 11) (3 4 9 10) (3 4 9 11) (3 5 6 10) (3 5 6 11) (3 5 7 10) (3 5 7 11) (3 5 8 10) (3 5 8 11) (3 5 9 10) (3 5 9 11))
:)
and if the l structure is different
like
(setq l '(((11))((21) (22))((31))))
the code maybe like as follow
(defun ab (lst1 lst2 / res)
(foreach x lst1
(foreach y lst2
(if (atom (car y))
(setq y (list y))
)
(setq res (append
res
(list (cons x y))
)
)
)
)
res
)
(defun test (lst / res)
(if (= (cdr lst) nil)
(setq res (car lst))
(setq res (ab (car lst) (test (cdr lst))))
)
)
(setq l '(((11))((21) (22))((31))))
(test1 l)===>
(((11) ((21) (31))) ((11) ((22) (31))))
(setq l '(((11)) ((21) (22))
((31)) ((41)(42)(43))
)
)
(test l)
===>
(((11) (21) (31) (41)) ((11) (21) (31) (42)) ((11) (21) (31) (43)) ((11) (22) (31) (41)) ((11) (22) (31) (42)) ((11) (22) (31) (43)))
-
and if the l structure is different
like
(setq l '(((11))((21) (22))((31))))
the code maybe like as follow
(defun cd (lst1 lst2 / res)
(foreach x lst1
(foreach y lst2
(setq res (append
res
(list (list x y))
)
)
)
)
res
)
(defun test1 (lst / res)
(if (= (cdr lst) nil)
(setq res (car lst))
(setq res (cd (car lst) (test1 (cdr lst))))
)
)
(setq l '(((11))((21) (22))((31))))
(test1 l)===>
(((11) ((21) (31))) ((11) ((22) (31))))
It is very a pity, but for the list
(setq l '(((11))((21) (22))((31))))
It is necessary to receive
(((11) (21) (31)) ((11) (22) (31)))
:?
For other lists.
(caar lst) == atom
Your program works! :)
-
:)
Evgeniy, I modify my code, now it works, sorry, it can do Example 1 and 2 ,but not 3, it seems that I still not finished.
-
:)
Evgeniy, I modify my code, now it works
Greetings Chen! :-)
At you it has perfectly turned out to perform work.
But you have decided to divide the task for two parts and have written two different programs...
I hoped to see one program, for all variants of the list...
-
You needed to unite the programs in one - then will work for all examples! :-)
(if (atom (caar lst))
(test-1 lst)
(test-2 lst)
)
-
In order to fit the two case in one, I have to use a global variable-> *A
Now it can sove the three sample.
but it make me very sad :-(, I think it must have a good solve method.
I will try to solve it in a more simple way.
(defun ab (lst1 lst2 / res)
(foreach x lst1
(foreach y lst2
(if (atom y)
(setq y (list y)
*A T
)
(if (and
(atom (car y))
(not *A)
)
(setq y (list y)
*A nil
)
)
)
(setq res (append
res
(list (cons x y))
)
)
)
)
res
)
(defun test (lst / res)
(if (= (cdr lst) nil)
(setq res (car lst))
(setq res (ab (car lst) (test (cdr lst))))
)
)
-
My congratulations Chen!
Last program works correctly! :)
edit >>
:-(
(test '(((11)) ((21) (22)) ((31))))
return
(((11) (21) 31) ((11) (22) 31))
but necessary
(((11) (21) (31)) ((11) (22) (31)))
-
Hi,
Quite the same as the one I posted, but recursive form.
(defun test (l / sub1 sub2)
(defun sub1 (e l)
(if l
(cons (append e (list (car l)))
(sub1 e (cdr l))
)
)
)
(defun sub2 (l)
(if (cadr l)
(sub2
(cons (apply 'append
(mapcar '(lambda (x)
(sub1 x (cadr l))
)
(car l)
)
)
(cddr l)
)
)
(car l)
)
)
(sub2 (cons (mapcar 'list (car l)) (cdr l)))
)
-
Hi,
Quite the same as the one I posted, but recursive form.
Excellently!
You have made the program which is very similar to mine...
All differences - at me all in one function (test).
-
My version of the program...
(defun te (l)
;; (te l)
;; By ElpanovEvgeniy
(if (cdr l)
(apply
(function append)
(mapcar (function (lambda (a) (mapcar (function (lambda (b) (cons a b))) (te (cdr l)))))
(car l)
) ;_ mapcar
) ;_ apply
(mapcar (function list) (car l))
) ;_ if
) ;_ defun
-
:-o One more time, a wonder of concision !!!
-
WOW!!!
-
so short code.
Evgeniy, could you tell me how to learn mapcar and recursive, is the only way that practice, or there are some quick way.:)
-
so short code.
Evgeniy, could you tell me how to learn mapcar and recursive, is the only way that practice, or there are some quick way.:)
:wink: ... about 15 years of practice :-)