;;; Little test harness, 'cause I'm paraoid about tricky code. (define r (make-random 42)) (define (rand n) (modulo (r) n)) ;;; For testing stable sort -- 3 & 2 compare the same. (define (my< x y) (< (quotient x 2) (quotient y 2))) (define (unstable-sort-test v) ; quick & heap vs simple insert (let ((v1 (vector-copy v)) (v2 (vector-copy v)) (v3 (vector-copy v))) (quick-sort! v1 <) (heap-sort! v2 <) (insert-sort! v3 <) (and (or (not (equal? v1 v2)) (not (equal? v1 v3)) (not (vector-sorted? v1 <))) (list v v1 v2 v3)))) (define (stable-sort-test v) ; insert, list & vector merge sorts (let ((v1 (vector-copy v)) (v2 (vector-copy v)) (v3 (list->vector (list-merge-sort! (vector->list v) my<))) (v4 (list->vector (list-merge-sort (vector->list v) my<)))) (vector-merge-sort! v1 my<) (insert-sort! v2 my<) (and (or (not (equal? v1 v2)) (not (equal? v1 v3)) (not (equal? v1 v4)) (not (vector-sorted? v1 my<))) (list v v1 v2 v3 v4)))) (define (do-test max-size) (let lp ((i 0)) (let ((i (cond ((= i 1000) (write-char #\.) (force-output) 0) (else (+ i 1)))) (v (random-vector (rand max-size)))) (cond ((unstable-sort-test v) => (lambda (x) (cons 'u x))) ((stable-sort-test v) => (lambda (x) (cons 's x))) (else (lp i)))))) (define (test-n-mail max-size) (let ((losers (do-test max-size)) (email-address "shivers@cc.gatech.edu")) (run (mail -s "sort lost" ,email-address) (<< ,losers)))) (define (random-vector size) (let ((v (make-vector size))) (fill-vector-randomly! v (* 10 size)) v)) (define (fill-vector-randomly! v maxval) (do ((i (- (vector-length v) 1) (- i 1))) ((< i 0)) (vector-set! v i (rand maxval))))