aboutsummaryrefslogtreecommitdiff
path: root/src/extent-sampling.sc
diff options
context:
space:
mode:
authorArun Isaac2021-02-11 14:44:34 +0530
committerArun Isaac2021-02-11 14:44:34 +0530
commit10d4a342fd02f79bdd848a87316c6f7dffc24019 (patch)
tree8dcc44f5d22870b5e275e11f59b3a6b3e7d46d03 /src/extent-sampling.sc
parent6faadaad7c59896591a5a1a20b11cc00715eda19 (diff)
downloadnsmc-10d4a342fd02f79bdd848a87316c6f7dffc24019.tar.gz
nsmc-10d4a342fd02f79bdd848a87316c6f7dffc24019.tar.lz
nsmc-10d4a342fd02f79bdd848a87316c6f7dffc24019.zip
Change extent oracle and true volume prototypes.
This change will make it easier for the scheme wrapper to curry extent oracles. * include/extent-sampling.h (extent_oracle_t): Define as a struct that bundles the parameters required by the actual extent oracle. * include/oracles.h (bernoulli_params, uniform_params, beta_params, cube_params, ellipsoid_params, spheroid_params): New types. (bernoulli_extent_generator, uniform_extent_generator, beta_extent_generator): Rename to bernoulli_extent_oracle, uniform_extent_oracle, beta_extent_oracle respectively and change to the new extent oracle prototype. (bernoulli_true_volume, uniform_true_volume, beta_true_volume, cube_extent_oracle, cube_extent_oracle_with_center, cube_true_volume, ellipsoid_extent_oracle, ellipsoid_true_volume, spheroid_extent_oracle, spheroid_true_volume): Change to new extent oracle and true volume prototypes. * src/oracles.sc: Likewise. * src/extent-sampling.sc (invoke-extent-oracle): New macro. (volume, volume-window, integral, volume-cone): Call using new extent oracle prototype.
Diffstat (limited to 'src/extent-sampling.sc')
-rw-r--r--src/extent-sampling.sc11
1 files changed, 7 insertions, 4 deletions
diff --git a/src/extent-sampling.sc b/src/extent-sampling.sc
index c6220e6..b54c44b 100644
--- a/src/extent-sampling.sc
+++ b/src/extent-sampling.sc
@@ -25,6 +25,9 @@
gsl-integration-workspace-free
body ...))
+(sc-define-syntax (invoke-extent-oracle extent-oracle r x)
+ ((struct-get extent-oracle oracle) r x (struct-get extent-oracle params)))
+
(pre-define CONFIDENCE-INTERVAL-FACTOR 1.96)
(pre-let* (VOLUME-MINIMUM-SAMPLES 100)
@@ -40,7 +43,7 @@
(> (rerror volume true-volume) rtol)
(< (gsl-rstat-n stats) VOLUME-MINIMUM-SAMPLES))
(random-direction-vector r x)
- (gsl-rstat-add (exp (+ vn (* dimension (log (extent-oracle x)))))
+ (gsl-rstat-add (exp (+ vn (* dimension (log (invoke-extent-oracle extent-oracle r x)))))
stats)
(set volume (gsl-rstat-mean stats)))))
(return volume)))
@@ -57,7 +60,7 @@
(with-vector x dimension
(do-while (< accurate-estimates window-length)
(random-direction-vector r x)
- (gsl-rstat-add (exp (+ vn (* dimension (log (extent-oracle x)))))
+ (gsl-rstat-add (exp (+ vn (* dimension (log (invoke-extent-oracle extent-oracle r x)))))
stats)
(set volume (gsl-rstat-mean stats))
(cond
@@ -105,7 +108,7 @@
(let* ((neval int 0))
(random-direction-vector r x)
(gsl-rstat-add (integral-per-direction integrand x r dimension
- (extent-oracle x) rtol (address-of neval))
+ (invoke-extent-oracle extent-oracle r x) rtol (address-of neval))
stats))
(set integral (gsl-rstat-mean stats))
(set error (/ (* CONFIDENCE-INTERVAL-FACTOR (gsl-rstat-sd-mean stats))
@@ -126,7 +129,7 @@
(with-vector x dimension
(for-i i number-of-samples
(hollow-cone-random-vector r mean theta-min theta-max x)
- (gsl-rstat-add (exp (+ vn (* dimension (log (extent-oracle x)))))
+ (gsl-rstat-add (exp (+ vn (* dimension (log (invoke-extent-oracle extent-oracle r x)))))
stats)))
(cond
(variance (set (pointer-get variance) (gsl-rstat-variance stats))))