Changeset 13852


Ignore:
Timestamp:
02/04/12 19:08:03 (9 years ago)
Author:
Mark Evenson
Message:

CL:SORT implementation replace non-optimal quicksort with public version.

With these changes, SORT seems to be a little faster (for vectors)
although I was not worried with optimizations. In ABCL 1.0.1, in my
machine, sorting 1000000 random integers takes around 10s on average
while now it takes 2s. However, I must point out I didn't do any
serious and proper benchmarking, just some runs.

I will be happy to answer any questions if necessary.

Cheers,
Jorge Tavares

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/sort.lisp

    r13838 r13852  
    3737  (sequence::seq-dispatch sequence
    3838    (sort-list sequence predicate key)
    39     (quick-sort sequence 0 (length sequence) predicate key)
     39    (quicksort sequence 0 (1- (length sequence)) predicate (or key #'identity))
    4040    (apply #'sequence:sort sequence predicate args)))
    4141
     
    183183            (return list-1))))))
    184184
     185#|
     186<> dc:author "Jorge Tavares" ;
     187    dc:description
     188"""
     189The quicksort function picks the pivot by selecting a midpoint and
     190also sorts the smaller partition first. These are enough to avoid the
     191stack overflow problem as reported. I've performed some tests and it
     192looks it is correct
     193"""" .
     194|#
     195;;;
     196;;; QUICKSORT
     197;;; - the pivot is a middle point
     198;;; - sorts the smaller partition first
     199;;;
     200(defun quicksort (vector start end predicate key)
     201  (declare (type fixnum start end)
     202     (type function predicate key))
     203  (if (< start end)
     204      (let* ((i start)
     205       (j (1+ end))
     206       (p (+ start (ash (- end start) -1)))
     207       (d (aref vector p))
     208       (kd (funcall key d)))
     209  (rotatef (aref vector p) (aref vector start))
     210  (block outer-loop
     211    (loop
     212      (loop
     213        (unless (> (decf j) i) (return-from outer-loop))
     214        (when (funcall predicate
     215           (funcall key (aref vector j)) kd)
     216    (return)))
     217      (loop
     218        (unless (< (incf i) j) (return-from outer-loop))
     219        (unless (funcall predicate
     220             (funcall key (aref vector i)) kd)
     221    (return)))
     222      (rotatef (aref vector i) (aref vector j))))
     223  (setf (aref vector start) (aref vector j)
     224        (aref vector j) d)
     225  (if (< (- j start) (- end j))
     226      (progn
     227        (quicksort vector start (1- j) predicate key)
     228        (quicksort vector (1+ j) end predicate key))
     229      (progn
     230        (quicksort vector (1+ j) end predicate key)
     231        (quicksort vector start (1- j) predicate key))))
     232      vector))
     233
     234;;; DEPRECATED -- to be removed in abcl-1.4
    185235;;; From ECL.
    186236(defun quick-sort (seq start end pred key)
Note: See TracChangeset for help on using the changeset viewer.