Jump to content

Smart sublists/subsets

EniSan

By EniSan
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

EniSan Rookie

EniSan

Posted
Posted

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 Veteran

rlx

Posted
Posted (edited) 
(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 by rlx
  • Thanks 1
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

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 by Lee Mac
  • Like 2
  • Thanks 1
rlx Veteran

rlx

Posted
Posted
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 Rookie

EniSan

Posted
  • Author
Posted

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

EniSan Rookie

EniSan

Posted
  • Author
Posted
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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...