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 的源代码，我想这不是一个好主意，然后我可以修改它以支持我的需要。现在我不知道从哪里开始。感谢任何帮助:)

Answer 1

我认为通过递归比较所有元素来天真地执行此操作可能太慢了，因为它在每个级别上都是二次的。

相反，我建议先将这些树转化为规范形式，然后使用equalp。规范形式意味着所有树的顺序都是一致的。

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无）（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 之前。

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

基本思想是遍历两个输入列表以提取最低级别的项目，但将每个提取的项目与其在树中的级别相关联。以下函数旨在创建一个项目列表，其中 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))

（ps：我没有真正测试过上面的代码，所以你可能需要做一些调整。它只是作为原型提供。）