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

93 lines
2.3 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
;;; DDERIV -- Table-driven symbolic derivation.
;;; Returns the wrong answer for quotients.
;;; Fortunately these aren't used in the benchmark.
(library (r6rs-benchmarks dderiv)
(export main)
(import (r6rs) (r6rs mutable-pairs) (r6rs-benchmarks))
(define (lookup key table)
(let loop ((x table))
(if (null? x)
#f
(let ((pair (car x)))
(if (eq? (car pair) key)
pair
(loop (cdr x)))))))
(define properties '())
(define (get key1 key2)
(let ((x (lookup key1 properties)))
(if x
(let ((y (lookup key2 (cdr x))))
(if y
(cdr y)
#f))
#f)))
(define (put key1 key2 val)
(let ((x (lookup key1 properties)))
(if x
(let ((y (lookup key2 (cdr x))))
(if y
(set-cdr! y val)
(set-cdr! x (cons (cons key2 val) (cdr x)))))
(set! properties
(cons (list key1 (cons key2 val)) properties)))))
(define (my+dderiv a)
(cons '+
(map dderiv (cdr a))))
(define (my-dderiv a)
(cons '-
(map dderiv (cdr a))))
(define (*dderiv a)
(list '*
a
(cons '+
(map (lambda (a) (list '/ (dderiv a) a)) (cdr a)))))
(define (/dderiv a)
(list '-
(list '/
(dderiv (cadr a))
(caddr a))
(list '/
(cadr a)
(list '*
(caddr a)
(caddr a)
(dderiv (caddr a))))))
(define (dderiv a)
(if (not (pair? a))
(if (eq? a 'x) 1 0)
(let ((f (get (car a) 'dderiv)))
(if f
(f a)
(fatal-error "No derivation method available")))))
(define (main . args)
(run-benchmark
"dderiv"
dderiv-iters
(lambda (result)
(equal? result
'(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x)))
(* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x)))
(* (* b x) (+ (/ 0 b) (/ 1 x)))
0)))
(lambda (a) (lambda () (dderiv a)))
'(+ (* 3 x x) (* a x x) (* b x) 5)))
(put '+ 'dderiv my+dderiv)
(put '- 'dderiv my-dderiv)
(put '* 'dderiv *dderiv)
(put '/ 'dderiv /dderiv))