static void SplineData_Init( SplineData **splinedata )
{
if(!splinedata) exit(1);
if(*splinedata) SplineData_Destroy(*splinedata);
(*splinedata)=XLALCalloc(1,sizeof(SplineData));
const int ncx = 159; // points in q
const int ncy = 49; // points in chi
(*splinedata)->ncx = ncx;
(*splinedata)->ncy = ncy;
// Set up B-spline basis for desired knots
double qvec[] = {1., 1.125, 1.25, 1.375, 1.5, 1.75, 2., 2.25, 2.5, 2.75, 3., 3.25, \
3.5, 3.75, 4., 4.25, 4.5, 4.75, 5., 5.5, 6., 6.5, 7., 7.5, 8., 8.5, \
9., 9.5, 10., 10.5, 11., 11.5, 12., 12.5, 13., 13.5, 14., 14.5, 15., \
15.5, 16., 16.5, 17., 17.5, 18., 18.5, 19., 19.5, 20., 20.5, 21., \
21.5, 22., 22.5, 23., 23.5, 24., 24.5, 25., 25.5, 26., 26.5, 27., \
27.5, 28., 28.5, 29., 29.5, 30., 30.5, 31., 31.5, 32., 32.5, 33., \
33.5, 34., 34.5, 35., 35.5, 36., 36.5, 37., 37.5, 38., 38.5, 39., \
39.5, 40., 41., 42., 43., 44., 45., 46., 47., 48., 49., 50., 51., \
52., 53., 54., 55., 56., 57., 58., 59., 60., 61., 62., 63., 64., 65., \
66., 67., 68., 69., 70., 71., 72., 73., 74., 75., 76., 77., 78., 79., \
80., 81., 82., 83., 84., 85., 86., 87., 88., 89., 90., 91., 92., 93., \
94., 95., 95.5, 96., 96.5, 97., 97.5, 98., 98.5, 98.75, 99., 99.25, \
99.5, 99.75, 100.};
double chivec[] = {-1., -0.975, -0.95, -0.925, -0.9, -0.875, -0.85, -0.825, -0.8, \
-0.775, -0.75, -0.725, -0.7, -0.675, -0.65, -0.625, -0.6, -0.55, \
-0.5, -0.45, -0.4, -0.35, -0.3, -0.25, -0.2, -0.15, -0.1, -0.05, 0., \
0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.325, 0.35, 0.375, 0.4, 0.425, \
0.45, 0.475, 0.5, 0.525, 0.55, 0.575, 0.6};
const size_t nbreak_x = ncx-2; // must have nbreak = n -2 for cubic splines
const size_t nbreak_y = ncy-2; // must have nbreak = n -2 for cubic splines
// allocate a cubic bspline workspace (k = 4)
gsl_bspline_workspace *bwx = gsl_bspline_alloc(4, nbreak_x);
gsl_bspline_workspace *bwy = gsl_bspline_alloc(4, nbreak_y);
// set breakpoints (and thus knots by hand)
gsl_vector *breakpts_x = gsl_vector_alloc(nbreak_x);
gsl_vector *breakpts_y = gsl_vector_alloc(nbreak_y);
for (UINT4 i=0; i<nbreak_x; i++)
gsl_vector_set(breakpts_x, i, qvec[i]);
for (UINT4 j=0; j<nbreak_y; j++)
gsl_vector_set(breakpts_y, j, chivec[j]);
gsl_bspline_knots(breakpts_x, bwx);
gsl_bspline_knots(breakpts_y, bwy);
gsl_vector_free(breakpts_x);
gsl_vector_free(breakpts_y);
(*splinedata)->bwx=bwx;
(*splinedata)->bwy=bwy;
}
static void SplineData_Init( SplineData **splinedata )
{
if(!splinedata) exit(1);
if(*splinedata) SplineData_Destroy(*splinedata);
(*splinedata)=XLALCalloc(1,sizeof(SplineData));
int ncx = 41+2; // points in q
int ncy = 21+2; // points in chi1
int ncz = 21+2; // points in chi2
(*splinedata)->ncx = ncx;
(*splinedata)->ncy = ncy;
(*splinedata)->ncz = ncz;
// Set up B-spline basis for desired knots
double qvec[] = {1., 1.125, 1.25, 1.375, 1.5, 1.625, 1.75, 1.875, 2., 2.25, 2.5, \
2.75, 3., 3.25, 3.5, 3.75, 4., 4.25, 4.5, 4.75, 5., 5.25, 5.5, 5.75, \
6., 6.25, 6.5, 6.75, 7., 7.25, 7.5, 7.75, 8., 8.25, 8.5, 8.75, 9., \
9.25, 9.5, 9.75, 10.};
double chi1vec[] = {-1., -0.95, -0.9, -0.85, -0.8, -0.75, -0.7, -0.6, -0.5, -0.4, -0.3, \
-0.2, -0.1, 0., 0.1, 0.2, 0.3, 0.4, 0.5, 0.55, 0.6};
double chi2vec[] = {-1., -0.95, -0.9, -0.85, -0.8, -0.75, -0.7, -0.6, -0.5, -0.4, -0.3, \
-0.2, -0.1, 0., 0.1, 0.2, 0.3, 0.4, 0.5, 0.55, 0.6};
const size_t nbreak_x = ncx-2; // must have nbreak = n-2 for cubic splines
const size_t nbreak_y = ncy-2; // must have nbreak = n-2 for cubic splines
const size_t nbreak_z = ncz-2; // must have nbreak = n-2 for cubic splines
// allocate a cubic bspline workspace (k = 4)
gsl_bspline_workspace *bwx = gsl_bspline_alloc(4, nbreak_x);
gsl_bspline_workspace *bwy = gsl_bspline_alloc(4, nbreak_y);
gsl_bspline_workspace *bwz = gsl_bspline_alloc(4, nbreak_z);
// set breakpoints (and thus knots by hand)
gsl_vector *breakpts_x = gsl_vector_alloc(nbreak_x);
gsl_vector *breakpts_y = gsl_vector_alloc(nbreak_y);
gsl_vector *breakpts_z = gsl_vector_alloc(nbreak_z);
for (UINT4 i=0; i<nbreak_x; i++)
gsl_vector_set(breakpts_x, i, qvec[i]);
for (UINT4 j=0; j<nbreak_y; j++)
gsl_vector_set(breakpts_y, j, chi1vec[j]);
for (UINT4 k=0; k<nbreak_z; k++)
gsl_vector_set(breakpts_z, k, chi2vec[k]);
gsl_bspline_knots(breakpts_x, bwx);
gsl_bspline_knots(breakpts_y, bwy);
gsl_bspline_knots(breakpts_z, bwz);
gsl_vector_free(breakpts_x);
gsl_vector_free(breakpts_y);
gsl_vector_free(breakpts_z);
(*splinedata)->bwx=bwx;
(*splinedata)->bwy=bwy;
(*splinedata)->bwz=bwz;
}
CAMLprim value ml_gsl_bspline_knots (value b, value w)
{
_DECLARE_VECTOR(b);
_CONVERT_VECTOR(b);
gsl_bspline_knots(&v_b, Bspline_val(w));
return Val_unit;
}
int gsl_bspline_deriv(double *x,
int *n,
int *degree,
int *nbreak,
int *order,
int *order_max,
double *x_min,
double *x_max,
double *quantile_vector,
int *knots_int,
double *Bx)
{
int k = *degree + 1; /* k in gsl */
int ncoeffs;
size_t i, j;
gsl_bspline_workspace *bw = gsl_bspline_alloc(k, *nbreak);
ncoeffs = (int)gsl_bspline_ncoeffs(bw);
gsl_vector *dBorder = gsl_vector_alloc(ncoeffs);
gsl_bspline_deriv_workspace *derivWS = gsl_bspline_deriv_alloc(k);
gsl_matrix *dB = gsl_matrix_alloc(ncoeffs, *order_max+1);
gsl_vector *quantile_vec = gsl_vector_alloc(*nbreak);
/* 7/12/10 added support for quantile knots */
if(*knots_int == 0) {
gsl_bspline_knots_uniform(*x_min, *x_max, bw);
} else {
for(i = 0; i < *nbreak; i++) gsl_vector_set(quantile_vec, i, quantile_vector[i]);
gsl_bspline_knots(quantile_vec, bw);
}
for (i = 0; i < *n; ++i)
{
/* compute B_j(xi) for all j */
gsl_bspline_deriv_eval(x[i], order[i], dB, bw, derivWS);
/* fill in row i of Bx */
gsl_matrix_get_col(dBorder, dB, order[i]);
for (j = 0; j < ncoeffs; ++j)
{
double Bj = gsl_vector_get(dBorder, j);
Bx[i*ncoeffs+j] = Bj;
}
}
gsl_bspline_free(bw);
gsl_vector_free(dBorder);
gsl_matrix_free(dB);
/* gsl_vector_free(quantile_vec);*/
gsl_bspline_deriv_free(derivWS);
return(0);
} /* main() */
static VALUE rb_gsl_bspline_knots(VALUE obj, VALUE b)
{
gsl_bspline_workspace *w;
Data_Get_Struct(obj, gsl_bspline_workspace, w);
#ifdef HAVE_NMATRIX_H
if (NM_IsNMatrix(b)) {
NM_DENSE_STORAGE *nm_bpts;
gsl_vector_view v;
nm_bpts = NM_STORAGE_DENSE(b);
v = gsl_vector_view_array((double*) nm_bpts->elements, NM_DENSE_COUNT(b));
gsl_bspline_knots(&v.vector, w);
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, w->knots);
}
#endif
gsl_vector *bpts;
CHECK_VECTOR(b);
Data_Get_Struct(b, gsl_vector, bpts);
gsl_bspline_knots(bpts, w);
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, w->knots);
}
int gsl_bspline(double *x,
int *n,
int *degree,
int *nbreak,
double *x_min,
double *x_max,
double *quantile_vector,
int *knots_int,
double *Bx)
{
int k = *degree + 1; /* k in gsl */
int ncoeffs;
int i, j;
gsl_bspline_workspace *bw = gsl_bspline_alloc(k, *nbreak);
ncoeffs = (int)gsl_bspline_ncoeffs(bw); /* *nbreak+k-2 */
gsl_vector *B = gsl_vector_alloc(ncoeffs);
gsl_vector *quantile_vec = gsl_vector_alloc(*nbreak);
/* 7/12/10 added support for quantile knots */
if(*knots_int == 0) {
gsl_bspline_knots_uniform(*x_min, *x_max, bw);
} else {
for(i = 0; i < *nbreak; i++) gsl_vector_set(quantile_vec, i, quantile_vector[i]);
gsl_bspline_knots(quantile_vec, bw);
}
for (i = 0; i < *n; ++i)
{
/* compute B_j(xi) for all j */
gsl_bspline_eval(x[i], B, bw);
/* fill in row i of Bx */
for (j = 0; j < ncoeffs; ++j)
{
double Bj = gsl_vector_get(B, j);
Bx[i*ncoeffs+j] = Bj; /* Bx:*n-by-(*nbreak+*degree-1) */
}
}
gsl_bspline_free(bw);
gsl_vector_free(B);
gsl_vector_free(quantile_vec);
return(0);
} /* main() */
int
main (int argc, char **argv)
{
int status = 0;
size_t order, breakpoints, i;
gsl_ieee_env_setup ();
argc = 0; /* prevent warnings about unused parameters */
argv = 0;
for (order = 1; order < 10; order++)
{
for (breakpoints = 2; breakpoints < 100; breakpoints++)
{
double a = -1.23 * order, b = 45.6 * order;
gsl_bspline_workspace *bw = gsl_bspline_alloc (order, breakpoints);
gsl_bspline_knots_uniform (a, b, bw);
test_bspline (bw);
gsl_bspline_free (bw);
}
}
for (order = 1; order < 10; order++)
{
for (breakpoints = 2; breakpoints < 100; breakpoints++)
{
double a = -1.23 * order, b = 45.6 * order;
gsl_bspline_workspace *bw = gsl_bspline_alloc (order, breakpoints);
gsl_vector *k = gsl_vector_alloc (breakpoints);
for (i = 0; i < breakpoints; i++)
{
double f, x;
f = sqrt (i / (breakpoints - 1.0));
x = (1 - f) * a + f * b;
gsl_vector_set (k, i, x);
};
gsl_bspline_knots (k, bw);
test_bspline (bw);
gsl_vector_free (k);
gsl_bspline_free (bw);
}
}
exit (gsl_test_summary ());
}
/**
* Recalculate the B-spline knots
*/
void BSpline::resetKnots()
{
bool isUniform = getAttribute("Uniform").asBool();
std::vector<double> breakPoints;
if ( isUniform )
{
// create uniform knots in the interval [StartX, EndX]
double startX = getAttribute("StartX").asDouble();
double endX = getAttribute("EndX").asDouble();
gsl_bspline_knots_uniform( startX, endX, m_bsplineWorkspace.get() );
getGSLBreakPoints( breakPoints );
storeAttributeValue( "BreakPoints", Attribute(breakPoints) );
}
else
{
// set the break points from BreakPoints vector attribute, update other attributes
breakPoints = getAttribute( "BreakPoints" ).asVector();
// check that points are in ascending order
double prev = breakPoints[0];
for(size_t i = 1; i < breakPoints.size(); ++i)
{
double next = breakPoints[i];
if ( next <= prev )
{
throw std::invalid_argument("BreakPoints must be in ascending order.");
}
prev = next;
}
int nbreaks = getAttribute( "NBreak" ).asInt();
// if number of break points change do necessary updates
if ( static_cast<size_t>(nbreaks) != breakPoints.size() )
{
storeAttributeValue("NBreak", Attribute(static_cast<int>(breakPoints.size())) );
resetGSLObjects();
resetParameters();
}
GSLVector bp = breakPoints;
gsl_bspline_knots( bp.gsl(), m_bsplineWorkspace.get() );
storeAttributeValue( "StartX", Attribute(breakPoints.front()) );
storeAttributeValue( "EndX", Attribute(breakPoints.back()) );
}
}
int
gsl_bspline_knots_greville (const gsl_vector *abscissae,
gsl_bspline_workspace *w,
double *abserr)
{
int s;
/* Check incoming arguments satisfy mandatory algorithmic assumptions */
if (w->k < 2)
GSL_ERROR ("w->k must be at least 2", GSL_EINVAL);
else if (abscissae->size < 2)
GSL_ERROR ("abscissae->size must be at least 2", GSL_EINVAL);
else if (w->nbreak != abscissae->size - w->k + 2)
GSL_ERROR ("w->nbreak must equal abscissae->size - w->k + 2", GSL_EINVAL);
if (w->nbreak == 2)
{
/* No flexibility in abscissae values possible in this degenerate case */
s = gsl_bspline_knots_uniform (
gsl_vector_get (abscissae, 0),
gsl_vector_get (abscissae, abscissae->size - 1), w);
}
else
{
double * storage;
gsl_matrix_view A;
gsl_vector_view tau, b, x, r;
size_t i, j;
/* Constants derived from the B-spline workspace and abscissae details */
const size_t km2 = w->k - 2;
const size_t M = abscissae->size - 2;
const size_t N = w->nbreak - 2;
const double invkm1 = 1.0 / w->km1;
/* Allocate working storage and prepare multiple, zero-filled views */
storage = (double *) calloc (M*N + 2*N + 2*M, sizeof (double));
if (storage == 0)
GSL_ERROR ("failed to allocate working storage", GSL_ENOMEM);
A = gsl_matrix_view_array (storage, M, N);
tau = gsl_vector_view_array (storage + M*N, N);
b = gsl_vector_view_array (storage + M*N + N, M);
x = gsl_vector_view_array (storage + M*N + N + M, N);
r = gsl_vector_view_array (storage + M*N + N + M + N, M);
/* Build matrix from interior breakpoints to interior Greville abscissae.
* For example, when w->k = 4 and w->nbreak = 7 the matrix is
* [ 1, 0, 0, 0, 0;
* 2/3, 1/3, 0, 0, 0;
* 1/3, 1/3, 1/3, 0, 0;
* 0, 1/3, 1/3, 1/3, 0;
* 0, 0, 1/3, 1/3, 1/3;
* 0, 0, 0, 1/3, 2/3;
* 0, 0, 0, 0, 1 ]
* but only center formed as first/last breakpoint is known.
*/
for (j = 0; j < N; ++j)
for (i = 0; i <= km2; ++i)
gsl_matrix_set (&A.matrix, i+j, j, invkm1);
/* Copy interior collocation points from abscissae into b */
for (i = 0; i < M; ++i)
gsl_vector_set (&b.vector, i, gsl_vector_get (abscissae, i+1));
/* Adjust b to account for constraint columns not stored in A */
for (i = 0; i < km2; ++i)
{
double * const v = gsl_vector_ptr (&b.vector, i);
*v -= (1 - (i+1)*invkm1) * gsl_vector_get (abscissae, 0);
}
for (i = 0; i < km2; ++i)
{
double * const v = gsl_vector_ptr (&b.vector, M - km2 + i);
*v -= (i+1)*invkm1 * gsl_vector_get (abscissae, abscissae->size - 1);
}
/* Perform linear least squares to determine interior breakpoints */
s = gsl_linalg_QR_decomp (&A.matrix, &tau.vector)
|| gsl_linalg_QR_lssolve (&A.matrix, &tau.vector,
&b.vector, &x.vector, &r.vector);
if (s)
{
free (storage);
return s;
}
/* "Expand" solution x by adding known first and last breakpoints. */
x = gsl_vector_view_array_with_stride (
gsl_vector_ptr (&x.vector, 0) - x.vector.stride,
x.vector.stride, x.vector.size + 2);
gsl_vector_set (&x.vector, 0, gsl_vector_get (abscissae, 0));
gsl_vector_set (&x.vector, x.vector.size - 1,
gsl_vector_get (abscissae, abscissae->size - 1));
/* Finally, initialize workspace knots using the now-known breakpoints */
s = gsl_bspline_knots (&x.vector, w);
free (storage);
}
/* Sum absolute errors in the resulting vs requested interior abscissae */
/* Provided as a fit quality metric which may be monitored by callers */
if (!s && abserr)
{
size_t i;
*abserr = 0;
for (i = 1; i < abscissae->size - 1; ++i)
*abserr += fabs ( gsl_bspline_greville_abscissa (i, w)
- gsl_vector_get (abscissae, i) );
}
return s;
}
TransformationModelBSpline::TransformationModelBSpline(
const TransformationModel::DataPoints & data, const Param & params)
{
params_ = params;
Param defaults;
getDefaultParameters(defaults);
params_.setDefaults(defaults);
if (data.size() < 4) // TODO: check number
{
throw Exception::IllegalArgument(__FILE__, __LINE__, __PRETTY_FUNCTION__, "'b_spline' model needs at least four data points");
}
Size num_breakpoints = params_.getValue("num_breakpoints");
String break_positions = params_.getValue("break_positions");
if ((break_positions != "uniform") && (break_positions != "quantiles"))
{
throw Exception::IllegalArgument(__FILE__, __LINE__, __PRETTY_FUNCTION__, "parameter 'break_positions' for 'b_spline' model must be 'uniform' or 'quantiles'");
}
size_ = data.size();
x_ = gsl_vector_alloc(size_);
y_ = gsl_vector_alloc(size_);
w_ = gsl_vector_alloc(size_);
for (size_t i = 0; i < size_; ++i)
{
gsl_vector_set(x_, i, data[i].first);
gsl_vector_set(y_, i, data[i].second);
gsl_vector_set(w_, i, 1.0); // TODO: non-uniform weights
}
gsl_vector_minmax(x_, &xmin_, &xmax_);
// set up cubic (k = 4) spline workspace:
if (num_breakpoints < 2)
{
num_breakpoints = 2;
LOG_WARN << "Warning: Increased parameter 'num_breakpoints' to 2 (minimum)." << endl;
}
else if (num_breakpoints > size_ - 2)
{
num_breakpoints = size_ - 2;
LOG_WARN << "Warning: Decreased parameter 'num_breakpoints' to " + String(num_breakpoints) + " (maximum for this number of data points)." << endl;
}
workspace_ = gsl_bspline_alloc(4, num_breakpoints);
if (break_positions == "uniform")
{
gsl_bspline_knots_uniform(xmin_, xmax_, workspace_);
}
else
{
vector<double> quantiles(num_breakpoints, 1.0);
double step = 1.0 / (num_breakpoints - 1);
for (Size i = 0; i < num_breakpoints - 1; ++i)
{
quantiles[i] = i * step;
}
gsl_vector * breakpoints;
breakpoints = gsl_vector_alloc(num_breakpoints);
getQuantiles_(x_, quantiles, breakpoints);
gsl_bspline_knots(breakpoints, workspace_);
gsl_vector_free(breakpoints);
}
ncoeffs_ = gsl_bspline_ncoeffs(workspace_);
gsl_vector_minmax(workspace_->knots, &xmin_, &xmax_);
computeFit_();
}
//spline locations held fixed in Mpc^-1; CMB basically fixed P(k) in these units
void dopksmoothbspline_(double *kvals, double *lnpklinear, double *lnpksmooth, int *npts) {
double kmaxsuppress = 0.01*0.7;
size_t n, ncoeffs, nbreak;
gsl_bspline_workspace *bw;
gsl_vector *B;
gsl_vector *c, *w, *x, *y;
gsl_matrix *X, *cov;
gsl_multifit_linear_workspace *mw;
double deltak,lastk;
int i,j,countkeep;
nbreak = 9;
gsl_vector *mybreaks = gsl_vector_alloc(nbreak);
gsl_vector_set(mybreaks,0,(0.001*0.7));
gsl_vector_set(mybreaks,1,(0.025*0.7));
gsl_vector_set(mybreaks,2,(0.075*0.7));
gsl_vector_set(mybreaks,3,(0.125*0.7));
gsl_vector_set(mybreaks,4,(0.175*0.7));
gsl_vector_set(mybreaks,5,(0.225*0.7));
gsl_vector_set(mybreaks,6,(0.275*0.7));
gsl_vector_set(mybreaks,7,(0.325*0.7));
gsl_vector_set(mybreaks,8,(0.375*0.7));
countkeep = 0;
for(i=0;i<(*npts);i++) {
if((kvals[i]) >= gsl_vector_get(mybreaks,0) && (kvals[i]) <= gsl_vector_get(mybreaks,nbreak-1)) {
countkeep += 1;
}
}
n = countkeep;
ncoeffs = nbreak + 2;
/* allocate a cubic bspline workspace (k = 4) */
bw = gsl_bspline_alloc(4, nbreak);
B = gsl_vector_alloc(ncoeffs);
x = gsl_vector_alloc(n);
y = gsl_vector_alloc(n);
X = gsl_matrix_alloc(n, ncoeffs);
c = gsl_vector_alloc(ncoeffs);
w = gsl_vector_alloc(n);
cov = gsl_matrix_alloc(ncoeffs, ncoeffs);
mw = gsl_multifit_linear_alloc(n, ncoeffs);
i=0;
for(j=0;j<(*npts);j++) {
if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) {
gsl_vector_set(x,i,(kvals[j]));
gsl_vector_set(y,i,exp(lnpklinear[j])*pow(kvals[j],1.5));
if(j>0) {
deltak = kvals[j] - kvals[j-1];
}
else {
deltak = kvals[0];
if(kvals[1] - kvals[0] < deltak) {
deltak = kvals[1]-kvals[0];
}
}
gsl_vector_set(w,i,deltak);
i+=1;
}
}
gsl_bspline_knots(mybreaks,bw);
for(i=0;i<n;i++) {
double xi = gsl_vector_get(x,i);
gsl_bspline_eval(xi,B,bw);
for(j=0;j<ncoeffs;j++) {
double Bj = gsl_vector_get(B,j);
gsl_matrix_set(X,i,j,Bj);
}
}
//do fit
double yi,yierr,chisq;
gsl_multifit_wlinear(X,w,y,c,cov,&chisq,mw);
i = 0;
for(j=0;j<(*npts);j++) {
if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) {
gsl_bspline_eval(gsl_vector_get(x,i),B,bw);
gsl_multifit_linear_est(B,c,cov,&yi,&yierr);
lnpksmooth[j] = log(yi*pow(kvals[j],-1.5));
i += 1;
}
else {
lnpksmooth[j] = lnpklinear[j];
}
//spline is wacky at small k -- suppress difference at k < 0.01
if(kvals[j] < kmaxsuppress) {
lnpksmooth[j] = lnpklinear[j];
}
}
assert(i==n);
gsl_bspline_free(bw);
gsl_vector_free(B);
gsl_vector_free(x);
gsl_vector_free(y);
gsl_vector_free(mybreaks);
gsl_matrix_free(X);
gsl_vector_free(c);
gsl_vector_free(w);
gsl_matrix_free(cov);
gsl_multifit_linear_free(mw);
}
int
main(int argc, char **argv)
{
size_t order, breakpoints, i;
gsl_ieee_env_setup();
argc = 0; /* prevent warnings about unused parameters */
argv = 0;
for (order = 1; order < 10; order++)
{
for (breakpoints = 2; breakpoints < 100; breakpoints++)
{
double a = -1.23 * order, b = 45.6 * order;
gsl_bspline_workspace *bw = gsl_bspline_alloc(order, breakpoints);
gsl_bspline_deriv_workspace *dbw = gsl_bspline_deriv_alloc(order);
gsl_bspline_knots_uniform(a, b, bw);
test_bspline(bw, dbw);
gsl_bspline_deriv_free(dbw);
gsl_bspline_free(bw);
}
}
for (order = 1; order < 10; order++)
{
for (breakpoints = 2; breakpoints < 100; breakpoints++)
{
double a = -1.23 * order, b = 45.6 * order;
gsl_bspline_workspace *bw = gsl_bspline_alloc(order, breakpoints);
gsl_bspline_deriv_workspace *dbw = gsl_bspline_deriv_alloc(order);
gsl_vector *k = gsl_vector_alloc(breakpoints);
for (i = 0; i < breakpoints; i++)
{
double f, x;
f = sqrt(i / (breakpoints - 1.0));
x = (1 - f) * a + f * b;
gsl_vector_set(k, i, x);
};
gsl_bspline_knots(k, bw);
test_bspline(bw, dbw);
gsl_vector_free(k);
gsl_bspline_deriv_free(dbw);
gsl_bspline_free(bw);
}
}
/* Spot check known 0th, 1st, 2nd derivative
evaluations for a particular k = 2 case. */
{
size_t i, j; /* looping */
const double xloc[4] = { 0.0, 1.0, 6.0, 7.0};
const double deriv[4][3] =
{
{ -1.0/2.0, 1.0/2.0, 0.0 },
{ -1.0/2.0, 1.0/2.0, 0.0 },
{ 0.0, -1.0/5.0, 1.0/5.0 },
{ 0.0, -1.0/5.0, 1.0/5.0 }
};
gsl_bspline_workspace *bw = gsl_bspline_alloc(2, 3);
gsl_bspline_deriv_workspace *dbw = gsl_bspline_deriv_alloc(2);
gsl_matrix *dB = gsl_matrix_alloc(gsl_bspline_ncoeffs(bw),
gsl_bspline_order(bw) + 1);
gsl_vector *breakpts = gsl_vector_alloc(3);
gsl_vector_set(breakpts, 0, 0.0);
gsl_vector_set(breakpts, 1, 2.0);
gsl_vector_set(breakpts, 2, 7.0);
gsl_bspline_knots(breakpts, bw);
for (i = 0; i < 4; ++i) /* at each location */
{
/* Initialize dB with poison to ensure we overwrite it */
gsl_matrix_set_all(dB, GSL_NAN);
gsl_bspline_deriv_eval(xloc[i], gsl_bspline_order(bw), dB, bw, dbw);
for (j = 0; j < gsl_bspline_ncoeffs(bw) ; ++j)
{
/* check basis function 1st deriv */
gsl_test_abs(gsl_matrix_get(dB, j, 1), deriv[i][j], GSL_DBL_EPSILON,
"b-spline k=%d basis #%d derivative %d at x = %f",
gsl_bspline_order(bw), j, 1, xloc[i]);
}
for (j = 0; j < gsl_bspline_ncoeffs(bw); ++j)
{
/* check k order basis function has k-th deriv equal to 0 */
gsl_test_abs(gsl_matrix_get(dB, j, gsl_bspline_order(bw)), 0.0,
GSL_DBL_EPSILON,
"b-spline k=%d basis #%d derivative %d at x = %f",
gsl_bspline_order(bw), j, gsl_bspline_order(bw),
xloc[i]);
}
}
gsl_matrix_free(dB);
gsl_bspline_deriv_free(dbw);
gsl_bspline_free(bw);
gsl_vector_free(breakpts);
}
/* Spot check known 0th, 1st, 2nd derivative
evaluations for a particular k = 3 case. */
{
size_t i, j; /* looping */
const double xloc[5] = { 0.0, 5.0, 9.0, 12.0, 15.0 };
const double eval[5][6] =
{
{ 4./25., 69./100., 3./ 20. , 0. , 0. , 0. },
{ 0. , 4./21. , 143./210. , 9./70., 0. , 0. },
{ 0. , 0. , 3./ 10. , 7./10., 0. , 0. },
{ 0. , 0. , 0. , 3./4. , 1./4., 0. },
{ 0. , 0. , 0. , 1./3. , 5./9., 1./9. }
};
const double deriv[5][6] =
{
{ -4./25., 3./50., 1./ 10., 0. , 0. , 0. },
{ 0. , -2./21., 1./105., 3./35., 0. , 0. },
{ 0. , 0. , -1./5. , 1./ 5., 0. , 0. },
{ 0. , 0. , 0. , -1./ 6., 1./6. , 0. },
{ 0. , 0. , 0. , -1./ 9., 1./27., 2./27. }
};
const double deriv2[5][6] =
{
{ 2./25., -17./150., 1.0/30.0 , 0.0 , 0. , 0. },
{ 0. , 1./ 42., -11.0/210.0, 1.0/35.0, 0. , 0. },
{ 0. , 0. , 1.0/15.0 ,-11.0/90.0, 1./18. , 0. },
{ 0. , 0. , 0.0 , 1.0/54.0, -7./162., 2./81. },
{ 0. , 0. , 0.0 , 1.0/54.0, -7./162., 2./81. }
};
gsl_bspline_workspace *bw = gsl_bspline_alloc(3, 5);
gsl_bspline_deriv_workspace *dbw = gsl_bspline_deriv_alloc(3);
gsl_matrix *dB = gsl_matrix_alloc(gsl_bspline_ncoeffs(bw),
gsl_bspline_order(bw) + 1);
gsl_vector *breakpts = gsl_vector_alloc(5);
gsl_vector_set(breakpts, 0, -3.0);
gsl_vector_set(breakpts, 1, 2.0);
gsl_vector_set(breakpts, 2, 9.0);
gsl_vector_set(breakpts, 3, 12.0);
gsl_vector_set(breakpts, 4, 21.0);
gsl_bspline_knots(breakpts, bw);
for (i = 0; i < 5; ++i) /* at each location */
{
/* Initialize dB with poison to ensure we overwrite it */
gsl_matrix_set_all(dB, GSL_NAN);
gsl_bspline_deriv_eval(xloc[i], gsl_bspline_order(bw), dB, bw, dbw);
/* check basis function evaluation */
for (j = 0; j < gsl_bspline_ncoeffs(bw); ++j)
{
gsl_test_abs(gsl_matrix_get(dB, j, 0), eval[i][j], GSL_DBL_EPSILON,
"b-spline k=%d basis #%d derivative %d at x = %f",
gsl_bspline_order(bw), j, 0, xloc[i]);
}
/* check 1st derivative evaluation */
for (j = 0; j < gsl_bspline_ncoeffs(bw); ++j)
{
gsl_test_abs(gsl_matrix_get(dB, j, 1), deriv[i][j], GSL_DBL_EPSILON,
"b-spline k=%d basis #%d derivative %d at x = %f",
gsl_bspline_order(bw), j, 1, xloc[i]);
}
/* check 2nd derivative evaluation */
for (j = 0; j < gsl_bspline_ncoeffs(bw); ++j)
{
gsl_test_abs(gsl_matrix_get(dB, j, 2), deriv2[i][j], GSL_DBL_EPSILON,
"b-spline k=%d basis #%d derivative %d at x = %f",
gsl_bspline_order(bw), j, 2, xloc[i]);
}
}
gsl_matrix_free(dB);
gsl_bspline_deriv_free(dbw);
gsl_bspline_free(bw);
gsl_vector_free(breakpts);
}
/* Check Greville abscissae functionality on a non-uniform k=1 */
{
size_t i; /* looping */
/* Test parameters */
const size_t k = 1;
const double bpoint_data[] = { 0.0, 0.2, 0.5, 0.75, 1.0 };
const size_t nbreak = sizeof(bpoint_data)/sizeof(bpoint_data[0]);
/* Expected results */
const double abscissae_data[] = { 0.1, 0.35, 0.625, 0.875 };
const size_t nabscissae = sizeof(abscissae_data)/sizeof(abscissae_data[0]);
gsl_vector_const_view bpoints = gsl_vector_const_view_array(bpoint_data, nbreak);
gsl_bspline_workspace *w = gsl_bspline_alloc(k, nbreak);
gsl_bspline_knots((const gsl_vector *) &bpoints, w);
gsl_test_int(nabscissae, gsl_bspline_ncoeffs(w),
"b-spline k=%d number of abscissae", k);
for (i = 0; i < nabscissae; ++i)
{
gsl_test_abs(gsl_bspline_greville_abscissa(i, w), abscissae_data[i], 2*k*GSL_DBL_EPSILON,
"b-spline k=%d Greville abscissa #%d at x = %f", k, i, abscissae_data[i]);
}
gsl_bspline_free(w);
}
/* Check Greville abscissae functionality on a non-uniform k=2 */
{
size_t i; /* looping */
/* Test parameters */
const size_t k = 2;
const double bpoint_data[] = { 0.0, 0.2, 0.5, 0.75, 1.0 };
const size_t nbreak = sizeof(bpoint_data)/sizeof(bpoint_data[0]);
/* Expected results */
const double abscissae_data[] = { 0.0, 0.2, 0.5, 0.75, 1.0 };
const size_t nabscissae = sizeof(abscissae_data)/sizeof(abscissae_data[0]);
gsl_vector_const_view bpoints = gsl_vector_const_view_array(bpoint_data, nbreak);
gsl_bspline_workspace *w = gsl_bspline_alloc(k, nbreak);
gsl_bspline_knots((const gsl_vector *) &bpoints, w);
gsl_test_int(nabscissae, gsl_bspline_ncoeffs(w),
"b-spline k=%d number of abscissae", k);
for (i = 0; i < nabscissae; ++i)
{
gsl_test_abs(gsl_bspline_greville_abscissa(i, w), abscissae_data[i], 2*k*GSL_DBL_EPSILON,
"b-spline k=%d Greville abscissa #%d at x = %f", k, i, abscissae_data[i]);
}
gsl_bspline_free(w);
}
/* Check Greville abscissae functionality on non-uniform k=3 */
{
size_t i; /* looping */
/* Test parameters */
const size_t k = 3;
const double bpoint_data[] = { 0.0, 0.2, 0.5, 0.75, 1.0 };
const size_t nbreak = sizeof(bpoint_data)/sizeof(bpoint_data[0]);
/* Expected results */
const double abscissae_data[] = { 0.0, 1.0/10.0, 7.0/20.0,
5.0/ 8.0, 7.0/ 8.0, 1.0 };
const size_t nabscissae = sizeof(abscissae_data)/sizeof(abscissae_data[0]);
gsl_vector_const_view bpoints = gsl_vector_const_view_array(bpoint_data, nbreak);
gsl_bspline_workspace *w = gsl_bspline_alloc(k, nbreak);
gsl_bspline_knots((const gsl_vector *) &bpoints, w);
gsl_test_int(nabscissae, gsl_bspline_ncoeffs(w),
"b-spline k=%d number of abscissae", k);
for (i = 0; i < nabscissae; ++i)
{
gsl_test_abs(gsl_bspline_greville_abscissa(i, w), abscissae_data[i], 2*k*GSL_DBL_EPSILON,
"b-spline k=%d Greville abscissa #%d at x = %f", k, i, abscissae_data[i]);
}
gsl_bspline_free(w);
}
/* Check Greville abscissae functionality on non-uniform k=4 */
{
size_t i; /* looping */
/* Test parameters */
const size_t k = 4;
const double bpoint_data[] = { 0.0, 0.2, 0.5, 0.75, 1.0 };
const size_t nbreak = sizeof(bpoint_data)/sizeof(bpoint_data[0]);
/* Expected results */
const double abscissae_data[] = { 0.0, 1.0/15.0, 7.0/30.0, 29.0/60.0,
3.0/ 4.0, 11.0/12.0, 1.0 };
const size_t nabscissae = sizeof(abscissae_data)/sizeof(abscissae_data[0]);
gsl_vector_const_view bpoints = gsl_vector_const_view_array(bpoint_data, nbreak);
gsl_bspline_workspace *w = gsl_bspline_alloc(k, nbreak);
gsl_bspline_knots((const gsl_vector *) &bpoints, w);
gsl_test_int(nabscissae, gsl_bspline_ncoeffs(w),
"b-spline k=%d number of abscissae", k);
for (i = 0; i < nabscissae; ++i)
{
gsl_test_abs(gsl_bspline_greville_abscissa(i, w), abscissae_data[i], 2*k*GSL_DBL_EPSILON,
"b-spline k=%d Greville abscissa #%d at x = %f", k, i, abscissae_data[i]);
}
gsl_bspline_free(w);
}
exit(gsl_test_summary());
}
