From ef3fa440db906a78b377d694313b2ef9aedda33a Mon Sep 17 00:00:00 2001 From: "Paul F. Dietz" Date: Tue, 26 Jul 2005 12:51:01 +0000 Subject: [PATCH] A more efficient algorithm for remove-duplicates on lists when there is no :key or :test-not argument and :test is one of the standardly acceptable arguments for make-hash-table. The previous algorithm ran in O(n^2) time; this algorithm runs in O(n) time, n the length of the list. --- BUGS | 4 +++ NEWS | 4 +++ src/code/seq.lisp | 79 ++++++++++++++++++++++++++++++++++++----------------- version.lisp-expr | 2 +- 4 files changed, 63 insertions(+), 26 deletions(-) diff --git a/BUGS b/BUGS index b53bde0..5b549dc 100644 --- a/BUGS +++ b/BUGS @@ -2111,3 +2111,7 @@ WORKAROUND: A simpler example: (compile nil '(lambda (x) (the (not (eql #\a)) x))) + + (partially fixed in 0.9.3.1, but a better representation for these + types is needed.) + diff --git a/NEWS b/NEWS index 536dd66..dee4379 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,8 @@ ;;;; -*- coding: utf-8; -*- +changes in sbcl-0.9.4 relative to sbcl-0.9.3: + * optimizations: REMOVE-DUPLICATES now runs in linear time on + lists in some cases. This partially fixes bug 384. + changes in sbcl-0.9.3 relative to sbcl-0.9.2: * New feature: Experimental support for bivalent streams: streams opened with :element-type :default now allow character and binary diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 92fc34a..a43e2f7 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -1548,40 +1548,69 @@ (declare (fixnum start)) (let* ((result (list ())) ; Put a marker on the beginning to splice with. (splice result) - (current list)) + (current list) + (hash (and test + (not key) + (not test-not) + (or (eql test #'eql) + (eql test #'eq) + (eql test #'equal) + (eql test #'equalp)) + ; (> (if end (- end start) (- (length list) start)) 20) + (make-hash-table :test test)))) (do ((index 0 (1+ index))) ((= index start)) (declare (fixnum index)) + ;; (if hash (setf (gethash (car current) hash) splice)) (setq splice (cdr (rplacd splice (list (car current))))) (setq current (cdr current))) (do ((index start (1+ index))) ((or (and end (= index (the fixnum end))) (atom current))) (declare (fixnum index)) - (if (or (and from-end - (not (if test-not - (member (apply-key key (car current)) - (nthcdr (1+ start) result) - :test-not test-not - :key key) - (member (apply-key key (car current)) - (nthcdr (1+ start) result) - :test test - :key key)))) - (and (not from-end) - (not (do ((it (apply-key key (car current))) - (l (cdr current) (cdr l)) - (i (1+ index) (1+ i))) - ((or (atom l) (and end (= i (the fixnum end)))) - ()) - (declare (fixnum i)) - (if (if test-not - (not (funcall test-not - it - (apply-key key (car l)))) - (funcall test it (apply-key key (car l)))) - (return t)))))) - (setq splice (cdr (rplacd splice (list (car current)))))) + (cond + (hash + (let ((prev (gethash (car current) hash))) + (cond + ((not prev) + (setf (gethash (car current) hash) splice) + (setq splice (cdr (rplacd splice (list (car current)))))) + (from-end nil) + (t + (let ((old (cdr prev))) + (let ((next (cdr old))) + (when next + (let ((next-val (car next))) + ;; (assert (eq (gethash next-val hash) old)) + (setf (cdr prev) next + (gethash next-val hash) prev + (gethash (car current) hash) splice + splice (cdr (rplacd splice (list (car current))))))))))))) + (t + (if (or (and from-end + (not (if test-not + (member (apply-key key (car current)) + (nthcdr (1+ start) result) + :test-not test-not + :key key) + (member (apply-key key (car current)) + (nthcdr (1+ start) result) + :test test + :key key)))) + (and (not from-end) + (not (do ((it (apply-key key (car current))) + (l (cdr current) (cdr l)) + (i (1+ index) (1+ i))) + ((or (atom l) (and end (= i (the fixnum end)))) + ()) + (declare (fixnum i)) + (if (if test-not + (not (funcall test-not + it + (apply-key key (car l)))) + (funcall test it (apply-key key (car l)))) + (return t)))))) + (setq splice (cdr (rplacd splice (list (car current)))))))) (setq current (cdr current))) (do () ((atom current)) diff --git a/version.lisp-expr b/version.lisp-expr index 189d325..8b044a6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.3" +"0.9.3.1" -- 1.7.10.4