MERGE SORTING

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.

(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)))))))
The 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


created July 16, 1995
last revised June 24, 1996

John David Stone (stone@math.grin.edu)