#!/usr/local/bin/guile \ -e main -s !# ;;; $Id: heapsort.guile,v 1.4 2001/06/29 23:12:37 doug Exp $ ;;; http://www.bagley.org/~doug/shootout/ (use-modules (ice-9 format)) (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 (+ (ash n -1) 1)) (i 0) (j 0) (rra 0.0)) (define (heapsortloop) (while #t (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) (throw 'return))))) (set! i l) (set! j (ash l 1)) (while (<= 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))) (catch 'return heapsortloop (lambda args #t)))) (define (main args) (let* ((n (or (and (= (length args) 2) (string->number (cadr args))) 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) (display (format "~,10F\n" (vector-ref ary n)))))