diff options
| -rw-r--r-- | src/oracles.sc | 52 |
1 files changed, 26 insertions, 26 deletions
diff --git a/src/oracles.sc b/src/oracles.sc index f0f53a8..173ac75 100644 --- a/src/oracles.sc +++ b/src/oracles.sc @@ -6,25 +6,25 @@ (pre-include "oracles.h") (pre-include "utils.h") -(define (bernoulli-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const bernoulli-params*) (convert-type params bernoulli-params*))) +(define (bernoulli-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const bernoulli-params*) (convert-type -params bernoulli-params*))) (return (if* (gsl-ran-bernoulli r (: params p)) (: params r1) (: params r0))))) -(define (bernoulli-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const bernoulli-params*) (convert-type params bernoulli-params*))) +(define (bernoulli-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const bernoulli-params*) (convert-type -params bernoulli-params*))) (return (* (volume-of-ball dimension) (+ (* (: params p) (gsl-pow-uint (: params r1) dimension)) (* (- 1 (: params p)) (gsl-pow-uint (: params r0) dimension))))))) -(define (uniform-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const uniform-params*) (convert-type params uniform-params*))) +(define (uniform-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const uniform-params*) (convert-type -params uniform-params*))) (return (gsl-ran-flat r (: params a) (: params b))))) ;; TODO: Verify the accuracy of this function for non-trivial a, b. -(define (uniform-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const uniform-params*) (convert-type params uniform-params*))) +(define (uniform-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const uniform-params*) (convert-type -params uniform-params*))) (return (- (exp (+ (ln-volume-of-ball dimension) (* dimension (log (: params b))) (- (log (+ dimension 1))))) @@ -32,12 +32,12 @@ (* dimension (log (: params a))) (- (log (+ dimension 1))))))))) -(define (beta-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const beta-params*) (convert-type params beta-params*))) +(define (beta-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const beta-params*) (convert-type -params beta-params*))) (return (gsl-ran-beta r (: params alpha) (: params beta))))) -(define (beta-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const beta-params*) (convert-type params beta-params*)) +(define (beta-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const beta-params*) (convert-type -params beta-params*)) (vol double (volume-of-ball dimension))) (for-i r dimension (set* vol (/ (+ (: params alpha) r) @@ -52,8 +52,8 @@ (set max (GSL-MAX max (fabs (gsl-vector-get x i))))) (return max))) -(define (cube-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const cube-params*) (convert-type params cube-params*))) +(define (cube-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const cube-params*) (convert-type -params cube-params*))) (return (/ (: params edge) 2 (infinity-norm x))))) (sc-define-syntax (compute-cube-extent-oracle-minimizand i) @@ -62,8 +62,8 @@ (gsl-vector-get (: params center) i))) (fabs (gsl-vector-get x i)))) -(define (cube-extent-oracle-with-center r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const cube-params*) (convert-type params cube-params*)) +(define (cube-extent-oracle-with-center r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const cube-params*) (convert-type -params cube-params*)) (min double (compute-cube-extent-oracle-minimizand 0))) ;; TODO: Start this loop from i = 1, not i = 0. That would be ;; slightly faster. @@ -71,34 +71,34 @@ (set min (GSL-MIN min (compute-cube-extent-oracle-minimizand i)))) (return min))) -(define (cube-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const cube-params*) (convert-type params cube-params*))) +(define (cube-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const cube-params*) (convert-type -params cube-params*))) (return (gsl-pow-uint (: params edge) dimension)))) -(define (ellipsoid-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const ellipsoid-params*) (convert-type params ellipsoid-params*)) +(define (ellipsoid-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const ellipsoid-params*) (convert-type -params ellipsoid-params*)) (k double 0)) (for-i i (: (: params axes) size) (set+ k (gsl-pow-2 (/ (gsl-vector-get x i) (gsl-vector-get (: params axes) i))))) (return (/ (sqrt k))))) -(define (ellipsoid-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const ellipsoid-params*) (convert-type params ellipsoid-params*)) +(define (ellipsoid-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const ellipsoid-params*) (convert-type -params ellipsoid-params*)) (vol double (volume-of-ball (: (: params axes) size)))) (for-i i (: (: params axes) size) (set* vol (gsl-vector-get (: params axes) i))) (return vol))) -(define (spheroid-extent-oracle r x params) (double (const gsl-rng*) (const gsl-vector*) void*) - (let* ((params (const spheroid-params*) (convert-type params spheroid-params*)) +(define (spheroid-extent-oracle r x -params) (double (const gsl-rng*) (const gsl-vector*) void*) + (let* ((params (const spheroid-params*) (convert-type -params spheroid-params*)) (xsub gsl-vector-const-view (gsl-vector-const-subvector x 1 (- (: x size) 1)))) (return (/ (sqrt (+ (gsl-pow-2 (gsl-blas-dnrm2 (address-of (struct-get xsub vector)))) (gsl-pow-2 (/ (gsl-vector-get x 0) (: params eccentricity))))))))) -(define (spheroid-true-volume dimension params) (double (unsigned int) void*) - (let* ((params (const spheroid-params*) (convert-type params spheroid-params*))) +(define (spheroid-true-volume dimension -params) (double (unsigned int) void*) + (let* ((params (const spheroid-params*) (convert-type -params spheroid-params*))) (return (* (volume-of-ball dimension) (: params eccentricity))))) |