67 lines
1.6 KiB
Scheme
67 lines
1.6 KiB
Scheme
;;; heapsort.scm
|
|
|
|
;; Prints 0.9990640717878372 instead of 0.9990640718 when n=1000.
|
|
;; Updated by Justin Smith
|
|
;;
|
|
;; Updated by Brent Fulgham to provide proper output formatting
|
|
|
|
(module heapsort mzscheme
|
|
(require (only srfi/13 string-index string-pad-right)
|
|
(only mzlib/string real->decimal-string))
|
|
|
|
(define IM 139968)
|
|
(define IA 3877)
|
|
(define IC 29573)
|
|
|
|
(define LAST 42)
|
|
(define (gen_random max)
|
|
(set! LAST (modulo (+ (* LAST IA) IC) IM))
|
|
(/ (* max LAST) IM))
|
|
|
|
(define (heapsort n ra)
|
|
(let ((ir n)
|
|
(l (+ (quotient n 2) 1))
|
|
(i 0)
|
|
(j 0)
|
|
(rra 0.0))
|
|
(let/ec return
|
|
(do ((bar #t))
|
|
((= 1 0))
|
|
(cond ((> l 1)
|
|
(set! l (- l 1))
|
|
(set! rra (vector-ref ra l)))
|
|
(else
|
|
(set! rra (vector-ref ra ir))
|
|
(vector-set! ra ir (vector-ref ra 1))
|
|
(set! ir (- ir 1))
|
|
(cond ((<= ir 1)
|
|
(vector-set! ra 1 rra)
|
|
(return #t)))))
|
|
(set! i l)
|
|
(set! j (* l 2))
|
|
(do ((foo #t))
|
|
((> j ir))
|
|
(cond ((and (< j ir) (< (vector-ref ra j) (vector-ref ra (+ j 1))))
|
|
(set! j (+ j 1))))
|
|
(cond ((< rra (vector-ref ra j))
|
|
(vector-set! ra i (vector-ref ra j))
|
|
(set! i j)
|
|
(set! j (+ j i)))
|
|
(else
|
|
(set! j (+ ir 1)))))
|
|
(vector-set! ra i rra)))))
|
|
|
|
(define (main args)
|
|
(let* ((n (or (and (= (vector-length args) 1) (string->number (vector-ref args 0)))
|
|
1))
|
|
(last (+ n 1))
|
|
(ary (make-vector last 0)))
|
|
(do ((i 1 (+ i 1)))
|
|
((= i last))
|
|
(vector-set! ary i (gen_random 1.0)))
|
|
(heapsort n ary)
|
|
(printf "~a~n"
|
|
(real->decimal-string (vector-ref ary n) 10))))
|
|
|
|
(main (current-command-line-arguments)))
|