ikarus/benchmarks/new/r6rs-benchmarks/pi.ss

159 lines
6.8 KiB
Scheme
Raw Normal View History

Added many benchmarks. added: benchmarks/new/r6rs-benchmarks/BUGS benchmarks/new/r6rs-benchmarks/array1.ss benchmarks/new/r6rs-benchmarks/bib benchmarks/new/r6rs-benchmarks/boyer.ss benchmarks/new/r6rs-benchmarks/browse.ss benchmarks/new/r6rs-benchmarks/cat.ss benchmarks/new/r6rs-benchmarks/conform.ss benchmarks/new/r6rs-benchmarks/cpstak.ss benchmarks/new/r6rs-benchmarks/ctak.ss benchmarks/new/r6rs-benchmarks/dderiv.ss benchmarks/new/r6rs-benchmarks/deriv.ss benchmarks/new/r6rs-benchmarks/destruc.ss benchmarks/new/r6rs-benchmarks/diviter.ss benchmarks/new/r6rs-benchmarks/divrec.ss benchmarks/new/r6rs-benchmarks/dynamic.src.ss benchmarks/new/r6rs-benchmarks/dynamic.ss benchmarks/new/r6rs-benchmarks/earley.ss benchmarks/new/r6rs-benchmarks/fibc.ss benchmarks/new/r6rs-benchmarks/fibfp.ss benchmarks/new/r6rs-benchmarks/gcbench.ss benchmarks/new/r6rs-benchmarks/gcold.ss benchmarks/new/r6rs-benchmarks/graphs.ss benchmarks/new/r6rs-benchmarks/lattice.ss benchmarks/new/r6rs-benchmarks/matrix.ss benchmarks/new/r6rs-benchmarks/maze.ss benchmarks/new/r6rs-benchmarks/mazefun.ss benchmarks/new/r6rs-benchmarks/mbrot.ss benchmarks/new/r6rs-benchmarks/nboyer.ss benchmarks/new/r6rs-benchmarks/nqueens.ss benchmarks/new/r6rs-benchmarks/ntakl.ss benchmarks/new/r6rs-benchmarks/paraffins.ss benchmarks/new/r6rs-benchmarks/parsing-test.sch benchmarks/new/r6rs-benchmarks/parsing.ss benchmarks/new/r6rs-benchmarks/perm9.ss benchmarks/new/r6rs-benchmarks/peval.ss benchmarks/new/r6rs-benchmarks/pi.ss benchmarks/new/r6rs-benchmarks/pnpoly.ss benchmarks/new/r6rs-benchmarks/ray.ss benchmarks/new/r6rs-benchmarks/todo-src/ benchmarks/new/r6rs-benchmarks/todo-src/README.flonum-benchmarks benchmarks/new/r6rs-benchmarks/todo-src/compiler.scm benchmarks/new/r6rs-benchmarks/todo-src/fft.scm benchmarks/new/r6rs-benchmarks/todo-src/fpsum.scm benchmarks/new/r6rs-benchmarks/todo-src/nbody.scm benchmarks/new/r6rs-benchmarks/todo-src/nucleic.scm benchmarks/new/r6rs-benchmarks/todo-src/primes.scm benchmarks/new/r6rs-benchmarks/todo-src/puzzle.scm benchmarks/new/r6rs-benchmarks/todo-src/quicksort.scm benchmarks/new/r6rs-benchmarks/todo-src/rn100 benchmarks/new/r6rs-benchmarks/todo-src/sboyer.scm benchmarks/new/r6rs-benchmarks/todo-src/scheme.scm benchmarks/new/r6rs-benchmarks/todo-src/simplex.scm benchmarks/new/r6rs-benchmarks/todo-src/slatex.scm benchmarks/new/r6rs-benchmarks/todo-src/slatex.sty benchmarks/new/r6rs-benchmarks/todo-src/smlboyer.scm benchmarks/new/r6rs-benchmarks/todo-src/string.scm benchmarks/new/r6rs-benchmarks/todo-src/succeed.scm benchmarks/new/r6rs-benchmarks/todo-src/sum.scm benchmarks/new/r6rs-benchmarks/todo-src/sum1.scm benchmarks/new/r6rs-benchmarks/todo-src/sumfp.scm benchmarks/new/r6rs-benchmarks/todo-src/sumloop.scm benchmarks/new/r6rs-benchmarks/todo-src/tail.scm benchmarks/new/r6rs-benchmarks/todo-src/tak.scm benchmarks/new/r6rs-benchmarks/todo-src/takl.scm benchmarks/new/r6rs-benchmarks/todo-src/temp.scm benchmarks/new/r6rs-benchmarks/todo-src/temp2.scm benchmarks/new/r6rs-benchmarks/todo-src/test.scm benchmarks/new/r6rs-benchmarks/todo-src/test.tex benchmarks/new/r6rs-benchmarks/todo-src/tfib.scm benchmarks/new/r6rs-benchmarks/todo-src/trav1.scm benchmarks/new/r6rs-benchmarks/todo-src/trav2.scm benchmarks/new/r6rs-benchmarks/todo-src/triangl.scm benchmarks/new/r6rs-benchmarks/todo-src/wc.scm modified: benchmarks/new/r6rs-benchmarks.ss benchmarks/results.Larceny-r6rs benchmarks/src/ntakl.scm
2007-06-13 07:17:57 -04:00
;;; PI -- Compute PI using bignums.
; See http://mathworld.wolfram.com/Pi.html for the various algorithms.
(library (r6rs-benchmarks pi)
(export main)
(import (r6rs) (r6rs-benchmarks))
; Utilities.
(define (width x)
(let loop ((i 0) (n 1))
(if (< x n) i (loop (+ i 1) (* n 2)))))
(define (root x y)
(let loop ((g (expt
2
(quotient (+ (width x) (- y 1)) y))))
(let ((a (expt g (- y 1))))
(let ((b (* a y)))
(let ((c (* a (- y 1))))
(let ((d (quotient (+ x (* g c)) b)))
(if (< d g) (loop d) g)))))))
(define (square-root x)
(root x 2))
(define (quartic-root x)
(root x 4))
(define (square x)
(* x x))
; Compute pi using the 'brent-salamin' method.
(define (pi-brent-salamin nb-digits)
(let ((one (expt 10 nb-digits)))
(let loop ((a one)
(b (square-root (quotient (square one) 2)))
(t (quotient one 4))
(x 1))
(if (= a b)
(quotient (square (+ a b)) (* 4 t))
(let ((new-a (quotient (+ a b) 2)))
(loop new-a
(square-root (* a b))
(- t
(quotient
(* x (square (- new-a a)))
one))
(* 2 x)))))))
; Compute pi using the quadratically converging 'borwein' method.
(define (pi-borwein2 nb-digits)
(let* ((one (expt 10 nb-digits))
(one^2 (square one))
(one^4 (square one^2))
(sqrt2 (square-root (* one^2 2)))
(qurt2 (quartic-root (* one^4 2))))
(let loop ((x (quotient
(* one (+ sqrt2 one))
(* 2 qurt2)))
(y qurt2)
(p (+ (* 2 one) sqrt2)))
(let ((new-p (quotient (* p (+ x one))
(+ y one))))
(if (= x one)
new-p
(let ((sqrt-x (square-root (* one x))))
(loop (quotient
(* one (+ x one))
(* 2 sqrt-x))
(quotient
(* one (+ (* x y) one^2))
(* (+ y one) sqrt-x))
new-p)))))))
; Compute pi using the quartically converging 'borwein' method.
(define (pi-borwein4 nb-digits)
(let* ((one (expt 10 nb-digits))
(one^2 (square one))
(one^4 (square one^2))
(sqrt2 (square-root (* one^2 2))))
(let loop ((y (- sqrt2 one))
(a (- (* 6 one) (* 4 sqrt2)))
(x 8))
(if (= y 0)
(quotient one^2 a)
(let* ((t1 (quartic-root (- one^4 (square (square y)))))
(t2 (quotient
(* one (- one t1))
(+ one t1)))
(t3 (quotient
(square (quotient (square (+ one t2)) one))
one))
(t4 (+ one
(+ t2
(quotient (square t2) one)))))
(loop t2
(quotient
(- (* t3 a) (* x (* t2 t4)))
one)
(* 4 x)))))))
; Try it.
(define (pies n m s)
(if (< m n)
'()
(let ((bs (pi-brent-salamin n))
(b2 (pi-borwein2 n))
(b4 (pi-borwein4 n)))
(cons (list b2 (- bs b2) (- b4 b2))
(pies (+ n s) m s)))))
(define expected
'((314159265358979323846264338327950288419716939937507
-54
124)
(31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170673
-51
-417)
(3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408122
-57
-819)
(314159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038195
-76
332)
(31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019089
-83
477)
(3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141268
-72
-2981)
(314159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196442881097566593344612847564823378678316527120190914564856692346034861045432664821339360726024914127372458700660631558817488152092096282925409171536431
-70
-2065)
(31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116089
-79
1687)
(3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118542
-92
-2728)
(314159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196442881097566593344612847564823378678316527120190914564856692346034861045432664821339360726024914127372458700660631558817488152092096282925409171536436789259036001133053054882046652138414695194151160943305727036575959195309218611738193261179310511854807446237996274956735188575272489122793818301194907
-76
-3726)))
(define (main . args)
(run-benchmark
"pi"
pi-iters
(lambda (result) (equal? result expected))
(lambda (n m s) (lambda () (pies n m s)))
50
500
50)))