int
gsl_linalg_PTLQ_svx_T (const gsl_matrix * LQ,
const gsl_vector * tau,
const gsl_permutation * p,
gsl_vector * x)
{
if (LQ->size1 != LQ->size2)
{
GSL_ERROR ("LQ matrix must be square", GSL_ENOTSQR);
}
else if (LQ->size2 != p->size)
{
GSL_ERROR ("matrix size must match permutation size", GSL_EBADLEN);
}
else if (LQ->size1 != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else
{
/* compute sol = b^T Q^T */
gsl_linalg_LQ_vecQT (LQ, tau, x);
/* Solve L^T x = sol, storing x inplace in sol */
gsl_blas_dtrsv (CblasLower, CblasTrans, CblasNonUnit, LQ, x);
gsl_permute_vector_inverse (p, x);
return GSL_SUCCESS;
}
}
int
gsl_linalg_LQ_svx_T (const gsl_matrix * LQ, const gsl_vector * tau, gsl_vector * x)
{
if (LQ->size1 != LQ->size2)
{
GSL_ERROR ("LQ matrix must be square", GSL_ENOTSQR);
}
else if (LQ->size1 != x->size)
{
GSL_ERROR ("matrix size must match x/rhs size", GSL_EBADLEN);
}
else
{
/* compute rhs = Q^T b */
gsl_linalg_LQ_vecQT (LQ, tau, x);
/* Solve R x = rhs, storing x in-place */
gsl_blas_dtrsv (CblasLower, CblasTrans, CblasNonUnit, LQ, x);
return GSL_SUCCESS;
}
}
CAMLprim value ml_gsl_linalg_LQ_vecQT(value LQ, value TAU, value V)
{
_DECLARE_MATRIX(LQ);
_DECLARE_VECTOR2(V,TAU);
_CONVERT_MATRIX(LQ);
_CONVERT_VECTOR2(V,TAU);
gsl_linalg_LQ_vecQT(&m_LQ, &v_TAU, &v_V);
return Val_unit;
}
int
gsl_linalg_LQ_lssolve_T (const gsl_matrix * LQ, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
{
const size_t N = LQ->size1;
const size_t M = LQ->size2;
if (M < N)
{
GSL_ERROR ("LQ matrix must have M>=N", GSL_EBADLEN);
}
else if (M != b->size)
{
GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
}
else if (N != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else if (M != residual->size)
{
GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view L = gsl_matrix_const_submatrix (LQ, 0, 0, N, N);
gsl_vector_view c = gsl_vector_subvector(residual, 0, N);
gsl_vector_memcpy(residual, b);
/* compute rhs = b^T Q^T */
gsl_linalg_LQ_vecQT (LQ, tau, residual);
/* Solve x^T L = rhs */
gsl_vector_memcpy(x, &(c.vector));
gsl_blas_dtrsv (CblasLower, CblasTrans, CblasNonUnit, &(L.matrix), x);
/* Compute residual = b^T - x^T A = (b^T Q^T - x^T L) Q */
gsl_vector_set_zero(&(c.vector));
gsl_linalg_LQ_vecQ(LQ, tau, residual);
return GSL_SUCCESS;
}
}
/**
* C++ version of gsl_linalg_LQ_vecQT().
* @param LQ A matrix
* @param tau A vector
* @param v A vector
* @return Error code on failure
*/
inline int LQ_vecQT( matrix const& LQ, vector const& tau, vector& v ){
return gsl_linalg_LQ_vecQT( LQ.get(), tau.get(), v.get() ); }