diff --git a/collects/tests/mzscheme/benchmarks/shootout/heapsort.ss b/collects/tests/mzscheme/benchmarks/shootout/heapsort.ss index 6e06323155..d21b570629 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/heapsort.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/heapsort.ss @@ -6,7 +6,8 @@ ;; Updated by Brent Fulgham to provide proper output formatting (module heapsort mzscheme - (require (only (lib "13.ss" "srfi") string-index string-pad-right)) + (require (only (lib "13.ss" "srfi") string-index string-pad-right) + (only (lib "string.ss") real->decimal-string)) (define IM 139968) (define IA 3877) @@ -50,15 +51,6 @@ (set! j (+ ir 1))))) (vector-set! ra i rra))))) - (define (roundto digits num) - (let* ([e (expt 10 digits)] - [num (round (* e (inexact->exact num)))]) - (format "~a.~a" - (quotient num e) - (substring (string-append (number->string (remainder num e)) - (make-string digits #\0)) - 0 digits)))) - (define (main args) (let* ((n (or (and (= (vector-length args) 1) (string->number (vector-ref args 0))) 1)) @@ -69,6 +61,6 @@ (vector-set! ary i (gen_random 1.0))) (heapsort n ary) (printf "~a~n" - (roundto 10 (vector-ref ary n))))) + (real->decimal-string (vector-ref ary n) 10)))) (main (current-command-line-arguments))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/moments.ss b/collects/tests/mzscheme/benchmarks/shootout/moments.ss index f7860380f4..4bcd562351 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/moments.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/moments.ss @@ -1,17 +1,10 @@ ; Moments.scm (module moments mzscheme - (require (only (lib "list.ss") sort)) + (require (only (lib "list.ss") sort) + (only (lib "string.ss") real->decimal-string)) - (define (roundto digits n) - (let* ([e (expt 10 digits)] - [num (round (abs (* e (inexact->exact n))))]) - (format "~a~a.~a" - (if (negative? n) "-" "") - (quotient num e) - (substring (string-append (number->string (remainder num e)) - (make-string digits #\0)) - 0 digits)))) + (define (to-str n) (real->decimal-string n 6)) (let* ((sum 0.0) (numlist (let loop ((line (read-line)) (numlist '())) @@ -63,10 +56,10 @@ (for-each display `("n: " ,n "\n" - "median: " ,(roundto 6 median) "\n" - "mean: " ,(roundto 6 mean) "\n" - "average_deviation: " ,(roundto 6 average_deviation ) "\n" - "standard_deviation: " ,(roundto 6 standard_deviation) "\n" - "variance: " ,(roundto 6 variance)"\n" - "skew: " ,(roundto 6 skew) "\n" - "kurtosis: " ,(roundto 6 kurtosis)"\n" )))))) \ No newline at end of file + "median: " ,(to-str median) "\n" + "mean: " ,(to-str mean) "\n" + "average_deviation: " ,(to-str average_deviation ) "\n" + "standard_deviation: " ,(to-str standard_deviation) "\n" + "variance: " ,(to-str variance)"\n" + "skew: " ,(to-str skew) "\n" + "kurtosis: " ,(to-str kurtosis)"\n" )))))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/nbody.ss b/collects/tests/mzscheme/benchmarks/shootout/nbody.ss index 1dd9802e12..1326d7985b 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/nbody.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/nbody.ss @@ -16,18 +16,7 @@ Correct output N = 1000 is -0.169087605 |# (module nbody mzscheme - (provide main) - - ;;; Stupid boiler-plate for formatting floating point value - (define (roundto digits n) - (let* ([e (expt 10 digits)] - [num (round (abs (* e (inexact->exact n))))]) - (format "~a~a.~a" - (if (negative? n) "-" "") - (quotient num e) - (substring (string-append (number->string (remainder num e)) - (make-string digits #\0)) - 0 digits)))) + (require (only (lib "string.ss") real->decimal-string)) ;; ------------------------------ ;; define planetary masses, initial positions & velocity @@ -147,20 +136,16 @@ Correct output N = 1000 is (loop-o (cdr o)))))) ;; ------------------------------- - (define (main args) - (let ((n (if (null? args) - 1 - (string->number (car args)))) - (system (list *sun* *jupiter* *saturn* *uranus* *neptune*))) + + (let ((n (string->number (vector-ref (current-command-line-arguments) 0))) + (system (list *sun* *jupiter* *saturn* *uranus* *neptune*))) + + (offset-momentum system) + + (printf "~a~%" (real->decimal-string (energy system) 9)) + + (do ((i 1 (+ i 1))) + ((< n i)) + (advance system 0.01)) - (offset-momentum system) - - (printf "~a~%" (roundto 9 (energy system))) - - (do ((i 1 (+ i 1))) - ((< n i)) - (advance system 0.01)) - - (printf "~a~%" (roundto 9 (energy system))))) - - (main (vector->list (current-command-line-arguments)))) + (printf "~a~%" (real->decimal-string (energy system) 9)))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/partialsums.ss b/collects/tests/mzscheme/benchmarks/shootout/partialsums.ss index 56db6e6b9c..80464539e6 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/partialsums.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/partialsums.ss @@ -12,17 +12,8 @@ ;; its time GCing; it runs 1.5 times as fast in mzscheme3m. (module partialsums mzscheme + (require (only (lib "string.ss") real->decimal-string)) - (define (roundto digits n) - (let* ([e (expt 10 digits)] - [num (round (abs (* e (inexact->exact n))))]) - (format "~a~a.~a" - (if (negative? n) "-" "") - (quotient num e) - (substring (string-append (number->string (remainder num e)) - (make-string digits #\0)) - 0 digits)))) - (let ((n (exact->inexact (string->number (vector-ref (current-command-line-arguments) 0)))) @@ -36,7 +27,7 @@ (if (= d n #;(+ n 1)) (let ([format-result (lambda (str n) - (printf str (roundto 9 n)))]) + (printf str (real->decimal-string n 9)))]) (format-result "~a\t(2/3)^k\n" s0) (format-result "~a\tk^-0.5\n" s1) diff --git a/collects/tests/mzscheme/benchmarks/shootout/random.ss b/collects/tests/mzscheme/benchmarks/shootout/random.ss index 4d29330197..df05ffa976 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/random.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/random.ss @@ -4,7 +4,7 @@ ;;; Modified for proper string output by Brent Fulgham (module random mzscheme - (provide main) + (require (only (lib "string.ss") real->decimal-string)) (define IM 139968) (define IA 3877) @@ -25,16 +25,13 @@ (make-string digits #\0)) 0 digits)))) - (define (main args) - (let ((n (if (= (vector-length args) 0) - 1 - (string->number (vector-ref args 0))))) - (let loop ((iter n)) - (if (> iter 1) - (begin - (gen_random 100.0) - (loop (- iter 1))))) - (printf "~a~%" - (roundto 9 (gen_random 100.0))))) - - (main (current-command-line-arguments))) + (let ((n (string->number + (vector-ref (current-command-line-arguments) + 0)))) + (let loop ((iter n)) + (if (> iter 1) + (begin + (gen_random 100.0) + (loop (- iter 1))))) + (printf "~a~%" + (real->decimal-string (gen_random 100.0) 9)))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/recursive.ss b/collects/tests/mzscheme/benchmarks/shootout/recursive.ss index 47a8043bd5..75018a31b1 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/recursive.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/recursive.ss @@ -9,6 +9,7 @@ ;; --------------------------------------------------------------------- (module recursive mzscheme + (require (only (lib "string.ss") real->decimal-string)) ;; ------------------------------- @@ -39,26 +40,19 @@ ;; ------------------------------- - (define (roundto digits n) - (let* ([e (expt 10 digits)] - [num (round (* e (inexact->exact n)))]) - (format "~a.~a" - (quotient num e) - (substring (string-append (number->string (remainder num e)) - (make-string digits #\0)) - 0 digits)))) - (define (main args) (let ((n (string->number (vector-ref args 0)))) (printf "Ack(3,~A): ~A~%" n (ack 3 n)) - (printf "Fib(~a): ~a~%" (roundto 1 (+ 27.0 n)) (roundto 1 (fibflt (+ 27.0 n)))) + (printf "Fib(~a): ~a~%" + (real->decimal-string (+ 27.0 n) 1) + (real->decimal-string (fibflt (+ 27.0 n)) 1)) (set! n (- n 1)) (printf "Tak(~A,~A,~A): ~A~%" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n)) (printf "Fib(3): ~A~%" (fib 3)) - (printf "Tak(3.0,2.0,1.0): ~a~%" (roundto 1 (takflt 3.0 2.0 1.0))))) + (printf "Tak(3.0,2.0,1.0): ~a~%" (real->decimal-string (takflt 3.0 2.0 1.0) 1)))) ;; ------------------------------- diff --git a/collects/tests/mzscheme/benchmarks/shootout/regexpdna.ss b/collects/tests/mzscheme/benchmarks/shootout/regexpdna.ss index 11e9817f7a..c7a33fd965 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/regexpdna.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/regexpdna.ss @@ -31,23 +31,7 @@ ;; ------------------------------- (define (ci-byte-regexp s) - (byte-regexp (ci-pattern s))) - (define (ci-pattern s) - (let ([m (regexp-match #rx#"^(.*)\\[([^]]*)\\](.*)$" s)]) - (if m - (bytes-append (ci-pattern (cadr m)) - #"[" - (regexp-replace* #rx#"[a-zA-Z]" (caddr m) both-cases) - #"]" - (ci-pattern (cadddr m))) - (regexp-replace* #rx#"[a-zA-Z]" s (lambda (s) - (string->bytes/latin-1 - (format "[~a]" (both-cases s)))))))) - (define (both-cases s) - (string->bytes/latin-1 - (format "~a~a" - (string-downcase (bytes->string/latin-1 s)) - (string-upcase (bytes->string/latin-1 s))))) + (byte-regexp (bytes-append #"(?i:" s #")"))) ;; ------------------------------- diff --git a/collects/tests/mzscheme/benchmarks/shootout/run.ss b/collects/tests/mzscheme/benchmarks/shootout/run.ss index 4570ae05ea..33fd8bc1fd 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/run.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/run.ss @@ -17,7 +17,7 @@ ("lists.ss" . "18") ("mandelbrot.ss") ("matrix.ss" . "600") - ("moments.ss" . "200") + ("moments.ss") 200 somethings... ("nbody.ss") ("nestedloop.ss" . "18") ("nsieve.ss")