Join sublist with the first four equal elements and add the fifth element

[Jéferson Gustavo]

Hello everyone!
I have a list with several other sublists of five elements each, I need to create a function that verifies that the first four elements of each sublist are the same, if they are, join the two sublists in one, and add the last number of the two sublists, for example:
((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4))
The function would return ((1 1 1 1 7) (2 2 2 2 3))
Thank you in advance!

[Lee Mac]

Quickly written:

(defun foo ( l / k r z )
    (foreach x l
        (setq k (reverse (cdr (reverse x))))
        (if (vl-some '(lambda ( y ) (if (apply 'and (mapcar '= k y)) (setq z y))) r)
            (setq r (subst (append k (list (+ (last z) (last x)))) z r))
            (setq r (cons x r))
        )
    )
    (reverse r)
)

_$ (foo '((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4)))
((1 1 1 1 7) (2 2 2 2 3))

 

Edited November 8, 2020 by Lee Mac

[Tharwat]

Here is one way.  

(setq lst '((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4)))

(foreach itm lst
  (setq one itm)
  (mapcar '(lambda (k)
             (if (vl-every '(lambda (a b) (= a b)) (setq c (mapcar '+ '(0 0 0 0) one)) (mapcar '+ '(0 0 0 0) k))
               (progn
                 (setq rtn (cons (append c (list (+ (nth 4 one) (nth 4 k)))) rtn))
                 (setq lst (vl-remove one lst)
                       lst (vl-remove k lst))
                 )
               (setq rtn (cons (list k) rtn))
               ))
          (cdr lst)
          )
  )

 

[Stefan BMR]

(defun f (l / r)
  (setq l (vl-sort l
              '(lambda (a b)
                 (cond
                   ((/= (car   a) (car   b)) (> (car   a) (car   b)));(not (equal (car a) (car b) 1e-8))
                   ((/= (cadr  a) (cadr  b)) (> (cadr  a) (cadr  b)))
                   ((/= (caddr a) (caddr b)) (> (caddr a) (caddr b)))
                   (T (> (cadddr a) (cadddr b)))
                 )
               )
             )
        r (list (car l))
  )           
  (foreach x (cdr l)
    (if
      (vl-every '(lambda (a b c) (= a b)) x (car r) '(0 0 0 0))
      (setq r (cons (mapcar '(lambda (a b c) (if c (+ a b) a)) x (car r) '(nil nil nil nil T)) (cdr r)))
      (setq r (cons x r))
    )
  )
  r
)

 

[Grrr]

(defun f ( L / c v k fnd )
  (foreach x (mapcar 'reverse L)
    (setq 
      v (car x) 
      k (reverse (cdr x))
      c
      (cond 
        ( (not (setq fnd (assoc k c))) 
          (cons (list k v) c)
        )
        ( (subst (list k (+ v (cadr fnd))) fnd c) )
      ); cond 
    ); setq 
  ); foreach 
  (if c (mapcar '(lambda (x) (append (car x) (list (last x)))) (reverse c)))
); defun 

_$ (f '((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4)))
((1 1 1 1 7) (2 2 2 2 3))

 

[Jéferson Gustavo]

Your capacity is impressive, it worked perfectly, thank you all!

[pBe]

(Defun foot (lst / a b c d e f x nlst)
  (While (setq a (Car lst))
    (setq x (Cdr lst))
    (setq b (reverse a)
	  c (Car b)
	  d (cdr b)
    )
    (while (setq e (car x))
      (if (equal (cdr (reverse e)) d)
	(setq c (+ (last e) c))
	(setq g (cons e g))
      )
      (setq x (cdr x))
    )

    (setq nlst (cons (append d (list c)) nlst)
	  lst  g
	  g    nil
    )
  )
  nlst
)

Test 

(setq lst '((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4)))
_$ (foot lst)
((1 1 1 1 7) (2 2 2 2 3))
_$ (foo lst)
((1 1 1 1 7) (2 2 2 2 3))
_$ (F:S lst)
((1 1 1 1 7) (2 2 2 2 3))
_$ (F:G lst)
((1 1 1 1 7) (2 2 2 2 3))
_$ (setq lst '((1 1 1 1 3) (2 2 2 2 2 3) (1 1 1 1 4) (1 1 1 1 1 4)(2 2 2 2 2 7)))
((1 1 1 1 3) (2 2 2 2 2 3) (1 1 1 1 4) (1 1 1 1 1 4) (2 2 2 2 2 7))
_$ (foot lst)
((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4))
_$ (foo lst)
((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4))
_$ (F:S lst)
((1 1 1 1 8) (2 2 2 2 4))
_$ (F:G lst)
((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4))