void SGMatrix<T>::inverse(SGMatrix<float64_t> matrix)
{
ASSERT(matrix.num_cols==matrix.num_rows);
int32_t* ipiv = SG_MALLOC(int32_t, matrix.num_cols);
clapack_dgetrf(CblasColMajor,matrix.num_cols,matrix.num_cols,matrix.matrix,matrix.num_cols,ipiv);
clapack_dgetri(CblasColMajor,matrix.num_cols,matrix.matrix,matrix.num_cols,ipiv);
SG_FREE(ipiv);
}
/*============================================================================*/
int ighmm_invert_det(double *sigmainv, double *det, int length, double *cov)
{
#define CUR_PROC "invert_det"
#ifdef DO_WITH_GSL
int i, j, s;
gsl_matrix *tmp;
gsl_matrix *inv;
tmp = gsl_matrix_alloc(length, length);
inv = gsl_matrix_alloc(length, length);
gsl_permutation *permutation = gsl_permutation_calloc(length);
for (i=0; i<length; ++i) {
for (j=0; j<length; ++j) {
#ifdef DO_WITH_GSL_DIAGONAL_HACK
if (i == j){
gsl_matrix_set(tmp, i, j, cov[i*length+j]);
}else{
gsl_matrix_set(tmp, i, j, 0.0);
}
#else
gsl_matrix_set(tmp, i, j, cov[i*length+j]);
#endif
}
}
gsl_linalg_LU_decomp(tmp, permutation, &s);
gsl_linalg_LU_invert(tmp, permutation, inv);
*det = gsl_linalg_LU_det(tmp, s);
gsl_matrix_free(tmp);
gsl_permutation_free(permutation);
for (i=0; i<length; ++i) {
for (j=0; j<length; ++j) {
sigmainv[i*length+j] = gsl_matrix_get(inv, i, j);
}
}
gsl_matrix_free(inv);
#elif defined HAVE_CLAPACK_DGETRF && HAVE_CLAPACK_DGETRI
char sign;
int info, i;
int *ipiv;
double det_tmp;
ipiv = malloc(length * sizeof *ipiv);
/* copy cov. matrix entries to result matrix, the rest is done in-place */
memcpy(sigmainv, cov, length * length * sizeof *cov);
/* perform in-place LU factorization of covariance matrix */
info = clapack_dgetrf(CblasRowMajor, length, length, sigmainv, length, ipiv);
/* determinant */
sign = 1;
for( i=0; i<length; ++i)
if( ipiv[i]!=i )
sign *= -1;
det_tmp = sigmainv[0];
for( i=length+1; i<(length*length); i+=length+1 )
det_tmp *= sigmainv[i];
*det = det_tmp * sign;
/* use the LU factorization to get inverse */
info = clapack_dgetri(CblasRowMajor, length, sigmainv, length, ipiv);
free(ipiv);
#else
*det = ighmm_determinant(cov, length);
ighmm_inverse(cov, length, *det, sigmainv);
#endif
return 0;
#undef CUR_PROC
}
int wrapper_clapack_dgetri(const enum CBLAS_ORDER Order, const int N, double *A, const int lda, const int *ipiv)
{
return clapack_dgetri(Order, N, A, lda, ipiv);
}
void arpack_dsaupd(double* matrix, int n, int nev, const char* which,
int mode, bool pos, double shift, double* eigenvalues,
double* eigenvectors, int& status)
{
// check if nev is greater than n
if (nev>n)
SG_SERROR("Number of required eigenpairs is greater than order of the matrix");
// check specified mode
if (mode!=1 && mode!=3)
SG_SERROR("Unknown mode specified");
// init ARPACK's reverse communication parameter
// (should be zero initially)
int ido = 0;
// specify that non-general eigenproblem will be solved
// (Ax=lGx, where G=I)
char bmat[2] = "I";
// init tolerance (zero means machine precision)
double tol = 0.0;
// allocate array to hold residuals
double* resid = new double[n];
// set number of Lanczos basis vectors to be used
// (with max(4*nev,n) sufficient for most tasks)
int ncv = nev*4>n ? n : nev*4;
// allocate array 'v' for dsaupd routine usage
int ldv = n;
double* v = new double[ldv*ncv];
// init array for i/o params for routine
int* iparam = new int[11];
// specify method for selecting implicit shifts (1 - exact shifts)
iparam[0] = 1;
// specify max number of iterations
iparam[2] = 2*2*n;
// set the computation mode (1 for regular or 3 for shift-inverse)
iparam[6] = mode;
// init array indicating locations of vectors for routine callback
int* ipntr = new int[11];
// allocate workaround arrays
double* workd = new double[3*n];
int lworkl = ncv*(ncv+8);
double* workl = new double[lworkl];
// init info holding status (should be zero at first call)
int info = 0;
// which eigenpairs to find
char* which_ = strdup(which);
// All
char* all_ = strdup("A");
// shift-invert mode
if (mode==3)
{
for (int i=0; i<n; i++)
matrix[i*n+i] -= shift;
if (pos)
{
clapack_dpotrf(CblasColMajor,CblasUpper,n,matrix,n);
clapack_dpotri(CblasColMajor,CblasUpper,n,matrix,n);
}
else
{
int* ipiv = new int[n];
clapack_dgetrf(CblasColMajor,n,n,matrix,n,ipiv);
clapack_dgetri(CblasColMajor,n,matrix,n,ipiv);
delete[] ipiv;
}
}
// main computation loop
do
{
dsaupd_(&ido, bmat, &n, which_, &nev, &tol, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
if ((ido==1)||(ido==-1))
{
cblas_dsymv(CblasColMajor,CblasUpper,
n,1.0,matrix,n,
(workd+ipntr[0]-1),1,
0.0,(workd+ipntr[1]-1),1);
}
} while ((ido==1)||(ido==-1));
// check if DSAUPD failed
if (info<0)
{
if ((info<=-1)&&(info>=-6))
SG_SWARNING("DSAUPD failed. Wrong parameter passed.");
else if (info==-7)
SG_SWARNING("DSAUPD failed. Workaround array size is not sufficient.");
else
SG_SWARNING("DSAUPD failed. Error code: %d.", info);
status = -1;
}
else
{
if (info==1)
SG_SWARNING("Maximum number of iterations reached.\n");
// allocate select for dseupd
int* select = new int[ncv];
// allocate d to hold eigenvalues
double* d = new double[2*ncv];
// sigma for dseupd
double sigma = shift;
// init ierr indicating dseupd possible errors
int ierr = 0;
// specify that eigenvectors to be computed too
int rvec = 1;
dseupd_(&rvec, all_, select, d, v, &ldv, &sigma, bmat,
&n, which_, &nev, &tol, resid, &ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &ierr);
if (ierr!=0)
{
SG_SWARNING("DSEUPD failed with status=%d", ierr);
status = -1;
}
else
{
for (int i=0; i<nev; i++)
{
eigenvalues[i] = d[i];
for (int j=0; j<n; j++)
eigenvectors[j*nev+i] = v[i*n+j];
}
}
// cleanup
delete[] select;
delete[] d;
}
// cleanup
delete[] all_;
delete[] which_;
delete[] resid;
delete[] v;
delete[] iparam;
delete[] ipntr;
delete[] workd;
delete[] workl;
};
