Common Lisp中的定制比较函数

Question

我需要比较两个列表，当嵌套的列表有序时，equalp函数表现得很好，但是当我需要一个自定义函数来判断嵌套列表的顺序混乱时，它返回T。类似于下面这样的东西;

    (setq temp1 '(((BCAT S) (FEATS NIL)) (DIR FS) (MODAL STAR)
      (((BCAT S) (FEATS NIL)) (MODAL STAR) (DIR BS)  ((FEATS NIL) (BCAT NP)))))

    (setq temp2 '((DIR FS) ((BCAT S) (FEATS NIL)) (MODAL STAR)
      (((BCAT S) (FEATS NIL)) (DIR BS) (MODAL STAR) ((BCAT NP) (FEATS NIL)))))

    (equalp-customized temp1 temp2) ; gotta make this return T

我曾尝试找到 equalp 的源代码，但我猜这不是一个好主意。如果我找到了，可能会修改它以满足我的需求。现在我不知道从哪里开始。感激任何帮助 :)

- Karavana

Answer 1

我认为简单地通过递归比较所有元素来完成此操作可能过于缓慢，因为每个级别都是二次的。

相反，我建议首先将这些树带入规范形式，然后使用equalp。 规范形式意味着在所有树中使顺序保持一致。

- Svante

---

因此，如果递归地对树进行排序，则只要它们都包含相同的元素，这些树就会有效地“相等”。不错。 - Sylwester

Answer 2

看起来你的输入树只由最低级别的原子2元列表组成。如果是这样，你可以将树简单地压扁成plist，然后检查是否有相等的集合。(但是，如果最低级别的列表可以包含任意数量的原子，则需要先遍历输入树以提取那些列表。)

Alexandria库中包含函数“flatten”，但它会删除输入中的“nil”条目。这里是一个替代函数，执行相同的操作，但保留NIL。结果是输入2元列表的plist。

(defun level-out (tree)
  "Flattens a tree respecting NILs."
  (loop for item in tree
        when (consp item)
          if (atom (car item))
            append item
          else append (level-out item)))

现在，举个例子：

(setq flat1 (level-out temp1)) -> (BCAT S FEATS NIL DIR FS MODAL STAR BCAT S FEATS NIL MODAL STAR DIR BS FEATS NIL BCAT NP)

接下来的函数会收集这些配对：

(defun pair-up (plist)
  (loop for (1st 2nd) on plist by #'cddr
      collect (list 1st 2nd)))

提供:

(setq pairs1 (pair-up flat1)) -> ((BCAT S) (FEATS NIL) (DIR FS) (MODAL STAR) (BCAT S) (FEATS NIL) (MODAL STAR) (DIR BS) (FEATS NIL) (BCAT NP))

现在这些配对已经以可使用Alexandria测试集合相等的形式呈现:

(defun nested-pairs-equal-p (tree1 tree2)
  (alexandria:set-equal (pair-up (level-out tree1))
                        (pair-up (level-out tree2))
                        :test #’equal))

(nested-pairs-equal-p temp1 temp2) -> T

提取嵌套列表

实际上，直接使用以下方法提取嵌套列表可能更加简单：

(defun level-out-nested-lists (tree)
  (loop for item in tree
      if (and (consp item) (atom (car item)))
      collect item
      else append (level-out-nested-lists item)))

在检查alexandria:set-equal之前。

提取按级别索引的嵌套列表

基本思想是遍历两个输入列表，提取最低级别的项，并将每个提取的项与其树中的级别关联。以下函数旨在创建一个项目的alist，其中car是级别，cdr是出现在该级别的项目列表：

(defun associate-tree-items-by-level (tree)
  "Returns an alist of items in tree indexed by level."
  (let (alist)
    (labels ((associate-tree-items-by-level-1 (tree level)
               (loop for item in tree
                 when (consp item)
                  if (atom (car item))
                   do (let ((pair (assoc level alist)))
                        (if pair
                          (rplacd pair (push item (cdr pair)))
                          (push (cons level (list item)) alist)))
                   else do (associate-tree-items-by-level-1 item (1+ level)))))
      (associate-tree-items-by-level-1 tree 1)
      (sort alist #'< :key #'first))))

那么，接下来：

(associate-tree-items-by-level
  '(((BCAT S) (FEATS NIL)) (DIR BS) (MODAL STAR) (((BCAT S) (FEATS NIL)) (MODAL STAR) (DIR FS) ((FEATS NIL) (BCAT NP)))))
->  ((1 (MODAL STAR) (DIR BS))
 (2 (DIR FS) (MODAL STAR) (FEATS NIL) (BCAT S))
 (3 (BCAT NP) (FEATS NIL) (FEATS NIL) (BCAT S)))

所有物品现在都被分组成袋子（不是集合，因为可能会有重复），并按等级进行索引。下一个函数应该测试物品是否相等的袋子。

(defun bag-equal-p (bag-list1 bag-list2)
  (and (= (length bag-list1) (length bag-list2))
       (loop with remainder = (copy-list bag-list2)
         for item1 in bag-list1
         do (alexandria:deletef remainder item1 :test #'equal :count 1)
         finally (return (not remainder)))))

为了检查输入的相等性，您可以执行以下操作：

(every #'bag-equal-p 
  (associate-tree-items-by-level input1)
  (associate-tree-items-by-level input2))

（提示：我并没有真正测试上面的代码，因此您可能需要进行一些调整。它仅作为原型提供。）

- davypough

---

谢谢您的想法，但这个例子怎么样？(((BCAT S) (FEATS NIL)) (DIR *BS*) (MODAL STAR) (((BCAT S) (FEATS NIL)) (MODAL STAR) (DIR *FS*) ((FEATS NIL) (BCAT NP)))))与((DIR _FS_) ((BCAT S) (FEATS NIL)) (MODAL STAR) (((BCAT S) (FEATS NIL)) (DIR _BS_) (MODAL STAR) ((BCAT NP) (FEATS NIL))))这两个(DIR BS)和(DIR FS)在不同的深度级别。这不应该返回true，但如果我们将整个内容平铺，那么它将是一个错误的正面反馈，对吗？ - Karavana

好的，我现在想我明白了你要找什么。你希望树中不同级别上的相同项目在比较时被视为不同的项目？请参见上面的编辑以获取此替代方案。 - davypough