Combine list with same element

[Hashiq]

I have a list structure like this:
 

list=((“aa” “A”) (“bb” “B”) (“cc” “A”) (“dd” “C”) (“ee” “D”) (“ff” “B”) (“gg” “C”) (“hh ” “A”)...)

I am struggling over combining 2 different lists with same element, the end result would be something look like this:

result_list=((“aacchh” “A”) (“bbff” “B”)(“ddgg” “C”) (“ee” “D”)...)

I think I need to use the mapcar and lambda function, but just not sure. Any help would be great.

Edited July 26, 2021 by Hashiq

[Hashiq]

edit: combine sublists with same second element (“A” “B” “C” in this example), forgive my bad English expression. 

Edited July 26, 2021 by Hashiq

[Hashiq]

I search all the answer I need, and find Lee Mac’s code in the link below maybe something relevant, but still can’t figure out the answers to my questions, any help would be great. 
https://www.cadtutor.net/forum/topic/63453-merge-two-sublist-of-a-master-list-and-replace-them-by-the-merged-one/?do=findComment&comment=523222

[thanhduan2407]

(defun C:00	(/ E1 E2 L1 L2 LST L0)
	(setq l0 nil l1 nil l2 nil)
	(setq	lst	(list	'("aa" "A")	'("bb" "B")	'("cc" "A")	'("dd" "C")	'("ee" "D")	'("ff" "B")	'("gg" "C")	'("hh " "A"))
	)
	(setq	l0 (mapcar '(lambda (x) (vl-remove-if '(lambda (y) (/= (cadr y) (cadr x))) lst))
										 (vl-sort lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
						 )
	)
	(setq	l1 (mapcar '(lambda	(e1)
											(list (apply 'strcat (mapcar '(lambda (e2) (car e2)) e1)) (cadr (last e1)))
										)
									 l0
					 )
	)
	(setq l2 (LM:UniqueFuzz l1 1e-8))
	(princ l2)
	(princ)
)
(defun LM:UniqueFuzz (l f)
	(if	l
		(cons	(car l)
					(LM:UniqueFuzz
						(vl-remove-if
							(function (lambda (x) (equal x (car l) f)))
							(cdr l)
						)
						f
					)
		)
	)
)

 You try!

Edited July 27, 2021 by thanhduan2407

[satishrajdev]

You can use following function to get desired result:

(defun foo (l f / r z)
  (foreach x l
    (if	(setq z	(vl-some '(lambda (y)
			    (if	(f x (car y))
			      y
			    )
			  )
			 r
		)
	)
      (setq r (subst (cons x z) z r))
      (setq r (cons (list x) r))
    )
  )
  (reverse (mapcar 'reverse r))
)

(setq lst (mapcar '(lambda (x)
		     (cons (apply 'strcat (mapcar 'car x)) (cadar x))
		   )
		  (foo l (lambda (e1 e2) (equal (cadr e1) (cadr e2))))
	  )
)

 

Result:

_$ (setq l '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A")))
(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A"))
_$ (setq lst (mapcar '(lambda (x)
		     (cons (apply 'strcat (mapcar 'car x)) (cadar x))
		   )
		  (foo l (lambda (e1 e2) (equal (cadr e1) (cadr e2))))
	  )
)
(("aacchh " . "A") ("bbff" . "B") ("ddgg" . "C") ("ee" . "D"))

 

[Tharwat]

My attempt.  

 

(setq lst '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh" "A")))

 

Test:

(while lst
  (setq itm (car lst))
  (or (and (vl-some (function (lambda (x) (and (= (cadr itm) (cadr x)) (setq fnd x)))) itms)
           (setq itms (subst (list (strcat (car fnd) (car itm)) (cadr itm)) fnd itms))
           )
      (setq itms (cons itm itms))
      )
  (setq lst (vl-remove itm lst))
  )
(reverse itms)

 

[Hashiq]

5 hours ago, thanhduan2407 said:

(defun C:00	(/ E1 E2 L1 L2 LST L0)
	(setq l0 nil l1 nil l2 nil)
	(setq	lst	(list	'("aa" "A")	'("bb" "B")	'("cc" "A")	'("dd" "C")	'("ee" "D")	'("ff" "B")	'("gg" "C")	'("hh " "A"))
	)
	(setq	l0 (mapcar '(lambda (x) (vl-remove-if '(lambda (y) (/= (cadr y) (cadr x))) lst))
										 (vl-sort lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
						 )
	)
	(setq	l1 (mapcar '(lambda	(e1)
											(list (apply 'strcat (mapcar '(lambda (e2) (car e2)) e1)) (cadr (last e1)))
										)
									 l0
					 )
	)
	(setq l2 (LM:UniqueFuzz l1 1e-8))
	(princ l2)
	(princ)
)
(defun LM:UniqueFuzz (l f)
	(if	l
		(cons	(car l)
					(LM:UniqueFuzz
						(vl-remove-if
							(function (lambda (x) (equal x (car l) f)))
							(cdr l)
						)
						f
					)
		)
	)
)

 You try!

