diff options
Diffstat (limited to 'bench.scm')
| -rw-r--r-- | bench.scm | 99 |
1 files changed, 76 insertions, 23 deletions
@@ -1,4 +1,4 @@ -;; Copyright (C) 1996, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2001, 2002 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -38,11 +38,17 @@ ;; whether to permit this exception to apply to your modifications. ;; If you do not wish that, delete this exception notice. -;;;; "bench.scm", Scheme benchmark computing digits of pi. +;;;; "bench.scm", Scheme benchmarks: digits of pi and random statistics. ;;; Author: Aubrey Jaffer. -(load (in-vicinity (implementation-vicinity) "pi.scm")) (require 'transcript) +(require-if 'inexact 'root) +(require-if 'inexact 'printf) +(require 'random) +(require 'array) +;;(load (in-vicinity (implementation-vicinity) "prng-v.scm")) + +(load (in-vicinity (implementation-vicinity) "pi.scm")) (define isqrt (cond ((provided? 'inexact) sqrt) (else (require 'root) integer-sqrt))) @@ -51,26 +57,23 @@ (else quotient))) (define around (cond ((provided? 'inexact) - (lambda (x bnd) - (cond ((>= 99999 (abs x) bnd) (inexact->exact (round x))) - ((> (abs x) 99999) (round x)) - (else x)))) - (else (lambda (x bnd) x)))) + (let () + (require 'printf) + (lambda (x prec) (sprintf #f "%.*g" prec x)))) + (else (lambda (x prec) x)))) -(define (time-pi digits) +(define (time-call proc . args) (let ((start-time (get-internal-run-time))) - (pi digits 4) + (apply proc args) (i/ (* 1000 (- (get-internal-run-time) start-time)) internal-time-units-per-second))) -(define (benchmark . arg) - (define file - (cond ((null? arg) "bench.log") - (else (car arg)))) +(define (benchmark-pi . arg) + (define file (if (null? arg) "pi.log" (car arg))) (do ((digits 50 (+ digits digits)) - (t 0 (time-pi (+ digits digits)))) - ((> t 3000) - (do ((tl '() (cons (time-pi digits) tl)) + (t 0 (time-call pi (+ digits digits) 4))) + ((> t 3600) + (do ((tl '() (cons (time-call pi digits 4) tl)) (j 12 (+ -1 j))) ((zero? j) (let* ((avg (i/ (apply + tl) (length tl))) @@ -80,18 +83,68 @@ (length tl))))) (and file (transcript-on file)) (for-each display - (list digits " digits took " (around avg 99) - " +/- " (around dev 3) ".ms")) + (list digits " digits of pi took " (around avg 4) ".ms" + " +/- " (around dev 2) ".ms")) (newline) (let ((scaled-avg (i/ (* (i/ (* avg 1000) digits) 1000) digits)) (scaled-dev (i/ (* (i/ (* dev 1000) digits) 1000) digits))) (for-each display (list " That is about " - (around scaled-avg 99) + (around scaled-avg 4) ".ms/(kB)^2" " +/- " - (around scaled-dev 3) - ".ms/(kB)^2")) + (around scaled-dev 2) ".ms/(kB)^2")) (newline) (and file (transcript-off))) )))))) -(benchmark) + +(define (prng samples modu sta) + (define sra (create-array (Au32) samples)) + (do ((cnt (+ -1 samples) (+ -1 cnt)) + (num (random modu sta) (random modu sta)) + (sum 0 (+ sum num))) + ((negative? cnt) + (set! sum (+ sum num)) + (let ((mean (i/ sum samples))) + (define (square-diff x) (define z (- x mean)) (* z z)) + (do ((cnt (+ -1 samples) (+ -1 cnt)) + (var2 0 (+ (square-diff (array-ref sra cnt)) var2))) + ((negative? cnt) + (for-each display + (list sum " / " samples " = " + mean " +/- " (isqrt (i/ var2 samples)))) + (newline))))) + (array-set! sra num cnt))) + +(define (benchmark-prng . arg) + (define file (if (null? arg) "prng.log" (car arg))) + (define sta + (seed->random-state "http://swissnet.ai.mit.edu/~jaffer/SLIB.html")) + (do ((samples 125 (* 4 samples)) + (t 0 (time-call prng (* 2 samples) 999 sta))) + ((or (> t 1000) (and (not (provided? 'bignum)) (> samples 1000))) + (do ((tl '() (cons (time-call prng samples 999 sta) tl)) + (j 12 (+ -1 j))) + ((zero? j) + (let* ((avg (i/ (apply + tl) (length tl))) + (dev (isqrt (i/ (apply + + (map (lambda (x) (* (- x avg) (- x avg))) + tl)) + (length tl))))) + (and file (transcript-on file)) + (for-each display + (list samples " random samples took " (around avg 4) ".ms" + " +/- " (around dev 2) ".ms")) + (newline) + (let ((scaled-avg (i/ (* avg 1000) samples)) + (scaled-dev (i/ (* dev 1000) samples))) + (for-each display + (list " That is about " + (around scaled-avg 4) ".ms/kB" + " +/- " + (around scaled-dev 2) ".ms/kB")) + (newline) + (and file (transcript-off))))))))) + +(benchmark-prng) +(newline) +(benchmark-pi) |