[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 на правильное
работает очень просто, счеты помнишь?

[Kirill_Ja]

Да, плмню. Я раз 20 прогнал ее в пошаговом режиме прежде чем понял почему как она работает

[gomer]

Сообщение от Kirill_Ja Да, плмню. Я раз 20 прогнал ее в пошаговом режиме прежде чем понял почему как она работает

Ну все просто: берешь шашлык на шампуре и три шампура сверху, снимаешь мяско и нанизываешь на первый шампур, снимаешь помидорчик, нанизываешь на второй шампур. и так пока есть что снимать. потом помидорчики нанизываешь на третий шампур, потом мяско, в конце концом отдаешь третий шампур генацвале...

[WST]

Добрый день. Подыму тему.
Помогите пожалуйста, есть список (1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24 n)
нужно получить два списка:
1. ((2 3)(6 2)(21 4)) где вторые числа подсписка количество первых в исходном списке
2. ((10 11 12 13 14)(16 17 18 19)(22)(25 26 .... n-2 n-1)) недостающие числа в исходном списке

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

Тупо в лоб:

Код:

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

 (setq lst '(1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24)
      res nil
) ;_ end of setq

(foreach item lst
  (if (setq temp (assoc item res))
    (setq res (subst (cons item (1+ (cdr temp))) temp res))
    (setq res (cons (cons item 1) res))
  ) ;_ end of if
) ;_ end of foreach

(vl-remove-if-not (function (lambda (x) (= (cdr x) 1))) res)
(vl-remove-if (function (lambda (x) (= (cdr x) 1))) res)

[WST]

Сообщение от Кулик Алексей aka kpblc Тупо в лоб: Код: [Выделить все] (setq lst '(1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24) res nil ) ;_ end of setq (foreach item lst (if (setq temp (assoc item res)) (setq res (subst (cons item (1+ (cdr temp))) temp res)) (setq res (cons (cons item 1) res)) ) ;_ end of if ) ;_ end of foreach (vl-remove-if-not (function (lambda (x) (= (cdr x) 1))) res) (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res)

Кулик Алексей aka kpblc спасибо огромное за помощь, первый список получили все как просил, а со вторым как быть?

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

Две последние строчки как раз и возвращают просимое: одна - один список, вторая - второй. ПРисваивай своим переменным и вперед ))

[WST]

Сообщение от Кулик Алексей aka kpblc Две последние строчки как раз и возвращают просимое: одна - один список, вторая - второй. ПРисваивай своим переменным и вперед ))

Присвоил и вот что получаем
(setq lst1(vl-remove-if-not (function (lambda (x) (= (cdr x) 1))) res)
lst2(vl-remove-if (function (lambda (x) (= (cdr x) 1))) res)
)

Command: !lst
(1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24)

Command: (reverse lst1)
((1 . 1) (3 . 1) (4 . 1) (5 . 1) (7 . 1) (8 . 1) (9 . 1) (15 . 1) (20 . 1) (23 . 1) (24 . 1))

Command: (reverse lst2)
((2 . 3) (6 . 2) (21 . 4))

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

Ну и ?

[WST]

Сообщение от WST 1. ((2 3)(6 2)(21 4)) где вторые числа подсписка количество первых в исходном списке 2. ((10 11 12 13 14)(16 17 18 19)(22)(25 26 .... n-2 n-1)) недостающие числа в исходном списке

первый тот
второй не тот

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

(mapcar (function car) (vl-sort (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res) (function <))

[WST]

Сообщение от Кулик Алексей aka kpblc (mapcar (function car) (vl-sort (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res) (function <))

Command: !res
((24 . 1) (23 . 1) (21 . 4) (20 . 1) (15 . 1) (9 . 1) (8 . 1) (7 . 1) (6 . 2) (5 . 1) (4 . 1) (3 . 1) (2 . 3) (1 . 1))

Command: (mapcar (function car) (vl-sort (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res) (function <))
(_> )
bad argument type: VLA-OBJECT nil

Command: (mapcar (function car) (vl-sort (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res) (function <)))
bad argument type: VLA-OBJECT nil

скобки не хватает может я не там ее поставил?

Command: (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res)
((21 . 4) (6 . 2) (2 . 3))

Command: (vl-sort (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res) (function <))
bad argument type: VLA-OBJECT nil

что то не так

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

Код:

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

 (setq lst '(1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24)
      res nil
) ;_ end of setq

(foreach item lst
  (if (setq temp (assoc item res))
    (setq res (subst (cons item (1+ (cdr temp))) temp res))
    (setq res (cons (cons item 1) res))
  ) ;_ end of if
) ;_ end of foreach

(setq lst1 (mapcar (function car) (vl-remove-if-not (function (lambda (x) (= (cdr x) 1))) res))
      lst2 (vl-remove-if (function (lambda (x) (= (cdr x) 1))) res)
) ;_ end of setq

[koMon]

только для целых чисел

Код:

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

 (setq _list '(1 2 2 2 3 4 5 6 6 7 8 9 15 20 21 21 21 21 23 24))
(setq index 0 list_1 nil list_2 nil _list_i_s (vl-sort-i _list '<) _list_i (vl-sort (vl-sort-i _list '<) '<))
(while (/= index (length _list))
	(if (/= (nth index _list_i_s) (nth index _list_i))
		(setq list_1 (append list_1 (list (list (nth index _list) (1+ (- (nth index _list_i_s) (nth index _list_i))))))
			  index (+ index (1+ (- (nth index _list_i_s) (nth index _list_i))))
		)
		(setq index (1+ index))
	)
)
(setq index 0 _list_s (vl-sort _list '<))
(while (/= index (1- (length _list_s)))
	(if (/= (nth (1+ index) _list_s) (1+ (nth index _list_s)))
		(progn
			(setq missed_list nil)
			(repeat (1- (- (nth (1+ index) _list_s) (setq missed (nth index _list_s))))
				(setq missed_list (append missed_list (list (setq missed (1+ missed)))))
			)
			(setq list_2 (append list_2 (list missed_list)))
		)
	)
	(setq index (1+ index))
)
(print list_1)
(print list_2)

[WST]

Кулик Алексей aka kpblc, Спасибо
koMon, Спасибо то что нужно, только для целых и надо