thanhduan2407.

Thank you for  your mapcar & lambda solution, I tried your code and it work great. but there is a little problem i should mention earlier, sometimes, there is a third ( fourth or more ) element within each sublist, like

(("aa" "A" "11") ("bb" "B" "22") ("cc" "A" "33") ("dd" "C" "44") ("ee" "D" "55") ("ff" "B" "66") ("gg" "C" "") ("hh" "A" "88"))

all sublists have the same length,  could we twist this code a little, to combine other elements base on the second element? result something like:

(("aacchh" "A" "113388") ("bbff" "B" "2266")("ddgg" "C" "44") ("ee" "D" "55")

i am thinking about change "(cadr (last e1)" to "(cdr (last e1)" at first, but that does not work.

[Hashiq]

4 hours ago, satishrajdev said:

You can use following function to get desired result:

(defun foo (l f / r z)
  (foreach x l
    (if	(setq z	(vl-some '(lambda (y)
			    (if	(f x (car y))
			      y
			    )
			  )
			 r
		)
	)
      (setq r (subst (cons x z) z r))
      (setq r (cons (list x) r))
    )
  )
  (reverse (mapcar 'reverse r))
)

(setq lst (mapcar '(lambda (x)
		     (cons (apply 'strcat (mapcar 'car x)) (cadar x))
		   )
		  (foo l (lambda (e1 e2) (equal (cadr e1) (cadr e2))))
	  )
)

 

Result:

_$ (setq l '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A")))
(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A"))
_$ (setq lst (mapcar '(lambda (x)
		     (cons (apply 'strcat (mapcar 'car x)) (cadar x))
		   )
		  (foo l (lambda (e1 e2) (equal (cadr e1) (cadr e2))))
	  )
)
(("aacchh " . "A") ("bbff" . "B") ("ddgg" . "C") ("ee" . "D"))

 

satishrajdev

thank you, i have tried your code, and it works, thanks again.

[Hashiq]

2 hours ago, Tharwat said:

My attempt.  

 

(setq lst '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh" "A")))

 

Test:

(while lst
  (setq itm (car lst))
  (or (and (vl-some (function (lambda (x) (and (= (cadr itm) (cadr x)) (setq fnd x)))) itms)
           (setq itms (subst (list (strcat (car fnd) (car itm)) (cadr itm)) fnd itms))
           )
      (setq itms (cons itm itms))
      )
  (setq lst (vl-remove itm lst))
  )
(reverse itms)

 

Tharwat,

thanks for your wonderfulI code, I really appreciate your time. Any idea on how to solve the same problem when those sublists contain three or more elements?

[Tharwat]

31 minutes ago, Hashiq said:

Tharwat,

thanks for your wonderfulI code, I really appreciate your time. Any idea on how to solve the same problem when those sublists contain three or more elements?

 

You're welcome.  

That requires a different go I believe, you can elaborate what you want then me or someone else would try to help you out with it if possible.

[confutatis]

I apologise, my attempt is very late:

(setq lst '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh" "A")))

 

Test:

(setq lst (mapcar '(lambda (elem) (reverse elem)) lst))
(setq lst2 "" lst3 '())
(while lst
 (setq elem (caar lst))
 (while (car (assoc elem lst))
  (setq lst2 (strcat lst2 (cadr (assoc elem lst))))
  (setq lst (vl-remove (assoc elem lst) lst))
 )
 (setq lst3 (cons (list elem lst2) lst3))
 (setq lst2 "")
)
(mapcar '(lambda (elem) (reverse elem)) (reverse lst3))

 

Edited July 27, 2021 by confutatis

[Grrr]

Using Lee's Group By Keys Sub its quite easy:

; https://www.theswamp.org/index.php?topic=53515.0
; Lee Mac 
(defun groupbykey ( lst / rtn tmp )
  (foreach itm (reverse lst)
    (if (setq tmp (assoc (car itm) rtn))
      (setq rtn (subst (vl-list* (car itm) (cdr itm) (cdr tmp)) tmp rtn))
      (setq rtn (cons  (list (car itm) (cdr itm)) rtn))
    )
  )
)

Ofcourse along with the mapcar'n'lambda stuff:

_$ (setq L '(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A")))
(("aa" "A") ("bb" "B") ("cc" "A") ("dd" "C") ("ee" "D") ("ff" "B") ("gg" "C") ("hh " "A"))
_$ (reverse (mapcar '(lambda (x) (cons (apply 'strcat (apply 'append (cdr x))) (car x))) (groupbykey (mapcar 'reverse L))))
(("aacchh " . "A") ("ddgg" . "C") ("bbff" . "B") ("ee" . "D"))

 

[Tharwat]

10 hours ago, Grrr said:

Using Lee's Group By Keys Sub its quite easy:

Why do you usually use lee's functions and not try to write yours ?

Would like to see your own attempts.