Вот ответ, который не зависит от использования функций CL, которые делают это для вас.В реальной жизни это было бы глупо: в языке есть функции, которые отвечают за это для вас, чтобы просто избежать бесконечного повторного изобретения колес.Однако для образовательных целей интересно написать такие функции, чтобы увидеть, как преобразовать алгоритмы в код.
Алгоритм.
Найтиout, если A является подсписком из B:
- , если A является пустым списком, то это;
- , если A не является пустым, а B пустым, это не так;
- если A является ведущим подсписком B, то это подсписок;
- , если A является подсписком хвоста B, это подсписок B.
Чтобы узнать, является ли A ведущим подсписком B:
- , если A является пустым списком, то это;
- , если A не пусто, а B - нет,
- , если первый элемент A равен первому элементу B, а остальная часть A является ведущим подсписком остальныхB, то это.
Фактически мы могли бы немного упростить это: нам не нужно делать все проверки для пустых списков в обоих местах.Но я не сделал этого ниже, так как довольно легко ошибиться (предыдущая версия этого ответа сделала ошиблась!).
Итак, нам нужно преобразовать этоописание на Лиспе.
Примечания.
- Эта функция опирается на локальную вспомогательную функцию
leading-sublist-p, которая сообщает вам, является ли это ведущим подсписком, как указано выше. - Это не совсем надежный CL, поскольку он предполагает, что хвостовые вызовы будут оптимизированы: если они не будут выполнены, он выйдет из стека для длинных списков.Однако, я думаю, что это красивее, чем эквивалентная явно-итеративная версия.
- Это вообще не делает попыток справиться с возможной цикличностью и, таким образом, будет иметь проблемы с завершением при наличии циклических списков (если любой список является круглым, тоне завершится).
- Вы можете указать функцию сравнения элементов с помощью ключевого аргумента
test обычным способом CL, по умолчанию eql. - На самом деле основнойloop также является локальной функцией,
any-sublist-p, которая существует исключительно для того, чтобы избежать необходимости передавать аргумент ключевого слова через итерацию (я изначально не смог передать его вообще, затем решил, занудно, что я не хотел иметьподумать о любых возможных издержках разбора аргумента-ключевого слова в цикле).
Вот оно:
(defun sublistp (a b &key (test #'eql))
;; is A a sublist of B, comparing elements with TEST.
;;
;; Return two values: either NIL and NIL if it is not a leading
;; sublist or T and the tail of B at which it matched.
;;
;; This works by asking whether A is a leading sublist of successive
;; tails of B
;;
(labels ((leading-sublist-p (x y)
;; is X a leading sublist of Y?
(cond ((null x)
;; the empty list is a leading sublist of any list
t)
((null y)
;; a non-empty list is not the leading sublist of
;; the empty list
nil)
((funcall test (first x) (first y))
;; otherwise X is a leading sublist of Y if the
;; first two elements compare the same and the
;; tail of X is a leading sublist of the tail of Y
(leading-sublist-p (rest x) (rest y)))))
(any-sublist-p (x y)
;; this does the work: it's here merely to avoid having
;; to pass the TEST argument down in the recursion.
(cond ((null x)
;; the empty list is a sublist of any list
(values t y))
((null y)
;; a non-empty list is not a sublist of an empty
;; list
(values nil nil))
((leading-sublist-p x y)
;; if X is a leading sublist of Y it's a sublist
(values t y))
(t
;; otherwise X is a sublist of Y if it is a
;; sublist of the tail of Y
(any-sublist-p x (rest y))))))
(any-sublist-p a b)))
Для добавленной стоимости, вот версия, котораяобнаруживает некоторые, но не все округлости, сравнивая последовательные хвосты с исходными аргументами.Это дешево (два дополнительных eq теста на цикл), но не находит все округлости: для этого вам нужна полноценная проверка, которая стоит дорого.
(defun sublistp (a b &key (test #'eql))
;; is A a sublist of B, comparing elements with TEST.
;;
;; Return two values: either NIL and NIL if it is not a leading
;; sublist or T and the tail of B at which it matched.
;;
;; This works by asking whether A is a leading sublist of successive
;; tails of B
;;
(labels ((leading-sublist-p (x y)
;; is X a leading sublist of Y?
(cond ((null x)
;; the empty list is a leading sublist of any list
t)
((null y)
;; a non-empty list is not the leading sublist of
;; the empty list
nil)
((funcall test (first x) (first y))
;; otherwise X is a leading sublist of Y if the
;; first two elements compare the same and the
;; tail of X is a leading sublist of the tail of Y.
(let ((rx (rest x))
(ry (rest y)))
;; If the tail of X is A then A is circular at
;; this point and we should give up & similarly
;; for Y. Note this does not find all
;; circularities, but finding some is perhaps
;; better than not finding any.
(when (eq rx a)
(error "A is trivially circular"))
(when (eq ry b)
(error "B is trivially circular"))
(leading-sublist-p rx ry)))))
(any-sublist-p (x y)
;; this does the work: it's here merely to avoid having
;; to pass the TEST argument down in the recursion.
(cond ((null x)
;; the empty list is a sublist of any list
(values t y))
((null y)
;; a non-empty list is not a sublist of an empty
;; list
(values nil nil))
((leading-sublist-p x y)
;; if X is a leading sublist of Y it's a sublist
(values t y))
(t
;; otherwise X is a sublist of Y if it is a
;; sublist of the tail of Y
(any-sublist-p x (rest y))))))
(any-sublist-p a b)))
Вот эта версия обнаруживаеттривиально-циклический аргумент:
> (sublistp (let ((a (list 1)))
(setf (cdr a) a)
a)
'(1 2 3 4))
Error: A is trivially circular
1 (abort) Return to top loop level 0.
Для значения хака, вот явно итеративная версия: мне сложнее понять.
(defun sublistp (a b &key (test #'eql))
;; is A a sublist of B, comparing elements with TEST.
;;
;; Return two values: either NIL and NIL if it is not a leading
;; sublist or T and the tail of B at which it matched.
;;
;; This works by asking whether A is a leading sublist of successive
;; tails of B
;;
(flet ((leading-sublist-p (x y)
;; is X a leading sublist of Y?
(loop for first-cycle = t then nil
for xt = x then (rest xt)
for yt = y then (rest yt)
unless first-cycle ;circularity only after 1st cycle
do (cond
;; If the tail of X is A then A is circular at
;; this point and we should give up & similarly
;; for Y. Note this does not find all
;; circularities, but finding some is perhaps
;; better than not finding any.
((eq xt a)
(error "A is trivially circular"))
((eq yt b)
(error "B is trivially circular")))
do (cond
((null xt)
;; the empty list is a leading sublist of any
;; list
(return-from leading-sublist-p t))
((null yt)
;; a non-empty list is not the leading
;; sublist of the empty list
(return-from leading-sublist-p nil))
((not (funcall test (first xt) (first yt)))
;; leading elements differ: fail
(return-from leading-sublist-p nil))))))
(cond ((null a)
;; the empty list is the sublist of any list
(values t b))
((null b)
;; no non-empty list is the sublist of any list
(values nil nil))
(t
(loop for bt = b then (rest b)
do (cond
((null bt)
(return-from sublistp (values nil nil)))
((leading-sublist-p a bt)
(return-from sublistp (values t bt)))))))))