I'm continuing (see my post "Counting sort") to implement the sorting
algorithms
you can find in "The Art of Computer Programming", volume 3, by D.
Knuth.
I'm posting the implementation of the insertion family sort algorithms.
I didn't implement:
- binary insertion sort
- binary insertion with two-way insertion sort
- multiple list insertion sort
Thanks for your comments,
Alberto Santini
(defun straight-insertion-sort (vec)
"Straight insertion sort as TAOCP, vol. 3, page 80
It's a simplified insertion sort with the gaps between the elements
equal to 1.
You can use the function insertion-sort too.
VEC: A vector of REAL numbers.
WARNING: vec is modified because the sorting is done in-place.
RETURN: The vector ordered in increasing order."
(assert (and (vectorp vec)
(every (function realp) vec)))
(loop :for i from 1 :below (length vec) :do
(let ((value (svref vec i)))
(setf (svref vec (loop :for j from i :downto 1
:until (< (svref vec (1- j)) value)
:do (setf (svref vec j) (svref vec (1- j)))
:finally (return j)))
value)))
(assert (every (function <=) vec (subseq vec 1)))
vec)
(defun insertion-sort (vec &optional (k 1))
"Generalized form of straight insertion sort as TAOCP, vol. 3, page
83
VEC: A vector of REAL numbers.
K: The distance between the vector elements used in shell sort.
WARNING: vec is modified because the sorting is done in-place.
RETURN: The vector ordered in increasing order."
(assert (and (vectorp vec)
(every (function realp) vec)
(>= k 1)))
(loop :for i from k :below (length vec) :do
(let ((value (svref vec i)))
(setf (svref vec (loop :for j from i :downto k :by k
:until (< (svref vec (- j k)) value)
:do (setf (svref vec j) (svref vec (- j k)))
:finally (return j)))
value)))
(when (< k (length vec))
(assert (every (function <=) vec (subseq vec k))))
vec)
(defun shell-sort (vec)
"Shell sort as TAOCP, vol. 3, page 83
VEC: A vector of REAL numbers.
WARNING: vec is modified because is used insertion-sorting function.
RETURN: The vector ordered in increasing order."
(assert (and (vectorp vec)
(every (function realp) vec)))
(let ((sedgewick-gaps '(8929 2161 1121 505 305 109 89 29 19 11 5 1)))
(loop :for i :in sedgewick-gaps :do
(insertion-sort vec i)))
(assert (every (function <=) vec (subseq vec 1)))
vec)
(defun list-insertion-sort (vec)
"List insertion sort as TAOCP, vol. 3, page 95
This is a pseudo list insertion sort, because the underlying data
structure
would have to contain the key and the link fields: in the
implementation
the record to sort isn't a linked linear list and the link fields are
separated by the data structure.
VEC: A vector of REAL numbers.
RETURN: A new vector of same length as vec containing the same elements
as vec,
ordered in increasing order. vec is not modified."
(assert (and (vectorp vec)
(every (function realp) vec)))
(let ((sorted-index (make-array (1+ (length vec))
:initial-element 0 :element-type 'integer)))
(setf (svref sorted-index 0) (length vec))
(setf (svref sorted-index (- (length sorted-index) 1)) 0)
(loop :for i :from (- (length vec) 2) :downto 0 :do
(let ((p (svref sorted-index 0))
(q 0))
(loop :while (and (> p 0)
(> (svref vec i) (svref vec (- p 1)))) :do
(setf q p)
(setf p (svref sorted-index q)))
(setf (svref sorted-index q) (+ i 1))
(setf (svref sorted-index (+ i 1)) p)))
(let ((sorted-vec (make-array (length vec) :initial-contents
(loop
:for i :from 0 :below (length
sorted-index)
:with f = (svref sorted-index 0)
:until (= f 0)
:collect (svref vec (- f 1))
:do (setf f (svref sorted-index f))))))
(assert (and (vectorp sorted-vec)
(= (length sorted-vec) (length vec))
(every (function <=) sorted-vec (subseq sorted-vec 1))))
sorted-vec)))