Different algorithms should be used for sorting a linear data structure by insertion, depending on whether the contents of the structure are to be rearranged in place (as is typical when the structure is a vector) or copied into a new container, leaving the original unchanged (as is typical when the structure is a list).
Here is the algorithm when a new, sorted structure is to be constructed.
The optional parameter permits the caller to supply a total order other
than <
(which is used by default). The main loop pulls one
element at a time from the original list and inserts it into the sorted
list by calling the insert
procedure.
The interally defined insert
procedure adds a new element to a
sorted list at the appropriate position, leaving it sorted. It uses the
reverse-it
procedure defined elsewhere.
Here is the more classical form of the insertion sort, which rearranges the elements of a vector. The main loop runs through the positions in the vector, from left to right, starting with the next-to-leftmost; at each position, it invokes the(define insertion-sort (lambda (ls . opt) (let* ((precedes? (if (null? opt) < (car opt))) (insert (lambda (new sorted) (let loop ((rest sorted) (passed '())) (cond ((null? rest) (reverse-it passed (list new))) ((precedes? new (car rest)) (reverse-it passed (cons new rest))) (else (loop (cdr rest) (cons (car rest) passed)))))))) (let outer-loop ((remaining ls) (done '())) (if (null? remaining) done (outer-loop (cdr remaining) (insert (car remaining) done)))))))
insert!
procedure to place the
element stored there correctly relative to its predecessors.
The insert!
procedure takes as its argument a position in the
vector and moves the element at that position to a lower-numbered position,
if necessary. It presupposes that those elements are already in the
correct order.
(define insertion-sort! (lambda (v . opt) (let ((precedes? (if (null? opt) < (car opt))) (len (vector-length v))) (let ((insert! (lambda (position) (let ((new (vector-ref v position))) (let loop ((trial (- position 1))) (if (negative? trial) ; at the left end: stop! (vector-set! v 0 new) (let ((displaced (vector-ref v trial))) (if (precedes? new displaced) (begin (vector-set! v (+ trial 1) displaced) (loop (- trial 1))) (vector-set! v (+ trial 1) new))))))))) (do ((index 1 (+ index 1))) ((<= len index)) (insert! index))))))
This document is available on the World Wide Web as
http://www.math.grin.edu/~stone/events/scheme-workshop/insertion.html