Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
  • 2 commits
  • 4 files changed
  • 0 commit comments
  • 1 contributor
Showing with 86 additions and 97 deletions.
  1. +14 −17 heapsort.lisp
  2. +2 −4 insertion-sort.lisp
  3. +22 −24 merge-sort.lisp
  4. +48 −52 quicksort.lisp
View
31 heapsort.lisp
@@ -26,7 +26,6 @@
;;; - adapted from the original source in CMUCL
;;;
-
;;; HEAPIFY, assuming both sons of root are heaps, percolates the root element
;;; through the sons to form a heap at root. Root and max are zero based
;;; coordinates, but the heap algorithm only works on arrays indexed from 1
@@ -85,25 +84,23 @@
;;; heapsort
;;;
-(defmacro heapsort-body (type ref predicate mkey sequence mstart mend)
- (with-gensyms (heapsort-call seq pred key start end i i-1)
- `(flet ((,heapsort-call (,seq ,start ,end ,pred ,key)
- (declare (type fixnum ,start ,end)
- (type ,type ,seq))
- (build-heap ,seq ,ref ,end ,pred ,@(if mkey `(,key)))
- (do* ((,i ,end ,i-1)
- (,i-1 (1- ,i) (1- ,i-1)))
- ((zerop ,i) ,seq)
- (declare (type fixnum ,i ,i-1))
- (rotatef (,ref ,seq ,start) (,ref ,seq ,i))
- (heapify ,seq ,ref ,start ,i-1 ,pred ,@(if mkey `(,key))))))
- (,heapsort-call ,sequence ,mstart ,mend ,predicate ,mkey))))
+(defmacro heapsort-body (type ref predicate key sequence end)
+ (with-gensyms (i i-1)
+ `(locally
+ (declare (type fixnum ,end)
+ (type ,type ,sequence))
+ (build-heap ,sequence ,ref ,end ,predicate ,@(if key `(,key)))
+ (do* ((,i ,end ,i-1)
+ (,i-1 (1- ,i) (1- ,i-1)))
+ ((zerop ,i) ,sequence)
+ (declare (type fixnum ,i ,i-1))
+ (rotatef (,ref ,sequence 0) (,ref ,sequence ,i))
+ (heapify ,sequence ,ref 0 ,i-1 ,predicate ,@(if key `(,key)))))))
-
(defun heapsort (sequence predicate &key key)
(let ((end (1- (length sequence))))
(if key
- (sort-dispatch heapsort-body predicate key sequence 0 end)
- (sort-dispatch heapsort-body predicate nil sequence 0 end))
+ (sort-dispatch heapsort-body predicate key sequence end)
+ (sort-dispatch heapsort-body predicate nil sequence end))
sequence))
View
6 insertion-sort.lisp
@@ -28,10 +28,8 @@
(defmacro insertion-sort-body (type ref predicate key sequence start end)
(with-gensyms (i j pivot data)
`(locally
- (declare (optimize (speed 3) (space 0))
- (type function ,predicate ,@(if key `(,key)))
- (type ,type ,sequence)
- ,@(unless key `((ignore ,key))))
+ (declare (type function ,predicate ,@(if key `(,key)))
+ (type ,type ,sequence))
;; the start arg is actually not necessary but it is included
;; to make it easier to use insertion sort in other sorting
;; algorithms such as quicksort
View
46 merge-sort.lisp
@@ -36,8 +36,7 @@
(declare (type fixnum ,start-a ,end-a ,start-b ,end-b ,start-aux)
(type ,type ,a ,b)
(type simple-vector ,aux)
- (type function ,predicate ,@(if key `(,key)))
- (optimize (speed 3) (safety 0)))
+ (type function ,predicate ,@(if key `(,key))))
(block ,merge-block
(let ((,i-a ,start-a)
(,i-b ,start-b)
@@ -99,28 +98,27 @@
(defmacro merge-sort-body (type ref mpredicate mkey msequence mstart mend)
(with-gensyms (merge-sort-call maux aux sequence start end predicate key mid direction)
`(locally
- (declare (optimize (speed 3) (safety 0)))
- (labels ((,merge-sort-call (,sequence ,start ,end ,predicate ,key ,aux ,direction)
- (declare (type function ,predicate ,@(if mkey `(,key)))
- (type fixnum ,start ,end)
- (type ,type ,sequence))
- (let ((,mid (+ ,start (ash (- ,end ,start) -1))))
- (declare (type fixnum ,mid))
- (if (<= (- ,mid 1) ,start)
- (unless ,direction (setf (,ref ,aux ,start) (,ref ,sequence ,start)))
- (,merge-sort-call ,sequence ,start ,mid ,predicate ,key ,aux (not ,direction)))
- (if (>= (+ ,mid 1) ,end)
- (unless ,direction (setf (,ref ,aux ,mid) (,ref ,sequence ,mid)))
- (,merge-sort-call ,sequence ,mid ,end ,predicate ,key ,aux (not ,direction)))
- (unless ,direction (psetq ,sequence ,aux ,aux ,sequence))
- ,(if mkey
- `(merge-sequences-body ,type ,ref ,sequence ,start ,mid ,sequence
- ,mid ,end ,aux ,start ,predicate ,key)
- `(merge-sequences-body ,type ,ref ,sequence ,start ,mid ,sequence
- ,mid ,end ,aux ,start ,predicate)))))
- (let ((,maux (make-array ,mend)))
- (declare (type simple-vector ,maux))
- (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))
+ (labels ((,merge-sort-call (,sequence ,start ,end ,predicate ,key ,aux ,direction)
+ (declare (type function ,predicate ,@(if mkey `(,key)))
+ (type fixnum ,start ,end)
+ (type ,type ,sequence))
+ (let ((,mid (+ ,start (ash (- ,end ,start) -1))))
+ (declare (type fixnum ,mid))
+ (if (<= (- ,mid 1) ,start)
+ (unless ,direction (setf (,ref ,aux ,start) (,ref ,sequence ,start)))
+ (,merge-sort-call ,sequence ,start ,mid ,predicate ,key ,aux (not ,direction)))
+ (if (>= (+ ,mid 1) ,end)
+ (unless ,direction (setf (,ref ,aux ,mid) (,ref ,sequence ,mid)))
+ (,merge-sort-call ,sequence ,mid ,end ,predicate ,key ,aux (not ,direction)))
+ (unless ,direction (psetq ,sequence ,aux ,aux ,sequence))
+ ,(if mkey
+ `(merge-sequences-body ,type ,ref ,sequence ,start ,mid ,sequence
+ ,mid ,end ,aux ,start ,predicate ,key)
+ `(merge-sequences-body ,type ,ref ,sequence ,start ,mid ,sequence
+ ,mid ,end ,aux ,start ,predicate)))))
+ (let ((,maux (make-array ,mend)))
+ (declare (type simple-vector ,maux))
+ (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))
;;;
View
100 quicksort.lisp
@@ -37,56 +37,55 @@
(defmacro quicksort-body (type ref mpredicate mkey msequence mstart mend pick-pivot)
(with-gensyms (quicksort-call partition-loop predicate key sequence start end i j pivot pivot-data pivot-key)
`(locally
- (declare (optimize (speed 3) (space 0)))
- (labels ((,quicksort-call (,sequence ,start ,end ,predicate ,key)
- ;; there is no need to declare ignore of key since it
- ;; is needed on the recursive call of quicksort
- (declare (type function ,predicate ,@(if mkey `(,key)))
- (type fixnum ,start ,end)
- (type ,type ,sequence))
- ;; the while loop avoids the second recursive call
- ;; to quicksort made at the end of the loop body
- (loop while (< ,start ,end)
- do (let* ((,i ,start)
- (,j (1+ ,end))
- ;; picks the pivot according to the given strategy
- (,pivot (,pick-pivot ,start ,end))
- (,pivot-data (,ref ,sequence ,pivot))
- ,@(if mkey
- `((,pivot-key (funcall ,key ,pivot-data)))
- `((,pivot-key ,pivot-data))))
- (declare (type fixnum ,i ,j ,pivot))
- (rotatef (,ref ,sequence ,pivot) (,ref ,sequence ,start))
- ;; two-way partitioning
- (block ,partition-loop
- (loop
+ (labels ((,quicksort-call (,sequence ,start ,end ,predicate ,key)
+ ;; there is no need to declare ignore of key since it
+ ;; is needed on the recursive call of quicksort
+ (declare (type function ,predicate ,@(if mkey `(,key)))
+ (type fixnum ,start ,end)
+ (type ,type ,sequence))
+ ;; the while loop avoids the second recursive call
+ ;; to quicksort made at the end of the loop body
+ (loop while (< ,start ,end)
+ do (let* ((,i ,start)
+ (,j (1+ ,end))
+ ;; picks the pivot according to the given strategy
+ (,pivot (,pick-pivot ,start ,end))
+ (,pivot-data (,ref ,sequence ,pivot))
+ ,@(if mkey
+ `((,pivot-key (funcall ,key ,pivot-data)))
+ `((,pivot-key ,pivot-data))))
+ (declare (type fixnum ,i ,j ,pivot))
+ (rotatef (,ref ,sequence ,pivot) (,ref ,sequence ,start))
+ ;; two-way partitioning
+ (block ,partition-loop
(loop
- (unless (> (decf ,j) ,i) (return-from ,partition-loop))
- (when (funcall ,predicate
- ,(if mkey
- `(funcall ,key (,ref ,sequence ,j))
- `(,ref ,sequence ,j))
- ,pivot-key) (return)))
- (loop
- (unless (< (incf ,i) ,j) (return-from ,partition-loop))
- (unless (funcall ,predicate
+ (loop
+ (unless (> (decf ,j) ,i) (return-from ,partition-loop))
+ (when (funcall ,predicate
,(if mkey
- `(funcall ,key (,ref ,sequence ,i))
- `(,ref ,sequence ,i))
+ `(funcall ,key (,ref ,sequence ,j))
+ `(,ref ,sequence ,j))
,pivot-key) (return)))
- (rotatef (,ref ,sequence ,i) (,ref ,sequence ,j))))
- (setf (,ref ,sequence ,start) (,ref ,sequence ,j)
- (,ref ,sequence ,j) ,pivot-data)
- ;; check each partition size and pick the smallest one
- ;; this way the stack depth worst-case is Theta(lgn)
- (if (< (- ,j ,start) (- ,end ,j))
- (progn
- (,quicksort-call ,sequence ,start (1- ,j) ,predicate ,key)
- (setf ,start (1+ ,j)))
- (progn
- (,quicksort-call ,sequence (1+ ,j) ,end ,predicate ,key)
- (setf ,end (1- ,j))))))))
- (,quicksort-call ,msequence ,mstart ,mend ,mpredicate ,mkey)))))
+ (loop
+ (unless (< (incf ,i) ,j) (return-from ,partition-loop))
+ (unless (funcall ,predicate
+ ,(if mkey
+ `(funcall ,key (,ref ,sequence ,i))
+ `(,ref ,sequence ,i))
+ ,pivot-key) (return)))
+ (rotatef (,ref ,sequence ,i) (,ref ,sequence ,j))))
+ (setf (,ref ,sequence ,start) (,ref ,sequence ,j)
+ (,ref ,sequence ,j) ,pivot-data)
+ ;; check each partition size and pick the smallest one
+ ;; this way the stack depth worst-case is Theta(lgn)
+ (if (< (- ,j ,start) (- ,end ,j))
+ (progn
+ (,quicksort-call ,sequence ,start (1- ,j) ,predicate ,key)
+ (setf ,start (1+ ,j)))
+ (progn
+ (,quicksort-call ,sequence (1+ ,j) ,end ,predicate ,key)
+ (setf ,end (1- ,j))))))))
+ (,quicksort-call ,msequence ,mstart ,mend ,mpredicate ,mkey)))))
;;;
@@ -105,8 +104,7 @@
sequence))
(defun median-pivot (start end)
- (declare (type fixnum start end)
- (optimize (speed 3) (space 0)))
+ (declare (type fixnum start end))
(the fixnum (+ start (ash (- end start) -1))))
@@ -128,13 +126,11 @@
sequence))
(defun bounded-random (min max)
- (declare (type fixnum min max)
- (optimize (speed 3) (safety 0)))
+ (declare (type fixnum min max))
(the fixnum (+ min (random (the fixnum (+ (- max min) 1))))))
(defun median-of-3-pivot (start end)
(declare (type fixnum start end)
- (optimize (speed 3) (safety 0))
(inline bounded-random insertion-sort))
(let ((pivots (vector (bounded-random start end)
(bounded-random start end)

No commit comments for this range

Something went wrong with that request. Please try again.