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() */
int
main()
{
const size_t n = 1000; /* number of observations */
const size_t p = 2; /* number of model parameters */
size_t i;
gsl_rng *r = gsl_rng_alloc(gsl_rng_default);
gsl_matrix *X = gsl_matrix_alloc(n, p);
gsl_vector *y = gsl_vector_alloc(n);
for (i = 0; i < n; ++i)
{
/* generate first random variable u */
double ui = 5.0 * gsl_ran_gaussian(r, 1.0);
/* set v = u + noise */
double vi = ui + gsl_ran_gaussian(r, 0.001);
/* set y = u + v + noise */
double yi = ui + vi + gsl_ran_gaussian(r, 1.0);
/* since u =~ v, the matrix X is ill-conditioned */
gsl_matrix_set(X, i, 0, ui);
gsl_matrix_set(X, i, 1, vi);
/* rhs vector */
gsl_vector_set(y, i, yi);
}
{
const size_t nL = 200; /* number of points on L-curve */
gsl_multifit_linear_workspace *w =
gsl_multifit_linear_alloc(n, p);
gsl_vector *c = gsl_vector_alloc(p); /* OLS solution */
gsl_vector *c_reg = gsl_vector_alloc(p); /* regularized solution */
gsl_vector *reg_param = gsl_vector_alloc(nL);
gsl_vector *rho = gsl_vector_alloc(nL); /* residual norms */
gsl_vector *eta = gsl_vector_alloc(nL); /* solution norms */
double lambda; /* optimal regularization parameter */
size_t reg_idx; /* index of optimal lambda */
double chisq, rnorm, snorm;
/* compute SVD of X */
gsl_multifit_linear_svd(X, w);
/* unregularized (standard) least squares fit, lambda = 0 */
gsl_multifit_linear_solve(0.0, X, y, c, &rnorm, &snorm, w);
chisq = pow(rnorm, 2.0);
fprintf(stderr, "=== Unregularized fit ===\n");
fprintf(stderr, "best fit: y = %g u + %g v\n",
gsl_vector_get(c, 0), gsl_vector_get(c, 1));
fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));
/* calculate L-curve and find its corner */
gsl_multifit_linear_lcurve(y, reg_param, rho, eta, w);
gsl_multifit_linear_lcorner(rho, eta, ®_idx);
/* store optimal regularization parameter */
lambda = gsl_vector_get(reg_param, reg_idx);
/* output L-curve */
for (i = 0; i < nL; ++i)
printf("%f %f\n", gsl_vector_get(rho, i), gsl_vector_get(eta, i));
/* output L-curve corner point */
printf("\n\n%f %f\n",
gsl_vector_get(rho, reg_idx),
gsl_vector_get(eta, reg_idx));
/* regularize with lambda */
gsl_multifit_linear_solve(lambda, X, y, c_reg, &rnorm, &snorm, w);
chisq = pow(rnorm, 2.0) + pow(lambda * snorm, 2.0);
fprintf(stderr, "=== Regularized fit ===\n");
fprintf(stderr, "optimal lambda: %g\n", lambda);
fprintf(stderr, "best fit: y = %g u + %g v\n",
gsl_vector_get(c_reg, 0), gsl_vector_get(c_reg, 1));
fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));
gsl_multifit_linear_free(w);
gsl_vector_free(c);
gsl_vector_free(c_reg);
gsl_vector_free(reg_param);
gsl_vector_free(rho);
gsl_vector_free(eta);
}
gsl_rng_free(r);
gsl_matrix_free(X);
gsl_vector_free(y);
return 0;
}
static int
secs2d_fit(void * vstate)
{
secs2d_state_t *state = (secs2d_state_t *) vstate;
const size_t npts = 200;
/* Note: to get a reasonable current map, use tol = 3e-1 */
const double tol = 1.0e-2;
gsl_vector *reg_param = gsl_vector_alloc(npts);
gsl_vector *rho = gsl_vector_alloc(npts);
gsl_vector *eta = gsl_vector_alloc(npts);
gsl_vector *G = gsl_vector_alloc(npts);
gsl_matrix_view A = gsl_matrix_submatrix(state->X, 0, 0, state->n, state->p);
gsl_vector_view b = gsl_vector_subvector(state->rhs, 0, state->n);
gsl_vector_view wts = gsl_vector_subvector(state->wts, 0, state->n);
double lambda_gcv, lambda_l, G_gcv;
double rnorm, snorm;
size_t i;
const char *lambda_file = "lambda.dat";
FILE *fp = fopen(lambda_file, "w");
double s0; /* largest singular value */
if (state->n < state->p)
return -1;
fprintf(stderr, "\n");
fprintf(stderr, "\t n = %zu\n", state->n);
fprintf(stderr, "\t p = %zu\n", state->p);
#if 1 /* TSVD */
{
double chisq;
size_t rank;
gsl_multifit_wlinear_tsvd(&A.matrix, &wts.vector, &b.vector, tol, state->c, state->cov,
&chisq, &rank, state->multifit_p);
rnorm = sqrt(chisq);
snorm = gsl_blas_dnrm2(state->c);
fprintf(stderr, "secs2d_fit: rank = %zu/%zu\n", rank, state->p);
}
#else /* Tikhonov / L-curve */
/* convert to standard form */
gsl_multifit_linear_applyW(&A.matrix, &wts.vector, &b.vector, &A.matrix, &b.vector);
fprintf(stderr, "\t computing SVD...");
/* compute SVD of A */
gsl_multifit_linear_svd(&A.matrix, state->multifit_p);
s0 = gsl_vector_get(state->multifit_p->S, 0);
fprintf(stderr, "done\n");
/* compute GCV curve */
gsl_multifit_linear_gcv(&b.vector, reg_param, G, &lambda_gcv, &G_gcv, state->multifit_p);
/* compute L-curve */
gsl_multifit_linear_lcurve(&b.vector, reg_param, rho, eta, state->multifit_p);
fprintf(stderr, "\t secs2d_fit: writing %s...", lambda_file);
for (i = 0; i < npts; ++i)
{
fprintf(fp, "%e %e %e %e\n",
gsl_vector_get(reg_param, i),
gsl_vector_get(rho, i),
gsl_vector_get(eta, i),
gsl_vector_get(G, i));
}
fprintf(stderr, "done\n");
gsl_multifit_linear_lcorner(rho, eta, &i);
lambda_l = gsl_vector_get(reg_param, i);
/* lower bound on lambda */
lambda_l = GSL_MAX(lambda_l, tol * s0);
/* solve regularized system with lambda_l */
gsl_multifit_linear_solve(lambda_l, &A.matrix, &b.vector, state->c, &rnorm, &snorm, state->multifit_p);
fprintf(stderr, "\t s0 = %.12e\n", s0);
fprintf(stderr, "\t lambda_l = %.12e\n", lambda_l);
fprintf(stderr, "\t lambda_gcv = %.12e\n", lambda_gcv);
fprintf(stderr, "\t rnorm = %.12e\n", rnorm);
fprintf(stderr, "\t snorm = %.12e\n", snorm);
fprintf(stderr, "\t cond(X) = %.12e\n", 1.0 / gsl_multifit_linear_rcond(state->multifit_p));
#endif
gsl_vector_free(reg_param);
gsl_vector_free(rho);
gsl_vector_free(eta);
gsl_vector_free(G);
fclose(fp);
return 0;
}
