AutoLISP：删除列表中的连续重复项

Question

我一直在寻找一种有效的方法来删除点列表中的连续重复项。

我最初的想法是循环遍历列表中的元素，与第 (n-1) 个元素进行比较，如果相等则将其删除。但是，删除列表中的元素并非易事，使用另一个函数会使其效率低下。

我知道 Lee Mac 的 RemoveOnce 函数，但我不知道如何修改它以在列表的连续元素之间进行比较。

例如，目标如下：

List = (p1 p2 p3 p3 p3 p2 p2 p4)

List_without_consecutive_duplicates = (p1 p2 p3 p2 p4)

谢谢！

Answer 1

这是我认为合法的 AutoLISP 的一种方式：

(defun remove-successive-duplicates (l / results current)
  (cond
   ((null l)
    l)
   (t
    (setq current (car l)
          results (list current))
    (foreach e (cdr l)
      (cond
       ((not (eq e current))
        (setq current e
              results (cons e results)))))
    (reverse results))))

如果列表上有看起来不存在的破坏性功能，或者如果有看起来也不存在的列表过滤功能，您可以做得更好。

这是另一种更漂亮但会导致长列表的堆栈溢出的方法：

(defun remove-successive-duplicates (l)
  (cond
   ((or (null l) (null (cdr l)))
    l)
   (t
    (cons (car l) (remove-current-duplicates-loop (cdr l) (car l))))))

(defun remove-successive-duplicates-loop (l current)
  (cond
   ((null (cdr l))
    (cond
     ((eq (car l) current)
      '())
     (t
      l)))
   ((eq (car l) current)
    (remove-successive-duplicates-loop (cdr l) current))
   (t
    (cons (car l) (remove-successive-duplicates-loop (cdr l) (car l))))))

Answer 2

这是一个迭代方法：

(defun remcondupes ( l / r )
    (while l
        (if (not (equal (car l) (cadr l) 1e-8))
            (setq r (cons (car l) r))
        )
        (setq l (cdr l))
    )
    (reverse r)
)

这是一个递归方法：

(defun remcondupes ( l )
    (if l
        (if (equal (car l) (cadr l) 1e-8)
            (remcondupes (cdr l))
            (cons (car l) (remcondupes (cdr l)))
        )
    )
)

在上述两种情况下，使用equal 函数将列表中的第一个元素与第二个元素进行比较，公差为1e-8（因为我们正在比较点），如果此测试将丢弃第一个元素已验证。

测试：

_$ (setq p1 '(1.2 2.3) p2 '(3.4 4.5) p3 '(5.6 6.7) p4 '(7.8 8.9))
(7.8 8.9)
_$ (setq lst (list p1 p2 p3 p3 p3 p2 p2 p4))
((1.2 2.3) (3.4 4.5) (5.6 6.7) (5.6 6.7) (5.6 6.7) (3.4 4.5) (3.4 4.5) (7.8 8.9))
_$ (remcondupes lst)
((1.2 2.3) (3.4 4.5) (5.6 6.7) (3.4 4.5) (7.8 8.9))

编辑：

或者，为了在比较容差范围内（根据下面 Will 的 cmets）考虑连续点，您可以考虑以下变化：

(defun remcondupes ( l / r )
    (while l
        (if (equal (car l) (cadr l) 1e-8)
            (setq l (cons (car l) (cddr l)))
            (setq r (cons (car l) r)
                  l (cdr l)
            )
        )
    )
    (reverse r)
)

(defun remcondupes ( l )
    (if l
        (if (equal (car l) (cadr l) 1e-8)
            (remcondupes (cons (car l) (cddr l)))
            (cons (car l) (remcondupes (cdr  l)))
        )
    )
)