[Apelsinov]

я очень извиняюсь, помогите, пожалуйста, вот вроде простая задачка, но не получается:

нужно список типа '((A 1) (A 2) (A 5) (B 6) (B 8) (C 4) (C 9)...)
превратить в ((A 8)) (B 14) (C 13)...)
где 8, 14 и 13 - суммы соответствующих вторых элементов подсписков.

голову уже сломал, все время получаются какие-то громоздкие конструкции, в которых я сам уже запутался...

[Кулик Алексей aka kpblc]

В качестве первой прикидки:

Код:

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

(setq lst '(("a" 1) ("a" 2) ("a" 5) ("b" 6) ("b" 8) ("c" 4) ("c" 9)))

(defun test (lst / lst_car res)
  (setq lst_car ((lambda (/ res)
                   (foreach item (mapcar 'car lst)
                     (if (not (member item res))
                       (setq res (cons item res))
                       ) ;_ end of if
                     ) ;_ end of foreach
                   (vl-sort res '<)
                   ) ;_ end of lambda
                 )
        ) ;_ end of setq
  (foreach item lst_car
    (setq lst_car
           (subst (cons item
                        (apply '+ (apply 'append (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) item)) lst))))
                        ) ;_ end of cons
                  item
                  lst_car
                  ) ;_ end of subst
          ) ;_ end of setq
    ) ;_ end of foreach
  lst_car
  ) ;_ end of defun

[CB]

Рекурсия

Код:

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

(defun test (lst)
  (if lst
    (cons ((lambda ( / a)
             (setq
               a (vl-remove-if-not
                   '(lambda (x) (equal (caar lst) (car x)))
                   lst
                 ) ;_ end of vl-remove-if-not
             ) ;_ end of setq
             (list (caar a) (apply '+ (mapcar 'cadr a)))
           ) ;_ end of lambda
          )
          (test (vl-remove-if
                  '(lambda (x) (equal (caar lst) (car x)))
                  lst
                ) ;_ end of vl-remove-if
          ) ;_ end of test
    ) ;_ end of cons
  ) ;_ end of if
) ;_ end of defun

[Apelsinov]

Кулик Алексей aka kpblc, CB, Спасибо!
особенно понравилось с рекурсией.

[Дима_]

Вчера в этой теме
я уже решал подобную задачу только у меня были не списки а пары и значение в виде строки (изменил cons на list, cdr на cadr и убрал atof)

Код:

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

