检查Common Lisp中的列表是否正确

Common Lisp中是否有一个标准函数可以在不发出错误信号的情况下检查不正确的列表（即循环列表和虚线列表）<代码>列表长度可以对照循环列表进行检查（它为循环列表返回

nil

），但在给定虚线列表时发出

类型错误

信号

方案的

列表？

遍历整个列表，确保它不是点或圆形的；Common Lisp的

listp

仅检查它是否给定了

nil

或cons单元格

下面是我能想到的最简单的方法：

(defun proper-list-p (x)
  (not (null (handler-case (list-length x) (type-error () nil)))))

由于已经提出了几种实现方案，并且发现了许多意想不到的问题，下面是一个针对有抱负的

proper-list-p

作者的测试套件：

(defun circular (xs)
  (let ((xs (copy-list xs)))
    (setf (cdr (last xs)) xs)
    xs))

(assert (eql t (proper-list-p '())))
(assert (eql t (proper-list-p '(1))))
(assert (eql t (proper-list-p '(1 2))))
(assert (eql t (proper-list-p '(1 2 3))))

(assert (not (proper-list-p 1)))
(assert (not (proper-list-p '(1 . 2))))
(assert (not (proper-list-p '(1 2 . 3))))
(assert (not (proper-list-p '(1 2 3 . 4))))

(assert (not (proper-list-p (circular '(1)))))
(assert (not (proper-list-p (circular '(1 2)))))
(assert (not (proper-list-p (circular '(1 2 3)))))
(assert (not (proper-list-p (list* 1 (circular '(2))))))
(assert (not (proper-list-p (list* 1 2 (circular '(3 4))))))

---

没有标准函数可以做到这一点，也许是因为这样一个函数被认为是相当昂贵的，如果它是正确的，但是，真的，在我看来，这只是语言中的一个省略

一个最小的（性能不是很好的）实现，它不依赖于处理错误（Python人认为这是一种合理的编程方式，我不这么认为，尽管这是一种风格选择），我认为

(defun proper-list-p (l)
  (typecase l
    (null t)
    (cons
     (loop for tail = l then (cdr tail)
           for seen = (list tail) then (push tail seen)
           do (cond ((null tail)
                     (return t))
                    ((not (consp tail))
                     (return nil))
                    ((member tail (rest seen))
                     (return nil)))))))

这在

l

的长度上需要二次时间，并且消耗的时间与

l

的长度成正比。显然，使用哈希表进行发生检查可以做得更好，并且可以使用龟兔算法来避免发生检查（但我不确定这有多复杂）

我相信在图书馆里有比这更好的功能。特别是有一个

---

在思考这个问题时，我还编写了以下函数：

(defun classify-list (l)
  "Classify a possible list, returning four values.

The first value is a symbol which is
- NULL if the list is empty;
- LIST if the list is a proper list;
- CYCLIC-LIST if it contains a cycle;
- IMPROPER-LIST if it does not end with nil;
- NIL if it is not a list.

The second value is the total number of conses in the list (following
CDRs only).  It will be 0 for an empty list or non-list.

The third value is the cons at which the cycle in the list begins, or
NIL if there is no cycle or the list isn't a list.

The fourth value is the number if conses in the cycle, or 0 if there is no cycle.

Note that you can deduce the length of the leading element of the list
by subtracting the total number of conses from the number of conses in
the cycle: you can then use NTHCDR to pull out the cycle."
  ;; This is written as a tail recursion, I know people don't like
  ;; that in CL, but I wrote it for me.
  (typecase l
    (null (values 'null 0 nil 0 0))
    (cons
     (let ((table (make-hash-table)))
       (labels ((walk (tail previous-tail n)
                  (typecase tail
                    (null
                     (values 'list n nil 0))
                    (cons
                     (let ((m (gethash tail table nil)))
                       (if m
                           (values 'cyclic-list n tail (- n m))
                         (progn
                           (setf (gethash tail table) n)
                           (walk (cdr tail) tail (1+ n))))))
                    (t
                     (values 'improper-list n previous-tail 0)))))
         (walk l nil 0))))
    (t (values nil 0 nil 0))))

---

这可以用来获取关于列表的一系列信息：列表的长度、是否合适、是否循环以及循环的位置。注意，在循环列表的情况下，这将返回循环结构作为其第三个值。我认为您需要使用发生检查来完成此操作–龟兔会告诉您列表是否是循环的，但不会告诉您循环从何处开始。

此外，与公认的答案相比，有些内容稍微不太详细：

(defun improper-tail (ls)
  (do ((x ls (cdr x))
       (visited nil (cons x visited)))
      ((or (not (consp x)) (member x visited)) x)))

(defun proper-list-p (ls)
  (null (improper-tail ls)))

或者像这样：

(defun proper-list-p (ls)
  (do ((x ls (cdr x))
       (visited nil (cons x visited)))
      ((or (not (consp x)) (member x visited)) (null x))))

被认为通过了op的所有测试断言

（tailp l（cdr l））

对于循环列表是

t

，但是对于非循环列表是

nil

归功于@tfp和@RainerJoswig，他们教会了我这一点

因此，您的功能将是：

(defun proper-listp (lst)
  (or (null lst)                           ; either a `'()` or:
      (and (consp lst)                     ; a cons
           (not (tailp lst (cdr lst)))     ; not circular
           (null (cdr (last lst))))))      ; not a dotted list

顺便说一下，我是故意使用

适当的列表p

。正确的是-通过对流

property-list-p

。但是，在

系统的
CLISP
实现中，此名称已被占用：%PROPER-LIST-P

为什么函数的定义会引发持续错误

我们在评论部分的讨论结论：

---

循环列表的

tailp

行为未定义。所以这个答案是错误的！谢谢你@Lassi解决了这个问题

在我们用

tailp

进行了无望的尝试之后，这里是使用 循环列表的精确表示：）

使用正则表达式（检测循环子列表） 没有正则表达式（无法检测循环子列表）

---

这是Alexandria函数：他们使用乌龟和兔子。@Lassi:是的，我认为我对乌龟和兔子的偏见实际上是没有根据的。对于通用函数来说，可能不可能比t&h做得更好。O（a+b）运行时，只使用两个指针。该页面还提供了另一种O（a+b）算法，以及其他占用更多存储空间的算法。@Lassi FWIW在这个评论线程中完成了我们的讨论&在旧的一个页面中，我在这个答案中添加了一个名为

classify list

的函数，它告诉您关于列表和可能是列表的内容的各种信息。我写这篇文章是因为我感兴趣：我认为它没有任何特别的价值。干得好。我也忍不住想在Scheme中写一个

长尾巴

：这个算法是从维基百科/亚历山大百科（Alexandria）上稍加修改的龟兔算法。它类似于CL-code，但是

（让foo（（a init）（b init）…）

生成一个递归函数

foo

，并用给定的初始参数调用它。

（正确的listp'（1.2））

表示一个

类型错误

，因此它与使用标准的

列表长度

相同。要检测这样一个虚线列表，您需要在

do

循环中的每次迭代中额外检查非cons、非null的

x

。除非修改了当前的可读表（它可以更改Lisp的语法），否则这应该是有效的。请参阅使用

（使用标准io语法（princ to string…）

确保标准的可读性。但是，即使使用标准语法，Lisp打印机的行为也非常复杂。因此，最好避免依赖其输出语法的精确细节

（char=#\#（char“foo”0））

可用于测试第一个字符（

char

将在字符串长度为零时发出错误信号）。从算法复杂性的角度来看，这将遍历列表两次-第一次是通过

princ to string

，因此它可以访问所有项目，然后是上次的另一次。可以修改标准循环检测算法（如乌龟和兔子），以便在一次过程中检查循环列表和虚线列表。如果发现非cons

cdr

，它将立即停止。这就是Alexandria的

proper-list-p

所做的：你是对的-子列表循环也会导致这种方法出现问题。一般来说，字符串处理可能比遍历列表花费更多的时间，即使您遍历列表两次；Lisp必须为字符串分配一些内存。regexp解析可能会分配更多内存，而且regexp行为通常非常复杂。读卡器和打印机非常复杂，通常最好在不完全需要它们的任何任务中避免使用它们：）可能没有什么比使用它们更简单的了

(setf *print-circle* t)

(ql:quickload :cl-ppcre)

(defun proper-listp (lst)
  (or (null lst)                                                   ; either a `'()` or:
      (and (consp lst)                                             ; a cons
           (not (cl-ppcre::scan "#\d+=(" (princ-to-string lst))))  ; not circular
           (null (cdr (last lst))))))                              ; not a dotted list

(defun proper-listp (lst)
  (or (null lst)                                                   ; either a `'()` or:
      (and (consp lst)                                             ; a cons
           (not (string= "#" (subseq (princ-to-string lst) 0 1)))  ; not circular
           (null (cdr (last lst))))))                              ; not a dotted list