152 lines
5.6 KiB
Scheme
152 lines
5.6 KiB
Scheme
;;; Copyright (c) 1985 Yale University
|
|
;;; Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
|
|
|
|
;;; This material was developed by the T Project at the Yale
|
|
;;; University Computer Science Department. Permission to copy this
|
|
;;; software, to redistribute it, and to use it for any purpose is
|
|
;;; granted, subject to the following restric- tions and
|
|
;;; understandings.
|
|
;;; 1. Any copy made of this software must include this copyright
|
|
;;; notice in full.
|
|
;;; 2. Users of this software agree to make their best efforts (a) to return
|
|
;;; to the T Project at Yale any improvements or extensions that they make,
|
|
;;; so that these may be included in future releases; and (b) to inform
|
|
;;; the T Project of noteworthy uses of this software.
|
|
;;; 3. All materials developed as a consequence of the use of this software
|
|
;;; shall duly acknowledge such use, in accordance with the usual standards
|
|
;;; of acknowledging credit in academic research.
|
|
;;; 4. Yale has made no warrantee or representation that the operation of
|
|
;;; this software will be error-free, and Yale is under no obligation to
|
|
;;; provide any services, by way of maintenance, update, or otherwise.
|
|
;;; 5. In conjunction with products arising from the use of this material,
|
|
;;; there shall be no use of the name of the Yale University nor of any
|
|
;;; adaptation thereof in any advertising, promotional, or sales literature
|
|
;;; without prior written consent from Yale in each case.
|
|
;;;
|
|
|
|
;;; We gratefully acknowledge Bob Nix
|
|
|
|
;;; SORT:ONLINE-MERGE-SORT!
|
|
;;; =======================
|
|
;;; On-Line Merge sort, a fast and stable algorithm for sorting a list.
|
|
;;; This is a very neat algorithm! Consider the following code:
|
|
;;;
|
|
;;; (DEFINE (MERGE-SORT L)
|
|
;;; (IF (NULL? (CDR L))
|
|
;;; L
|
|
;;; (MERGE (MERGE-SORT (FIRST-HALF-OF L))
|
|
;;; (MERGE-SORT (SECOND-HALF-OF L)))))
|
|
;;;
|
|
;;; The nested calls to MERGE above form a binary tree, with MERGE's of
|
|
;;; singleton lists at the leaves, and a MERGE of two lists of size N/2 at
|
|
;;; the top. The algorithm below traverses this MERGE-tree in post-order,
|
|
;;; moving from the lower left hand corner to the right.
|
|
;;;
|
|
;;; This algorithm sorts N objects with about NlgN+2N comparisons and exactly
|
|
;;; lgN conses. The algorithm used is a version of mergesort that is
|
|
;;; amenable to Lisp's data accessing primitives. The first phase of the
|
|
;;; algorithm is an "addition" phase in which each element X is added to
|
|
;;; a list of lists of sorted runs B in much the same manner as a one is
|
|
;;; added to a binary number. If the first "digit" of B is 0, i.e. the first
|
|
;;; list in B is NIL, then the element to be added becomes the first digit
|
|
;;; of B. If that digit is non empty then you merge the digit with X and
|
|
;;; recurse on the rest of B -- setting the first digit of B to be zero.
|
|
;;; For example:
|
|
;;;
|
|
;;; Reversed LIST B
|
|
;;; Binary # Each sublist is sorted.
|
|
;;;
|
|
;;; 0000 ()
|
|
;;; 1000 ((x))
|
|
;;; 0100 (() (x x))
|
|
;;; 1100 ((x) (x x))
|
|
;;; 0010 (() () (x x x x))
|
|
;;; 1010 ((x) () (x x x x))
|
|
;;; 0110 (() (x x) (x x x x))
|
|
;;; 1110 ((x) (x x) (x x x x))
|
|
;;; 0001 (() () () (x x x x x x x x))
|
|
;;; 1001 ((x) () () (x x x x x x x x))
|
|
;;;
|
|
;;; The algorithm then merges the sublists of these lists into
|
|
;;; one list, and returns that list.
|
|
;;;
|
|
;;; To see the algorithm in action, trace LIST-MERGE!.
|
|
;;;
|
|
|
|
;;; Returns list L sorted using OBJ-< for comparisons.
|
|
|
|
(define (sort-list l obj-<)
|
|
(cond ((or (null? l)
|
|
(null? (cdr l)))
|
|
l)
|
|
(else
|
|
(online-merge-sort! (append l '()) ; copy-list
|
|
obj-<))))
|
|
|
|
;;; Returns list L sorted using OBJ-< for comparisons.
|
|
;;; L is destructively altered.
|
|
|
|
(define (sort-list! l obj-<)
|
|
(cond ((or (null? l)
|
|
(null? (cdr l)))
|
|
l)
|
|
(else
|
|
(online-merge-sort! l obj-<))))
|
|
|
|
;;; The real sort procedure. Elements of L are added to B, a list of sorted
|
|
;;; lists as defined above. When all elements of L have been added to B
|
|
;;; the sublists of B are merged together to get the desired sorted list.
|
|
|
|
(define (online-merge-sort! l obj-<)
|
|
(let ((b (cons '() '())))
|
|
(let loop ((l l))
|
|
(cond ((null? l)
|
|
(do ((c (cddr b) (cdr c))
|
|
(r (cadr b) (list-merge! (car c) r obj-<)))
|
|
((null? c)
|
|
r)))
|
|
(else
|
|
(let ((new-l (cdr l)))
|
|
(set-cdr! l '())
|
|
(add-to-sorted-lists l b obj-<)
|
|
(loop new-l)))))))
|
|
|
|
;;; X is a list that is merged into B, the list of sorted lists.
|
|
|
|
(define (add-to-sorted-lists x b obj-<)
|
|
(let loop ((x x) (b b))
|
|
(let ((l (cdr b)))
|
|
(cond ((null? l)
|
|
(set-cdr! b (cons x '())))
|
|
((null? (car l))
|
|
(set-car! l x))
|
|
(else
|
|
(let ((y (list-merge! x (car l) obj-<)))
|
|
(set-car! l '())
|
|
(loop y l)))))))
|
|
|
|
;;; Does a stable side-effecting merge of L1 and L2.
|
|
|
|
(define (list-merge! l1 l2 obj-<)
|
|
(cond ((null? l1) l2)
|
|
((null? l2) l1)
|
|
((obj-< (car l1) (car l2))
|
|
(real-list-merge! l2 (cdr l1) obj-< l1)
|
|
l1)
|
|
(else
|
|
(real-list-merge! l1 (cdr l2) obj-< l2)
|
|
l2)))
|
|
|
|
;;; Does the real work of LIST-MERGE!. L1 is assumed to be non-empty.
|
|
|
|
(define (real-list-merge! l1 l2 obj-< prev)
|
|
(let loop ((a l1) (b l2) (prev prev))
|
|
(cond ((null? b)
|
|
(set-cdr! prev a))
|
|
((obj-< (car a) (car b))
|
|
(set-cdr! prev a)
|
|
(loop b (cdr a) a))
|
|
(else
|
|
(set-cdr! prev b)
|
|
(loop a (cdr b) b)))))
|