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.

[ElpanovEvgeniy]

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

[ElpanovEvgeniy]

You needed to unite the programs in one - then will work for all examples! 

Code: [Select]

(if (atom (caar lst))
 (test-1 lst)
 (test-2 lst)
)

[qjchen]

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.

Code: [Select]

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


[ElpanovEvgeniy]

My congratulations Chen!
Last program works correctly!

edit >>
 

Code: [Select]

(test '(((11)) ((21) (22)) ((31))))
return
(((11) (21) 31) ((11) (22) 31)) 
but necessary
(((11) (21) (31)) ((11) (22) (31)))

[gile]

Hi,

Quite the same as the one I posted, but recursive form.

Code: [Select]

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

[ElpanovEvgeniy]

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

[ElpanovEvgeniy]

My version of the program... 

Code: [Select]

(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

[gile]

  One more time, a wonder of concision !!!

[JohnK]

WOW!!!

[qjchen]

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.

[Kerry]

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.

   ... about 15 years of practice