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

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

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

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

> qual или tree-equal

Вот-вот, хотел посоветовать)

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

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

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

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

(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)))

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

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

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

У ТС:

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

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

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

я вроде отслеживаю. через listp спускаясь

вернее через условие по listp

Должен быть какой-нибудь параметр, вроде deep, чтобы указать до какой глубины сравнивать.

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

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

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

(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)))

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

также подразумевается, что при написании функции можно пользоваться только 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 выезжает на таких алгоритмах).

> И такую элементарную вещь сделать не можешь?

Зато отличный повод устроить очередной лиспосрач.

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

и правда, так лучше.

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

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

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

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

В этом случае как раз всё хорошо (в 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) итераций.

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

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

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

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

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

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

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

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

чисто и функционально - самое важное

pseudo-cat хорошо написал, в духе SICP.

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

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

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

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

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

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

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

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

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

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

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

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

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

Это уже будут переменные в let и incf - не функционально.

в смысле (setf var (funcall f ...))

я видимл не так понял, можете пример на псевдокоде или лиспе?

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

Согласен.

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

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

(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?

Ну я думаю, ТС учтет)

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

> (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

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

ужас какой-то)

А, я понял теперь, что глубина рекурсии задана числом, а я думал, она задана неизвестным условием ,которое и выразил в виде переменной. И, видимо, 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
    ))

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

то что-то типа этого сойдёт?

Вот (linux.org.ru) создал тему по этому поводу.

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

А скобок ?)

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

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

(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) 
))