Во-первых, поведение не определено, когда вы мутируете константные данные: когда вы что-то заключаете в кавычки (здесь список), среда Lisp имеет право рассматривать это как константу. См. также этот вопрос, почему defparameter
или defvar
предпочтительнее setq
. И так...
(setq list '(a b c))
(rplacd (cddr list) list)
... было бы лучше написать как:
(defparameter *list* (copy-list '(a b c)))
(setf (cdr (last *list*)) *list*)
Во-вторых, ваш код плохо отформатирован и имеет неправильные соглашения об именах (пожалуйста, используйте тире для разделения слов); вот с обычной раскладкой, с помощью emacs:
(defun circularp (list)
(let (first (car list)))
(labels ((circ2 (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (circ2 (cdr list))))))))
При таком форматировании должны быть очевидны две вещи:
let
не содержит форм тела: вы определяете локальные переменные и никогда их не используете; вы также можете удалить строку let
.
Кроме того, в let
отсутствует одна пара скобок: то, что вы написали, определяет имя переменной first
и другую переменную с именем car
, связанную с list
. Я предполагаю, что вы хотите определить first
как (car list)
.
Вы определяете локальную функцию circ2
, но никогда ее не используете. Я ожидаю, что функция circularp
(-p
для «предиката», например numberp
, stringp
) вызовет (circ2 (cdr list))
. Я предпочитаю переименовывать circ2
в visit
(или recurse
), потому что это что-то значит.
С приведенными выше исправлениями это будет:
(defun circularp (list)
(let ((first (car list)))
(labels ((visit (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
Однако, если ваш список не циклический, а содержит один и тот же элемент несколько раз (например, '(a a b))
), вы будете сообщать о нем как о циклическом, потому что вы проверяете содержащиеся в нем данные, а не только структуру. Не смотрите в CAR
здесь:
(defun circularp (list)
(let ((first list))
(labels ((visit (list)
(cond
((atom list) nil)
((eq list first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
Кроме того, внутренняя функция является хвостовой рекурсией, но нет гарантии, что реализация Common Lisp автоматически устраняет хвостовые вызовы (вы должны проверить свою реализацию; большинство из них может сделать это по запросу). Это означает, что вы рискуете выделить столько кадров стека вызовов, сколько у вас есть элементов в списке, что плохо. Лучше использовать цикл напрямую:
(defun circularp (list)
(loop
for cursor on (cdr list)
while (consp cursor)
thereis (eq cursor list)))
И последнее, но не менее важное: ваш подход очень распространен, но он терпит неудачу, когда список не является одной большой круговой цепочкой ячеек, а просто где-то содержит цикл. Рассмотрим, например:
CL-USER> *list*
#1=(A B C . #1#)
CL-USER> (push 10 *list*)
(10 . #1=(A B C . #1#))
CL-USER> (push 20 *list*)
(20 10 . #1=(A B C . #1#))
(см. этот ответ, где я объясняю, что означают #1=
и #1#
)
Списки с числами в начале демонстрируют цикличность, но вы не можете просто использовать первую cons-ячейку в качестве маркера, потому что вы будете вечно зацикливаться внутри кругового подсписка. Это тип или проблемы, которые решает алгоритм Черепахи и Зайца (могут быть и другие методы, наиболее распространенным из которых является сохранение посещенных элементов в хеш-таблице).
После вашего последнего редактирования вот что я бы сделал, если бы хотел проверить цикличность рекурсивным способом без labels
:
(defun circularp (list &optional seen)
(and (consp list)
(or (if (member list seen) t nil)
(circularp (cdr list) (cons list seen)))))
Мы отслеживаем все посещенные cons-ячейки в seen
, который является необязательным и инициализируется равным NIL (вы можете передать другое значение, но это можно рассматривать как функцию).
Тогда мы говорим, что список является циклическим относительно увиденного, если это cons-ячейка, которая либо: (i) уже существует в увиденном, либо (ii) такова, что ее CDR является циклическим относительно до (cons list seen)
.
Единственный дополнительный трюк здесь — убедиться, что результат является логическим, а не возвращаемым значением member
(это подсписок, где искомый элемент является первым элементом): если в вашей среде *PRINT-CIRCLE*
установлено на NIL, а список на самом деле круговой, вы не хотите, чтобы он пытался распечатать результат.
Вместо (if (member list seen) t nil)
вы также можете использовать:
(when (member list seen))
(position list seen)
- и конечно
(not (not (member list seen)))
person
coredump
schedule
08.01.2017