aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/extent-sampling.sc24
1 files changed, 15 insertions, 9 deletions
diff --git a/src/extent-sampling.sc b/src/extent-sampling.sc
index 0c0708c..d46f31d 100644
--- a/src/extent-sampling.sc
+++ b/src/extent-sampling.sc
@@ -78,15 +78,21 @@
(return (* (surface-area-of-ball n)
result))))
-(define (integral integrand extent-oracle true-integral r dimension rtol stats)
- (void (const integrand-t*) (const extent-oracle-t*) double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*)
- (with-vector x dimension
- (do-while (> (rerror (gsl-rstat-mean stats) true-integral)
- rtol)
- (random-direction-vector r x)
- (gsl-rstat-add (integral-per-direction integrand x dimension
- (invoke-extent-oracle extent-oracle r x) rtol)
- stats))))
+(pre-let* (WINDOW-LENGTH 1000)
+ (define (integral integrand extent-oracle true-integral r dimension rtol stats)
+ (void (const integrand-t*) (const extent-oracle-t*) double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*)
+ (define accurate-estimates int 0)
+ (with-vector x dimension
+ (do-while (< accurate-estimates WINDOW-LENGTH)
+ (random-direction-vector r x)
+ (gsl-rstat-add (integral-per-direction integrand x dimension
+ (invoke-extent-oracle extent-oracle r x) rtol)
+ stats)
+ (cond
+ ((rtol? (gsl-rstat-mean stats) true-integral rtol)
+ (set+ accurate-estimates 1))
+ (else
+ (set accurate-estimates 0)))))))
(define (volume-cone extent-oracle r mean omega-min omega-max number-of-samples variance)
(double (const extent-oracle-t*) (const gsl-rng*) (const gsl-vector*) double double (unsigned int) double*)