Topic: (Challenge) Transformation of the list.

[ElpanovEvgeniy]

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

Code: [Select]

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


[ElpanovEvgeniy]

On Monday, at this time, I shall show my variant...
Have a good time!

[ElpanovEvgeniy]

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?

[JohnK]

Sorry Evgeniy,
I am still trying to understand the problem. (complex.)

Can you explain again?

[ElpanovEvgeniy]

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

[ElpanovEvgeniy]

(setq lst '((11 12) (21) (31 32)))
11,12,21,31,32 = atom or list...
(length lst) = any
(length (car lst)) = any

[JohnK]

...
It is necessary to find all variants of the transposed list without repetitions
...

Ahh!! Very good!! Thank you.

[ElpanovEvgeniy]

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. 

[ElpanovEvgeniy]

I wish to explain the task once again... 

Code: [Select]

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

[JohnK]

I believe Evgeniy has give us a challenge involving ``Permutations and Combinations''

This will be a lot of fun!

[gile]

Hi,

Here's my contribution.

EDIT: I'm sorry there was a little mistake (sub1 instead of sub).

Code: [Select]

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

[ElpanovEvgeniy]

Greetings gile

At you it has very well turned out!

[qjchen]

hi,evgeniy, I use recursive method to do it

Code: [Select]

(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

Code: [Select]

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

[ElpanovEvgeniy]

and if the l structure is different
like
(setq l '(((11))((21) (22))((31))))
the code maybe like as follow

Code: [Select]

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

[qjchen]

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.