Permalink
Browse files

最適化中

  • Loading branch information...
1 parent 683465c commit 6d4c673891214b404f00856bb2358f034e7d39da @sile committed Oct 2, 2010
Showing with 52 additions and 55 deletions.
  1. +52 −55 mqsort.lisp
View
@@ -1,58 +1,58 @@
(in-package :mqsort)
-(declaim (inline sort sv-sort swap select-pivot))
+(declaim (inline sort sv-sort partition set-pivot-at-front swap-range swap-if-greater))
(defmacro muffle (exp)
`(locally
(declare #+SBCL (sb-ext:muffle-conditions sb-ext:compiler-note))
,exp))
-(defun swap (vec &key start1 start2 count)
+(defmacro sref (vector index)
+ `(the most-efficient-string (svref ,vector ,index)))
+
+(defun swap-range (ary &key start1 start2 count)
(loop REPEAT count
FOR i OF-TYPE array-index FROM start1
FOR j OF-TYPE array-index FROM start2
DO
- (rotatef (aref vec i) (aref vec j))))
+ (rotatef (sref ary i) (sref ary j))))
-(defun select-pivot (vec beg end depth)
- (declare (ignorable vec beg end depth))
- ;;(let ((p (the array-index (+ beg (random (the (mod 100)#|XXX|# (- end beg)))))))
- ;;(rotatef (aref vec p) (aref vec beg))
- ;;beg))
- ;;beg)
+(defun swap-if-greater (ary x y depth)
+ (when (string> (sref ary x) (sref ary y) :start1 depth :start2 depth)
+ (rotatef (sref ary x) (sref ary y)))
+ ary)
- (flet ((code (i &aux (s (aref vec i)))
- (declare (most-efficient-string s))
+(defun set-pivot-at-front (ary beg end depth)
+ (flet ((code (i &aux (s (sref ary i)))
(if (>= depth (length s))
-1
- (char-code (char s depth)))))
- (declare (inline code))
- (let ((p (let ((mid (+ beg (floor (- end beg) 2))))
- (let ((1c (code beg))
- (2c (code mid))
- (3c (code (1- end))))
- (if (< 1c 2c)
- (if (< 1c 3c)
- (if (< 2c 3c) mid (1- end))
- beg)
- (if (< 2c 3c)
- mid
- (if (< 1c 3c) beg (1- end))))))))
- (rotatef (aref vec p) (aref vec beg))
- beg)))
-
-(defun partition (vec beg end depth)
- (declare #.*fastest*
- (simple-vector vec)
- (array-index beg end depth))
- (flet ((code (i &aux (s (aref vec i)))
- (declare (most-efficient-string s))
+ (char-code (char s depth))))
+ (set-pivot (pos)
+ (rotatef (sref ary beg) (sref ary pos))))
+ (declare (inline code set-pivot))
+ (let* ((mid (+ beg (floor (- end beg) 2)))
+ (las (1- end))
+ (a (code beg))
+ (b (code mid))
+ (c (code las)))
+ (if (< a b)
+ (when (< a c)
+ (if (< b c)
+ (set-pivot mid)
+ (set-pivot las)))
+ (if (< b c)
+ (set-pivot mid)
+ (unless (< a c)
+ (set-pivot las)))))))
+
+(defun partition (ary beg end depth)
+ (flet ((code (i &aux (s (sref ary i)))
(if (>= depth (length s))
-1
(char-code (char s depth)))))
(declare (inline code))
- (let* ((pivot (select-pivot vec beg end depth))
- (pivot-code (code pivot))
+ (set-pivot-at-front ary beg end depth)
+ (let* ((pivot (code beg))
(ls-front (1+ beg))
(ls-last (1+ beg))
(gt-front (1- end))
@@ -61,25 +61,25 @@
(loop
(loop WHILE (<= ls-last gt-front)
FOR code = (code ls-last)
- WHILE (<= code pivot-code)
+ WHILE (<= code pivot)
DO
- (when (= code pivot-code)
- (rotatef (aref vec ls-front) (aref vec ls-last))
+ (when (= code pivot)
+ (rotatef (sref ary ls-front) (sref ary ls-last))
(incf ls-front))
(incf ls-last))
(loop WHILE (<= ls-last gt-front)
FOR code = (code gt-front)
- WHILE (>= code pivot-code)
+ WHILE (>= code pivot)
DO
- (when (= code pivot-code)
- (rotatef (aref vec gt-front) (aref vec gt-last))
+ (when (= code pivot)
+ (rotatef (sref ary gt-front) (sref ary gt-last))
(decf gt-last))
(decf gt-front))
(when (> ls-last gt-front)
(return))
- (rotatef (aref vec ls-last) (aref vec gt-front))
+ (rotatef (sref ary ls-last) (sref ary gt-front))
(incf ls-last)
(decf gt-front))
@@ -88,28 +88,27 @@
(gt-beg ls-last)
(gt-end (1+ gt-last)))
(let ((len (min (- ls-beg beg) (- ls-end ls-beg))))
- (swap vec :start1 beg :start2 (- ls-end len) :count len))
+ (swap-range ary :start1 beg :start2 (- ls-end len) :count len))
(let ((len (min (- end gt-end) (- gt-end gt-beg))))
- (swap vec :start1 (- end len) :start2 gt-beg :count len))
+ (swap-range ary :start1 gt-beg :start2 (- end len) :count len))
- (values (the array-index (+ beg (- ls-end ls-beg)))
- (the array-index (- end (- gt-end gt-beg))))))))
+ (values (+ beg (- ls-end ls-beg))
+ (- end (- gt-end gt-beg)))))))
-(defun sv-sort-impl (vec beg end depth)
+(defun sv-sort-impl (vec beg end depth &aux (len (- end beg)))
(declare #.*fastest*
- (simple-vector vec)
(array-index beg end depth))
- (if (<= (- end beg) 1)
- vec
+ (if (<= len 2)
+ (if (<= len 1)
+ vec
+ (swap-if-greater vec beg (1+ beg) depth))
(multiple-value-bind (eql-beg eql-end) (partition vec beg end depth)
(sv-sort-impl vec beg eql-beg depth)
- (when (< depth (length (the most-efficient-string (aref vec eql-beg))))
+ (when (< depth (length (sref vec eql-beg)))
(sv-sort-impl vec eql-beg eql-end (1+ depth)))
(sv-sort-impl vec eql-end end depth))))
(defun sv-sort(vec)
- (declare #.*fastest*
- (simple-vector vec))
(sv-sort-impl vec 0 (length vec) 0))
(defun sort (vector)
@@ -120,5 +119,3 @@
(vector (muffle (sv-sort (coerce vector 'simple-vector))))))
-
-

0 comments on commit 6d4c673

Please sign in to comment.