static void
check_traverser(const size_t n, const enum array_order order, gsl_bst_trav * trav, int data,
const char *desc, const gsl_bst_workspace * w)
{
int *prev, *cur, *next;
prev = gsl_bst_trav_prev(trav);
if (prev != NULL)
{
gsl_test(*prev > data, "bst %s[n=%zu,order=%d] %s traverser ahead of %d, but should be ahead of %d",
gsl_bst_name(w), n, order, desc, *prev, data);
}
gsl_bst_trav_next(trav);
cur = gsl_bst_trav_cur(trav);
gsl_test(*cur != data, "bst %s[n=%zu,order=%d] %s traverser at %d, but should be at %d",
gsl_bst_name(w), n, order, desc, *cur, data);
next = gsl_bst_trav_next(trav);
if (next != NULL)
{
gsl_test(*next < data, "bst %s[n=%zu,order=%d] %s traverser behind %d, but should be behind %d",
gsl_bst_name(w), n, order, desc, *next, data);
}
gsl_bst_trav_prev(trav);
}
void
test_fdf_e (const gsl_root_fdfsolver_type * T,
const char * description, gsl_function_fdf *fdf,
double root, double correct_root)
{
int status;
size_t iterations = 0;
double prev = 0 ;
gsl_root_fdfsolver * s = gsl_root_fdfsolver_alloc(T);
status = gsl_root_fdfsolver_set (s, fdf, root) ;
gsl_test (status, "%s (set), %s", T->name, description);
do
{
iterations++ ;
prev = gsl_root_fdfsolver_root(s);
gsl_root_fdfsolver_iterate (s);
status = gsl_root_test_delta(gsl_root_fdfsolver_root(s), prev,
EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (!status, "%s, %s", gsl_root_fdfsolver_name(s),
description, gsl_root_fdfsolver_root(s) - correct_root);
gsl_root_fdfsolver_free(s);
}
void
test_f (const gsl_min_fminimizer_type * T,
const char * description, gsl_function *f,
double lower_bound, double middle, double upper_bound,
double correct_minimum)
{
int status;
size_t iterations = 0;
double m, a, b;
double x_lower, x_upper;
gsl_min_fminimizer * s;
x_lower = lower_bound;
x_upper = upper_bound;
s = gsl_min_fminimizer_alloc (T) ;
gsl_min_fminimizer_set (s, f, middle, x_lower, x_upper) ;
do
{
iterations++ ;
status = gsl_min_fminimizer_iterate (s);
m = gsl_min_fminimizer_x_minimum(s);
a = gsl_min_fminimizer_x_lower(s);
b = gsl_min_fminimizer_x_upper(s);
#ifdef DEBUG
printf("%.12f %.18f %.12f %.18f %.12f %.18f status=%d\n",
a, GSL_FN_EVAL(f, a), m, GSL_FN_EVAL(f, m), b, GSL_FN_EVAL(f, b), status);
#endif
if (a > b)
gsl_test (GSL_FAILURE, "interval is invalid (%g,%g)", a, b);
if (m < a || m > b)
gsl_test (GSL_FAILURE, "m lies outside interval %g (%g,%g)", m, a, b);
if (status) break ;
status = gsl_min_test_interval (a, b, EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (status, "%s, %s (%g obs vs %g expected) ",
gsl_min_fminimizer_name(s), description,
gsl_min_fminimizer_x_minimum(s), correct_minimum);
/* check the validity of the returned result */
if (!WITHIN_TOL (m, correct_minimum, EPSREL, EPSABS))
{
gsl_test (GSL_FAILURE, "incorrect precision (%g obs vs %g expected)",
m, correct_minimum);
}
gsl_min_fminimizer_free (s);
}
void
test_f (const gsl_root_fsolver_type * T, const char * description, gsl_function *f,
double lower_bound, double upper_bound, double correct_root)
{
int status;
size_t iterations = 0;
double r, a, b;
double x_lower, x_upper;
gsl_root_fsolver * s;
x_lower = lower_bound;
x_upper = upper_bound;
s = gsl_root_fsolver_alloc(T);
gsl_root_fsolver_set(s, f, x_lower, x_upper) ;
do
{
iterations++ ;
gsl_root_fsolver_iterate (s);
r = gsl_root_fsolver_root(s);
a = gsl_root_fsolver_x_lower(s);
b = gsl_root_fsolver_x_upper(s);
if (a > b)
gsl_test (GSL_FAILURE, "interval is invalid (%g,%g)", a, b);
if (r < a || r > b)
gsl_test (GSL_FAILURE, "r lies outside interval %g (%g,%g)", r, a, b);
status = gsl_root_test_interval (a,b, EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (status, "%s, %s (%g obs vs %g expected) ",
gsl_root_fsolver_name(s), description,
gsl_root_fsolver_root(s), correct_root);
if (iterations == MAX_ITERATIONS)
{
gsl_test (GSL_FAILURE, "exceeded maximum number of iterations");
}
/* check the validity of the returned result */
if (!WITHIN_TOL (r, correct_root, EPSREL, EPSABS))
{
gsl_test (GSL_FAILURE, "incorrect precision (%g obs vs %g expected)",
r, correct_root);
}
gsl_root_fsolver_free(s);
}
static void
test_ops(const size_t M, const size_t N,
const double density, const gsl_rng *r)
{
size_t i, j;
int status;
/* test gsl_spmatrix_add */
{
gsl_spmatrix *A = create_random_sparse(M, N, density, r);
gsl_spmatrix *B = create_random_sparse(M, N, density, r);
gsl_spmatrix *A_ccs = gsl_spmatrix_ccs(A);
gsl_spmatrix *B_ccs = gsl_spmatrix_ccs(B);
gsl_spmatrix *C_ccs = gsl_spmatrix_alloc_nzmax(M, N, 1, GSL_SPMATRIX_CCS);
gsl_spmatrix *A_crs = gsl_spmatrix_crs(A);
gsl_spmatrix *B_crs = gsl_spmatrix_crs(B);
gsl_spmatrix *C_crs = gsl_spmatrix_alloc_nzmax(M, N, 1, GSL_SPMATRIX_CRS);
gsl_spmatrix_add(C_ccs, A_ccs, B_ccs);
gsl_spmatrix_add(C_crs, A_crs, B_crs);
status = 0;
for (i = 0; i < M; ++i)
{
for (j = 0; j < N; ++j)
{
double aij, bij, cij;
aij = gsl_spmatrix_get(A_ccs, i, j);
bij = gsl_spmatrix_get(B_ccs, i, j);
cij = gsl_spmatrix_get(C_ccs, i, j);
if (aij + bij != cij)
status = 1;
aij = gsl_spmatrix_get(A_crs, i, j);
bij = gsl_spmatrix_get(B_crs, i, j);
cij = gsl_spmatrix_get(C_crs, i, j);
if (aij + bij != cij)
status = 2;
}
}
gsl_test(status == 1, "test_ops: add M="F_ZU" N="F_ZU" CCS", M, N);
gsl_test(status == 2, "test_ops: add M="F_ZU" N="F_ZU" CRS", M, N);
gsl_spmatrix_free(A);
gsl_spmatrix_free(B);
gsl_spmatrix_free(A_ccs);
gsl_spmatrix_free(B_ccs);
gsl_spmatrix_free(C_ccs);
gsl_spmatrix_free(A_crs);
gsl_spmatrix_free(B_crs);
gsl_spmatrix_free(C_crs);
}
} /* test_ops() */
void test_nied2(void)
{
int status = 0;
double v[3];
/* int i; */
/* test in dimension 2 */
gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 2);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 );
gsl_qrng_free(g);
gsl_test (status, "Niederreiter d=2");
status = 0;
/* test in dimension 3 */
g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 3);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 || v[2] != 0.3125 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.5625 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 || v[2] != 0.6875 );
gsl_test (status, "Niederreiter d=3");
status = 0;
gsl_qrng_init(g);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 || v[2] != 0.3125 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.5625 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 || v[2] != 0.6875 );
gsl_qrng_free(g);
gsl_test (status, "Niederreiter d=3 (reinitialized)");
}
int
sys_driver (const gsl_odeiv_step_type * T,
const gsl_odeiv_system * sys,
double t0, double t1, double hstart,
double y[], double epsabs, double epsrel,
const char desc[])
{
/* This function evolves a system sys with stepper T from t0 to t1.
Step length is varied via error control with possibly different
absolute and relative error tolerances.
*/
int s = 0;
int steps = 0;
double t = t0;
double h = hstart;
gsl_odeiv_step * step = gsl_odeiv_step_alloc (T, sys->dimension);
gsl_odeiv_control *c =
gsl_odeiv_control_standard_new (epsabs, epsrel, 1.0, 0.0);
gsl_odeiv_evolve *e = gsl_odeiv_evolve_alloc (sys->dimension);
while (t < t1)
{
s = gsl_odeiv_evolve_apply (e, c, step, sys, &t, t1, &h, y);
if (s != GSL_SUCCESS)
{
gsl_test(s, "sys_driver: %s evolve_apply returned %d",
gsl_odeiv_step_name (step), s);
break;
}
if (steps > 1e7)
{
gsl_test(GSL_EMAXITER,
"sys_driver: %s evolve_apply reached maxiter at t=%g",
gsl_odeiv_step_name (step), t);
s = GSL_EMAXITER;
break;
}
steps++;
}
gsl_test(s, "%s %s [%g,%g], %d steps completed",
gsl_odeiv_step_name (step), desc, t0, t1, steps);
gsl_odeiv_evolve_free (e);
gsl_odeiv_control_free (c);
gsl_odeiv_step_free (step);
return s;
}
void
generic_rng_test (const gsl_rng_type * T)
{
gsl_rng *r = gsl_rng_alloc (T);
const char *name = gsl_rng_name (r);
unsigned long int kmax = 0, kmin = 1000;
double sigma = 0;
const unsigned long int ran_max = gsl_rng_max (r);
const unsigned long int ran_min = gsl_rng_min (r);
int status = rng_max_test (r, &kmax, ran_max);
gsl_test (status,
"%s, observed vs theoretical maximum (%lu vs %lu)",
name, kmax, ran_max);
status = rng_min_test (r, &kmin, ran_min, ran_max);
gsl_test (status,
"%s, observed vs theoretical minimum (%lu vs %lu)",
name, kmin, ran_min);
status = rng_sum_test (r, &sigma);
gsl_test (status,
"%s, sum test within acceptable sigma (observed %.2g sigma)",
name, sigma);
status = rng_bin_test (r, &sigma);
gsl_test (status,
"%s, bin test within acceptable chisq (observed %.2g sigma)",
name, sigma);
gsl_rng_set (r, 1); /* set seed to 1 */
status = rng_max_test (r, &kmax, ran_max);
gsl_rng_set (r, 1); /* set seed to 1 */
status |= rng_min_test (r, &kmin, ran_min, ran_max);
gsl_rng_set (r, 1); /* set seed to 1 */
status |= rng_sum_test (r, &sigma);
gsl_rng_set (r, 12345); /* set seed to a "typical" value */
status |= rng_max_test (r, &kmax, ran_max);
gsl_rng_set (r, 12345); /* set seed to a "typical" value */
status |= rng_min_test (r, &kmin, ran_min, ran_max);
gsl_rng_set (r, 12345); /* set seed to a "typical" value */
status |= rng_sum_test (r, &sigma);
gsl_test (status, "%s, maximum and sum tests for non-default seeds", name);
gsl_rng_free (r);
}
int main()
{
gsl_ieee_env_setup ();
gsl_test( test_dht_exact(), "Small Exact DHT");
gsl_test( test_dht_simple(), "Simple DHT");
gsl_test( test_dht_exp1(), "Exp J1 DHT");
gsl_test( test_dht_poly1(), "Poly J1 DHT");
exit (gsl_test_summary());
}
static void
test_random(const size_t N, const gsl_rng *r, const int compress)
{
const gsl_splinalg_itersolve_type *T = gsl_splinalg_itersolve_gmres;
const double tol = 1.0e-8;
int status;
gsl_spmatrix *A = create_random_sparse(N, N, 0.3, r);
gsl_spmatrix *B;
gsl_vector *b = gsl_vector_alloc(N);
gsl_vector *x = gsl_vector_calloc(N);
/* these random matrices require all N iterations to converge */
gsl_splinalg_itersolve *w = gsl_splinalg_itersolve_alloc(T, N, N);
const char *desc = gsl_splinalg_itersolve_name(w);
create_random_vector(b, r);
if (compress)
B = gsl_spmatrix_compcol(A);
else
B = A;
status = gsl_splinalg_itersolve_iterate(B, b, tol, x, w);
gsl_test(status, "%s random status s=%d N=%zu", desc, status, N);
/* check that the residual satisfies ||r|| <= tol*||b|| */
{
gsl_vector *res = gsl_vector_alloc(N);
double normr, normb;
gsl_vector_memcpy(res, b);
gsl_spblas_dgemv(CblasNoTrans, -1.0, A, x, 1.0, res);
normr = gsl_blas_dnrm2(res);
normb = gsl_blas_dnrm2(b);
status = (normr <= tol*normb) != 1;
gsl_test(status, "%s random residual N=%zu normr=%.12e normb=%.12e",
desc, N, normr, normb);
gsl_vector_free(res);
}
gsl_spmatrix_free(A);
gsl_vector_free(b);
gsl_vector_free(x);
gsl_splinalg_itersolve_free(w);
if (compress)
gsl_spmatrix_free(B);
} /* test_random() */
void
test_compress(const size_t M, const size_t N, const double density,
const gsl_rng *r)
{
int status;
size_t i, j;
gsl_spmatrix *m, *ccs, *crs, *ccstr;
m = create_random_sparse(M, N, density, r);
// Compress column sum duplicates
ccs = gsl_spmatrix_compress(m, GSL_SPMATRIX_CCS);
// Compress row sum duplicates
crs = gsl_spmatrix_compress(m, GSL_SPMATRIX_CRS);
status = 0;
for (i = 0; i < ccs->size1; i++)
for (j = 0; j < ccs->size2; j++)
if (gsl_spmatrix_get(crs, i, j) != gsl_spmatrix_get(ccs, i, j))
status = 1;
gsl_test(status, "test_compress: _compress at M=%zu, N=%zu", M, N);
return;
// Transpose in place by changing major
gsl_spmatrix_transpose(crs);
status = 0;
for (i = 0; i < crs->size1; i++)
for (j = 0; j < crs->size2; j++)
if (gsl_spmatrix_get(crs, i, j) != gsl_spmatrix_get(ccs, j, i))
status = 1;
gsl_test(status, "test_compress: transpose inplace at M=%zu, N=%zu", M, N);
gsl_spmatrix_transpose(crs);
// Convert by transpose copy
gsl_spmatrix_switch_major(crs, ccs);
status = 0;
for (i = 0; i < ccs->size1; i++)
for (j = 0; j < ccs->size2; j++)
if (gsl_spmatrix_get(crs, i, j) != gsl_spmatrix_get(ccs, i, j))
status = 1;
gsl_test(status, "test_compress: _switch_major at M=%zu, N=%zu", M, N);
gsl_spmatrix_free(m);
gsl_spmatrix_free(ccs);
gsl_spmatrix_free(crs);
gsl_spmatrix_free(ccstr);
return;
}
void
FUNCTION (test, trap) (void)
{
TYPE (gsl_block) * b = FUNCTION (gsl_block, alloc) (0);
gsl_test (b != 0, NAME (gsl_block) "_alloc traps zero length");
}
static int
test_bicubic_nonlinear()
{
int status;
double xarr[] = {1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0};
double yarr[] = {1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0};
/* least common multiple of x and y */
double zarr[] = { 1, 2, 3, 4, 5, 6, 7, 8,
2, 2, 6, 4, 10, 6, 14, 8,
3, 6, 3, 12, 15, 6, 21, 24,
4, 4, 12, 4, 20, 12, 28, 8,
5, 10, 15, 20, 5, 30, 35, 40,
6, 6, 6, 12, 30, 6, 42, 24,
7, 14, 21, 28, 35, 42, 7, 56,
8, 8, 24, 8, 40, 24, 56, 8};
double xval[] = {1.4, 2.3, 4.7, 3.3, 7.5, 6.6, 5.1};
double yval[] = {1.0, 1.8, 1.9, 2.5, 2.7, 4.1, 3.3};
/* results computed using GSL 1D cubic interpolation twice */
double zval[] = { 1.4, 3.11183531264736, 8.27114315792559, 5.03218982537718,
22.13230634702637, 23.63206834997871, 17.28553080971182 };
size_t xsize = sizeof(xarr) / sizeof(xarr[0]);
size_t ysize = sizeof(yarr) / sizeof(yarr[0]);
size_t test_size = sizeof(xval) / sizeof(xval[0]);
status = test_interp2d(xarr, yarr, zarr, xsize, ysize, xval, yval, zval,
NULL, NULL, NULL, NULL, NULL, test_size,
gsl_interp2d_bicubic);
gsl_test(status, "bicubic interpolation on nonlinear symmetric function");
return status;
}
void
rng_test (const gsl_rng_type * T, unsigned long int seed, unsigned int n,
unsigned long int result)
{
gsl_rng *r = gsl_rng_alloc (T);
unsigned int i;
unsigned long int k = 0;
int status;
if (seed != 0)
{
gsl_rng_set (r, seed);
}
for (i = 0; i < n; i++)
{
k = gsl_rng_get (r);
}
status = (k != result);
gsl_test (status, "%s, %u steps (%u observed vs %u expected)",
gsl_rng_name (r), n, k, result);
gsl_rng_free (r);
}
// This function contributed by Andrew W. Steiner <*****@*****.**>
int test_bicubic_nonlinear_nonsq() {
int status;
double xarr[] = {1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0};
double yarr[] = {1.0, 4.0, 6.0, 8.0, 10.0, 12.0, 14.0, 16.0};
double zarr[] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
2, 2, 6, 4, 10, 6, 14, 8, 11, 12,
3, 6, 3, 12, 15, 6, 21, 24, 13, 14,
4, 4, 12, 4, 20, 12, 28, 8, 15, 16,
5, 10, 15, 20, 5, 30, 35, 40, 17, 18,
6, 6, 6, 12, 30, 6, 42, 24, 19, 20,
7, 14, 21, 28, 35, 42, 7, 56, 21, 22,
8, 8, 24, 8, 40, 24, 56, 8, 23, 24};
double xval[] = {1.4, 2.3, 9.7, 3.3, 9.5, 6.6, 5.1};
double yval[] = {1.0, 1.8, 1.9, 2.5, 2.7, 4.1, 3.3};
// results computed using GSL 1D cubic interpolation twice
double zval[]={1.4,2.46782030941187003,10.7717721621846465,
4.80725067958096375,11.6747032398627297,
11.2619968682970111,9.00168877916872567};
size_t xsize = sizeof(xarr) / sizeof(xarr[0]);
size_t ysize = sizeof(yarr) / sizeof(yarr[0]);
size_t test_size = sizeof(xval) / sizeof(xval[0]);
status = test_interp2d(xarr, yarr, zarr, xsize, ysize, xval, yval, zval, NULL, NULL, NULL, NULL, NULL, test_size, interp2d_bicubic);
gsl_test(status, "bicubic interpolation on nonlinear symmetric function");
return status;
}
/*
* Tests bilinear interpolation with an asymmetric function, f(x,y)!=f(y,x),
* and off-diagonal interpolation points (x,y) where x and y may or may not
* be equal.
*/
static int
test_bilinear_asymmetric_z()
{
int status;
double xarr[] = {0.0, 1.0, 2.0, 3.0};
double yarr[] = {0.0, 1.0, 2.0, 3.0};
double zarr[] = {1.0, 1.1, 1.2, 1.4,
1.3, 1.4, 1.5, 1.7,
1.5, 1.6, 1.7, 1.9,
1.6, 1.9, 2.2, 2.3};
double xval[] = { 0.0, 0.5, 1.0, 1.5, 2.5, 3.0,
1.3954, 1.6476, 0.824957,
2.41108, 2.98619, 1.36485 };
double yval[] = {0.0, 0.5, 1.0, 1.5, 2.5, 3.0,
0.265371, 2.13849, 1.62114,
1.22198, 0.724681, 0.0596087 };
/* results computed using Mathematica 9.0.1.0 */
double zval[] = {1.0, 1.2, 1.4, 1.55, 2.025, 2.3,
1.2191513, 1.7242442248, 1.5067237,
1.626612, 1.6146423, 1.15436761};
size_t xsize = sizeof(xarr) / sizeof(xarr[0]);
size_t ysize = sizeof(yarr) / sizeof(yarr[0]);
size_t test_size = sizeof(xval) / sizeof(xval[0]);
status = test_interp2d(xarr, yarr, zarr, xsize, ysize, xval, yval, zval,
NULL, NULL, NULL, NULL, NULL, test_size,
gsl_interp2d_bilinear);
gsl_test(status, "bilinear interpolation with asymmetric z values");
return status;
}
void
FUNCTION (test, binary) (const size_t M, const size_t N)
{
TYPE (gsl_matrix) * m = FUNCTION (gsl_matrix, calloc) (M, N);
size_t i, j;
size_t k = 0;
char filename[] = "test.XXXXXX";
#if !defined( _MSC_VER )
int fd = mkstemp(filename);
#else
char * fd = _mktemp(filename);
# define fdopen fopen
#endif
{
FILE *f = fdopen(fd, "wb");
k = 0;
for (i = 0; i < M; i++)
{
for (j = 0; j < N; j++)
{
k++;
FUNCTION (gsl_matrix, set) (m, i, j, (BASE) k);
}
}
FUNCTION (gsl_matrix, fwrite) (f, m);
fclose (f);
}
{
FILE *f = fopen (filename, "rb");
TYPE (gsl_matrix) * mm = FUNCTION (gsl_matrix, alloc) (M, N);
status = 0;
FUNCTION (gsl_matrix, fread) (f, mm);
k = 0;
for (i = 0; i < M; i++)
{
for (j = 0; j < N; j++)
{
k++;
if (mm->data[i * N + j] != (BASE) k)
status = 1;
}
}
gsl_test (status, NAME (gsl_matrix) "_write and read");
fclose (f);
FUNCTION (gsl_matrix, free) (mm);
}
unlink(filename);
FUNCTION (gsl_matrix, free) (m);
}
void
test_shuffle (void)
{
double count[10][10] ;
int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
int i, j, status = 0;
for (i = 0; i < 10; i++)
{
for (j = 0; j < 10; j++)
{
count[i][j] = 0 ;
}
}
for (i = 0 ; i < N; i++)
{
for (j = 0; j < 10; j++)
x[j] = j ;
gsl_ran_shuffle (r_global, x, 10, sizeof(int)) ;
for (j = 0; j < 10; j++)
count[x[j]][j] ++ ;
}
for (i = 0; i < 10; i++)
{
for (j = 0; j < 10; j++)
{
double expected = N / 10.0 ;
double d = fabs(count[i][j] - expected);
double sigma = d / sqrt(expected) ;
if (sigma > 5 && d > 1)
{
status = 1 ;
gsl_test (status,
"gsl_ran_shuffle %d,%d (%g observed vs %g expected)",
i, j, count[i][j]/N, 0.1) ;
}
}
}
gsl_test (status, "gsl_ran_shuffle on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;
}
void
test_bspline(gsl_bspline_workspace * bw, gsl_bspline_deriv_workspace * dbw)
{
gsl_vector *B;
gsl_matrix *dB;
size_t i, j;
size_t n = 100;
size_t ncoeffs = gsl_bspline_ncoeffs(bw);
size_t order = gsl_bspline_order(bw);
size_t nbreak = gsl_bspline_nbreak(bw);
double a = gsl_bspline_breakpoint(0, bw);
double b = gsl_bspline_breakpoint(nbreak - 1, bw);
B = gsl_vector_alloc(ncoeffs);
dB = gsl_matrix_alloc(ncoeffs, 1);
/* Ensure B-splines form a partition of unity */
for (i = 0; i < n; i++)
{
double xi = a + (b - a) * (i / (n - 1.0));
double sum = 0;
gsl_bspline_eval(xi, B, bw);
for (j = 0; j < ncoeffs; j++)
{
double Bj = gsl_vector_get(B, j);
int s = (Bj < 0 || Bj > 1);
gsl_test(s,
"basis-spline coefficient %u is in range [0,1] for x=%g",
j, xi);
sum += Bj;
}
gsl_test_rel(sum, 1.0, order * GSL_DBL_EPSILON,
"basis-spline order %u is normalized for x=%g", order,
xi);
}
/* Ensure B-splines 0th derivatives agree with regular evaluation */
for (i = 0; i < n; i++)
{
double xi = a + (b - a) * (i / (n - 1.0));
gsl_bspline_eval(xi, B, bw);
gsl_bspline_deriv_eval(xi, 0, dB, bw, dbw);
for (j = 0; j < ncoeffs; j++)
{
gsl_test_abs(gsl_matrix_get(dB, j, 0), gsl_vector_get(B, j),
GSL_DBL_EPSILON,
"b-spline order %d basis #%d evaluation and 0th derivative consistent for x=%g",
order, j, xi);
}
}
gsl_vector_free(B);
gsl_matrix_free(dB);
}
int
test_f(const char * desc, gsl_multimin_function *f, initpt_function initpt,
const gsl_multimin_fminimizer_type *T)
{
int status;
size_t i, iter = 0;
gsl_vector *x = gsl_vector_alloc (f->n);
gsl_vector *step_size = gsl_vector_alloc (f->n);
gsl_multimin_fminimizer *s;
fcount = 0; gcount = 0;
(*initpt) (x);
for (i = 0; i < f->n; i++)
gsl_vector_set (step_size, i, 1);
s = gsl_multimin_fminimizer_alloc(T, f->n);
gsl_multimin_fminimizer_set (s, f, x, step_size);
#ifdef DEBUG
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
#endif
do
{
iter++;
status = gsl_multimin_fminimizer_iterate(s);
#ifdef DEBUG
printf("%i: \n",iter);
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
printf("f(x) %g\n", gsl_multimin_fminimizer_minimum (s));
printf("size: %g\n", gsl_multimin_fminimizer_size (s));
printf("\n");
#endif
status = gsl_multimin_test_size (gsl_multimin_fminimizer_size (s),
1e-3);
}
while (iter < 5000 && status == GSL_CONTINUE);
status |= (fabs(s->fval) > 1e-5);
gsl_test(status, "%s, on %s: %d iter (fn=%d), f(x)=%g",
gsl_multimin_fminimizer_name(s),desc, iter, fcount, s->fval);
gsl_multimin_fminimizer_free(s);
gsl_vector_free(x);
gsl_vector_free(step_size);
return status;
}
int
test_fdf(const char * desc,
gsl_multimin_function_fdf *f,
initpt_function initpt,
const gsl_multimin_fdfminimizer_type *T)
{
int status;
size_t iter = 0;
double step_size;
gsl_vector *x = gsl_vector_alloc (f->n);
gsl_multimin_fdfminimizer *s;
fcount = 0; gcount = 0;
(*initpt) (x);
step_size = 0.1 * gsl_blas_dnrm2 (x);
s = gsl_multimin_fdfminimizer_alloc(T, f->n);
gsl_multimin_fdfminimizer_set (s, f, x, step_size, 0.1);
#ifdef DEBUG
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
printf("g "); gsl_vector_fprintf (stdout, s->gradient, "%g");
#endif
do
{
iter++;
status = gsl_multimin_fdfminimizer_iterate(s);
#ifdef DEBUG
printf("%i: \n",iter);
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
printf("g "); gsl_vector_fprintf (stdout, s->gradient, "%g");
printf("f(x) %g\n",s->f);
printf("dx %g\n",gsl_blas_dnrm2(s->dx));
printf("\n");
#endif
status = gsl_multimin_test_gradient(s->gradient,1e-3);
}
while (iter < 5000 && status == GSL_CONTINUE);
status |= (fabs(s->f) > 1e-5);
gsl_test(status, "%s, on %s: %i iters (fn+g=%d+%d), f(x)=%g",
gsl_multimin_fdfminimizer_name(s),desc, iter, fcount, gcount, s->f);
gsl_multimin_fdfminimizer_free(s);
gsl_vector_free(x);
return status;
}
void
test (diff_fn * diff, gsl_function * f, gsl_function * df, double x,
const char * desc)
{
double result, abserr;
double expected = GSL_FN_EVAL (df, x);
(*diff) (f, x, &result, &abserr);
gsl_test_abs (result, expected, abserr, desc);
gsl_test (fabs(result-expected) > abserr, "%s, valid error estimate", desc);
}
void
testDiscretePDF (double (*f) (void), double (*pdf) (unsigned int),
const char *name)
{
double count[BINS], p[BINS];
unsigned int i;
int status = 0, status_i = 0;
for (i = 0; i < BINS; i++)
count[i] = 0;
for (i = 0; i < N; i++)
{
int r = (int) (f ());
if (r >= 0 && r < BINS)
count[r]++;
}
for (i = 0; i < BINS; i++)
p[i] = pdf (i);
for (i = 0; i < BINS; i++)
{
double d = fabs (count[i] - N * p[i]);
if (p[i] != 0)
{
double s = d / sqrt (N * p[i]);
status_i = (s > 5) && (d > 1);
}
else
{
status_i = (count[i] != 0);
}
status |= status_i;
if (status_i)
gsl_test (status_i, "%s i=%d (%g observed vs %g expected)",
name, i, count[i] / N, p[i]);
}
if (status == 0)
gsl_test (status, "%s, sampling against pdf over range [%d,%d) ",
name, 0, BINS);
}
void test_sobol(void)
{
int status = 0;
double v[3];
/* int i; */
/* test in dimension 2 */
gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_sobol, 2);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 );
gsl_qrng_free(g);
gsl_test (status, "Sobol d=2");
status = 0;
/* test in dimension 3 */
g = gsl_qrng_alloc(gsl_qrng_sobol, 3);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 || v[2] != 0.625 );
gsl_test (status, "Sobol d=3");
status = 0;
gsl_qrng_init(g);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 || v[2] != 0.625 );
gsl_qrng_free(g);
gsl_test (status, "Sobol d=3 (reinitialized)");
}
void
test_f_e (const gsl_min_fminimizer_type * T,
const char * description, gsl_function *f,
double lower_bound, double middle, double upper_bound,
double correct_minimum)
{
int status;
size_t iterations = 0;
double x_lower, x_upper;
double a, b;
gsl_min_fminimizer * s;
x_lower = lower_bound;
x_upper = upper_bound;
s = gsl_min_fminimizer_alloc (T) ;
status = gsl_min_fminimizer_set (s, f, middle, x_lower, x_upper) ;
if (status != GSL_SUCCESS)
{
gsl_min_fminimizer_free (s) ;
gsl_test (status == GSL_SUCCESS, "%s, %s", T->name, description);
return ;
}
do
{
iterations++ ;
gsl_min_fminimizer_iterate (s);
a = gsl_min_fminimizer_x_lower(s);
b = gsl_min_fminimizer_x_upper(s);
status = gsl_min_test_interval (a, b, EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (!status, "%s, %s", gsl_min_fminimizer_name(s), description,
gsl_min_fminimizer_x_minimum(s) - correct_minimum);
gsl_min_fminimizer_free (s);
}
void
test_choose (void)
{
double count[10] ;
int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
int y[3] = {0, 1, 2} ;
int i, j, status = 0;
for (i = 0; i < 10; i++)
{
count[i] = 0 ;
}
for (i = 0 ; i < N; i++)
{
for (j = 0; j < 10; j++)
x[j] = j ;
gsl_ran_choose (r_global, y, 3, x, 10, sizeof(int)) ;
for (j = 0; j < 3; j++)
count[y[j]]++ ;
}
for (i = 0; i < 10; i++)
{
double expected = 3.0 * N / 10.0 ;
double d = fabs(count[i] - expected);
double sigma = d / sqrt(expected) ;
if (sigma > 5 && d > 1)
{
status = 1 ;
gsl_test (status,
"gsl_ran_choose %d (%g observed vs %g expected)",
i, count[i]/N, 0.1) ;
}
}
gsl_test (status, "gsl_ran_choose (3) on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;
}
void
test_fdf (const gsl_root_fdfsolver_type * T, const char * description,
gsl_function_fdf *fdf, double root, double correct_root)
{
int status;
size_t iterations = 0;
double prev = 0 ;
gsl_root_fdfsolver * s = gsl_root_fdfsolver_alloc(T);
gsl_root_fdfsolver_set (s, fdf, root) ;
do
{
iterations++ ;
prev = gsl_root_fdfsolver_root(s);
gsl_root_fdfsolver_iterate (s);
status = gsl_root_test_delta(gsl_root_fdfsolver_root(s), prev,
EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (status, "%s, %s (%g obs vs %g expected) ",
gsl_root_fdfsolver_name(s), description,
gsl_root_fdfsolver_root(s), correct_root);
if (iterations == MAX_ITERATIONS)
{
gsl_test (GSL_FAILURE, "exceeded maximum number of iterations");
}
/* check the validity of the returned result */
if (!WITHIN_TOL (gsl_root_fdfsolver_root(s), correct_root,
EPSREL, EPSABS))
{
gsl_test (GSL_FAILURE, "incorrect precision (%g obs vs %g expected)",
gsl_root_fdfsolver_root(s), correct_root);
}
gsl_root_fdfsolver_free(s);
}
void
test_f_e (const gsl_root_fsolver_type * T,
const char * description, gsl_function *f,
double lower_bound, double upper_bound, double correct_root)
{
int status;
size_t iterations = 0;
double x_lower, x_upper;
gsl_root_fsolver * s;
x_lower = lower_bound;
x_upper = upper_bound;
s = gsl_root_fsolver_alloc(T);
status = gsl_root_fsolver_set(s, f, x_lower, x_upper) ;
gsl_test (status != GSL_EINVAL, "%s (set), %s", T->name, description);
if (status == GSL_EINVAL)
{
gsl_root_fsolver_free(s);
return ;
}
do
{
iterations++ ;
gsl_root_fsolver_iterate (s);
x_lower = gsl_root_fsolver_x_lower(s);
x_upper = gsl_root_fsolver_x_lower(s);
status = gsl_root_test_interval (x_lower, x_upper,
EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (!status, "%s, %s", gsl_root_fsolver_name(s), description,
gsl_root_fsolver_root(s) - correct_root);
gsl_root_fsolver_free(s);
}
void
FUNCTION(test_complex,bitreverse_order) (size_t stride, size_t n)
{
int status ;
size_t logn, i ;
BASE * tmp = (BASE *) malloc (2 * n * stride * sizeof (BASE));
BASE * data = (BASE *) malloc (2 * n * stride * sizeof (BASE));
BASE * reversed_data = (BASE *) malloc (2 * n * stride * sizeof (BASE));
for (i = 0; i < 2 * stride * n; i++)
{
data[i] = (BASE)i ;
}
memcpy (tmp, data, 2 * n * stride * sizeof(BASE)) ;
logn = 0 ; while (n > (1U<<logn)) {logn++ ; } ;
/* do a naive bit reversal as a baseline for testing the other routines */
for (i = 0; i < n; i++)
{
size_t i_tmp = i ;
size_t j = 0 ;
size_t bit ;
for (bit = 0; bit < logn; bit++)
{
j <<= 1; /* reverse shift i into j */
j |= i_tmp & 1;
i_tmp >>= 1;
}
reversed_data[2*j*stride] = data[2*i*stride] ;
reversed_data[2*j*stride+1] = data[2*i*stride+1] ;
}
FUNCTION(fft_complex,bitreverse_order) (data, stride, n, logn);
status = FUNCTION(compare_complex,results) ("naive bit reverse",
reversed_data,
"gsl_fft_complex_bitreverse_order",
data,
stride, n, 1e6);
gsl_test (status, "gsl_fft_complex_bitreverse_order, n = %d", n);
free (reversed_data) ;
free (data) ;
free (tmp) ;
}
void
FUNCTION (test, binary_noncontiguous) (const size_t M, const size_t N)
{
TYPE (gsl_matrix) * l = FUNCTION (gsl_matrix, calloc) (M+1, N+1);
VIEW (gsl_matrix, view) m = FUNCTION (gsl_matrix, submatrix) (l, 0, 0, M, N);
size_t i, j;
size_t k = 0;
{
FILE *f = fopen ("test.dat", "wb");
k = 0;
for (i = 0; i < M; i++)
{
for (j = 0; j < N; j++)
{
k++;
FUNCTION (gsl_matrix, set) (&m.matrix, i, j, (BASE) k);
}
}
FUNCTION (gsl_matrix, fwrite) (f, &m.matrix);
fclose (f);
}
{
FILE *f = fopen ("test.dat", "rb");
TYPE (gsl_matrix) * ll = FUNCTION (gsl_matrix, alloc) (M+1, N+1);
VIEW (gsl_matrix, view) mm = FUNCTION (gsl_matrix, submatrix) (ll, 0, 0, M, N);
status = 0;
FUNCTION (gsl_matrix, fread) (f, &mm.matrix);
k = 0;
for (i = 0; i < M; i++)
{
for (j = 0; j < N; j++)
{
k++;
if (FUNCTION (gsl_matrix, get) (&mm.matrix, i, j) != (BASE) k)
status = 1;
}
}
gsl_test (status, NAME (gsl_matrix) "_write and read (noncontiguous)");
fclose (f);
FUNCTION (gsl_matrix, free) (ll);
}
FUNCTION (gsl_matrix, free) (l);
}
