Smart sublists/subsets

[EniSan]

Hi people, I want some help to find one way to group subsets of A in certain way.
Let A be a list of subsets and B a list of all possible elements of each A subset.
I want C that holds all combined B terms using A sublists.

e.g. 01

(setq A
 (list 
  (list 750.0 500.0 500.0)
  (list 750.0 500.0 400.0)
  (list 750.0 500.0 400.0)
  (list 500.0 500.0 400.0)
  (list 750.0 500.0)
  (list 750.0 500.0)
  (list 750.0 400.0)
  (list 500.0 500.0)
  (list 500.0 400.0)
  (list 500.0 400.0)
  (list 750.0)
  (list 500.0)
  (list 500.0)
  (list 400.0)
 )
)

(setq B (list 750.0 500.0 500.0 400.0))

expected result
C = 
(
 ((750.0 500.0 500.0) (400.0))
 ((750.0 500.0 400.0) (500.0))
 ((750.0 500.0 400.0) (500.0))
 ((500.0 500.0 400.0) (750.0))
 ((750.0 500.0) (500.0 400.0))
 ((750.0 500.0) (500.0 400.0))
 ((750.0 400.0) (500.0 500.0))
 ((500.0 500.0) (750.0 400.0))
 ((500.0 400.0) (750.0 500.0))
 ((500.0 400.0) (750.0 500.0))
 ((750.0) (500.0 500.0 400.0))
 ((500.0) (750.0 500.0 400.0))
 ((500.0) (750.0 500.0 400.0))
 ((400.0) (750.0 500.0 500.0))
)

;------------------------------------
e.g. 02

(setq A
 (list 
  (list 100.0 100.0 100.0)
  (list 200.0 100.0)
  (list 200.0 100.0) 
  (list 200.0 100.0)
  (list 100.0 100.0)
  (list 100.0 100.0)
  (list 100.0 100.0)
  (list 200.0)
  (list 100.0)
  (list 100.0) 
  (list 100.0)
 )
)

(setq B (list 200.0 100.0 100.0 100.0))