(defun sub-test (lst / x)
(setq x (car (car lst)))
(if lst
(cons (list x
              (apply '+ (mapcar 'cadr (vl-remove-if-not '(lambda (y) (= (car y) x))lst))))
        (sub-test (vl-remove-if '(lambda (y) (= x (car y))) (cdr lst))))))

p.s. вот и вся рекурсия

[WST]

Всех поздравляю с наступившим НОВЫМ ГОДОМ
у меня похожая ситуация но нужно суммировать цифры в зависимости от первых двух элементов под списков
имеется список типа
(("a" "a" 1) ("a" "a" 2) ("a" "b" 1) ("a" "b" 2) ("b" "a" 1) ("b" "a" 2) ("b" "b" 1) ("b" "b" 2) ("c" "a" 1) ("c" "a" 2) ("c" "b" 1) ("c" "b" 2))
должны получить
(("a" "a" 3) ("a" "b" 3) ("b" "a" 3) ("b" "b" 3) ("c" "a" 3) ("c" "b" 3))

[TararykovDG]

WST, здесь было похожее, но в зависимости от первых трех элементов списка, переделать под твой вариант несложно

[WST]

TararykovDG,
Спасибо за ссылку нашел то что мне нужно даже не пришлось ничего менять

[WST]

Добрый день.
Подыму тему, есть список
(("СК 105-3" "1") ("СК 105-3" "2") ("СК 105-5" "3") ("СК 105-5" "4") ("СК 105-5" "5") ("СК 105-3" "6"))
нужно получить
(("СК 105-3" "1" "2" "6") ("СК 105-5" "3" "4" "5"))

[Кулик Алексей aka kpblc]

По-быстрому:

Код:

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

 (defun tt (/ res)
  (foreach item '(("СК 105-3" "1")
                  ("СК 105-3" "2")
                  ("СК 105-5" "3")
                  ("СК 105-5" "4")
                  ("СК 105-5" "5")
                  ("СК 105-3" "6")
                  )
    (if (not (member (car item) (mapcar (function car) res)))
      (setq res (cons item res))
      (setq res (subst (cons (car item)
                             (cons (cadr item)
                                   (cdr (assoc (car item) res))
                                   ) ;_ end of cons
                             ) ;_ end of cons
                       (assoc (car item) res)
                       res
                       ) ;_ end of subst
            ) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of foreach
  (vl-sort (mapcar
             (function
               (lambda (x)
                 (cons (car x) (vl-sort (cdr x) '<))
                 ) ;_ end of lambda
               ) ;_ end of function
             res
             ) ;_ end of mapcar
           (function (lambda (a b) (< (car a) (car b))))
           ) ;_ end of vl-sort
  ) ;_ end of defun

[WST]

Кулик Алексей aka kpblc, спасибо за оперативный ответ все хорошо но если будет список
(("СК 105-3" "1") ("СК 105-3" "2") ("СК 105-5" "3") ("СК 105-5" "4") ("СК 105-5" "5") ("СК 105-3" "6") ("СК 105-3" "10")))
то получим
(("СК 105-3" "1" "10" "2" "6") ("СК 105-5" "3" "4" "5"))
а хотелось бы
(("СК 105-3" "1" "2" "6" "10") ("СК 105-5" "3" "4" "5"))

Добавил
спасибо разобрался

[Дима_]

решил размяться:

Код:

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

 (defun test(lst)
  ((lambda (frec) (reverse (mapcar '(lambda (x) (cons (car x) (reverse (cdr x)))) (frec '() lst))))
   (lambda (ret lst)
     (if lst
	     ((lambda (x)
		     (frec (if x (subst (cons (car x) (cons (cadar lst) (cdr x))) x ret)
			             (cons (car lst) ret))
				   (cdr lst)))
		  (assoc (caar lst) ret))
		 ret))))

[WST]

Дима_, и вам большое спасибо то что надо!

[gomer]

Код:

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

 (defun _sort (lst)
  ((lambda (flag)
     (if lst
       (cons
	 (cons (caar lst)
	       (mapcar 'cadr (vl-remove-if-not flag lst)))
	 (_sort (vl-remove-if flag (cdr lst))))))
    (function (lambda (x) (= (car x) (caar lst))))))

[Дима_]

то Gomer - тоже вариант - красиво.

[WST]

Кулик Алексей aka kpblc, Дима_, gomer, огромное спасибо

[Kirill_Ja]

Код:

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

 (defun funnn (/ in_l out_l membrs)
(setq in_l '((a 1) (a 3) (a 4) (b 1) (b 7) (b 8)))
(mapcar (function (lambda (x) (if (eval (car x)) (set (car x) (+ (eval (car x)) (cadr x))) (progn (setq membrs (append membrs (list (car x)))) (set (car x) (cadr x)) )))) in_l)
(mapcar (function (lambda (x) (setq out_l (append out_l (list (list x (eval x))))) (set x nil) )) membrs)
out_l
);_defun

Лисп может быть еще и веселым)))
Писал на скорую руку исключительно фана для, поэтому нужно, чтобы имена переменных с именами A B и так далее по тексту не использовались до выполнения кода.

[gomer]

Kirill_Ja, Если честно не понял юмора спросонья. Суммируя предыдущий опыт я б написал бы так

Код:

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

 (defun calc (lst)
  ((lambda (f)
     (if lst
       (cons (list (caar lst)
                   (apply '+
                          (mapcar 'cadr
                                  (vl-remove-if-not f lst))))
             (calc (vl-remove-if f lst)))))
    '(lambda (x) (= (caar lst) (car x)))))

зы Когда ты уже научишься писать в столбик, а не в строчку
а если хочешь юмора, вот тебе смешная функция:

Код:

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

 (defun vl-sort-if-not (f lst)
  ((lambda (f-rec) (f-rec f lst nil nil nil))
    (lambda (f lst a b c)
      (if lst
        (if ((eval f) (car lst))
          (f-rec f (cdr lst) (cons (car lst) a) b c)
          (f-rec f (cdr lst) a (cons (car lst) b) c))
        (cond (a (f-rec f nil (cdr a) b (cons (car a) c)))
              (b (f-rec f nil a (cdr b) (cons (car b) c)))
              (c))))))

но одна из другого анекдота

[Kirill_Ja]

Offtop: Оборжака))) Моск сломаешь)))
Не до конца понял как работает.
Можно лучше проиллюстрировать чем так?

Код:

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

 (vl-sort-if 'numberp '(5 "a" 6 "b" 3 "c" 12 fff 78))
_1_$ 
("a" "b" "c" FFF 5 6 3 12 78)
_$ 

[gomer]

Сообщение от Kirill_Ja Оборжака

о мои седые помидоры вот так же шь

Код:

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

 (defun vl-sort-if (f lst)
  ((lambda (f-rec) (f-rec f lst nil nil nil))
    (lambda (f lst a b c)
      (if lst
        (if ((eval f) (car lst))
          (f-rec f (cdr lst) a (cons (car lst) b) c)
          (f-rec f (cdr lst) (cons (car lst) a) b c))
        (cond (a (f-rec f nil (cdr a) b (cons (car a) c)))
              (b (f-rec f nil a (cdr b) (cons (car b) c)))
              (c))))))

зы поменял название функции в #18 на правильное
работает очень просто, счеты помнишь?