sum items with the same cdr from a list

[adaptacad]

Hello again everyone.
I try a list
ex:

(setq lst
  '(
    (52.7553 . "ITEM_1")
    (110.412 . "ITEM_2") 
    (45.4596 . "ITEM_3") 
    (54.023 . "ITEM_4")
    (65.2474 . "ITEM_1") 
    (45.4596 . "ITEM_1") 
    (45.4596 . "ITEM_2") 
    (52.7553 . "ITEM_1")
    (110.412 . "ITEM_2") 
    (45.4596 . "ITEM_3") 
    (54.023 . "ITEM_4") 
    (65.2474 . "ITEM_1")
    (45.4596 . "ITEM_1") 
    (45.4596 . "ITEM_2")
  )
)

What is the best way to add the car of all items by associating the equivalent cdr:
((326,925 . "ITEM_1") ....

the same for all items

[ВeekeeCZ · Accepted solution]

Nothing fancy or complicated. Just common approach using assoc.

(defun :sumbycdr (lst / lst2 a)
  (foreach e lst
    (setq lst2 (if (setq a (assoc (cdr e) lst2))
		 (subst (cons (cdr e) (+ (cdr a) (car e))) a lst2)
		 (cons (cons (cdr e) (car e)) lst2))))
  (vl-sort (mapcar '(lambda (x) (cons (cdr x) (car x))) lst2)
	   '(lambda (e1 e2) (< (cdr e1) (cdr e2)))))

[CodeDing · Accepted solution]

I wanted to try also lol. Is it pretty? No. Is it efficient? No. Is it fun to look at? A lil bit.

(defun cdrSum (lst / LM:MultiAssoc LM:Unique)
  ;; Helper Function(s)
  (defun LM:MultiAssoc (k l / i) (if (setq i (assoc k l)) (cons (cdr i) (LM:MultiAssoc k (cdr (member i l))))))
  (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; Work
  (mapcar
    '(lambda (x) (cons x (apply '+ (LM:MultiAssoc x (mapcar 'cons (mapcar 'cdr lst) (mapcar 'car lst))))))
    (LM:Unique (mapcar 'cdr lst))
  );mapcar
);defun

Best,

~DD

[john.uhden · Accepted solution]

(apply '+ (mapcar 'car lst))

Nope, that gets you the total of all of them.

Here ya go...

(defun sort+sum (lst / new)
  (foreach item lst
    (if (setq x (assoc (cdr item) new))
      (setq new (subst (cons (cdr item)(+ (cdr x)(car item))) x new))
      (setq new (cons (cons (cdr item)(car item)) new))
    )
  )
  (reverse new)
)

 Command: (sort+sum lst)
(("ITEM_1" . 326.925) ("ITEM_2" . 311.743) ("ITEM_3" . 90.9192) ("ITEM_4" . 108.046))

[CodeDing · Accepted solution]

Another:

(defun cdrSum2 (lst / LM:Unique)
  ;; Helper Function(s)
  (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; Work
  (mapcar
    '(lambda (x)
      (cons x
        (apply '+
          (mapcar 'car
            (vl-remove-if-not
              '(lambda (y) (eq x (cdr y)))
              lst
            );vl
          );mapcar
        );apply
      );cons
    );lambda
    (LM:Unique (mapcar 'cdr lst))
  );mapcar
);defun

[hak_vz · Accepted solution]

Here is my try on the subject

(defun cdr_sum (lst / ret items p)
	(foreach e lst
		(cond 
			((member (cdr e) items)
				(setq p (assoc (cdr e) ret))
				(setq ret (subst (cons (car p) (+ (cdr p)(car e))) (assoc (car p) ret) ret))
			)
			((not (member (cdr e) items))
			    (setq items (cons (cdr e) items))
				(setq ret (cons (cons (cdr e) (car e)) ret))
			)
			
		)
	)
	(reverse ret)
)

Command: (cdr_sum lst)
(("ITEM_1" . 326.925) ("ITEM_2" . 311.743) ("ITEM_3" . 90.9192) ("ITEM_4" . 108.046))

[pbejse · Accepted solution]

---

@adaptacad wrote:

What is the best way to add the car of all items by associating the equivalent cdr:
((326,925 . "ITEM_1") ....

---

(defun why_cdr (l / a b l2)
  (while (setq a (Car l))
    (foreach itm (cdr l)
      (if (eq (cdr a) (cdr itm))
	(setq a (cons (+ (car a) (car itm)) (cdr a)))
	(setq b (cons itm b))
      )
    )
    (setq l2 (cons a l2) l b b nil
    )
  )
  (reverse l2)
)

(why_cdr lst)
((326.925 . "ITEM_1") (311.743 . "ITEM_2") (90.9192 . "ITEM_3") (108.046 . "ITEM_4"))

Here's a thought, instead of trying to sum all similar cdr items on that type of list, why not add the values while building the list. Let us know if you need help with that.

BTW, any reason why you end up with that kind of list ? why not name before value? 

(("ITEM_1" . 326.925) ("ITEM_2" . 311.743) ("ITEM_3" . 90.9192) ("ITEM_4" . 108.046))

That is far more easier to add the similar items while building the list.

HTH

[john.uhden]

I'm a little disappointed in all you guys and gals.

No one has pointed out that I hadn't localized x.  Shame on me; shame on you. 😠

[hak_vz]

---

@john.uhden wrote:

I'm a little disappointed in all you guys and gals.

No one has pointed out that I hadn't localized x.  Shame on me; shame on you. 😠

---

@john.uhden  Don't be disappointed. After so many code we've provided, OP's has to start learning autolisp, at least the basics, to be able to add final touches to provided code. In this post we have 4-5 similar but also different solutions and your code is really top notch.

[pbejse]

---

@john.uhden wrote:

I'm a little disappointed in all you guys and gals.

No one has pointed out that I hadn't localized x.  Shame on me; shame on you. 😠

---

I honestly did not looked at any of the codes. but now that you mentioned that. I notice that  @ВeekeeCZ and my contribution are the only two that stayed true to the request and returns the same format. ((326,925 . "ITEM_1").

[adaptacad]

Thank you so much guys!! you are the best!!

@pbejse @hak_vz @john.uhden @CodeDing @ВeekeeCZ 

[john.uhden]

@hak_vz 

Aw, c'mon, Hak.

Just having a little fun busting ourselves.

[CodeDing]

---

@pbejse wrote:

---

but now that you mentioned that. I notice that  @ВeekeeCZ and my contribution are the only two that stayed true to the request and returns the same format. ((326,925 . "ITEM_1").

---

I have a feeling that a debate could be made that returning the unique Names first is a better approach. OP did not provide more context!

[pbejse]

---

@CodeDing wrote:

I have a feeling that a debate could be made that returning the unique Names first is a better approach. OP did not provide more context!

---

I said the same thing on post #7  and more. There is no debate there @CodeDing  🙂

Also, as per OP.

- What is the best way to add the car of all items by associating the equivalent cdr:
((326,925 . "ITEM_1") .... the same for all items

A variation of @john.uhden's contribution [ returns the same format as per OP ]

(defun sort+sum2 (lst / x new)
  (foreach item	lst
    (setq new (if (setq x (assoc (cdr item) new))
      (subst (list (car x)
		(cons (+ (car (cadr x)) (car item)) (cdr item))) x new)
     (cons (list (Cdr item) item ) new))
    )
  )
  (reverse (mapcar 'cadr new))
)

_$ (sort+sum2 lst)
((326.925 . "ITEM_1") (311.743 . "ITEM_2") (90.9192 . "ITEM_3") (108.046 . "ITEM_4"))

[john.uhden]

@pbejse 

Yes, but I agree with your earlier comment that the pairs looked backward anyway and would be easier to deal with in the format '("ITEM_#" . ###.###) just like an entity data association list '(code . value).

Whatever, he's now got a number of solutions.  Good work!

[CodeDing]

Well, if OP desires.. 🤔

(defun cdrSum (lst / LM:Unique)
  ;; Helper Function(s)
  (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; Work
  (mapcar
    '(lambda (x)
      (cons
        (apply '+
          (mapcar 'car
            (vl-remove-if-not
              '(lambda (y) (eq x (cdr y)))
              lst
            );vl
          );mapcar
        );apply
        x
      );cons
    );lambda
    (LM:Unique (mapcar 'cdr lst))
  );mapcar
);defun

Command: (cdrSum lst)
((326.925 . "ITEM_1") (311.743 . "ITEM_2") (90.9192 . "ITEM_3") (108.046 . "ITEM_4"))

Best,

~DD

[john.uhden]

;; Though I haven't tested because my AutoCAD isn't working,
;; this should work whether the pairs are backwards or forwards.

;; (that is once you fix my mistakes)

(defun revpair (pair)(cons (cdr pair)(car pair)))
(defun sort+sum3 (lst / rvrs new)
  (if (= (type (caar lst)) 'REAL)
    (setq lst (mapcar 'revpair lst) rvrs 1)
  )
  (foreach item lst
    (if (not (assoc (car item) new))
	  (setq new (cons (cons (car item)(apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x)(car item))) lst)))) new))
	)
  )
  (if rvrs (mapcar 'revpair new) new)
)

[luizhcastanho]

Can you help me, I have a similar problem.

If fourth item was the same, i need to sum the second item

(setq lst (list ' (120 5 6.3 "N1") ' (110 9 6.3 "N2")' (110 9 8 "N3")' (130 7 6.3 "N4") '(130 7 6.3 "N4") '(120 10 6.3 "N1")))

The list should look like this

(list ' (120 15 6.3 "N1")' (110 9 6.3 "N2")'' (110 9 8 "N3")'' (130 14 6.3 "N4"))

Thanks

[john.uhden]

@luizhcastanho ,

Presuming you mean to combine each "N1" item with other "N1" items (and same for "N4" etc), I came up with the following:

(defun combine (lst / item matches new)
  (while lst
    (setq item (car lst))
    (and
      (setq matches (vl-remove-if-not '(lambda (x)(= (nth 3 x)(nth 3 item))) (cdr lst)))
      (setq item (subst (apply '+ (mapcar '(lambda (x)(nth 2 x)) (cons item matches)))(nth 2 item) item))
      (foreach match matches (setq lst (vl-remove match lst)))
    )
    (setq new (cons item new) lst (cdr lst))
  )
  (reverse new)
)

So, if 

(setq lst '((120 5 6.3 "N1") (110 9 6.3 "N2") (110 9 8 "N3") (130 7 6.3 "N4") (130 7 6.3 "N4") (120 10 6.3 "N1"))

Command: (combine lst)

((120 5 12.6 "N1") (110 9 6.3 "N2") (110 9 8 "N3") (130 7 12.6 "N4"))

[luizhcastanho]

When I do an isolated test it works, but within my lisp it gives an error error:

bad argument type: numberp: "5"

(setq item (subst (apply '+ (mapcar '(lambda (x)(nth 1 x)) (cons item matches)))(nth 1 item) item))

Command NGTTAB -> enter 2x

Your code is on line 560

Thank you for your help