about summary refs log tree commit diff
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))))