LINUX.ORG.RU

[lisp] поатомное сравнение списков


0

1

need some help
функция должна выполнять сабж, возвращать T либо NIL в случае совпадения или несовпадения соответственно.
собственно, функция берет CAR от заданного X и заданного Y (X Y - списки), проверяет их на равенство, и идет дальше в случае совпадения. если car является списком, углубляемся в рекурсию.
вопрос - как прервать выполнение проверки на некотором уровне рекурсии и вернуть NIL?

★★

Ответ на: комментарий от fads

> и да, школота на моем лоре, императивщики не нужны и т.д.

Претендуешь на то, что «не школота»? И такую элементарную вещь сделать не можешь? Вообще, юзай equal или tree-equal, а то этот велосипед тебе, похоже, не под силу.

archimag ★★★ ()

Если уж так надо, то лист (1 2 3) это cons-ячейки

(1 . (2 . (3 . nil)))

Значит сравнивай car, вызывай cdr. И так рекурсивно. Когда cdr вернет nil - выходи из рекурсии.

// Вроде ничего не напутал)

shamazmazum ()
(defun tree-equal-p (tree-1 tree-2 &key (test #'equal) deep)
  (labels ((rec (tree-1 tree-2 deep)
             (when (/= (length tree-1) (length tree-2))
               (return-from tree-equal-p nil))
             (unless (and (numberp deep) (zerop deep))
               (iter (for a in tree-1)
                     (for b in tree-2)
                     (typecase a
                       (atom (typecase b
                               (atom (unless (funcall test a b)
                                       (return-from tree-equal-p nil)))
                               (cons (return-from tree-equal-p nil))))
                       (cons (typecase b
                               (atom (return-from tree-equal-p nil))
                               (cons (rec a b (when (numberp deep) (1- deep)))))))))
             t))
    (rec tree-1 tree-2 deep)))

но это императивщина, так что придётся вам из принципиальных позииций курить катаморфизмы )

quasimoto ★★★★ ()
Ответ на: комментарий от shamazmazum

> Значит сравнивай car, вызывай cdr. И так рекурсивно.

Нужно еще учесть, что кары сами могут быть списками, то чтоб проверить что всё равно, функция должна возвращать что-то типа (and (compare (car a) (car b)) (compare (cdr a) (cdr b))).

smh ★★★ ()
Ответ на: комментарий от quasimoto
(defun same-car-tree (l1 l2)
  (cond ((and (not l1) (not l2)) 
	 t)
	((and (listp (car l1))
	      (listp (car l2)))
	 (and (same-car-tree (car l1) (car l2))
	      (same-car-tree (cdr l1) (cdr l2))))
	((equal (car l1) (car l2))
	 (same-car-tree (cdr l1) (cdr l2)))
	(t 
	 nil)))
pseudo-cat ★★★ ()
Ответ на: комментарий от pseudo-cat

У ТС:

вопрос - как прервать выполнение проверки на некотором уровне рекурсии и вернуть NIL?

там фишка с отслеживанием глубины рекурсии нужна, не просто tree-equal (который и так есть в стандартной библиотеке).

Кстати, там iter можно на mapc заменить у меня.

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto
(defun tree-equal-p (tree-1 tree-2 &key (test #'equal) deep)
  (labels ((rec (tree-1 tree-2 deep)
             (when (/= (length tree-1) (length tree-2))
               (return-from tree-equal-p nil))
             (unless (and (numberp deep) (zerop deep))
               (mapc #'(lambda (a b)
                         (typecase a
                           (atom (typecase b
                                   (atom (unless (funcall test a b)
                                           (return-from tree-equal-p nil)))
                                   (cons (return-from tree-equal-p nil))))
                           (cons (typecase b
                                   (atom (return-from tree-equal-p nil))
                                   (cons (rec a b (when (numberp deep) (1- deep))))))))
                     tree-1
                     tree-2))
             t))
    (rec tree-1 tree-2 deep)))

(tree-equal-p '(1 (2 (3 4))) '(1 (2 (3 5))))
;=> NIL

(tree-equal-p '(1 (2 (3 4))) '(1 (2 (3 5))) :deep 0)
;=> T

(tree-equal-p '(1 (2 (3 4))) '(1 (2 (3 5))) :deep 1)
;=> T

(tree-equal-p '(1 (2 (3 4))) '(1 (2 (3 5))) :deep 2)
;=> T

(tree-equal-p '(1 (2 (3 4))) '(1 (2 (3 5))) :deep 3)
;=> NIL
quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

Некоторые списки равны, но некоторые ровнее, получается :)

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

фишка с отслеживанием глубины рекурсии нужна

да, конкретно это меня и интересует.
также подразумевается, что при написании функции можно пользоваться только car, cdr, cond, eq, и другими примитивными, а также пользоваться функциональным стилем

fads ★★ ()
Ответ на: комментарий от quasimoto
(defun same-car-tree (l1 l2 &optional (deep 0))
  (format t "~&l1: ~a,   l2:~a" l1 l2)
  (cond ((and (not l1) (not l2)) 
	 t)
	((and (listp (car l1))
	      (listp (car l2))
	      (> deep 0))  
	 (and (same-car-tree (car l1) (car l2) (1- deep))
	      (same-car-tree (cdr l1) (cdr l2) (1- deep))))
	((equal (car l1) (car l2))
	 (same-car-tree (cdr l1) (cdr l2) deep))
	(t 
	 nil)))

по мне так лучше выглядит, чем в императивном стиле

pseudo-cat ★★★ ()
Ответ на: комментарий от fads

также подразумевается, что при написании функции можно пользоваться только car, cdr, cond, eq, и другими примитивными, а также пользоваться функциональным стилем

Ну так я написал выше :)

