[Composter]

Добрый день.у меня получается вот такой список
(("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 2.25933)
("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 3.12518)
("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 3.60096)
("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1))
подскажите как мне просуммировать его что бы при совпадении первых трех элементов суммировался 4 элемент, и пустые списки удалялись.т.е. что бы в итоге получился вот такой список
(("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 8.98547)
("_V_zaslonki" "40_Дроссельное устройство" "400" 3)
("_V_zaslonki" "40_Дроссельное устройство" "500x200" 3))

[Do$]

Код:

[Выделить все]

 (defun test (lst / rez tmp sum)
  (while lst
    (setq tmp (car lst)
	  sum (apply '+
		     (mapcar 'last
			     (vl-remove-if-not
			       '(lambda	(a)
				  (and (= (car a) (car tmp))
				       (= (cadr a) (cadr tmp))
				       (= (caddr a) (caddr tmp))
				  ) ;_ end of and
				) ;_ end of lambda
			       lst
			     ) ;_ end of vl-remove-if-not
		     ) ;_ end of mapcar
	      ) ;_ end of apply
	  rez (cons (list (car tmp) (cadr tmp) (caddr tmp) sum) rez)
	  lst (vl-remove-if
		'(lambda (a)
		   (and	(= (car a) (car tmp))
			(= (cadr a) (cadr tmp))
			(= (caddr a) (caddr tmp))
		   ) ;_ end of and
		 ) ;_ end of lambda
		lst
	      ) ;_ end of vl-remove-if
    ) ;_ end of setq
  ) ;_ end of while
  (reverse rez)
) ;_ end of defun


(test
  '(("_V_prit_01"
     "03_Воздуховод прямоугольный"
     "400x450"
     2.25933
    )
    ("_V_prit_01"
     "03_Воздуховод прямоугольный"
     "400x450"
     3.12518
    )
    ("_V_prit_01"
     "03_Воздуховод прямоугольный"
     "400x450"
     3.60096
    )
    ("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
    ("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
    ("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
    ("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
    ("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
    ("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
   )
) ;_ end of test

[VVA]

Мой вариант

Код:

[Выделить все]

 (defun test1 (lst / ret tmp)
  (vl-load-com)
  (foreach item
           (mapcar
             '(lambda (x)
                (setq x (reverse x))
                (list (strcase (vl-prin1-to-string (cdr x))) (car x))
              ) ;_ end of lambda
             lst
           ) ;_ end of mapcar
    (if (setq tmp (assoc (car item) ret))
      (setq ret
             (subst (list (car tmp) (+ (cadr tmp) (cadr item))) tmp ret)
      ) ;_ end of setq
      (setq ret (cons item ret))
    ) ;_ end of if
  ) ;_ end of foreach
  (mapcar '(lambda (x) (reverse (cons (cadr x) (read (car x)))))
          ret
  ) ;_ end of mapcar
) ;_ end of defun

Использование

Код:

[Выделить все]

 
(setq lst
       (list
         '("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 2.25933)
         '("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 3.12518)
         '("_V_prit_01" "03_Воздуховод прямоугольный" "400x450" 3.60096)
         '("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
         '("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
         '("_V_zaslonki" "40_Дроссельное устройство" "400" 1)
         '("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
         '("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
         '("_V_zaslonki" "40_Дроссельное устройство" "500x200" 1)
       ) ;_ end of list
) ;_ end of setq
(test1 lst)
;(
;("_V_ZASLONKI" "40_ДРОССЕЛЬНОЕ УСТРОЙСТВО" "500X200" 3)
;("_V_ZASLONKI" "40_ДРОССЕЛЬНОЕ УСТРОЙСТВО" "400" 3)
;("_V_PRIT_01" "03_ВОЗДУХОВОД ПРЯМОУГОЛЬНЫЙ" "400X450" 8.98547)
;)

Сделал регистронезависимым, если не нужно - убери strcase из функции test1

[Composter]

спасибо большое,особенно за оперативность.лисп от vva более универсален и не зависит от того сколько элементов в каждом списке.

[CB]

Еще вариант:

Код:

[Выделить все]

 
(defun test2 (lst / temp)
  (if lst
    (progn
      (setq temp (reverse (car lst))
            lst  (vl-remove-if
                   '(lambda (a)
                      (if (equal (cdr temp) (cdr (reverse a)))
                        (setq temp
                               (cons (+ (last a) (car temp))
                                     (cdr temp)
                               ) ;_ end of cons
                        ) ;_ end of setq
                      ) ;_ end of if
                    ) ;_ end of lambda
                   (cdr lst)
                 ) ;_ end of vl-remove-if
      ) ;_ end of setq
      (cons (reverse temp) (test2 lst))
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

;;;Вызов  (test2 lst)

[Елпанов Евгений]

Если воспользоваться рекурсией:

Код:

[Выделить все]

 (defun test (l)
  (if l
    (if (equal (cdr (reverse (car l))) (cdr (reverse (cadr l))))
      (test (cons (reverse (cons (+ (last (car l)) (last (cadr l))) (cdr (reverse (car l))))) (cddr l)))
      (cons (car l) (test (cdr l)))
    )
  )
)

Программа только для отсортированного списка.

[Oliver_88]

Самый длинный вариант.

Код:

[Выделить все]

 (defun test2  (lst)
  (if lst
    (cons
      (reverse
	(cons
	  (apply '+
		 (mapcar
		   'last
		   (vl-remove-if-not
		     '(lambda (x)
			(equal
			  (cdr (reverse x))
			  (cdr (reverse (car lst)))
			  )
			)
		     lst
		     )
		   )
		 )
	    (cdr
	      (reverse (car lst))
	      )
	  )
	)
      (test2
	(vl-remove-if
	  '(lambda (x)
	     (equal
	       (cdr (reverse x))
	       (cdr (reverse (car lst)))
	       )
	     )
	  lst
	  )
	)
      )
    )
  )

[Li6-D]

Незатейливо:

Код:

[Выделить все]

 (defun test3 (lst / s p lst1)
  (while lst
    (setq s 0 
          p (cdr (reverse (car lst)))
          lst (vl-remove-if
               '(lambda (x) (if (equal p (cdr (reverse x))) (setq s (+ s (last x)))))
                lst
              )
          lst1 (cons (reverse (cons s p)) lst1)
  ) )
  (reverse lst1)
)

[Do$]

Offtop: Конкурс, однако