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; }