| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > lisp помогите обработать список

lisp помогите обработать список

Ответ
Поиск в этой теме
Непрочитано 17.08.2010, 11:51 #1
lisp помогите обработать список
Apelsinov
 
Проектировщик ВК. LISP-любитель.
 
Москва
Регистрация: 15.12.2003
Сообщений: 1,158

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

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

голову уже сломал, все время получаются какие-то громоздкие конструкции, в которых я сам уже запутался...
Просмотров: 8632
 
Непрочитано 17.08.2010, 12:04
1 | #2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


В качестве первой прикидки:
Код:
[Выделить все]
(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
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.08.2010, 12:37
1 | #3
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Рекурсия
Код:
[Выделить все]
(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
CB вне форума  
 
Автор темы   Непрочитано 17.08.2010, 13:49
#4
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,158
<phrase 1=


Кулик Алексей aka kpblc, CB, Спасибо!
особенно понравилось с рекурсией.
Apelsinov вне форума  
 
Непрочитано 17.08.2010, 14:29
#5
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Вчера в этой теме
я уже решал подобную задачу только у меня были не списки а пары и значение в виде строки (изменил 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. вот и вся рекурсия
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 01.01.2012, 16:24
#6
WST


 
Регистрация: 21.04.2011
Сообщений: 135


Всех поздравляю с наступившим НОВЫМ ГОДОМ
у меня похожая ситуация но нужно суммировать цифры в зависимости от первых двух элементов под списков
имеется список типа
(("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))
WST вне форума  
 
Непрочитано 01.01.2012, 16:47
#7
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


WST, здесь было похожее, но в зависимости от первых трех элементов списка, переделать под твой вариант несложно
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 01.01.2012, 20:58
#8
WST


 
Регистрация: 21.04.2011
Сообщений: 135


TararykovDG,
Спасибо за ссылку нашел то что мне нужно даже не пришлось ничего менять
WST вне форума  
 
Непрочитано 07.11.2014, 15:10
#9
WST


 
Регистрация: 21.04.2011
Сообщений: 135


Добрый день.
Подыму тему, есть список
(("СК 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"))
WST вне форума  
 
Непрочитано 07.11.2014, 15:19
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


По-быстрому:
Код:
[Выделить все]
 (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
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 07.11.2014, 15:38
#11
WST


 
Регистрация: 21.04.2011
Сообщений: 135


Кулик Алексей 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"))

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

Последний раз редактировалось WST, 07.11.2014 в 16:09.
WST вне форума  
 
Непрочитано 07.11.2014, 16:25
#12
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


решил размяться:
Код:
[Выделить все]
 (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))))
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 07.11.2014, 16:31
#13
WST


 
Регистрация: 21.04.2011
Сообщений: 135


Дима_, и вам большое спасибо то что надо!
WST вне форума  
 
Непрочитано 07.11.2014, 19:36
1 | #14
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


Код:
[Выделить все]
 (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 вне форума  
 
Непрочитано 07.11.2014, 20:07
#15
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


то Gomer - тоже вариант - красиво.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 07.11.2014, 20:59
#16
WST


 
Регистрация: 21.04.2011
Сообщений: 135


Кулик Алексей aka kpblc, Дима_, gomer, огромное спасибо
WST вне форума  
 
Непрочитано 16.11.2014, 03:40
#17
Kirill_Ja


 
Регистрация: 28.07.2008
Мурманск
Сообщений: 208
<phrase 1=


Код:
[Выделить все]
 (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 и так далее по тексту не использовались до выполнения кода.
__________________
Мне не нужно сделать за меня. Если я что-то ищу, то пути решения.
Kirill_Ja вне форума  
 
Непрочитано 16.11.2014, 13:25
#18
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


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))))))
но одна из другого анекдота

Последний раз редактировалось gomer, 16.11.2014 в 16:37.
gomer вне форума  
 
Непрочитано 16.11.2014, 15:58
#19
Kirill_Ja


 
Регистрация: 28.07.2008
Мурманск
Сообщений: 208
<phrase 1=


Offtop: Оборжака))) Моск сломаешь)))
Не до конца понял как работает.
Можно лучше проиллюстрировать чем так?
Код:
[Выделить все]
 (vl-sort-if 'numberp '(5 "a" 6 "b" 3 "c" 12 fff 78))
_1_$ 
("a" "b" "c" FFF 5 6 3 12 78)
_$ 
__________________
Мне не нужно сделать за меня. Если я что-то ищу, то пути решения.
Kirill_Ja вне форума  
 
Непрочитано 16.11.2014, 16:37
#20
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


Цитата:
Сообщение от 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 на правильное
работает очень просто, счеты помнишь?
gomer вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > lisp помогите обработать список

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Lisp показывает ошибку Плохо сформированный список на входе BBLainer LISP 20 27.04.2010 18:40
Lisp, помогите с алгоритмом "подтягивания" поллиний 2123 LISP 1 03.02.2010 23:58
Lisp: Список элементов в слоях ALFMario LISP 4 29.04.2008 17:26
Помощь по Лире Серега М Лира / Лира-САПР 52 28.05.2007 02:47
Помогите отладить lisp программу Мишаня LISP 7 31.07.2006 12:54