Или вам просто интересно чтобы было чисто и функционально? Это можно, но есть несколько моментов:

1) Это будет обобщённая (однопроходная) свёртка на АТД представляющем собой декартовое произведение АТД вида конс-ячеек (List ~ Nil + t * (Cons List)).

2) Или это будет простой функциональный код, который без list fusion оптимизаций будет работать во много проходов.

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

И даже однопроходный функциональный алгоритм будет создавать лишние итерации, те что можно отсечь с помощью return-from в императивном CL коде.

Зачем писать заведомо непонятный функциональный код (1) или заведомо неэффективный (2)? Тут нужен либо императивный код, либо идти изобретать новые методы для adt fusion (а это вообще, область CS, я кстати думаю, что довольно интересная - есть кое что на тему list fusion, то засчёт чего Haskell выезжает на таких алгоритмах).

quasimoto ★★★★ ()
Ответ на: комментарий от balodja

Хотя, нет, это не лиспосрач и никогда им не станет.

balodja ★★★ ()
Ответ на: комментарий от quasimoto

а в чём неэффективность моего кода? он один раз проходит, спускается на сколько сказали и прерывает дальнейшие итерации при первом несовпадении

pseudo-cat ★★★ ()
Ответ на: комментарий от balodja

обсуждение алгоритма на лиспе это лиспосрач? тогда логично, что то же самое на с++ будет c++срач, на русском - русскосрач, да и вообще любое обсуждение последовательностей действий будет срачем. У меня есть кулинарная книга, там замечательный сплошной срач с картинками

pseudo-cat ★★★ ()
Ответ на: комментарий от pseudo-cat

а в чём неэффективность моего кода?

В этом случае как раз всё хорошо (в SBCL tree-equal примерно так же выглядит) благодаря тому что and - специальная форма.

Но вот некий пример на тему: в списке есть n элементов удовлетворяющих предикату test и m остальных элементов, нужно сделать преобразование:

