/* 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
gsl_multifit_linear_stdform1 (const gsl_vector * L,
const gsl_matrix * X,
const gsl_vector * y,
gsl_matrix * Xs,
gsl_vector * ys,
gsl_multifit_linear_workspace * work)
{
int status;
status = gsl_multifit_linear_wstdform1(L, X, NULL, y, Xs, ys, 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);
}
/* 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);
}
