Problem: Given an list of elements, construct a list containing the same elements, but arranged in monotonically non-decreasing order (under some total ordering that may also be specified as an argument; < is used by default).
The mergesort algorithm implemented here consists of dividing the list into two parts of equal size (in any appropriately efficient way -- order is irrelevant during this part of the process), sorting each part separately, and merging the results. Of course, the same method can be used recursively to sort each of the parts. The process of division and subdivision is continued until parts are reached that consist of single elements; these of course are already (trivially sorted) and ready to be merged.
Here is an efficient splitting procedure. It takes any list as argument and returns a pair of lists, each containing half of the elements of the operand.
The(define split (lambda (ls) (let loop ((rest ls) (left '()) (right '())) (cond ((null? rest) (cons left right)) ((null? (cdr rest)) (cons (cons (car rest) left) right)) (else (loop (cddr rest) (cons (car rest) left) (cons (cadr rest) right)))))))
mergesort
procedure itself first checks for the special
case of an empty list, then enters a named-let expression in which every
recursive call meets the precondition that the argument is a non-empty
list. In each call, the list is tested to see whether it has a single
element. If so, it is returned unchanged; otherwise, it is split, the
pieces are sorted by recursive calls, and the resulting sorted lists are
merged.
The internally defined merge
procedure is a slight variation
of the one described elsewhere in this collection
of algorithms.
(define mergesort (lambda (ls . opt) (let* ((precedes? (if (null? opt) < (car opt))) (merge (lambda (list-1 list-2) (let loop ((source-1 list-1) (source-2 list-2) (so-far '())) (cond ((null? source-1) (reverse-it so-far source-2)) ((null? source-2) (reverse-it so-far source-1)) (else (let ((car-1 (car source-1)) (car-2 (car source-2))) (if (precedes? car-2 car-1) (loop source-1 (cdr source-2) (cons car-2 so-far)) (loop (cdr source-1) source-2 (cons car-1 so-far)))))))))) (if (null? ls) '() (let helper ((piece ls)) (if (null? (cdr piece)) piece (let ((parts (split piece))) (merge (helper (car parts)) (helper (cdr parts))))))))))
This document is available on the World Wide Web as
http://www.math.grin.edu/~stone/events/scheme-workshop/mergesort.html