[Mozgunov]

Ребят подскажите как можно сделать вот такую штуку. Есть список типа

Код:

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

((тип1 значение) (тип2 значение) (тип1 значение) (тип 3 значение))

Как получить список типа:

Код:

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

((тип1 суммарное_значение_типа_1) (тип2 суммарное_значение_типа_2) (тип3 суммарное_значение_типа_3))

Пример может есть какой? Спасибо!

[TararykovDG]

Mozgunov, попробуй так

Код:

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

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

Пример:
_$ (setq lst (list (list "t1" 2) (list "t2" 5) (list "t1" 3) (list "t3" 7) (list "t1" 10) (list "t2" 3) (list "t3" 1)))
(("t1" 2) ("t2" 5) ("t1" 3) ("t3" 7) ("t1" 10) ("t2" 3) ("t3" 1))
_$ (sum_lst lst)
(("t1" 15) ("t2" 8) ("t3" 8))

[Mozgunov]

TararykovDG, Спасибо большое! Всё работает. Сейчас буду разбираться что к чему.

[Лиспер]

Вариант без рекурсии и побыстрее:

Код:

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

(setq key_lst '(("key1" 1) ("key2" 2) ("key1" -10.) ("t1" 10)))
(defun sum_test (lst / res)
  (foreach item lst
    (setq res
           (cond
             ((member (car item) (mapcar (function car) res))
              (subst (list (car item)
                           (+ (cadr item) (cadr (assoc (car item) res)))
                           ) ;_ end of list
                     (assoc (car item) res)
                     res
                     ) ;_ end of subst
              )
             (t (cons item res))
             ) ;_ end of cond
          ) ;_ end of setq
    ) ;_ end of foreach
  res
  ) ;_ end of defun

[Дима_]

Сообщение от Лиспер Вариант без рекурсии и побыстрее:

Насчет быстрее тут совсем не однозначно...

[Лиспер]

Я проверял на коротких списках. Чем список длиннее, тем, конечно, результаты будут неоднозначнее.

[Mozgunov]

Спасибо. У меня в списке 50-70 элементов. Поэтому первый вариант вполне годится! Скорость выполнения не критична.

[gomer]

Чет я совсем туплю...
Нужно развернуть список и все его подсписки...
придумал такого динозавра...

Код:

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

 (defun reverse-tree (tree)
  (if (listp tree)
    (reverse
      ((setq
	 f-rec
	  (lambda (tree)
	    (mapcar
	      '(lambda (node)
		 (if (atom node)
		   node
		   (f-rec (reverse node))
		 )
	       )
	      tree
	    )
	  )
       )
	tree
      )
    )
    tree
  )
)

а как без лямбды

[Do$]

Вот так получилось:

Код:

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

 (defun reverse-tree (lst)
  ;;(reverse-tree '("1" "2" "3" "4" ("5" "6" "7" "8") "9" "10" (("10.0" "10.1" "10.2" ("10.2.1" "10.2.2" "10.2.3" "10.2.4") "10.3") "11" "12" "13" "14")))
  (if lst
    (reverse
      (cons (if (listp (car lst))
       (reverse-tree (car lst))
       (car lst)
     ) ;_ end of if
     (reverse (reverse-tree (cdr lst)))
      ) ;_ end of cons
    ) ;_ end of reverse
  ) ;_ end of if
) ;_ end of defun

[Дима_]

To Gomer - что я вижу у Вас появилась f-rec! Самое интересное - что эту задачу я бы предпочел решить mapcarom:

Код:

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

 (defun reverse-tree (lst)
(mapcar '(lambda (x)
           (if (listp x)
               (reverse-tree x)
               x))
        (reverse lst)))

P.S. кстати во всех трех кодах есть на первый раз незаметная логическая ошибка - кто видит какая?

[gomer]

Сообщение от Дима_ To Gomer - что я вижу у Вас появилась f-rec! Самое интересное - что эту задачу я бы предпочел решить mapcarom:

тю, я знал, что все так просто... Но, как ни крутил... так и не додумался...
Дима_, если эта f-rec не появилась бы, то было бы моего вопроса...
Задание, которое я решал было:

Реализовать функцию, которая в исходном списке заменяет все элементы-списки результатами их реверсирования. Реверсирование производить на всех уровнях вложения. Пример: для списка ‘(1 ((2 3) 4) 5 6) результатом будет : ‘(1 (4 (3 2)) 5 6).

получилась такая функция:

Код:

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

 (defun reverse-tree (tree)
  (mapcar
    '(lambda (node)
       (if (atom node)
	 node
	 (reverse-tree (reverse node))
       )
     )
     tree
  )
)

Естественно я подумал: почему верхний уровень не реверсируется...
Нутром почуял ошибку...
Дима_,
Но что же за ошибка, в кодах???

[Дима_]

Сообщение от gomer Но что же за ошибка, в кодах???

Она не столько в кодах - сколько в особенности автолиспа попробуй выполнить (reverse-tree (entget (entlast))) - в любой версии reverse-tree.

[gomer]

Сообщение от Дима_ попробуй выполнить (reverse-tree (entget (entlast)))

А можно подробнее? Подозреваю, что выпендреж vl из за точечных пар...

[Дима_]

формально список - это последовательность точечных пар заканчивающихся nil (он же '()) - но функция listp - определяет его за "своего" - хотя формально он таким не является - нельзя применить "списочную" фунцию (mapcar, append и пр.) к (cons 1 1) или (cons 1 (cons 1 1)), atom в свою очередь тоже его "своим" не признает - то есть для реализации с любым списком неплохобы "забацать" какой-нибудь consp и решить - надо ли менять пару местами.

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

у меня получилось:

Код:

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

 (defun f (l)
 (if (atom l) l
  (reverse (mapcar 'f l))
 )
)

[Do$]

Сообщение от Елпанов Евгений у меня получилось: Код: [Выделить все] (defun f (l) (if (atom l) l (reverse (mapcar 'f l)) ) )

Браво, Евгений!

[gomer]

Все, я понял...
Вот что я искал...

Код:

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

 (defun reverse-tree (tree)
  (if (atom tree)
    tree
    (mapcar 'reverse-tree (reverse tree))
  )
)

Елпанов Евгений, вам самое большое: thank_you: