int
gsl_multifit_linear_stdform2 (const gsl_matrix * LQR,
const gsl_vector * Ltau,
const gsl_matrix * X,
const gsl_vector * y,
gsl_matrix * Xs,
gsl_vector * ys,
gsl_matrix * M,
gsl_multifit_linear_workspace * work)
{
int status;
status = gsl_multifit_linear_wstdform2(LQR, Ltau, X, NULL, y, Xs, ys, M, work);
return status;
}
/* 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);
}
