[Lisp/Vlisp] list manipulation

[Lisp/Vlisp] list manipulation

krzysztof.psujek
Advocate Advocate
1,236 Views
7 Replies
Message 1 of 8

[Lisp/Vlisp] list manipulation

krzysztof.psujek
Advocate
Advocate

Hi,

I've got some problems with list manipulation,

I will be grateful if sb could help me with it.

 

1) how sort such association list by given order for example

;list
(setq lst '((("A" 5) ("B" 4) ("C" 6)) (("D" 1) ("B" 8) ("C" 9) ("A" 5)) (("E" 1) ("B" 8)))
;defined sort order
(setq order '("D" "A" "B" "C" "E"))

;want to get sth like this
;-> ((("A" 5) ("B" 4) ("C" 6)) (("D" 1) ("A" 5) ("B" 8) ("C" 9)) (("B" 8) ("E" 1)))

 2) how can I get merged values in second item (always strings so with strcat function) and join lists at the same time 

    when one of the sublist is the same...

 

I think below example should clarify what I mean:

 

(setq lst2 ' (
              (("a" X) ("b" Y) ("c" Z)) 
              (("a" X) ("d" N) ("e" A))
              (("a" X) ("f" Y) ("d" Z))
              (("a" Y) ("b" B) ("d" A))
              (("a" Y) ("c" C) ("f" B))
              (("a" Z) ("b" X) ("d" C))
              (("a" Z) ("b" Y) ("d" D))
              (("a" Z) ("b" Z) ("e" X))
             )

-> (
       (("a" X)("b" Y)("c" Z)("d" NZ)("e" A)("f" Y))
       (("a" Y)("b" B)("d" A)("c" C)("f" B))
       (("a" Z)("b" XYZ) ("d" CD)("e" X))
    )

I've tried some mapcar/lambda operation but failed,

thanks in advance for any clues

 

Chris

0 Likes
Accepted solutions (3)
1,237 Views
7 Replies
Replies (7)
Message 2 of 8

ВeekeeCZ
Consultant
Consultant
Accepted solution

ADD 1

 

(mapcar
    '(lambda (x)
       (vl-remove nil
         (mapcar
           '(lambda (y)
              (assoc y x))
           '("D" "A" "B" "C" "E"))))
    '((("A" 5) ("B" 4) ("C" 6)) (("D" 1) ("B" 8) ("C" 9) ("A" 5)) (("E" 1) ("B" 8))))
Message 3 of 8

patrick_35
Collaborator
Collaborator
0 Likes
Message 4 of 8

krzysztof.psujek
Advocate
Advocate

Great,

it works as I wanted.

When I'm reading your code now, it's seems to be obvious

but I spent lot of time trying mapcar and  vl-sort combination and didn't find solution

Thank you very much.

 

Chris 

0 Likes
Message 5 of 8

ВeekeeCZ
Consultant
Consultant
Accepted solution

AD 2 -- not so simply clever

 

  (defun :resort (lst2 / lst a)
    (mapcar '(lambda (yy / lst)
	       (foreach zz (cdr yy)
		 (setq lst (if (setq a (assoc (car zz) lst))
			     (subst (list (car a) (strcat (cadr a) (cadr zz)))
				    a
				    lst)
			     (cons zz lst))))
	       (append (list (car yy)) (reverse lst)))
	    
	    (reverse
	      (foreach xx lst2
		(setq lst (if (setq a (assoc (car xx) lst))
			    (subst (append a (cdr xx))
				   a
				   lst)
			    (cons xx lst)))))))

 

List used for testing:

 

Spoiler
  (setq lst2 ' (
		(("a" "X") ("b" "Y") ("c" "Z"))
		(("a" "X") ("d" "N") ("e" "A"))
		(("a" "X") ("f" "Y") ("d" "Z"))
		(("a" "Y") ("b" "B") ("d" "A"))
		(("a" "Y") ("c" "C") ("f" "B"))
		(("a" "Z") ("b" "X") ("d" "C"))
		(("a" "Z") ("b" "Y") ("d" "D"))
		(("a" "Z") ("b" "Z") ("e" "X"))
		))

 

Message 6 of 8

stevor
Collaborator
Collaborator
Accepted solution

 

May be a method:

 

 ; Sort Cars by Key List
 (Defun L_SortCarSOL ( DLL KL / MKL MGL  DL CD K  )
  ;(princ "\n DL: ") (prin1 DL)
  (foreach K KL       ;(princ "\n K: ") (prin1 K)
   (setq MKL nil) ; Match Key L
   (Foreach Dl DLL   ; (princ "\n DL: ") (prin1 DL)
    (setq CD (car DL))     ; (prin1 " Car-DL: ") (prin1 CD)
    (if (= CD K) (setq mkL (cons DL MKL) ))
   ) ;(PP_"mkL")  
   (if MKL (setq MGL (cons MKL MGL))) ; Match Group
  )  (reverse MGL) )
 
 
 (setq RL nil  SDLL NIL)  (textscr)
 (foreach DL LST                              
  (setq SDL (L_SortCarSOL DL ORDER))  
  (setq SDLL (cons (mapcar 'car SDL) SDLL) )
 )
 (setq RLL (reverse SDLL)) 

S
0 Likes
Message 7 of 8

krzysztof.psujek
Advocate
Advocate

You have used proper list for testing. I prepared some simple example to show how expected result should looks like.

That works to! 

Thank you again.

 

Chris 

 

0 Likes
Message 8 of 8

krzysztof.psujek
Advocate
Advocate

Different approach but also works well.

Thank you for your help.

 

Regards,

Chris

0 Likes