Permalink
Browse files

Initial checkin

  • Loading branch information...
0 parents commit b08e9022b6046604faf90d950d59e228286a69bc @dharmatech committed Jun 25, 2009
Showing with 430 additions and 0 deletions.
  1. +14 −0 kernel-generic.sls
  2. +27 −0 kernel-numeric.sls
  3. +32 −0 kernel-strutl.sls
  4. +27 −0 numerics-quadrature-defint.sls
  5. +86 −0 numerics-quadrature-quadrature.sls
  6. +244 −0 numerics-quadrature-rational.sls
@@ -0,0 +1,14 @@
+
+(library
+
+ (sicm kernel-generic)
+
+ (export)
+
+ (import (rnrs))
+
+ (define (magnitude obj)
+
+ (cond ((number? obj) (abs obj))))
+
+ )
@@ -0,0 +1,27 @@
+
+(library
+
+ (sicm kernel-numeric)
+
+ (export close-enuf?
+ )
+
+ (import (rnrs)
+
+ )
+
+ (define *machine-epsilon*
+ (let loop ((e 1.0))
+ (if (= 1.0 (+ e 1.0))
+ (* 2 e)
+ (loop (/ e 2)))))
+
+ (define (close-enuf? h1 h2 tolerance)
+ (<= (magnitude (- h1 h2))
+ (* .5
+ (max tolerance *machine-epsilon*)
+ (+ (magnitude h1)
+ (magnitude h2)
+ 2.0))))
+
+ )
@@ -0,0 +1,32 @@
+
+(library
+
+ (sicm kernel-strutl)
+
+ (export merge-streams
+ stream-of-iterates
+ shorten-stream
+ )
+
+ (import (rnrs)
+ (srfi :41))
+
+ (define (stream-of-iterates next value)
+ (stream-cons value
+ (stream-of-iterates next (next value))))
+
+ (define (shorten-stream n s)
+ (if (or (= n 0)
+ (stream-null? s))
+ stream-null
+ (stream-cons (stream-car s)
+ (shorten-stream (- n 1)
+ (stream-cdr s)))))
+
+ (define (merge-streams s1 s2)
+ (stream-cons (stream-car s1)
+ (stream-cons (stream-car s2)
+ (merge-streams (stream-cdr s1)
+ (stream-cdr s2)))))
+
+ )
@@ -0,0 +1,27 @@
+
+(library
+
+ (sicm numerics-quadrature-defint)
+
+ (export definite-integral)
+
+ (import (rnrs)
+ (sicm numerics-quadrature-quadrature)
+ )
+
+ (define (definite-integral-with-tolerance f x1 x2 tolerance)
+ (evaluate-definite-integral 'open f x1 x2 tolerance))
+
+ (define (definite-integral-numerical f t1 t2 tolerance)
+
+ (if (and (number? t1)
+ (number? t2)
+ (= t1 t2))
+
+ 0
+
+ (definite-integral-with-tolerance f t1 t2 tolerance)))
+
+ (define definite-integral definite-integral-numerical)
+
+ )
@@ -0,0 +1,86 @@
+
+(library
+
+ (sicm numerics-quadrature-quadrature)
+
+ (export evaluate-definite-integral
+ )
+
+ (import (rnrs)
+ (sicm numerics-quadrature-rational)
+ )
+
+ (define :-infinity ':-infinity)
+ (define :+infinity ':+infinity)
+ (define *infinities* (list :-infinity :+infinity))
+
+ (define evaluate-definite-integral
+
+ (lambda (method integrand lower-limit upper-limit allowable-error)
+
+ (if (not (and integrand lower-limit upper-limit))
+ (error "Missing parameter for definite integral"
+ `(integrand ,integrand
+ lower-limit ,lower-limit
+ upper-limit ,upper-limit)))
+
+ (let ((lower-limit (if (memq lower-limit *infinities*)
+ lower-limit
+ (inexact lower-limit)))
+ (upper-limit (if (memq upper-limit *infinities*)
+ upper-limit
+ (inexact upper-limit)))
+ (allowable-error (inexact allowable-error)))
+
+ (if (or (memq lower-limit *infinities*)
+ (memq upper-limit *infinities*))
+
+ ;; (evaluate-improper-integral method
+ ;; integrand
+ ;; upper-limit
+ ;; lower-limit
+ ;; allowable-error)
+
+ #f
+
+ (case method
+
+ ((open)
+ (integrate-open integrand
+ lower-limit upper-limit
+ allowable-error))
+
+ ((closed-closed)
+ (integrate-closed-closed-1 integrand
+ lower-limit upper-limit
+ allowable-error))
+
+ ((closed-open)
+ (integrate-closed-open-1 integrand
+ lower-limit upper-limit
+ allowable-error))
+
+ ((open-closed)
+ (integrate-open-closed-1 integrand
+ lower-limit upper-limit
+ allowable-error))
+
+ ((open-open)
+ (integrate-open-open integrand
+ lower-limit upper-limit
+ allowable-error))
+
+ ;; ((romberg)
+ ;; (romberg-quadrature integrand
+ ;; lower-limit upper-limit
+ ;; allowable-error))
+
+ ;; ((bulirsch-stoer)
+ ;; (bulirsch-stoer-quadrature integrand
+ ;; lower-limit upper-limit
+ ;; allowable-error))
+
+ (else
+ (error "Unknown method -- DEFINITE-INTEGRAL" method)))))))
+
+ )
Oops, something went wrong.

0 comments on commit b08e902

Please sign in to comment.