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.
(define (insertion-sort ls . opt)
(let ((precedes? (if (null? opt) < (car opt))))
(define (insert 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))))))
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 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! v . opt)
(let ((precedes? (if (null? opt) < (car opt)))
(len (vector-length v)))
(define (insert! 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