PROSAGA码农传奇-lisp-如何在Lisp中比较两个列表

<div class =“post-text”itemprop =“text”>
  
    这是一个答案，它不依赖于使用CL为您执行此操作的功能。在现实生活中，这将是一个愚蠢的事情：语言具有为您解决这个问题的功能，以避免像这样无休止的轮子重塑。但是出于教育目的，编写这样的函数来了解如何将算法转换为代码是很有趣的。
  
  
    的
      算法。
    </强>
  
  <UL>
    <LI>
      
        要确定A是否是B的子列表：
      
      <UL>
        <LI>
          如果A是空列表那么它是;
        </LI>
        <LI>
          如果A不为空且B为空则不是;
        </LI>
        <LI>
          如果A是
          
            领导
          
           B的子列表是子列表;
        </LI>
        <LI>
          如果A是B尾的子列表，则它是B的子列表。
        </LI>
      </UL>
    </LI>
    <LI>
      
        找出A是否是a
        
          领导
        
         B的子列表：
      
      <UL>
        <LI>
          如果A是空列表，那么它是;
        </LI>
        <LI>
          如果A不是空的而B则不是;
        </LI>
        <LI>
          如果A的第一个元素等于B的第一个元素，而A的其余部分是B的其余部分的前导子列表，则它是。
        </LI>
      </UL>
    </LI>
  </UL>
  
    事实上，我们可以稍微简化一下：我们不需要对两个地方的空列表进行所有检查。但我没有在下面这样做，因为它很容易出错（这个答案的先前版本
    
      没有
    
     弄错了！）。
  
  
    因此，我们要做的是将该描述转换为Lisp。
  
  
    的
      笔记。
    </强>
  
  <UL>
    <LI>
      这依赖于本地辅助功能，
       <code>
 leading-sublist-p
 </code>
      ，告诉你它是否是上面的主要子列表。
    </LI>
    <LI>
      这不是完全可靠的CL，因为它假设尾部调用将被优化：如果它们不是，它将用于长列表的堆栈。然而，它比我认为的等效显式迭代版本更漂亮。
    </LI>
    <LI>
      这根本不会尝试处理可能的循环，因此在存在循环列表时会出现终止问题（如果任一列表是循环的，它将不会终止）。
    </LI>
    <LI>
      您可以使用a指定元素比较函数
       <code>
 test
 </code>
       通常的CL方式的关键字参数，默认为
       <code>
 eql
 </code>
      。
    </LI>
    <LI>
      实际上主循环也是局部函数，
       <code>
 any-sublist-p
 </code>
      ，它的存在完全是为了避免必须通过迭代传递关键字参数（我最初根本没有传递它，然后，我终于决定，我不想考虑关键字参数解析的任何可能的开销在循环）。
    </LI>
  </UL>
  
    这里是：
  
   <pre>
 <code>
 (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)))

</code>
 </pre>
  <HR />
  
    对于附加值，这里是一个通过比较连续尾部和原始参数来检测一些但不是全部圆形的版本。这很便宜（另外两个
     <code>
 eq
 </code>
     每个循环测试），但没有找到所有圆形：要做到这一点，你需要一个完全成熟的发生检查，这是昂贵的。
  
   <pre>
 <code>
 (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)))

</code>
 </pre>
  
    这个版本检测到一个非常循环的参数：
  
   <pre>
 <code>
 > (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.

</code>
 </pre>
  <HR />
  
    对于黑客价值，这里是一个明确的迭代版本：我发现这更难理解。
  
   <pre>
 <code>
 (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)))))))))

</code>
 </pre>
</DIV>