Changeset 8007 in project


Ignore:
Timestamp:
01/31/08 08:31:01 (12 years ago)
Author:
Ivan Raikov
Message:

Bug fix in ode-bpr normal-sample.

Location:
ode/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • ode/trunk/examples/schneidman98.scm

    r8005 r8007  
    195195                  ))
    196196    (let* ((schneidman98-1 (ode:waveform-transformer schneidman98))
    197            (schneidman98-2 (ode:rate-transformer schneidman98-1)))
     197           (schneidman98-2 (ode:bpr-transformer schneidman98-1)))
    198198      schneidman98-2)))
    199199
  • ode/trunk/extensions/ode-bpr.scm

    r8005 r8007  
    101101(define (binom-approx x n p s)
    102102  (let ((np (fp* p (fp- n 1.0)))
    103         (q  (fp- 1 p))
     103        (q  (fp- 1.0 p))
    104104        (xmin 0)
    105         (xmax (fp- n 1)))
     105        (xmax (fp- n 1.0)))
    106106    (let ((result
    107107           (if (not  (and (fp< p 1.0) (>= np 10.0) (>= (fp* np q) 10.0)))
    108                (random-mtzig:randb! n p s)
     108               (let ((v (random-mtzig:randb! n p s)))
     109                 v)
    109110               (let ((mu np) (sigma (fp* np q)))
    110111                 (fp+ mu (fp* (sqrt sigma) x))))))
     
    137138          (env-extend! ((ode 'env-extend!) new-env))
    138139          (eqdef!  ((ode 'eqdef!) new-env)))
    139 
     140      (print "fptype = " fptype)
    140141      (if (not (environment-includes? sys 'std-normal-sample))
    141142          (let* ((randn!  (if (equal? fptype 'double)
     
    148149
    149150      (if (not (environment-includes? sys 'binom-approx))
    150           (let ((fn (lambda (x n p) (binom-approx x n p (car binom-seed)))))
     151          (let ((fn (lambda (x n p) (binom-approx x n p binom-seed))))
    151152            (env-extend! 'binom-approx '(prim) fn
    152153                         `((formals (,fptype ,fptype ,fptype)) (rt ,fptype)))))
     
    163164                (let* ((g  (make-digraph name (string-append (symbol->string name) " probability rate graph")))
    164165                       (seed       (gensym "seed"))
     166                       (seedv      (or seedv (random-mtzig:init)))
    165167                       (ssize      (string->symbol (string-append "sample-size_" (symbol->string name))))
    166168                       (samvec     (vector-name "sample-vector" name))
  • ode/trunk/ode.scm

    r8001 r8007  
    186186                  cube > < <= >= = and or
    187187                  round ceiling floor max min
    188                   fpvector)
     188                  fpvector-ref)
    189189              (list fp+ fp- fp* fp/ expt fpneg
    190190                    abs atan asin acos sin cos exp log sqrt tan
Note: See TracChangeset for help on using the changeset viewer.