4

我正在寻找类似的东西#'delete-duplicates，但我知道列表中的所有元素都已经排序，或者反向排序，或者至少排列使得重复项已经彼此相邻。我希望利用这些知识来确保执行速度与列表中元素数量的平方不成比例。#'maplist用它来发展我自己的解决方案是微不足道的，但是语言中已经有一些东西了吗？重新发明轮子会很尴尬。

需要明确的是，对于较大长度的列表，我希望删除的运行时间与列表的长度成正比，而不是与该长度的平方成正比。这是我希望避免的行为：

 1 (defun one-shot (cardinality)
 2   (labels ((generate-list (the-count)
 3              (let* ((the-list (make-list the-count)))
 4                (do ((iterator 0 (1+ iterator)))
 5                  ((>= iterator the-count))
 6                  (setf (nth iterator the-list) iterator))
 7                the-list)))
 8     (let* ((given-list (generate-list cardinality))
 9            (stripped-list)
10            (start-time)
11            (end-time))
12       (setf start-time (get-universal-time))
13       (setf stripped-list (delete-duplicates given-list :test #'eql))
14       (setf end-time (get-universal-time))
15       (princ "for n = ")
16       (princ cardinality)
17       (princ ", #'delete-duplicates took ")
18       (princ (- end-time start-time))
19       (princ " seconds")
20       (terpri))))
21 (one-shot 20000)
22 (one-shot 40000)
23 (one-shot 80000)
for n = 20000, #'delete-duplicates took 6 seconds
for n = 40000, #'delete-duplicates took 24 seconds
for n = 80000, #'delete-duplicates took 95 seconds
4

5 回答 5

4

语言中没有这样的东西，但是这样的东西只会让一个通过列表：

(defun delete-adjacent-duplicates (list &key key (test 'eql))
  (loop
     for head = list then (cdr head)
     until (endp head)
     finally (return list)
     do (setf (cdr head)
              (member (if (null key) (car head)
                          (funcall key (car head)))
                      (cdr head)
                      :key key :test-not test))))

正如@wvxvw 指出的那样，可以使用(loop for head on list finally (return list) do ...). 但是，3.6 遍历规则和副作用说，cdr在对象遍历期间修改列表链会导致未定义的行为。但是，尚不清楚loop for head on list技术上是否是对象遍历操作。关于循环的文档在6.1.2.1.3 The for-as-on-list subclause中说

在 for-as-on-list 子句中，for 或 as 构造遍历列表。... 变量 var 绑定到 form1 中列表的连续尾部。在每次迭代结束时，将函数 step-fun 应用于列表；step-fun 的默认值为 cdr。... 当到达列表末尾时，for 或 as 结构会导致终止。

这表示 step 函数总是在迭代结束时应用，所以听起来loop for head on list应该没问题。无论如何，使用do循环可以避免任何可能的问题：

(defun delete-adjacent-duplicates (list &key key (test 'eql))
  (do ((head list (cdr head)))
      ((endp head) list)
    (setf (cdr head)
          (member (if (null key) (car head)
                      (funcall key (car head)))
                  (cdr head)
                  :key key :test-not test))))

这个想法是从head列表开始，然后将其设置cdr为以不同元素开头的第一个尾部，然后推进头部，并继续直到没有任何东西。member假设以合理的方式实现，这应该与列表的长度呈线性关系。使用member意味着您无需做任何额外的工作即可以适当的方式获得:key和:test工作。（请注意:testfordel-dups将是:test-notof member。） 注意：这实际上有一个小问题，因为该key函数将为最终列表中的每个元素调用两次：一次是尾部的第一个元素，一次是当它是car的head。

CL-USER> (delete-adjacent-duplicates (list 1 1 1 1 2 2 3 3 3))
(1 2 3)
CL-USER> (delete-adjacent-duplicates (list 1 2 2))
(1 2)
CL-USER> (delete-adjacent-duplicates (list 1 3 5 6 4 2 3 5) :key 'evenp)
(1 6 3)

我希望任何线性时间解决方案都将采用类似的方法；持有对当前头部的引用，找到以不同元素开头的下一个尾部，然后使该尾部成为cdr头部。

于 2013-11-04T19:28:14.210 回答
4

我希望 REMOVE-DUPLICATES 具有线性时间实现。（确实*在我的本地 SBCL 安装中。）

请注意，指定 REMOVE-DUPLICATES 和 DELETE-DUPLICATES 具有相同的返回值，并且不保证 DELETE-DUPLICATES 的副作用。

* 线性时间码路径仅在 :test 为 #'eq、#'eql、#'equal 或 #'equalp（它依赖于哈希表）且没有 :key 或 :test-not 参数时采用提供。

于 2013-11-05T06:39:33.737 回答
2

作为记录：您的测试代码基本上就是这样的：

(defun one-shot (n &aux (list (loop for i below n collect i)))
  (time (delete-duplicates list))
  (values))

在删除重复缓慢的情况下，与实现维护人员交谈也可能很有用。

例如(one-shot 1000000)，在我的 Mac 上的 CCL 中运行一秒钟。在 LispWorks 中，它在 0.155 秒内运行。

于 2013-11-04T20:03:38.533 回答
2

语言标准中没有类似的东西。但是，您可以使用以下任一方式执行此操作loop：

(defun remove-adjacent-duplicates (list &key (test #'eql))
  (loop for obj in list 
        and prev = nil then obj 
        for take = t then (not (funcall test obj prev))
        when take collect obj))

或与reduce（练习留给读者）。

有关破坏性实现，请参见另一个答案。

PS。除非你在时间上做一些棘手的事情，否则你最好使用time.

于 2013-11-04T19:21:53.677 回答
2

有点不同的方法：

(defun compress-duplicates (list &key (test #'eql))
  (labels ((%compress-duplicates (head tail)
             (if (null tail)
               (setf (cdr head) tail)
               (progn (unless (funcall test (car head) (car tail))
                        (setf (cdr head) tail head (cdr head)))
                      (%compress-duplicates head (cdr tail))))))
    (%compress-duplicates list (cdr list)) 
    list))
                  
(compress-duplicates (list 1 1 1 2 2 3 4 4 1 1 1))
;; (1 2 3 4 1)

SBCLdelete-duplicates实现测试：

(defun test-delete-duplicates ()
  (labels ((%test (list)
             (gc)
             (time (delete-duplicates list))))
    (loop
       :repeat 6
       :for list := (loop :for i :from 0 :below 1000
                       :collect (random 100))
       :then (append list list) :do (%test (copy-list list)))))

;; (test-delete-duplicates)

;; Evaluation took:
;;   0.002 seconds of real time
;;   0.002000 seconds of total run time (0.002000 user, 0.000000 system)
;;   100.00% CPU
;;   3,103,936 processor cycles
;;   0 bytes consed
  
;; Evaluation took:
;;   0.003 seconds of real time
;;   0.003000 seconds of total run time (0.003000 user, 0.000000 system)
;;   100.00% CPU
;;   6,347,431 processor cycles
;;   0 bytes consed
  
;; Evaluation took:
;;   0.006 seconds of real time
;;   0.006000 seconds of total run time (0.005000 user, 0.001000 system)
;;   100.00% CPU
;;   12,909,947 processor cycles
;;   0 bytes consed
  
;; Evaluation took:
;;   0.012 seconds of real time
;;   0.012000 seconds of total run time (0.012000 user, 0.000000 system)
;;   100.00% CPU
;;   25,253,024 processor cycles
;;   0 bytes consed
  
;; Evaluation took:
;;   0.023 seconds of real time
;;   0.022000 seconds of total run time (0.022000 user, 0.000000 system)
;;   95.65% CPU
;;   50,716,442 processor cycles
;;   0 bytes consed
  
;; Evaluation took:
;;   0.049 seconds of real time
;;   0.050000 seconds of total run time (0.050000 user, 0.000000 system)
;;   102.04% CPU
;;   106,747,876 processor cycles
;;   0 bytes consed

显示线速度。

ECLdelete-duplicates实现测试：

;; (test-delete-duplicates)
;; real time : 0.003 secs
;; run time  : 0.003 secs
;; gc count  : 1 times
;; consed    : 95796160 bytes
;; real time : 0.007 secs
;; run time  : 0.006 secs
;; gc count  : 1 times
;; consed    : 95874304 bytes
;; real time : 0.014 secs
;; run time  : 0.014 secs
;; gc count  : 1 times
;; consed    : 95989920 bytes
;; real time : 0.028 secs
;; run time  : 0.027 secs
;; gc count  : 1 times
;; consed    : 96207136 bytes
;; real time : 0.058 secs
;; run time  : 0.058 secs
;; gc count  : 1 times
;; consed    : 96617536 bytes
;; real time : 0.120 secs
;; run time  : 0.120 secs
;; gc count  : 1 times
;; consed    : 97412352 bytes

线性时间也增加。

于 2013-11-04T23:27:16.293 回答