/* solve system with lambda = 0 and test against OLS solution */
static void
test_reg1(const gsl_matrix * X, const gsl_vector * y,
const gsl_vector * wts, const double tol,
gsl_multifit_linear_workspace * w, const char * desc)
{
const size_t n = X->size1;
const size_t p = X->size2;
double rnorm, snorm, chisq;
gsl_vector *c0 = gsl_vector_alloc(p);
gsl_vector *c1 = gsl_vector_alloc(p);
gsl_matrix *cov = gsl_matrix_alloc(p, p);
size_t j;
if (wts)
{
gsl_matrix *Xs = gsl_matrix_alloc(n, p);
gsl_vector *ys = gsl_vector_alloc(n);
gsl_multifit_wlinear(X, wts, y, c0, cov, &chisq, w);
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
gsl_multifit_linear_svd(Xs, w);
gsl_multifit_linear_solve(0.0, Xs, ys, c1, &rnorm, &snorm, w);
gsl_matrix_free(Xs);
gsl_vector_free(ys);
}
else
{
gsl_multifit_linear(X, y, c0, cov, &chisq, w);
gsl_multifit_linear_svd(X, w);
gsl_multifit_linear_solve(0.0, X, y, c1, &rnorm, &snorm, w);
}
gsl_test_rel(rnorm*rnorm, chisq, tol,
"test_reg1: %s, lambda = 0, n=%zu p=%zu chisq", desc, n, p);
/* test c0 = c1 */
for (j = 0; j < p; ++j)
{
double c0j = gsl_vector_get(c0, j);
double c1j = gsl_vector_get(c1, j);
gsl_test_rel(c1j, c0j, tol, "test_reg1: %s, lambda = 0, n=%zu p=%zu c0/c1",
desc, n, p);
}
gsl_vector_free(c0);
gsl_vector_free(c1);
gsl_matrix_free(cov);
}
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;
}
/* solve system with given lambda and L and test against
* normal equations solution */
static void
test_reg4(const double lambda, const gsl_matrix * L, const gsl_matrix * X,
const gsl_vector * y, const gsl_vector * wts, const double tol,
gsl_multifit_linear_workspace * w, const char *desc)
{
const size_t m = L->size1;
const size_t n = X->size1;
const size_t p = X->size2;
double rnorm0, snorm0;
double rnorm1, snorm1;
gsl_vector *c0 = gsl_vector_alloc(p);
gsl_vector *c1 = gsl_vector_alloc(p);
gsl_matrix *LTL = gsl_matrix_alloc(p, p); /* L^T L */
gsl_matrix *XTX = gsl_matrix_alloc(p, p); /* X^T W X + lambda^2 L^T L */
gsl_vector *XTy = gsl_vector_alloc(p); /* X^T W y */
gsl_permutation *perm = gsl_permutation_alloc(p);
gsl_matrix *Xs = (m < p) ? gsl_matrix_alloc(n - (p - m), m) : gsl_matrix_alloc(n, p);
gsl_vector *ys = (m < p) ? gsl_vector_alloc(n - (p - m)) : gsl_vector_alloc(n);
gsl_matrix *M = (m < p) ? gsl_matrix_alloc(n, p) : gsl_matrix_alloc(m, p);
gsl_vector *cs = (m < p) ? gsl_vector_alloc(m) : gsl_vector_alloc(p);
gsl_matrix *WX = gsl_matrix_alloc(n, p);
gsl_vector *Wy = gsl_vector_alloc(n);
gsl_vector *Lc = gsl_vector_alloc(m);
gsl_vector *r = gsl_vector_alloc(n);
gsl_matrix *LQR = gsl_matrix_alloc(m, p);
gsl_vector *Ltau = gsl_vector_alloc(GSL_MIN(m, p));
int signum;
size_t j;
/* compute WX = sqrt(W) X, Wy = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, WX, Wy, w);
/* construct XTy = X^T W y */
gsl_blas_dgemv(CblasTrans, 1.0, WX, Wy, 0.0, XTy);
/* construct XTX = X^T W X + lambda^2 L^T L */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L, L, 0.0, LTL);
gsl_matrix_scale(LTL, lambda * lambda);
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, WX, WX, 0.0, XTX);
gsl_matrix_add(XTX, LTL);
/* solve XTX c = XTy with LU decomp */
gsl_linalg_LU_decomp(XTX, perm, &signum);
gsl_linalg_LU_solve(XTX, perm, XTy, c0);
/* solve with reg routine */
gsl_matrix_memcpy(LQR, L);
gsl_multifit_linear_L_decomp(LQR, Ltau);
gsl_multifit_linear_wstdform2(LQR, Ltau, X, wts, y, Xs, ys, M, w);
gsl_multifit_linear_svd(Xs, w);
gsl_multifit_linear_solve(lambda, Xs, ys, cs, &rnorm0, &snorm0, w);
gsl_multifit_linear_wgenform2(LQR, Ltau, X, wts, y, cs, M, c1, w);
/* test snorm = ||L c1|| */
gsl_blas_dgemv(CblasNoTrans, 1.0, L, c1, 0.0, Lc);
snorm1 = gsl_blas_dnrm2(Lc);
gsl_test_rel(snorm0, snorm1, tol, "test_reg4: %s snorm lambda=%g", desc, lambda);
/* test rnorm = ||y - X c1||_W */
gsl_vector_memcpy(r, Wy);
gsl_blas_dgemv(CblasNoTrans, -1.0, WX, c1, 1.0, r);
rnorm1 = gsl_blas_dnrm2(r);
gsl_test_rel(rnorm0, rnorm1, tol, "test_reg4: %s rnorm lambda=%g", desc, lambda);
/* test c0 = c1 */
for (j = 0; j < p; ++j)
{
double c0j = gsl_vector_get(c0, j);
double c1j = gsl_vector_get(c1, j);
gsl_test_rel(c1j, c0j, tol, "test_reg4: %s lambda=%g n=%zu p=%zu j=%zu",
desc, lambda, n, p, j);
}
gsl_matrix_free(LTL);
gsl_matrix_free(XTX);
gsl_vector_free(XTy);
gsl_vector_free(c0);
gsl_vector_free(c1);
gsl_permutation_free(perm);
gsl_matrix_free(Xs);
gsl_vector_free(ys);
gsl_vector_free(cs);
gsl_matrix_free(M);
gsl_vector_free(Lc);
gsl_matrix_free(WX);
gsl_vector_free(Wy);
gsl_vector_free(r);
gsl_matrix_free(LQR);
gsl_vector_free(Ltau);
}
/* solve system with given lambda and L = diag(L) and test against
* normal equations solution */
static void
test_reg3(const double lambda, const gsl_vector * L, const gsl_matrix * X,
const gsl_vector * y, const gsl_vector * wts, const double tol,
gsl_multifit_linear_workspace * w, const char * desc)
{
const size_t n = X->size1;
const size_t p = X->size2;
double rnorm0, snorm0;
double rnorm1, snorm1;
gsl_vector *c0 = gsl_vector_alloc(p);
gsl_vector *c1 = gsl_vector_alloc(p);
gsl_matrix *XTX = gsl_matrix_alloc(p, p); /* X^T W X + lambda^2 L^T L */
gsl_vector *XTy = gsl_vector_alloc(p); /* X^T W y */
gsl_matrix *Xs = gsl_matrix_alloc(n, p); /* standard form X~ */
gsl_vector *ys = gsl_vector_alloc(n); /* standard form y~ */
gsl_vector *Lc = gsl_vector_alloc(p);
gsl_vector *r = gsl_vector_alloc(n);
gsl_permutation *perm = gsl_permutation_alloc(p);
int signum;
size_t j;
/* compute Xs = sqrt(W) X, ys = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
/* construct XTy = X^T W y */
gsl_blas_dgemv(CblasTrans, 1.0, Xs, ys, 0.0, XTy);
/* construct XTX = X^T W X + lambda^2 L^T L */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, Xs, Xs, 0.0, XTX);
for (j = 0; j < p; ++j)
{
double lj = gsl_vector_get(L, j);
*gsl_matrix_ptr(XTX, j, j) += pow(lambda * lj, 2.0);
}
/* solve XTX c = XTy with LU decomp */
gsl_linalg_LU_decomp(XTX, perm, &signum);
gsl_linalg_LU_solve(XTX, perm, XTy, c0);
/* solve with reg routine */
gsl_multifit_linear_wstdform1(L, X, wts, y, Xs, ys, w);
gsl_multifit_linear_svd(Xs, w);
gsl_multifit_linear_solve(lambda, Xs, ys, c1, &rnorm0, &snorm0, w);
gsl_multifit_linear_genform1(L, c1, c1, w);
/* test snorm = ||L c1|| */
gsl_vector_memcpy(Lc, c1);
gsl_vector_mul(Lc, L);
snorm1 = gsl_blas_dnrm2(Lc);
gsl_test_rel(snorm0, snorm1, tol, "test_reg3: %s, snorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test rnorm = ||y - X c1||, compute again Xs = sqrt(W) X and ys = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
gsl_vector_memcpy(r, ys);
gsl_blas_dgemv(CblasNoTrans, -1.0, Xs, c1, 1.0, r);
rnorm1 = gsl_blas_dnrm2(r);
gsl_test_rel(rnorm0, rnorm1, tol, "test_reg3: %s, rnorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test c0 = c1 */
for (j = 0; j < p; ++j)
{
double c0j = gsl_vector_get(c0, j);
double c1j = gsl_vector_get(c1, j);
gsl_test_rel(c1j, c0j, tol, "test_reg3: %s, c0/c1 j=%zu lambda=%g n=%zu p=%zu",
desc, j, lambda, n, p);
}
gsl_matrix_free(Xs);
gsl_matrix_free(XTX);
gsl_vector_free(XTy);
gsl_vector_free(c0);
gsl_vector_free(c1);
gsl_vector_free(Lc);
gsl_vector_free(ys);
gsl_vector_free(r);
gsl_permutation_free(perm);
}
/* solve standard form system with given lambda and test against
* normal equations solution, L = I */
static void
test_reg2(const double lambda, const gsl_matrix * X, const gsl_vector * y,
const gsl_vector * wts, const double tol,
gsl_multifit_linear_workspace * w, const char * desc)
{
const size_t n = X->size1;
const size_t p = X->size2;
double rnorm0, snorm0;
double rnorm1, snorm1;
gsl_vector *c0 = gsl_vector_alloc(p);
gsl_vector *c1 = gsl_vector_alloc(p);
gsl_matrix *XTX = gsl_matrix_alloc(p, p); /* X^T W X + lambda^2 I */
gsl_vector *XTy = gsl_vector_alloc(p); /* X^T W y */
gsl_matrix *Xs = gsl_matrix_alloc(n, p);
gsl_vector *ys = gsl_vector_alloc(n);
gsl_vector_view xtx_diag = gsl_matrix_diagonal(XTX);
gsl_permutation *perm = gsl_permutation_alloc(p);
gsl_vector *r = gsl_vector_alloc(n);
int signum;
size_t j;
/* compute Xs = sqrt(W) X and ys = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
/* construct XTy = X^T W y */
gsl_blas_dgemv(CblasTrans, 1.0, Xs, ys, 0.0, XTy);
/* construct XTX = X^T W X + lambda^2 I */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, Xs, Xs, 0.0, XTX);
gsl_vector_add_constant(&xtx_diag.vector, lambda*lambda);
/* solve XTX c = XTy with LU decomp */
gsl_linalg_LU_decomp(XTX, perm, &signum);
gsl_linalg_LU_solve(XTX, perm, XTy, c0);
/* compute SVD of X */
gsl_multifit_linear_svd(Xs, w);
/* solve regularized standard form system with lambda */
gsl_multifit_linear_solve(lambda, Xs, ys, c1, &rnorm0, &snorm0, w);
/* test snorm = ||c1|| */
snorm1 = gsl_blas_dnrm2(c1);
gsl_test_rel(snorm0, snorm1, tol, "test_reg2: %s, snorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test rnorm = ||y - X c1|| */
gsl_vector_memcpy(r, ys);
gsl_blas_dgemv(CblasNoTrans, -1.0, Xs, c1, 1.0, r);
rnorm1 = gsl_blas_dnrm2(r);
gsl_test_rel(rnorm0, rnorm1, tol, "test_reg2: %s, rnorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test c0 = c1 */
for (j = 0; j < p; ++j)
{
double c0j = gsl_vector_get(c0, j);
double c1j = gsl_vector_get(c1, j);
gsl_test_rel(c1j, c0j, tol, "test_reg2: %s, c0/c1 lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
}
gsl_matrix_free(XTX);
gsl_vector_free(XTy);
gsl_matrix_free(Xs);
gsl_vector_free(ys);
gsl_vector_free(c0);
gsl_vector_free(c1);
gsl_vector_free(r);
gsl_permutation_free(perm);
}
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() */
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;
}