size_t
gsl_linalg_QRPT_rank (const gsl_matrix * QR, const double tol)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
gsl_vector_const_view diag = gsl_matrix_const_diagonal(QR);
double eps;
size_t i;
size_t r = 0;
if (tol < 0.0)
{
double min, max, absmax;
int ee;
gsl_vector_minmax(&diag.vector, &min, &max);
absmax = GSL_MAX(fabs(min), fabs(max));
ee = (int) (log(absmax) / log(2.0));
eps = 20.0 * (M + N) * pow(2.0, (double) ee) * GSL_DBL_EPSILON;
}
else
eps = tol;
/* count number of diagonal elements with |di| > eps */
for (i = 0; i < GSL_MIN(M, N); ++i)
{
double di = gsl_vector_get(&diag.vector, i);
if (fabs(di) > eps)
++r;
}
return r;
}
static double
cholesky_LDLT_norm1(const gsl_matrix * LDLT, const gsl_permutation * p, gsl_vector * work)
{
const size_t N = LDLT->size1;
gsl_vector_const_view D = gsl_matrix_const_diagonal(LDLT);
gsl_vector_view diagA = gsl_vector_subvector(work, N, N);
double max = 0.0;
size_t i, j;
/* reconstruct diagonal entries of original matrix A */
for (j = 0; j < N; ++j)
{
double Ajj;
/* compute diagonal (j,j) entry of A */
Ajj = gsl_vector_get(&D.vector, j);
for (i = 0; i < j; ++i)
{
double Di = gsl_vector_get(&D.vector, i);
double Lji = gsl_matrix_get(LDLT, j, i);
Ajj += Di * Lji * Lji;
}
gsl_vector_set(&diagA.vector, j, Ajj);
}
gsl_permute_vector_inverse(p, &diagA.vector);
for (j = 0; j < N; ++j)
{
double sum = 0.0;
double Ajj = gsl_vector_get(&diagA.vector, j);
for (i = 0; i < j; ++i)
{
double *wi = gsl_vector_ptr(work, i);
double Aij = gsl_matrix_get(LDLT, i, j);
double absAij = fabs(Aij);
sum += absAij;
*wi += absAij;
}
gsl_vector_set(work, j, sum + fabs(Ajj));
}
for (i = 0; i < N; ++i)
{
double wi = gsl_vector_get(work, i);
max = GSL_MAX(max, wi);
}
return max;
}
int
gsl_linalg_pcholesky_svx(const gsl_matrix * LDLT,
const gsl_permutation * p,
gsl_vector * x)
{
if (LDLT->size1 != LDLT->size2)
{
GSL_ERROR ("LDLT matrix must be square", GSL_ENOTSQR);
}
else if (LDLT->size1 != p->size)
{
GSL_ERROR ("matrix size must match permutation size", GSL_EBADLEN);
}
else if (LDLT->size2 != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else
{
gsl_vector_const_view D = gsl_matrix_const_diagonal(LDLT);
/* x := P b */
gsl_permute_vector(p, x);
/* solve: L w = P b */
gsl_blas_dtrsv(CblasLower, CblasNoTrans, CblasUnit, LDLT, x);
/* solve: D y = w */
gsl_vector_div(x, &D.vector);
/* solve: L^T z = y */
gsl_blas_dtrsv(CblasLower, CblasTrans, CblasUnit, LDLT, x);
/* compute: x = P^T z */
gsl_permute_vector_inverse(p, x);
return GSL_SUCCESS;
}
}
gsl_matrix * mygsl_matrix_diagalloc(const gsl_matrix * mat, const double x)
{
gsl_vector_const_view diag = gsl_matrix_const_diagonal(mat);
return mygsl_matrix_diagalloc(&diag.vector, x);
}