n-m-list -> `(,(fold-some-fun-on n-list) ,@m-list)

прямая реализация:

(list* (fold f i (filter test list)) (filter anti-test list))

осуществляет 3n + 2m итераций,

немного поправленая:

(multiple-value-bind (allows not-allows) (partition test list) (list* (fold f i allows) not-allows))

делает 2n + m

и только прямая свёртка или ручной цикл дают желаемые (n + m) итераций.

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

при этом прямая свёртка не очень хорошо выглядит и не очень хороший эффект оказывает на использование памяти.

quasimoto ★★★★ ()
Ответ на: комментарий от pseudo-cat

> обсуждение алгоритма на лиспе это лиспосрач?

Да фигли тут обсуждать? Был бы ещё какой алгоритм, а то ведь детский сад.

archimag ★★★ ()
Ответ на: комментарий от quasimoto

чисто и функционально - самое важное
приоритет на использовании рекурсии для уменьшения объема кода.
и да, это задание для первокурсников, свертки и другой матан здесь неприменим.

fads ★★ ()
Ответ на: комментарий от quasimoto

> Зачем писать заведомо непонятный функциональный код (1) или заведомо неэффективный (2)?

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

smh ★★★ ()
Ответ на: комментарий от pseudo-cat

а в чём неэффективность моего кода?

Хотя нет - непример, если имеем неравные атомы по одному и тому же пути в дереве или атом и список - почему бы сразу не вернуть nil? То что в императивном коде return-from.

quasimoto ★★★★ ()
Ответ на: комментарий от smh

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

Бывает :) Обычно понятный - неэффективный, а более эффективный - менее понятный. Как в том пример выше с (fold ... (filter ...)) (filter ...)) - просто но в несколько проходов.

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

это как повезёт с входным списком - поиск в глубину или в ширину раньше сойдётся к неверному решению.

Но если надо в ширину списка искать, постепенно углубляясь во вложенные списки, тогда да, я не знаю как прервать параллельные итерации, кроме как не использовать общие изменяемые данные.

pseudo-cat ★★★ ()
Ответ на: комментарий от smh

> Ну функциональный код иногда бывает намного яснее императивного

Угу, один код иногда бывает намного яснее другого кода, а императивщину vs функциональщину здесь не при чём.

archimag ★★★ ()
Ответ на: комментарий от pseudo-cat

одновременно на каждой итерации делать: разделение nm-списка на n и m и применять fold-some-f даёт n+m итераций вроде

Это второй вариант - partition разбивает список на m-список и n-список за n + m итераций и fold для n-списка потом добавляет ещё n итераций - того 2n + m.

Вообще, если учитывать все детали, с экономией памяти в дополнение к итерациям, то тут безобидная строчка превращается в глупую императивную простыню :)

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

partition разбивает список на m-список и n-список за n + m итераций и fold для n-списка потом добавляет ещё n

во время разбиения можно вызывать эту ф-цию)

pseudo-cat ★★★ ()
Ответ на: комментарий от archimag

> Угу, один код иногда бывает намного яснее другого кода, а императивщину vs функциональщину здесь не при чём.

Согласен.

smh ★★★ ()
Ответ на: комментарий от pseudo-cat

Вот пример - reduce-constants собирает константы у транзитивных функций. Вроде как partition и reduce прекрасно подходят, но как-то неудобно их использовать. Императивный цикл + присваивание пишутся дольше, но явно работают более точнее, если можно так сказать.

quasimoto ★★★★ ()
Ответ на: комментарий от quasimoto

если рассматривать тот старый пример, то что-то типа этого сойдёт? -

(defun test2 (l some-f &optional (acc-n nil) (acc-m nil)) ;n - odd
  (format t "* ")
  (cond ((not l)
	 (list acc-n acc-m))
	((oddp (car l))
	 (test2 (cdr l)
		some-f
		(cons (funcall some-f (car l)) acc-n)
		acc-m))
	(t 
	 (test2 (cdr l) some-f acc-n (cons (car l) acc-m)))))


CL-USER> (test2 '(1 2 3 4 5 6 7) (lambda (x) (* x 3)))
* * * * * * * * 
((21 15 9 3) (6 4 2))

или что вы имели ввиду под вторым n в 2n?

pseudo-cat ★★★ ()

Что, сессия близка? Наверное, ты неправильно понял задание. Но, то, что ты вербализовал, делается так:

> (defparameter *god-says-stop-here* nil)
*god-says-stop-here*

> (defun exclusive-or (x y) (or (and x (not y)) (and y (not x))))
exclusive-or

> (defun compare-lists-and-stop-magically (l1 l2 test)
             (labels ((inner (l1 l2)
                      (cond (*god-says-stop-here* 
                             (return-from compare-lists-and-stop-magically nil))
                      ((and (null l1) (null l2)) t)   
                      ((exclusive-or l1 l2) nil) 
                      ((funcall test (car l1) (car l2))
                        (inner (cdr l1) (cdr l2)))
                      (t nil))))
               (inner l1 l2)))     
compare-lists-and-stop-magically

> compare-lists-and-stop-magically '(1 2 3) '(1 2) '=
NIL

> compare-lists-and-stop-magically '(1 2 3) '(1 2 3) '=
T

> compare-lists-and-stop-magically '(1 2 3) `(1 ,(progn (setf *god-says-stop-here* t) 2) 3) '=
NIL

