4

のようなものを探してい#'delete-duplicatesますが、リストのすべての要素が既にソートされているか、逆にソートされているか、少なくとも重複が互いに隣接するように配置されていることを知っています。その知識を使用して、実行速度がリスト内の要素数の 2 乗に比例しないようにしたいと考えています。#'maplist自分のソリューションを成長させるために使用するのは簡単ですが、言語にはすでに何かがありますか? 車輪を再発明するのは恥ずかしいことです。

明確にするために、リストの長さが長い場合、削除の実行時間は、その長さの2乗に比例するのではなく、リストの長さに比例するようにしたいと思います。これは私が避けたい動作です:

 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

言語にはこのようなものはありませんが、次のようなものはリストを 1 回だけ通過します。

(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 の for-as-on-list 副次節が記載されています

for-as-on-list サブ節では、for または as 構文がリストを反復処理します。… 変数 var は、form1 のリストの連続する末尾にバインドされます。各反復の終わりに、関数 step-fun がリストに適用されます。step-fun のデフォルト値は cdr です。… for または as コンストラクトは、リストの最後に到達すると終了します。

これは、ステップ関数が反復の最後に常に適用されることを示しているため、問題ないように聞こえ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作業するために余分な作業を行う必要がなくなります。( forがofになることに注意してください。) 注: 実際には、関数が最後のリストの各要素に対して2 回呼び出されるという点で、これにはわずかな問題があります。のとき。:key:test:testdel-dups:test-notmemberkeycarhead

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)

線形時間ソリューションは、同様のアプローチを取ると思います。現在の head への参照を保持し、別の要素で始まる次の tail を見つけて、その tail をcdrhead にします。

于 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

言語標準にはそのようなものはありません。ただし、次のいずれかを使用してそれを行うことができます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 に答える
2

記録のために：あなたのテストコードは基本的にこれだけです：

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

また、delete-duplicates が遅い場合は、実装の管理者に相談することも役立つかもしれません。

たとえば(one-shot 1000000)、私の Mac の CCL では 1 秒で実行されます。LispWorks では 0.155 秒で実行されます。

于 2013-11-04T20:03:38.533 に答える