From 10d4a342fd02f79bdd848a87316c6f7dffc24019 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Thu, 11 Feb 2021 14:44:34 +0530
Subject: 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.
---
 src/extent-sampling.sc | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

(limited to 'src/extent-sampling.sc')

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))))
-- 
cgit v1.2.3