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; };