static void
test_reg_system(const size_t n, const size_t p, const gsl_rng *r)
{
gsl_matrix *X = gsl_matrix_alloc(n, p);
gsl_vector *y = gsl_vector_alloc(n);
gsl_vector *c = gsl_vector_alloc(p);
gsl_vector *wts = gsl_vector_alloc(n);
gsl_multifit_linear_workspace *w = gsl_multifit_linear_alloc(n, p);
gsl_multifit_linear_workspace *wbig = gsl_multifit_linear_alloc(n + 10, p + 5);
gsl_vector *diagL = gsl_vector_alloc(p);
gsl_matrix *Lsqr = gsl_matrix_alloc(p, p);
gsl_matrix *Ltall = gsl_matrix_alloc(5*p, p);
gsl_matrix *L1 = gsl_matrix_alloc(p - 1, p);
gsl_matrix *L2 = gsl_matrix_alloc(p - 2, p);
gsl_matrix *L3 = gsl_matrix_alloc(p - 3, p);
gsl_matrix *L5 = gsl_matrix_alloc(p - 5, p);
size_t i;
/* generate random weights */
test_random_vector(wts, r, 0.0, 1.0);
/* generate well-conditioned system and test against OLS solution */
test_random_matrix(X, r, -1.0, 1.0);
test_random_vector(y, r, -1.0, 1.0);
test_reg1(X, y, NULL, 1.0e-10, w, "unweighted");
test_reg1(X, y, wts, 1.0e-10, w, "weighted");
/* generate ill-conditioned system */
test_random_matrix_ill(X, r);
test_random_vector(c, r, -1.0, 1.0);
/* compute y = X c + noise */
gsl_blas_dgemv(CblasNoTrans, 1.0, X, c, 0.0, y);
test_random_vector_noise(r, y);
/* random diag(L) vector */
test_random_vector(diagL, r, -2.0, 2.0);
/* random square and tall L matrices */
test_random_matrix(Lsqr, r, -2.0, 2.0);
test_random_matrix(Ltall, r, -2.0, 2.0);
gsl_multifit_linear_Lk(p, 1, L1);
gsl_multifit_linear_Lk(p, 2, L2);
gsl_multifit_linear_Lk(p, 3, L3);
gsl_multifit_linear_Lk(p, 5, L5);
for (i = 0; i < 3; ++i)
{
/*
* can't make lambda too small or normal equations
* approach won't work well
*/
double lambda = pow(10.0, -(double) i);
/* test unweighted */
test_reg2(lambda, X, y, NULL, 1.0e-6, w, "unweighted");
test_reg3(lambda, diagL, X, y, NULL, 1.0e-6, w, "unweighted");
test_reg4(lambda, Lsqr, X, y, NULL, 1.0e-8, w, "Lsqr unweighted");
test_reg4(lambda, Ltall, X, y, NULL, 1.0e-8, w, "Ltall unweighted");
test_reg4(lambda, L1, X, y, NULL, 1.0e-6, w, "L1 unweighted");
test_reg4(lambda, L2, X, y, NULL, 1.0e-6, w, "L2 unweighted");
test_reg4(lambda, L3, X, y, NULL, 1.0e-5, w, "L3 unweighted");
test_reg4(lambda, L5, X, y, NULL, 1.0e-4, w, "L5 unweighted");
/* test weighted */
test_reg2(lambda, X, y, wts, 1.0e-6, w, "weighted");
test_reg3(lambda, diagL, X, y, wts, 1.0e-6, w, "weighted");
test_reg4(lambda, Lsqr, X, y, wts, 1.0e-8, w, "Lsqr weighted");
test_reg4(lambda, L1, X, y, wts, 1.0e-6, w, "L1 weighted");
test_reg4(lambda, L2, X, y, wts, 1.0e-6, w, "L2 weighted");
test_reg4(lambda, L3, X, y, wts, 1.0e-5, w, "L3 weighted");
test_reg4(lambda, L5, X, y, wts, 1.0e-4, w, "L5 weighted");
/* test again with larger workspace */
test_reg2(lambda, X, y, NULL, 1.0e-6, wbig, "unweighted big");
test_reg3(lambda, diagL, X, y, NULL, 1.0e-6, wbig, "unweighted big");
test_reg4(lambda, Lsqr, X, y, NULL, 1.0e-8, wbig, "Lsqr unweighted big");
test_reg4(lambda, L1, X, y, NULL, 1.0e-6, wbig, "L1 unweighted big");
test_reg4(lambda, L2, X, y, NULL, 1.0e-6, wbig, "L2 unweighted big");
test_reg4(lambda, L3, X, y, NULL, 1.0e-5, wbig, "L3 unweighted big");
test_reg4(lambda, L5, X, y, NULL, 1.0e-4, wbig, "L5 unweighted big");
test_reg2(lambda, X, y, wts, 1.0e-6, wbig, "weighted big");
test_reg3(lambda, diagL, X, y, wts, 1.0e-6, wbig, "weighted big");
test_reg4(lambda, Lsqr, X, y, wts, 1.0e-8, wbig, "Lsqr weighted big");
test_reg4(lambda, L1, X, y, wts, 1.0e-6, wbig, "L1 weighted big");
test_reg4(lambda, L2, X, y, wts, 1.0e-6, wbig, "L2 weighted big");
test_reg4(lambda, L3, X, y, wts, 1.0e-5, wbig, "L3 weighted big");
test_reg4(lambda, L5, X, y, wts, 1.0e-4, wbig, "L5 weighted big");
}
gsl_matrix_free(X);
gsl_vector_free(y);
gsl_vector_free(c);
gsl_vector_free(wts);
gsl_vector_free(diagL);
gsl_matrix_free(Lsqr);
gsl_matrix_free(Ltall);
gsl_matrix_free(L1);
gsl_matrix_free(L2);
gsl_matrix_free(L3);
gsl_matrix_free(L5);
gsl_multifit_linear_free(w);
gsl_multifit_linear_free(wbig);
}
static void
test_reg_sobolev(const size_t p, const size_t kmax, const gsl_rng *r)
{
const double tol = 1.0e-12;
size_t i, j, k;
gsl_matrix *L = gsl_matrix_alloc(p, p);
gsl_matrix *LTL = gsl_matrix_alloc(p, p); /* Sobolov L^T L */
gsl_matrix *LTL2 = gsl_matrix_alloc(p, p); /* alternate L^T L */
gsl_matrix *Li = gsl_matrix_alloc(p, p);
gsl_multifit_linear_workspace *w = gsl_multifit_linear_alloc(p, p);
for (k = 0; k <= kmax; ++k)
{
gsl_vector *alpha = gsl_vector_alloc(k + 1);
/* random weights */
test_random_vector(alpha, r, 0.0, 1.0);
/* compute Sobolev matrix */
gsl_multifit_linear_Lsobolev(p, k, alpha, L, w);
/* compute LTL = L^T L */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L, L, 0.0, LTL);
/* now compute LTL2 = L^T L using individual L_i factors */
{
gsl_matrix_set_zero(LTL2);
for (i = 0; i <= k; ++i)
{
gsl_matrix_view Liv = gsl_matrix_submatrix(Li, 0, 0, p - i, p);
double ai = gsl_vector_get(alpha, i);
/* compute a_i L_i */
gsl_multifit_linear_Lk(p, i, &Liv.matrix);
gsl_matrix_scale(&Liv.matrix, ai);
/* LTL += L_i^T L_i */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, &Liv.matrix, &Liv.matrix, 1.0, LTL2);
}
}
/* test LTL = LTL2 */
for (i = 0; i < p; ++i)
{
for (j = 0; j < p; ++j)
{
double aij = gsl_matrix_get(LTL, i, j);
double bij = gsl_matrix_get(LTL2, i, j);
gsl_test_rel(aij, bij, tol, "sobolov k=%zu LTL(%zu,%zu)", k, i, j);
}
}
gsl_vector_free(alpha);
}
gsl_matrix_free(L);
gsl_matrix_free(Li);
gsl_matrix_free(LTL);
gsl_matrix_free(LTL2);
gsl_multifit_linear_free(w);
}
int
gsl_multifit_linear_Lsobolev(const size_t p, const size_t kmax,
const gsl_vector *alpha, gsl_matrix *L,
gsl_multifit_linear_workspace *work)
{
if (p > work->pmax)
{
GSL_ERROR("p is larger than workspace", GSL_EBADLEN);
}
else if (p <= kmax)
{
GSL_ERROR("p must be larger than derivative order", GSL_EBADLEN);
}
else if (kmax + 1 != alpha->size)
{
GSL_ERROR("alpha must be size kmax + 1", GSL_EBADLEN);
}
else if (p != L->size1)
{
GSL_ERROR("L matrix is wrong size", GSL_EBADLEN);
}
else if (L->size1 != L->size2)
{
GSL_ERROR("L matrix is not square", GSL_ENOTSQR);
}
else
{
int s;
size_t j, k;
gsl_vector_view d = gsl_matrix_diagonal(L);
const double alpha0 = gsl_vector_get(alpha, 0);
/* initialize L to alpha0^2 I */
gsl_matrix_set_zero(L);
gsl_vector_add_constant(&d.vector, alpha0 * alpha0);
for (k = 1; k <= kmax; ++k)
{
gsl_matrix_view Lk = gsl_matrix_submatrix(work->Q, 0, 0, p - k, p);
double ak = gsl_vector_get(alpha, k);
/* compute a_k L_k */
s = gsl_multifit_linear_Lk(p, k, &Lk.matrix);
if (s)
return s;
gsl_matrix_scale(&Lk.matrix, ak);
/* LTL += L_k^T L_k */
gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, &Lk.matrix, 1.0, L);
}
s = gsl_linalg_cholesky_decomp(L);
if (s)
return s;
/* copy Cholesky factor to upper triangle and zero out bottom */
gsl_matrix_transpose_tricpy('L', 1, L, L);
for (j = 0; j < p; ++j)
{
for (k = 0; k < j; ++k)
gsl_matrix_set(L, j, k, 0.0);
}
return GSL_SUCCESS;
}
}
