Changeset 11545


Ignore:
Timestamp:
Dec 18, 2008, 3:29:04 PM (11 years ago)
Author:
gz
Message:

Make delete-duplicates use a hash table if the total number of elements is larger than *delete-duplicates-hash-threshold* (default 200)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/sequences.lisp

    r10942 r11545  
    12191219;;; Delete-Duplicates:
    12201220
     1221(defparameter *delete-duplicates-hash-threshold*  200)
     1222
    12211223(defun list-delete-duplicates* (list test test-not key from-end start end)
    12221224  ;;(%print "test:" test "test-not:" test-not "key:" key)
    1223   (let ((handle (cons nil list)))
    1224     (do ((current  (nthcdr start list) (cdr current))
    1225          (previous (nthcdr start handle))
    1226          (index start (1+ index)))
    1227         ((or (= index end) (null current))
    1228          (cdr handle))
    1229       ;;(%print "outer loop top current:" current "previous:" previous)
    1230       (if (do ((x (if from-end
    1231                     (nthcdr (1+ start) handle)
    1232                     (cdr current))
    1233                   (cdr x))
    1234                (i (1+ index) (1+ i)))
    1235               ((or (null x)
    1236                    (and (not from-end) (= i end))
    1237                    (eq x current))
    1238                nil)
    1239             ;;(%print "inner loop top x:" x "i:" i)
    1240             (if (list-delete-duplicates*-aux current x test test-not key)
    1241               (return t)))
    1242         (rplacd previous (cdr current))
    1243         (setq previous (cdr previous))))))
     1225  (let* ((len (- end start))
     1226         (handle (cons nil list))
     1227         (previous (nthcdr start handle)))
     1228    (declare (dynamic-extent handle))
     1229    (if (and (> len *delete-duplicates-hash-threshold*)
     1230             (or (eq test 'eq) (eq test 'eql) (eq test 'equal) (eq test 'equalp)
     1231                 (eq test #'eq) (eq test #'eql) (eq test #'equal) (eq test #'equalp)))
     1232      (let ((hash (make-hash-table :size len :test test :shared nil)))
     1233        (loop for i from start below end as obj in (cdr previous)
     1234          do (incf (gethash (funcall key obj) hash 0)))
     1235        (loop for i from start below end while (cdr previous)
     1236          do (let* ((current (cdr previous))
     1237                    (obj (car current))
     1238                    (obj-key (funcall key obj)))
     1239               (if (if from-end
     1240                     ;; Keep first ref
     1241                     (prog1 (gethash obj-key hash) (setf (gethash obj-key hash) nil))
     1242                     ;; Keep last ref
     1243                     (eql (decf (gethash obj-key hash)) 0))
     1244                 (setq previous current)
     1245                 (rplacd previous (cdr current))))))
     1246      (do ((current (cdr previous) (cdr current))
     1247           (index start (1+ index)))
     1248          ((or (= index end) (null current)))
     1249        ;;(%print "outer loop top current:" current "previous:" previous)
     1250        (if (do ((x (if from-end
     1251                      (nthcdr (1+ start) handle)
     1252                      (cdr current))
     1253                    (cdr x))
     1254                 (i (1+ index) (1+ i)))
     1255                ((or (null x)
     1256                     (and (not from-end) (= i end))
     1257                     (eq x current))
     1258                 nil)
     1259              ;;(%print "inner loop top x:" x "i:" i)
     1260              (if (list-delete-duplicates*-aux current x test test-not key)
     1261                (return t)))
     1262          (rplacd previous (cdr current))
     1263          (setq previous (cdr previous)))))
     1264    (cdr handle)))
    12441265
    12451266(defun list-delete-duplicates*-aux (current x test test-not key)
     
    12561277                                         &optional (length (length vector)))
    12571278  (declare (vector vector))
    1258   (do ((index start (1+ index))
    1259        (jndex start))
    1260       ((= index end)
    1261        (do ((index index (1+ index))            ; copy the rest of the vector
    1262             (jndex jndex (1+ jndex)))
    1263            ((= index length)
    1264             (setq vector (shrink-vector vector jndex)))
    1265             (aset vector jndex (aref vector index))))
    1266       (aset vector jndex (aref vector index))
    1267       (unless (position (funcall key (aref vector index)) vector :key key
    1268                              :start (if from-end start (1+ index)) :test test
    1269                                            :end (if from-end jndex end) :test-not test-not)
    1270               (setq jndex (1+ jndex)))))
     1279  (let* ((len (- end start))
     1280         (index start)
     1281         (jndex start))
     1282    (if (and (not test-not)
     1283             (> len *delete-duplicates-hash-threshold*)
     1284             (or (eq test 'eq) (eq test 'eql) (eq test 'equal) (eq test 'equalp)
     1285                 (eq test #'eq) (eq test #'eql) (eq test #'equal) (eq test #'equalp)))
     1286        (let ((hash (make-hash-table :size len :test test :shared nil)))
     1287          (loop for i from start below end as obj = (aref vector i)
     1288             do (incf (gethash (funcall key obj) hash 0)))
     1289          (loop while (< index end) as obj = (aref vector index) as obj-key = (funcall key obj)
     1290             do (incf index)
     1291             do (when (if from-end
     1292                          (prog1 (gethash obj-key hash) (setf (gethash obj-key hash) nil))
     1293                          (eql (decf (gethash obj-key hash)) 0))
     1294                  (aset vector jndex obj)
     1295                  (incf jndex))))
     1296        (loop while (< index end) as obj = (aref vector index)
     1297           do (incf index)
     1298           do (unless (position (funcall key obj) vector :key key
     1299                                :start (if from-end start index) :test test
     1300                                :end (if from-end jndex end) :test-not test-not)
     1301                (aset vector jndex obj)
     1302                (incf jndex))))
     1303    (do ((index index (1+ index))       ; copy the rest of the vector
     1304         (jndex jndex (1+ jndex)))
     1305        ((= index length)
     1306         (setq vector (shrink-vector vector jndex)))
     1307      (aset vector jndex (aref vector index)))))
     1308
    12711309
    12721310(defun delete-duplicates (sequence &key (test #'eql) test-not (start 0) from-end end key)
Note: See TracChangeset for help on using the changeset viewer.