diff options
| -rw-r--r-- | src/extent-sampling.sc | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/src/extent-sampling.sc b/src/extent-sampling.sc index 71051fd..0c0708c 100644 --- a/src/extent-sampling.sc +++ b/src/extent-sampling.sc @@ -36,17 +36,21 @@ (sc-define-syntax (invoke-extent-oracle extent-oracle r x) ((: extent-oracle oracle) r x (: extent-oracle params))) -(pre-define CONFIDENCE-INTERVAL-FACTOR 1.96) - -(define (volume extent-oracle true-volume r dimension rtol stats) - (void (const extent-oracle-t*) double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*) - (let* ((vn double (ln-volume-of-ball dimension))) - (with-vector x dimension - (do-while (> (rerror (gsl-rstat-mean stats) true-volume) - rtol) - (random-direction-vector r x) - (gsl-rstat-add (exp (+ vn (* dimension (log (invoke-extent-oracle extent-oracle r x))))) - stats))))) +(pre-let* (WINDOW-LENGTH 1000) + (define (volume extent-oracle true-volume r dimension rtol stats) + (void (const extent-oracle-t*) double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*) + (define accurate-estimates int 0) + (let* ((vn double (ln-volume-of-ball dimension))) + (with-vector x dimension + (do-while (< accurate-estimates WINDOW-LENGTH) + (random-direction-vector r x) + (gsl-rstat-add (exp (+ vn (* dimension (log (invoke-extent-oracle extent-oracle r x))))) + stats) + (cond + ((rtol? (gsl-rstat-mean stats) true-volume rtol) + (set+ accurate-estimates 1)) + (else + (set accurate-estimates 0)))))))) (sc-define-syntax (invoke-integrand integrand r x) ((: integrand integrand) r x (: integrand params))) |