expected result
C = (
((100.0 100.0 100.0) (200.0))
((200.0 100.0) (100.0 100.0))
((200.0 100.0) (100.0 100.0))
((200.0 100.0) (100.0 100.0))
((100.0 100.0) (200.0 100.0))
((100.0 100.0) (200.0 100.0))
((100.0 100.0) (200.0 100.0))
((200.0) (100.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
)
 

[rlx]

(defun t1 ( / A B)
  (setq A '((750.0 500.0 500.0)(750.0 500.0 400.0)(750.0 500.0 400.0)(500.0 500.0 400.0)(750.0 500.0)
            (750.0 500.0)(750.0 400.0)(500.0 500.0)(500.0 400.0)(500.0 400.0)(750.0)(500.0)(500.0)(400.0)))
  (setq B '(750.0 500.0 500.0 400.0)) (mapcar '(lambda (x) (cons x (list (f2 x B)))) A))

(defun t2 ( / A B)
  (setq A '((100.0 100.0 100.0)(200.0 100.0)(200.0 100.0)(200.0 100.0)
            (100.0 100.0)(100.0 100.0)(100.0 100.0)(200.0)(100.0)(100.0)(100.0)))
  (setq B (list 200.0 100.0 100.0 100.0)) (mapcar '(lambda (x) (cons x (list (f2 x B)))) A))

; stolen from Master Lee LM:SubstOnce -> (f1 "A" 1 '(1 1 2)) -> ("A" 1 2)
(defun f1 (a b l)(mapcar '(lambda (x)(if (equal b x)(setq x a a nil b nil)) x) l))
;;; (f2 '(750.0 500.0 500.0) '(750.0 500.0 500.0 400.0)) -> (400.0)
(defun f2 ( x y )(mapcar '(lambda (z)(setq y (f1 nil z y))) x)(vl-remove nil y))
; print list (test function)
(defun prl (lst)(mapcar '(lambda(x)(princ "\n")(princ x)) lst))
(setq C1 (t1) C2 (t2))
;;; show result in dialog
(alert (strcat "C1 :\n" (vl-princ-to-string C1) "\n\nC2 :\n" (vl-princ-to-string C2)))
;;; or show result as lists
(princ "\n\nC1 :")(prl C1)(princ "\n\nC2 :")(prl C2)

;|
C1 :
((750.0 500.0 500.0) (400.0))
((750.0 500.0 400.0) (500.0))
((750.0 500.0 400.0) (500.0))
((500.0 500.0 400.0) (750.0))
((750.0 500.0) (500.0 400.0))
((750.0 500.0) (500.0 400.0))
((750.0 400.0) (500.0 500.0))
((500.0 500.0) (750.0 400.0))
((500.0 400.0) (750.0 500.0))
((500.0 400.0) (750.0 500.0))
((750.0) (500.0 500.0 400.0))
((500.0) (750.0 500.0 400.0))
((500.0) (750.0 500.0 400.0))
((400.0) (750.0 500.0 500.0))

C2 :
((100.0 100.0 100.0) (200.0))
((200.0 100.0) (100.0 100.0))
((200.0 100.0) (100.0 100.0))
((200.0 100.0) (100.0 100.0))
((100.0 100.0) (200.0 100.0))
((100.0 100.0) (200.0 100.0))
((100.0 100.0) (200.0 100.0))
((200.0) (100.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
((100.0) (200.0 100.0 100.0))
|;

Edited December 11, 2020 by rlx

[EniSan]

Thank you very much rlx. Worked perfectly.

[Lee Mac]

The duplicate elements present in each list make this task slightly trickier than it would otherwise be - here is an alternative solution:

(defun f ( a b )
    (mapcar
       '(lambda ( x / z )
            (setq z b)
            (list x (foreach y x (setq z (LM:removeonce y z))))
        )
        a
    )
)

(defun LM:removeonce ( x l / f )
    (setq f equal)
    (vl-remove-if '(lambda ( a ) (if (f a x) (setq f (lambda ( a b ) nil)))) l)
)

_$ (f a b)
(
    ((750.0 500.0 500.0) (400.0))
    ((750.0 500.0 400.0) (500.0))
    ((750.0 500.0 400.0) (500.0))
    ((500.0 500.0 400.0) (750.0))
    ((750.0 500.0) (500.0 400.0))
    ((750.0 500.0) (500.0 400.0))
    ((750.0 400.0) (500.0 500.0))
    ((500.0 500.0) (750.0 400.0))
    ((500.0 400.0) (750.0 500.0))
    ((500.0 400.0) (750.0 500.0))
    ((750.0) (500.0 500.0 400.0))
    ((500.0) (750.0 500.0 400.0))
    ((500.0) (750.0 500.0 400.0))
    ((400.0) (750.0 500.0 500.0))
)

 

Edited December 12, 2020 by Lee Mac

[rlx]

2 hours ago, Lee Mac said:

The duplicate elements present in each list make this task slightly trickier than it would otherwise be - here is an alternative solution:

 

 

cool alternative

[EniSan]

Thanks for the solution, Lee Mac. Small and elegant, congratulations.

[EniSan]

On 12/12/2020 at 12:39 PM, Lee Mac said:

The duplicate elements present in each list make this task slightly trickier than it would otherwise be - here is an alternative solution:

(defun f ( a b )
    (mapcar
       '(lambda ( x / z )
            (setq z b)
            (list x (foreach y x (setq z (LM:removeonce y z))))
        )
        a
    )
)

(defun LM:removeonce ( x l / f )
    (setq f equal)
    (vl-remove-if '(lambda ( a ) (if (f a x) (setq f (lambda ( a b ) nil)))) l)
)

_$ (f a b)
(
    ((750.0 500.0 500.0) (400.0))
    ((750.0 500.0 400.0) (500.0))
    ((750.0 500.0 400.0) (500.0))
    ((500.0 500.0 400.0) (750.0))
    ((750.0 500.0) (500.0 400.0))
    ((750.0 500.0) (500.0 400.0))
    ((750.0 400.0) (500.0 500.0))
    ((500.0 500.0) (750.0 400.0))
    ((500.0 400.0) (750.0 500.0))
    ((500.0 400.0) (750.0 500.0))
    ((750.0) (500.0 500.0 400.0))
    ((500.0) (750.0 500.0 400.0))
    ((500.0) (750.0 500.0 400.0))
    ((400.0) (750.0 500.0 500.0))
)

 

 

Thanks for the solution, Lee Mac. Small and elegant, congratulations.

 

There is another topic created by me similar to this one in which I would like to obtain a short and elegant solution like the ones presented by you, if either of you can take a look I appreciate it. The last post was a solution I found, however for large lists the processing is quite time consuming.
Follow the link of the last post I published:
https://www.cadtutor.net/forum/topic/70814-possible-paths-and-ordered-according-to-criteria/?do=findComment&comment=569373