void StripedDGamma::calcDijGammaYr( gsl_vector *res, const gsl_matrix *R,
size_t i, size_t j, const gsl_vector *yr ) {
size_t n_row = 0, k;
gsl_vector sub_yr, sub_res;
for (k = 0; k < myS->getBlocksN(); n_row += myS->getBlock(k)->getN(), k++) {
sub_yr = gsl_vector_const_subvector(yr, n_row * R->size2,
myS->getBlock(k)->getN() * R->size2).vector;
sub_res = gsl_vector_const_subvector(res, n_row * R->size2,
myS->getBlock(k)->getN() * R->size2).vector;
myLHDGamma[k]->calcDijGammaYr(&sub_res, R, i, j, &sub_yr);
}
}
int
gsl_linalg_QR_Qvec (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * v)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else if (v->size != M)
{
GSL_ERROR ("vector size must be M", GSL_EBADLEN);
}
else
{
size_t i;
/* compute Q^T v */
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector),
i, M - i);
gsl_vector_view w = gsl_vector_subvector (v, i, M - i);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_hv (ti, &h.vector, &w.vector);
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_householder_hv (double tau, const gsl_vector * v, gsl_vector * w)
{
/* applies a householder transformation v to vector w */
const size_t N = v->size;
if (tau == 0)
return GSL_SUCCESS ;
{
/* compute d = v'w */
double d0 = gsl_vector_get(w,0);
double d1, d;
gsl_vector_const_view v1 = gsl_vector_const_subvector(v, 1, N-1);
gsl_vector_view w1 = gsl_vector_subvector(w, 1, N-1);
gsl_blas_ddot (&v1.vector, &w1.vector, &d1);
d = d0 + d1;
/* compute w = w - tau (v) (v'w) */
{
double w0 = gsl_vector_get (w,0);
gsl_vector_set (w, 0, w0 - tau * d);
}
gsl_blas_daxpy (-tau * d, &v1.vector, &w1.vector);
}
return GSL_SUCCESS;
}
int
gsl_linalg_LQ_vecQ (const gsl_matrix * LQ, const gsl_vector * tau, gsl_vector * v)
{
const size_t N = LQ->size1;
const size_t M = LQ->size2;
if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else if (v->size != M)
{
GSL_ERROR ("vector size must be M", GSL_EBADLEN);
}
else
{
size_t i;
/* compute v Q^T */
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_row (LQ, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector),
i, M - i);
gsl_vector_view w = gsl_vector_subvector (v, i, M - i);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_hv (ti, &(h.vector), &(w.vector));
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_QR_QTmat (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * A)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else if (A->size1 != M)
{
GSL_ERROR ("matrix must have M rows", GSL_EBADLEN);
}
else
{
size_t i;
/* compute Q^T A */
for (i = 0; i < GSL_MIN (M, N); i++)
{
gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector), i, M - i);
gsl_matrix_view m = gsl_matrix_submatrix(A, i, 0, M - i, A->size2);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_hm (ti, &(h.vector), &(m.matrix));
}
return GSL_SUCCESS;
}
}
void mcmclib_Givens_representation_asymm(gsl_matrix* M, const gsl_vector* alpha12_sigma) {
const size_t n = M->size1;
const size_t offset = n*(n-1)/2;
gsl_matrix* P1 = gsl_matrix_alloc(n, n);
gsl_matrix* P2 = gsl_matrix_alloc(n, n);
gsl_vector_const_view alpha1 = gsl_vector_const_subvector(alpha12_sigma, 0, offset);
gsl_vector_const_view alpha2 = gsl_vector_const_subvector(alpha12_sigma, offset, offset);
gsl_vector_const_view sigma = gsl_vector_const_subvector(alpha12_sigma, 2*offset, n);
mcmclib_Givens_rotations(P1, &alpha1.vector);
mcmclib_Givens_rotations(P2, &alpha2.vector);
gsl_vector* sigmas = gsl_vector_alloc(n);
gsl_vector_memcpy(sigmas, &sigma.vector);
vSortDesc(sigmas);
anti_SVD(M, P1, P2, sigmas);
gsl_vector_free(sigmas);
gsl_matrix_free(P1);
gsl_matrix_free(P2);
}
void HLayeredBlWStructure::fillMatrixFromP( gsl_matrix* c, const gsl_vector* p ) {
size_t sum_np = 0, sum_nl = 0, l_1, j;
gsl_vector psub;
for (l_1 = 0; l_1 < getQ(); sum_np += getLayerNp(l_1),
sum_nl += getLayerLag(l_1), ++l_1) {
for (j = 0; j < getLayerLag(l_1); ++j) {
psub = gsl_vector_const_subvector(p, sum_np + j, getN()).vector;
gsl_matrix_set_col(c, j + sum_nl, &psub);
}
}
}
void StripedStructure::fillMatrixFromP( gsl_matrix* c, const gsl_vector* p ) {
size_t n_row = 0, sum_np = 0;
gsl_matrix_view sub_c;
for (size_t l = 0; l < getBlocksN();
sum_np += myStripe[l]->getNp(), n_row += getBlock(l)->getN(), l++) {
sub_c = gsl_matrix_submatrix(c, n_row, 0, getBlock(l)->getN(), c->size2);
gsl_vector_const_view sub_p = gsl_vector_const_subvector(p, sum_np,
myStripe[l]->getNp());
myStripe[l]->fillMatrixFromP(&sub_c.matrix, &sub_p.vector);
}
}
void StripedDGamma::calcYrtDgammaYr( gsl_matrix *grad, const gsl_matrix *R,
const gsl_vector *yr ) {
size_t n_row = 0, k;
gsl_matrix_set_zero(grad);
for (k = 0; k < myS->getBlocksN(); n_row += myS->getBlock(k)->getN(), k++) {
gsl_vector_const_view sub_yr = gsl_vector_const_subvector(yr, n_row * R->size2,
myS->getBlock(k)->getN() * R->size2);
myLHDGamma[k]->calcYrtDgammaYr(myTmpGrad, R, &sub_yr.vector);
gsl_matrix_add(grad, myTmpGrad);
}
}
void StripedStructure::multByGtUnweighted( gsl_vector* p, const gsl_matrix *Rt,
const gsl_vector *y, double alpha, double beta, bool skipFixedBlocks ){
size_t n_row = 0, sum_np = 0, d = Rt->size2;
gsl_vector subp, suby;
for (size_t l = 0; l < getBlocksN();
sum_np += myStripe[l]->getNp(), n_row += getBlock(l)->getN() * d, l++) {
suby = gsl_vector_const_subvector(y, n_row, getBlock(l)->getN() * d).vector;
subp = gsl_vector_subvector(p, sum_np, myStripe[l]->getNp()).vector;
myStripe[l]->multByGtUnweighted(&subp, Rt, &suby, alpha, beta,
skipFixedBlocks);
}
}
int
gsl_linalg_LQ_unpack (const gsl_matrix * LQ, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * L)
{
const size_t N = LQ->size1;
const size_t M = LQ->size2;
if (Q->size1 != M || Q->size2 != M)
{
GSL_ERROR ("Q matrix must be M x M", GSL_ENOTSQR);
}
else if (L->size1 != N || L->size2 != M)
{
GSL_ERROR ("R matrix must be N x M", GSL_ENOTSQR);
}
else if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else
{
size_t i, j, l_border;
/* Initialize Q to the identity */
gsl_matrix_set_identity (Q);
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_row (LQ, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector,
i, M - i);
gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_mh (ti, &h.vector, &m.matrix);
}
/* Form the lower triangular matrix L from a packed LQ matrix */
for (i = 0; i < N; i++)
{
l_border=GSL_MIN(i,M-1);
for (j = 0; j <= l_border ; j++)
gsl_matrix_set (L, i, j, gsl_matrix_get (LQ, i, j));
for (j = l_border+1; j < M; j++)
gsl_matrix_set (L, i, j, 0.0);
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_QR_unpack (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * R)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (Q->size1 != M || Q->size2 != M)
{
GSL_ERROR ("Q matrix must be M x M", GSL_ENOTSQR);
}
else if (R->size1 != M || R->size2 != N)
{
GSL_ERROR ("R matrix must be M x N", GSL_ENOTSQR);
}
else if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else
{
size_t i, j;
/* Initialize Q to the identity */
gsl_matrix_set_identity (Q);
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_column (QR, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector,
i, M - i);
gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_hm (ti, &h.vector, &m.matrix);
}
/* Form the right triangular matrix R from a packed QR matrix */
for (i = 0; i < M; i++)
{
for (j = 0; j < i && j < N; j++)
gsl_matrix_set (R, i, j, 0.0);
for (j = i; j < N; j++)
gsl_matrix_set (R, i, j, gsl_matrix_get (QR, i, j));
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_householder_hm (double tau, const gsl_vector * v, gsl_matrix * A)
{
/* applies a householder transformation v,tau to matrix m */
if (tau == 0.0)
{
return GSL_SUCCESS;
}
#ifdef USE_BLAS
{
gsl_vector_const_view v1 = gsl_vector_const_subvector (v, 1, v->size - 1);
gsl_matrix_view A1 = gsl_matrix_submatrix (A, 1, 0, A->size1 - 1, A->size2);
size_t j;
for (j = 0; j < A->size2; j++)
{
double wj = 0.0;
gsl_vector_view A1j = gsl_matrix_column(&A1.matrix, j);
gsl_blas_ddot (&A1j.vector, &v1.vector, &wj);
wj += gsl_matrix_get(A,0,j);
{
double A0j = gsl_matrix_get (A, 0, j);
gsl_matrix_set (A, 0, j, A0j - tau * wj);
}
gsl_blas_daxpy (-tau * wj, &v1.vector, &A1j.vector);
}
}
#else
{
size_t i, j;
for (j = 0; j < A->size2; j++)
{
/* Compute wj = Akj vk */
double wj = gsl_matrix_get(A,0,j);
for (i = 1; i < A->size1; i++) /* note, computed for v(0) = 1 above */
{
wj += gsl_matrix_get(A,i,j) * gsl_vector_get(v,i);
}
/* Aij = Aij - tau vi wj */
/* i = 0 */
{
double A0j = gsl_matrix_get (A, 0, j);
gsl_matrix_set (A, 0, j, A0j - tau * wj);
}
/* i = 1 .. M-1 */
for (i = 1; i < A->size1; i++)
{
double Aij = gsl_matrix_get (A, i, j);
double vi = gsl_vector_get (v, i);
gsl_matrix_set (A, i, j, Aij - tau * vi * wj);
}
}
}
#endif
return GSL_SUCCESS;
}
int
gsl_multifit_linear_wstdform2 (const gsl_matrix * LQR,
const gsl_vector * Ltau,
const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
gsl_matrix * Xs,
gsl_vector * ys,
gsl_matrix * M,
gsl_multifit_linear_workspace * work)
{
const size_t m = LQR->size1;
const size_t n = X->size1;
const size_t p = X->size2;
if (n > work->nmax || p > work->pmax)
{
GSL_ERROR("observation matrix larger than workspace", GSL_EBADLEN);
}
else if (p != LQR->size2)
{
GSL_ERROR("LQR and X matrices have different numbers of columns", GSL_EBADLEN);
}
else if (n != y->size)
{
GSL_ERROR("y vector does not match X", GSL_EBADLEN);
}
else if (w != NULL && n != w->size)
{
GSL_ERROR("weights vector must be length n", GSL_EBADLEN);
}
else if (m >= p) /* square or tall L matrix */
{
/* the sizes of Xs and ys depend on whether m >= p or m < p */
if (n != Xs->size1 || p != Xs->size2)
{
GSL_ERROR("Xs matrix must be n-by-p", GSL_EBADLEN);
}
else if (n != ys->size)
{
GSL_ERROR("ys vector must have length n", GSL_EBADLEN);
}
else
{
int status;
size_t i;
gsl_matrix_const_view R = gsl_matrix_const_submatrix(LQR, 0, 0, p, p);
/* compute Xs = sqrt(W) X and ys = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, Xs, ys);
if (status)
return status;
/* compute X~ = X R^{-1} using QR decomposition of L */
for (i = 0; i < n; ++i)
{
gsl_vector_view v = gsl_matrix_row(Xs, i);
/* solve: R^T y = X_i */
gsl_blas_dtrsv(CblasUpper, CblasTrans, CblasNonUnit, &R.matrix, &v.vector);
}
return GSL_SUCCESS;
}
}
else /* L matrix with m < p */
{
const size_t pm = p - m;
const size_t npm = n - pm;
/*
* This code closely follows section 2.6.1 of Hansen's
* "Regularization Tools" manual
*/
if (npm != Xs->size1 || m != Xs->size2)
{
GSL_ERROR("Xs matrix must be (n-p+m)-by-m", GSL_EBADLEN);
}
else if (npm != ys->size)
{
GSL_ERROR("ys vector must be of length (n-p+m)", GSL_EBADLEN);
}
else if (n != M->size1 || p != M->size2)
{
GSL_ERROR("M matrix must be n-by-p", GSL_EBADLEN);
}
else
{
int status;
gsl_matrix_view A = gsl_matrix_submatrix(work->A, 0, 0, n, p);
gsl_vector_view b = gsl_vector_subvector(work->t, 0, n);
gsl_matrix_view LTQR = gsl_matrix_view_array(LQR->data, p, m); /* qr(L^T) */
gsl_matrix_view Rp = gsl_matrix_view_array(LQR->data, m, m); /* R factor of L^T */
gsl_vector_const_view LTtau = gsl_vector_const_subvector(Ltau, 0, m);
/*
* M(:,1:p-m) will hold QR decomposition of A K_o; M(:,p) will hold
* Householder scalars
*/
gsl_matrix_view MQR = gsl_matrix_submatrix(M, 0, 0, n, pm);
gsl_vector_view Mtau = gsl_matrix_subcolumn(M, p - 1, 0, GSL_MIN(n, pm));
gsl_matrix_view AKo, AKp, HqTAKp;
gsl_vector_view v;
size_t i;
/* compute A = sqrt(W) X and b = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, &A.matrix, &b.vector);
if (status)
return status;
/* compute: A <- A K = [ A K_p ; A K_o ] */
gsl_linalg_QR_matQ(<QR.matrix, <tau.vector, &A.matrix);
AKp = gsl_matrix_submatrix(&A.matrix, 0, 0, n, m);
AKo = gsl_matrix_submatrix(&A.matrix, 0, m, n, pm);
/* compute QR decomposition [H,T] = qr(A * K_o) and store in M */
gsl_matrix_memcpy(&MQR.matrix, &AKo.matrix);
gsl_linalg_QR_decomp(&MQR.matrix, &Mtau.vector);
/* AKp currently contains A K_p; apply H^T from the left to get H^T A K_p */
gsl_linalg_QR_QTmat(&MQR.matrix, &Mtau.vector, &AKp.matrix);
/* the last npm rows correspond to H_q^T A K_p */
HqTAKp = gsl_matrix_submatrix(&AKp.matrix, pm, 0, npm, m);
/* solve: Xs R_p^T = H_q^T A K_p for Xs */
gsl_matrix_memcpy(Xs, &HqTAKp.matrix);
for (i = 0; i < npm; ++i)
{
gsl_vector_view x = gsl_matrix_row(Xs, i);
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &Rp.matrix, &x.vector);
}
/*
* compute: ys = H_q^T b; this is equivalent to computing
* the last q elements of H^T b (q = npm)
*/
v = gsl_vector_subvector(&b.vector, pm, npm);
gsl_linalg_QR_QTvec(&MQR.matrix, &Mtau.vector, &b.vector);
gsl_vector_memcpy(ys, &v.vector);
return GSL_SUCCESS;
}
}
}
int
gsl_linalg_symmtd_unpack (const gsl_matrix * A,
const gsl_vector * tau,
gsl_matrix * Q,
gsl_vector * diag,
gsl_vector * sdiag)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
}
else if (tau->size + 1 != A->size1)
{
GSL_ERROR ("size of tau must be (matrix size - 1)", GSL_EBADLEN);
}
else if (Q->size1 != A->size1 || Q->size2 != A->size1)
{
GSL_ERROR ("size of Q must match size of A", GSL_EBADLEN);
}
else if (diag->size != A->size1)
{
GSL_ERROR ("size of diagonal must match size of A", GSL_EBADLEN);
}
else if (sdiag->size + 1 != A->size1)
{
GSL_ERROR ("size of subdiagonal must be (matrix size - 1)", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
size_t i;
/* Initialize Q to the identity */
gsl_matrix_set_identity (Q);
for (i = N - 2; i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_column (A, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector, i + 1, N - (i+1));
double ti = gsl_vector_get (tau, i);
gsl_matrix_view m = gsl_matrix_submatrix (Q, i + 1, i + 1, N-(i+1), N-(i+1));
gsl_linalg_householder_hm (ti, &h.vector, &m.matrix);
}
/* Copy diagonal into diag */
for (i = 0; i < N; i++)
{
double Aii = gsl_matrix_get (A, i, i);
gsl_vector_set (diag, i, Aii);
}
/* Copy subdiagonal into sd */
for (i = 0; i < N - 1; i++)
{
double Aji = gsl_matrix_get (A, i+1, i);
gsl_vector_set (sdiag, i, Aji);
}
return GSL_SUCCESS;
}
}
int
gsl_multifit_linear_wgenform2 (const gsl_matrix * LQR,
const gsl_vector * Ltau,
const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
const gsl_vector * cs,
const gsl_matrix * M,
gsl_vector * c,
gsl_multifit_linear_workspace * work)
{
const size_t m = LQR->size1;
const size_t n = X->size1;
const size_t p = X->size2;
if (n > work->nmax || p > work->pmax)
{
GSL_ERROR("X matrix does not match workspace", GSL_EBADLEN);
}
else if (p != LQR->size2)
{
GSL_ERROR("LQR matrix does not match X", GSL_EBADLEN);
}
else if (p != c->size)
{
GSL_ERROR("c vector does not match X", GSL_EBADLEN);
}
else if (w != NULL && n != w->size)
{
GSL_ERROR("w vector does not match X", GSL_EBADLEN);
}
else if (n != y->size)
{
GSL_ERROR("y vector does not match X", GSL_EBADLEN);
}
else if (m >= p) /* square or tall L matrix */
{
if (p != cs->size)
{
GSL_ERROR("cs vector must be length p", GSL_EBADLEN);
}
else
{
int s;
gsl_matrix_const_view R = gsl_matrix_const_submatrix(LQR, 0, 0, p, p); /* R factor of L */
/* solve R c = cs for true solution c, using QR decomposition of L */
gsl_vector_memcpy(c, cs);
s = gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &R.matrix, c);
return s;
}
}
else /* rectangular L matrix with m < p */
{
if (m != cs->size)
{
GSL_ERROR("cs vector must be length m", GSL_EBADLEN);
}
else if (n != M->size1 || p != M->size2)
{
GSL_ERROR("M matrix must be size n-by-p", GSL_EBADLEN);
}
else
{
int status;
const size_t pm = p - m;
gsl_matrix_view A = gsl_matrix_submatrix(work->A, 0, 0, n, p);
gsl_vector_view b = gsl_vector_subvector(work->t, 0, n);
gsl_matrix_view Rp = gsl_matrix_view_array(LQR->data, m, m); /* R_p */
gsl_matrix_view LTQR = gsl_matrix_view_array(LQR->data, p, m);
gsl_vector_const_view LTtau = gsl_vector_const_subvector(Ltau, 0, m);
gsl_matrix_const_view MQR = gsl_matrix_const_submatrix(M, 0, 0, n, pm);
gsl_vector_const_view Mtau = gsl_matrix_const_subcolumn(M, p - 1, 0, GSL_MIN(n, pm));
gsl_matrix_const_view To = gsl_matrix_const_submatrix(&MQR.matrix, 0, 0, pm, pm);
gsl_vector_view workp = gsl_vector_subvector(work->xt, 0, p);
gsl_vector_view v1, v2;
/* compute A = sqrt(W) X and b = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, &A.matrix, &b.vector);
if (status)
return status;
/* initialize c to zero */
gsl_vector_set_zero(c);
/* compute c = L_inv cs = K_p R_p^{-T} cs */
/* set c(1:m) = R_p^{-T} cs */
v1 = gsl_vector_subvector(c, 0, m);
gsl_vector_memcpy(&v1.vector, cs);
gsl_blas_dtrsv(CblasUpper, CblasTrans, CblasNonUnit, &Rp.matrix, &v1.vector);
/* c <- K R_p^{-T} cs = [ K_p R_p^{_T} cs ; 0 ] */
gsl_linalg_QR_Qvec(<QR.matrix, <tau.vector, c);
/* compute: b1 = b - A L_inv cs */
gsl_blas_dgemv(CblasNoTrans, -1.0, &A.matrix, c, 1.0, &b.vector);
/* compute: b2 = H^T b1 */
gsl_linalg_QR_QTvec(&MQR.matrix, &Mtau.vector, &b.vector);
/* compute: b3 = T_o^{-1} b2 */
v1 = gsl_vector_subvector(&b.vector, 0, pm);
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &To.matrix, &v1.vector);
/* compute: b4 = K_o b3 */
gsl_vector_set_zero(&workp.vector);
v2 = gsl_vector_subvector(&workp.vector, m, pm);
gsl_vector_memcpy(&v2.vector, &v1.vector);
gsl_linalg_QR_Qvec(<QR.matrix, <tau.vector, &workp.vector);
/* final solution vector */
gsl_vector_add(c, &workp.vector);
return GSL_SUCCESS;
}
}
}
int
gsl_linalg_householder_mh (double tau, const gsl_vector * v, gsl_matrix * A)
{
/* applies a householder transformation v,tau to matrix m from the
right hand side in order to zero out rows */
if (tau == 0)
return GSL_SUCCESS;
/* A = A - tau w v' */
#ifdef USE_BLAS
{
gsl_vector_const_view v1 = gsl_vector_const_subvector (v, 1, v->size - 1);
gsl_matrix_view A1 = gsl_matrix_submatrix (A, 0, 1, A->size1, A->size2-1);
size_t i;
for (i = 0; i < A->size1; i++)
{
double wi = 0.0;
gsl_vector_view A1i = gsl_matrix_row(&A1.matrix, i);
gsl_blas_ddot (&A1i.vector, &v1.vector, &wi);
wi += gsl_matrix_get(A,i,0);
{
double Ai0 = gsl_matrix_get (A, i, 0);
gsl_matrix_set (A, i, 0, Ai0 - tau * wi);
}
gsl_blas_daxpy(-tau * wi, &v1.vector, &A1i.vector);
}
}
#else
{
size_t i, j;
for (i = 0; i < A->size1; i++)
{
double wi = gsl_matrix_get(A,i,0);
for (j = 1; j < A->size2; j++) /* note, computed for v(0) = 1 above */
{
wi += gsl_matrix_get(A,i,j) * gsl_vector_get(v,j);
}
/* j = 0 */
{
double Ai0 = gsl_matrix_get (A, i, 0);
gsl_matrix_set (A, i, 0, Ai0 - tau * wi);
}
/* j = 1 .. N-1 */
for (j = 1; j < A->size2; j++)
{
double vj = gsl_vector_get (v, j);
double Aij = gsl_matrix_get (A, i, j);
gsl_matrix_set (A, i, j, Aij - tau * wi * vj);
}
}
}
#endif
return GSL_SUCCESS;
}
