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

50 lines
1.5 KiB
Scheme

;;; DERIV -- Symbolic derivation.
(library (r6rs-benchmarks deriv)
(export main)
(import (r6rs) (r6rs-benchmarks))
;;; Returns the wrong answer for quotients.
;;; Fortunately these aren't used in the benchmark.
(define (deriv a)
(cond ((not (pair? a))
(if (eq? a 'x) 1 0))
((eq? (car a) '+)
(cons '+
(map deriv (cdr a))))
((eq? (car a) '-)
(cons '-
(map deriv (cdr a))))
((eq? (car a) '*)
(list '*
a
(cons '+
(map (lambda (a) (list '/ (deriv a) a)) (cdr a)))))
((eq? (car a) '/)
(list '-
(list '/
(deriv (cadr a))
(caddr a))
(list '/
(cadr a)
(list '*
(caddr a)
(caddr a)
(deriv (caddr a))))))
(else
(fatal-error "No derivation method available"))))
(define (main . args)
(run-benchmark
"deriv"
deriv-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 () (deriv a)))
'(+ (* 3 x x) (* a x x) (* b x) 5))))