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 int
test_shaw_system(gsl_rng *rng_p, const size_t n, const size_t p,
const double lambda_expected,
gsl_vector *rhs)
{
const size_t npoints = 1000; /* number of points on L-curve */
const double tol1 = 1.0e-12;
const double tol2 = 1.0e-10;
const double tol3 = 1.0e-5;
gsl_vector * reg_param = gsl_vector_alloc(npoints);
gsl_vector * rho = gsl_vector_alloc(npoints);
gsl_vector * eta = gsl_vector_alloc(npoints);
gsl_matrix * X = gsl_matrix_alloc(n, p);
gsl_matrix * cov = gsl_matrix_alloc(p, p);
gsl_vector * c = gsl_vector_alloc(p);
gsl_vector * ytmp = gsl_vector_alloc(n);
gsl_vector * y;
gsl_vector * r = gsl_vector_alloc(n);
gsl_multifit_linear_workspace * work =
gsl_multifit_linear_alloc (n, p);
size_t reg_idx, i;
double lambda, rnorm, snorm;
/* build design matrix */
shaw_system(X, ytmp);
if (rhs)
y = rhs;
else
{
y = ytmp;
/* add random noise to exact rhs vector */
test_random_vector_noise(rng_p, y);
}
/* SVD decomposition */
gsl_multifit_linear_svd(X, work);
/* calculate L-curve */
gsl_multifit_linear_lcurve(y, reg_param, rho, eta, work);
/* test rho and eta vectors */
for (i = 0; i < npoints; ++i)
{
double rhoi = gsl_vector_get(rho, i);
double etai = gsl_vector_get(eta, i);
double lami = gsl_vector_get(reg_param, i);
/* solve regularized system and check for consistent rho/eta values */
gsl_multifit_linear_solve(lami, X, y, c, &rnorm, &snorm, work);
gsl_test_rel(rhoi, rnorm, tol3, "shaw rho n="F_ZU" p="F_ZU" lambda=%e",
n, p, lami);
gsl_test_rel(etai, snorm, tol1, "shaw eta n="F_ZU" p="F_ZU" lambda=%e",
n, p, lami);
}
/* calculate corner of L-curve */
gsl_multifit_linear_lcorner(rho, eta, ®_idx);
lambda = gsl_vector_get(reg_param, reg_idx);
/* test against known lambda value if given */
if (lambda_expected > 0.0)
{
gsl_test_rel(lambda, lambda_expected, tol1,
"shaw: n="F_ZU" p="F_ZU" L-curve corner lambda",
n, p);
}
/* compute regularized solution with optimal lambda */
gsl_multifit_linear_solve(lambda, X, y, c, &rnorm, &snorm, work);
/* compute residual norm ||y - X c|| */
gsl_vector_memcpy(r, y);
gsl_blas_dgemv(CblasNoTrans, 1.0, X, c, -1.0, r);
/* test rnorm value */
gsl_test_rel(rnorm, gsl_blas_dnrm2(r), tol2,
"shaw: n="F_ZU" p="F_ZU" rnorm", n, p);
/* test snorm value */
gsl_test_rel(snorm, gsl_blas_dnrm2(c), tol2,
"shaw: n="F_ZU" p="F_ZU" snorm", n, p);
gsl_matrix_free(X);
gsl_matrix_free(cov);
gsl_vector_free(reg_param);
gsl_vector_free(rho);
gsl_vector_free(eta);
gsl_vector_free(r);
gsl_vector_free(c);
gsl_vector_free(ytmp);
gsl_multifit_linear_free(work);
return 0;
} /* test_shaw_system() */