den73 ★★★★★ ()
Ответ на: комментарий от den73

А, я понял теперь, что глубина рекурсии задана числом, а я думал, она задана неизвестным условием ,которое и выразил в виде переменной. И, видимо, labels нельзя использовать? Ну тогда (не буду уже проверять, просто как идея).

(defun compare-lists (l1 l2 depth test)
  (cond
    ((= depth 0) nil) ; достигнута глубина
    ((and (null l1) (null l2)) t)  ; оба списка кончились
    ((exclusive-or l1 l2) nil)  ; только один кончился
    ((funcall test (car l1) (car l2)) ; проверка прошла
     (compare-lists (cdr l1) (cdr l2) (- depth 1) test))
    ; если мы здесь, автоматически вернётся nil
    ))

den73 ★★★★★ ()
Ответ на: комментарий от den73

Правда, если дают такие задачи, то, видимо, преподаватель и сам не понимает, зачем нужен лисп. Поскольку ты студент, то скажу тебе на всякий случай. Лисп нужен как динамическая среда (почти любую функцию и любой класс можно поменять в рантайме, а это бывает важно, например, когда программу вообще нельзя остановить или когда её очень долго перезапускать) и как среда метапрограммирования (очень легко расширять язык новыми конструкциями, а также порождать программный код как результат произвольных вычислений). А все эти рекурсии и «борьба с императивщиной» - это всё, хоть и нужно для общего развития, но может быть реализовано почти на любом языке, а вовсе не обязательно на лиспе. В качестве упражнения - напиши то же самое на Бейсике, С или Паскале.

den73 ★★★★★ ()
Ответ на: комментарий от den73

Правильная расстановка отступов предоставляется читателю.

А скобок ?)

quasimoto ★★★★ ()
Ответ на: комментарий от den73

не глубина рекурсии, а глубина спуска по вложенным спискам :)

pseudo-cat ★★★ ()

недавно сдал эту задачу. вот то, что требовалось

(defun equal1 (x y) 
    (cond ((and (null x) (null y)) t) 
    ((and (atom(car x)) (atom(car y))) 
    (and (eq(car x)(car y)) (equal1 (cdr x)(cdr y)))) 
    ((and (not (atom (car x) ) ) (not (atom (car y) ) )    ) 
    (and (equal1 (car x) (car y) ) (equal1 (cdr x) (cdr y) ) )) 
    (t nil) 
))

fads ★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.