void Vector::permute ( const Permutation& p, const bool inverse ) {
if ( inverse ) {
gsl_permute_vector_inverse( &p, &this->vector );
} else {
gsl_permute_vector( &p, &this->vector );
}
}
static VALUE rb_gsl_vector_permute(VALUE obj, VALUE pp)
{
gsl_permutation *p = NULL;
gsl_vector *v = NULL;
int status;
CHECK_PERMUTATION(pp);
Data_Get_Struct(pp, gsl_permutation, p);
Data_Get_Struct(obj, gsl_vector, v);
status = gsl_permute_vector(p, v);
return INT2FIX(status);
}
/* singleton */
static VALUE rb_gsl_permute_vector(VALUE obj, VALUE pp, VALUE vv)
{
gsl_permutation *p = NULL;
gsl_vector *v;
int status;
CHECK_VECTOR(vv);
Data_Get_Struct(pp, gsl_permutation, p);
Data_Get_Struct(vv, gsl_vector, v);
status = gsl_permute_vector(p, v);
return INT2FIX(status);
}
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;
}
}
int w_update(
gsl_matrix *weights,
gsl_matrix *x_white,
gsl_matrix *bias,
gsl_matrix *shuffled_x_white, //work space for shuffled x_white
gsl_permutation *p, // random permutation
gsl_rng *r, // random stream from gsl
double lrate){
int error = 0;
size_t i;
const size_t NVOX = x_white->size2;
const size_t NCOMP = x_white->size1;
size_t block = (size_t)floor(sqrt(NVOX/3.0));
gsl_matrix *ib = gsl_matrix_alloc(1,block);
gsl_matrix_set_all( ib, 1.0);
gsl_ran_shuffle (r, p->data, NVOX, sizeof(size_t));
// gsl_matrix *shuffled_x_white = gsl_matrix_alloc(NCOMP,NVOX);
// gsl_matrix_memcpy(shuffled_x_white, x_white);
gsl_vector_view arow;
#pragma omp parallel for private(i,arow)
for (i = 0; i < x_white->size1; i++) {
arow = gsl_matrix_row(shuffled_x_white,i);
gsl_permute_vector (p, &arow.vector);
}
size_t start;
gsl_matrix *unmixed = gsl_matrix_alloc(NCOMP,block);
gsl_matrix *unm_logit = gsl_matrix_alloc(NCOMP,block);
gsl_matrix *temp_I = gsl_matrix_alloc(NCOMP,NCOMP);
gsl_matrix *ones = gsl_matrix_alloc(block,1);
gsl_matrix_set_all(ones, 1.0);
double max;
gsl_matrix_view sub_x_white_view;
// gsl_matrix *d_unmixer = gsl_matrix_alloc(NCOMP,NCOMP);
for (start = 0; start < NVOX; start = start + block) {
if (start + block > NVOX-1){
block = NVOX-start;
gsl_matrix_free(ib);
ib = gsl_matrix_alloc(1,block);
gsl_matrix_set_all( ib, 1.0);
gsl_matrix_free(unmixed);
unmixed = gsl_matrix_alloc(NCOMP,block);
gsl_matrix_free(unm_logit);
unm_logit = gsl_matrix_alloc(NCOMP,block);
gsl_matrix_free(ones);
ones = gsl_matrix_alloc(block,1);
gsl_matrix_set_all(ones, 1.0);
}
// sub_x_white = xwhite[:, permute[start:start+block]]
sub_x_white_view = gsl_matrix_submatrix(shuffled_x_white, 0,start, NCOMP, block );
// Compute unmixed = weights . sub_x_white + bias . ib
matrix_mmul(weights, &sub_x_white_view.matrix, unmixed);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans,
1.0, bias, ib, 1.0, unmixed);
// Compute 1-2*logit
gsl_matrix_memcpy(unm_logit, unmixed);
matrix_apply_all(unm_logit, logit);
// weights = weights + lrate*(block*I+(unm_logit*unmixed.T))*weights
gsl_matrix_set_identity(temp_I); // temp_I = I
// (1) temp_I = block*temp_I +unm_logit*unmixed.T
gsl_blas_dgemm( CblasNoTrans,CblasTrans,
1.0, unm_logit, unmixed,
(double)block , temp_I);
// BE CAREFUL with aliasing here! use d_unmixer if problems arise
// gsl_matrix_memcpy(d_unmixer, weights);
// (2) weights = weights + lrate*temp_I*weights
gsl_blas_dgemm( CblasNoTrans,CblasNoTrans,
lrate, temp_I, weights,
1.0, weights);
// Update the bias
gsl_blas_dgemm( CblasNoTrans, CblasNoTrans,
lrate, unm_logit, ones,
1.0, bias);
// check if blows up
max = gsl_matrix_max(weights);
if (max > MAX_W){
if (lrate<1e-6) {
printf("\nERROR: Weight matrix may not be invertible\n");
error = 2;
break;
}
error = 1;
break;
}
}
// set number of threads back to normal
// openblas_set_num _threads(MAX_THREAD);
//clean up
// gsl_rng_free (r);
// gsl_permutation_free (p);
// gsl_matrix_free(d_unmixer);
gsl_matrix_free(ib);
gsl_matrix_free(unmixed);
gsl_matrix_free(temp_I);
gsl_matrix_free(ones);
gsl_matrix_free(unm_logit);
// gsl_matrix_free(shuffled_x_white);
return(error);
}
int lseShurComplement(gsl_matrix * A, gsl_matrix * C,
gsl_vector * b, gsl_vector * d,
gsl_vector * x, gsl_vector * lambda, double * sigma)
{
int i;
double xi;
gsl_vector *c0, *S, *tau;
gsl_matrix *CT, *U;
gsl_permutation *perm;
gsl_vector_view row, cp;
gsl_matrix_view R;
if (A->size2 != C->size2) return -1;
if (A->size2 != x->size) return -1;
if (A->size1 < A->size2) return -1;
if (b != NULL && A->size1 != b->size) return -1;
if (C->size1 != d->size) return -1;
if (C->size1 != lambda->size) return -1;
c0 = gsl_vector_alloc(x->size);
gsl_matrix_get_row(c0, C, 0);
/* Cholesky factorization of A^T A = R^T R via QRPT decomposition */
perm = gsl_permutation_alloc(x->size);
tau = gsl_vector_alloc(x->size);
gsl_linalg_QRPT_decomp(A, tau, perm, &i, x);
/* cp = R^{-T} P A^T b = Q^T b */
if (b != NULL) {
gsl_linalg_QR_QTvec(A, tau, b);
cp = gsl_vector_subvector(b, 0, x->size);
}
gsl_vector_free(tau);
/* C P -> C */
R = gsl_matrix_submatrix(A, 0, 0, A->size2, A->size2);
for (i = 0; i < C->size1; ++i) {
row = gsl_matrix_row(C, i);
gsl_permute_vector(perm, &row.vector);
}
/* Compute C inv(R) -> C */
gsl_blas_dtrsm(CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 1.0,
&R.matrix, C);
/* The Schur complement D = C C^T,
Compute SVD of D = U S^2 U^T by SVD of C^T = V S U^T */
CT = gsl_matrix_alloc(C->size2, C->size1);
gsl_matrix_transpose_memcpy(CT, C);
U = gsl_matrix_alloc(CT->size2, CT->size2);
S = gsl_vector_alloc(CT->size2);
gsl_linalg_SV_decomp(CT, U, S, lambda);
/* Right hand side of the Shur complement system
d - C (A^T A)^-1 A^T b = d - C cp -> d
(with C P R^-1 -> C and R^-T P^T A^T b -> cp) */
if (b != NULL) {
gsl_blas_dgemv(CblasNoTrans, -1.0, C, &cp.vector, 1.0, d);
}
/* Calculate S U^T lambda, where -lambda is the Lagrange multiplier */
gsl_blas_dgemv(CblasTrans, 1.0, U, d, 0.0, lambda);
gsl_vector_div(lambda, S);
/* Calculate sigma = || A x ||_2 = || x ||_2 (before inv(R) x -> x) */
*sigma = gsl_blas_dnrm2(lambda);
/* Compute inv(R)^T C^T lambda = C^T lambda (with C inv(R) ->C) */
gsl_blas_dgemv(CblasNoTrans, 1.0, CT, lambda, 0.0, x);
/* x = inv(A^T A) C^T lambda = inv(R) [inv(R)^T C^T lambda] */
if (R.matrix.data[R.matrix.size1 * R.matrix.size2 - 1] != 0.0) {
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &R.matrix, x);
}
else { /* Special case when A is singular */
gsl_vector_set_basis(x, x->size - 1);
*sigma = 0.0;
}
/* Permute back, 1-step iterative refinement on first constraint */
gsl_permute_vector_inverse(perm, x);
gsl_blas_ddot(x, c0, &xi);
gsl_vector_scale(x, d->data[0] / xi);
/* get the real lambda from S U^T lambda previously stored in lambda */
gsl_vector_div(lambda, S);
gsl_vector_memcpy(S, lambda);
gsl_blas_dgemv(CblasNoTrans, 1.0, U, S, 0.0, lambda);
gsl_vector_free(c0);
gsl_vector_free(S);
gsl_matrix_free(U);
gsl_matrix_free(CT);
gsl_permutation_free(perm);
return 0;
}
