mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

(vector_scale, vector_scale_x): Renamed former to the

Browse source 
latter, since it modifies its argument.
(vector_scale_x, vector_sum_squares, scm_random_normal_vector_x):
Do not use scm_universal_vector_length for non-uniform vectors.
Use scm_f64vector_elements to access innards of uniform vectors.
This commit is contained in:
Marius Vollmer 2004-10-27 19:28:05 +00:00
parent faa0036593
commit 46d25cffa8
1 changed files with 57 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

64
libguile/random.c
View file

@ -33,6 +33,7 @@
#include "libguile/feature.h" #include "libguile/feature.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/unif.h" #include "libguile/unif.h"
#include "libguile/srfi-4.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/validate.h" #include "libguile/validate.h"
@ -426,34 +427,52 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
#if SCM_HAVE_ARRAYS #if SCM_HAVE_ARRAYS
static void static void
vector_scale (SCM v, double c) vector_scale_x (SCM v, double c)
{ {
int n = scm_to_int (scm_uniform_vector_length (v)); size_t n;
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) {
n = SCM_VECTOR_LENGTH (v);
while (n-- > 0)
SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c; SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c;
}
else else
while (--n >= 0) {
((double *) SCM_VELTS (v))[n] *= c; /* must be a f64vector. */
double *elts = scm_f64vector_elements (v);
n = scm_c_uniform_vector_length (v);
while (n-- > 0)
elts[n] *= c;
scm_uniform_vector_release (v);
}
} }
static double static double
vector_sum_squares (SCM v) vector_sum_squares (SCM v)
{ {
double x, sum = 0.0; double x, sum = 0.0;
int n = scm_to_int (scm_uniform_vector_length (v)); size_t n;
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) {
n = SCM_VECTOR_LENGTH (v);
while (n-- > 0)
{ {
x = SCM_REAL_VALUE (SCM_VELTS (v)[n]); x = SCM_REAL_VALUE (SCM_VELTS (v)[n]);
sum += x * x; sum += x * x;
} }
}
else else
while (--n >= 0)
{ {
x = ((double *) SCM_VELTS (v))[n]; /* must be a f64vector. */
double *elts = scm_f64vector_elements (v);
n = scm_c_uniform_vector_length (v);
while (n-- > 0)
{
x = elts[n];
sum += x * x; sum += x * x;
} }
scm_uniform_vector_release (v);
}
return sum; return sum;
} }
@ -477,7 +496,7 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0,
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, state); SCM_VALIDATE_RSTATE (2, state);
scm_random_normal_vector_x (v, state); scm_random_normal_vector_x (v, state);
vector_scale (v, vector_scale_x (v,
pow (scm_c_uniform01 (SCM_RSTATE (state)), pow (scm_c_uniform01 (SCM_RSTATE (state)),
1.0 / scm_to_int (scm_uniform_vector_length (v))) 1.0 / scm_to_int (scm_uniform_vector_length (v)))
/ sqrt (vector_sum_squares (v))); / sqrt (vector_sum_squares (v)));
@ -500,7 +519,7 @@ SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, state); SCM_VALIDATE_RSTATE (2, state);
scm_random_normal_vector_x (v, state); scm_random_normal_vector_x (v, state);
vector_scale (v, 1 / sqrt (vector_sum_squares (v))); vector_scale_x (v, 1 / sqrt (vector_sum_squares (v)));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -513,18 +532,27 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
"(i.e., with mean 0 and variance 1).") "(i.e., with mean 0 and variance 1).")
#define FUNC_NAME s_scm_random_normal_vector_x #define FUNC_NAME s_scm_random_normal_vector_x
{ {
int n; size_t n;
SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v);
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, state); SCM_VALIDATE_RSTATE (2, state);
n = scm_to_int (scm_uniform_vector_length (v));
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) {
SCM_VECTOR_SET (v, n, scm_from_double (scm_c_normal01 (SCM_RSTATE (state)))); n = SCM_VECTOR_LENGTH (v);
while (n-- > 0)
SCM_VECTOR_SET (v, n,
scm_from_double (scm_c_normal01 (SCM_RSTATE (state))));
}
else else
while (--n >= 0) {
((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); /* must be a f64vector. */
double *elts = scm_f64vector_elements (v);
n = scm_c_uniform_vector_length (v);
while (n-- > 0)
elts[n] = scm_c_normal01 (SCM_RSTATE (state));
scm_uniform_vector_release (v);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME