Question

我需要比较两个列表，当我按顺序排列嵌套列表时，equipp做得很好，但是我需要一个自定义函数，当我混合了嵌套列表的顺序时返回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元素列表组成。如果是这样，您可以简单地将树木压扁成木桩，然后检查是否相等。（但是，如果最低级别的列表可以包含任意数量的原子，那么您将需要通过首先遍历输入树来提取这些列表。）

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（水平temp1））->（BCAT S零位DIR FS MODAL STAR BCAT S FEATS零位DIR BS FEATS NIL BCAT NP）

然后，以下函数收集对：

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

给予：

（setq pair1（pair 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)))

在检查亚历山大：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：我还没有真正测试过上面的代码，因此您可能需要进行一些调整。它仅作为原型提供。）

常见Lisp中的自定义比较功能

2 个答案: