/*
* log determinant using blas
*
*/
double log_det(gsl_matrix* m) {
gsl_matrix* lu;
gsl_permutation* p;
double result;
int signum;
p = gsl_permutation_alloc(m->size1);
lu = gsl_matrix_alloc(m->size1, m->size2);
gsl_matrix_memcpy(lu, m);
gsl_linalg_LU_decomp(lu, p, &signum);
result = gsl_linalg_LU_lndet(lu);
gsl_matrix_free(lu);
gsl_permutation_free(p);
return(result);
}
/**
* \brief Compute Savitzky-Golay coefficients and store them into #h.
*
* This function follows GSL conventions in that it writes its result into a matrix allocated by
* the caller and returns a non-zero result on error.
*
* The coefficient matrix is defined as the matrix H mapping a set of input values to the values
* of the polynomial of order #polynom_order which minimizes squared deviations from the input
* values. It is computed using the formula \$H=V(V^TV)^(-1)V^T\$, where \$V\$ is the Vandermonde
* matrix of the point indices.
*
* For a short description of the mathematical background, see
* http://www.statistics4u.info/fundstat_eng/cc_filter_savgol_math.html
*/
int SmoothFilter::savitzkyGolayCoefficients(int points, int polynom_order, gsl_matrix *h) {
int error = 0; // catch GSL error codes
// compute Vandermonde matrix
gsl_matrix *vandermonde = gsl_matrix_alloc(points, polynom_order+1);
for (int i = 0; i < points; ++i) {
gsl_matrix_set(vandermonde, i, 0, 1.0);
for (int j = 1; j <= polynom_order; ++j)
gsl_matrix_set(vandermonde, i, j, gsl_matrix_get(vandermonde,i,j-1) * i);
}
// compute V^TV
gsl_matrix *vtv = gsl_matrix_alloc(polynom_order+1, polynom_order+1);
error = gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, vandermonde, vandermonde, 0.0, vtv);
if (!error) {
// compute (V^TV)^(-1) using LU decomposition
gsl_permutation *p = gsl_permutation_alloc(polynom_order+1);
int signum;
error = gsl_linalg_LU_decomp(vtv, p, &signum);
if (!error) {
gsl_matrix *vtv_inv = gsl_matrix_alloc(polynom_order+1, polynom_order+1);
error = gsl_linalg_LU_invert(vtv, p, vtv_inv);
if (!error) {
// compute (V^TV)^(-1)V^T
gsl_matrix *vtv_inv_vt = gsl_matrix_alloc(polynom_order+1, points);
error = gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, vtv_inv, vandermonde, 0.0, vtv_inv_vt);
if (!error) {
// finally, compute H = V(V^TV)^(-1)V^T
error = gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, vandermonde, vtv_inv_vt, 0.0, h);
}
gsl_matrix_free(vtv_inv_vt);
}
gsl_matrix_free(vtv_inv);
}
gsl_permutation_free(p);
}
gsl_matrix_free(vtv);
gsl_matrix_free(vandermonde);
return error;
}
// Sets inv_A to the inverse of A, and returns the determinant of A. If inv_A is NULL, then
// A is inverted in place. If worspaces p and LU are provided, the function does not have to
// allocate its own workspaces.
double invert_matrix(gsl_matrix* A, gsl_matrix* inv_A, gsl_permutation* p, gsl_matrix* LU) {
unsigned int N = A->size1;
assert(N == A->size2);
// Allocate workspaces if none are provided
bool del_p = false;
bool del_LU = false;
if(p == NULL) { p = gsl_permutation_alloc(N); del_p = true; }
if(LU == NULL) { LU = gsl_matrix_alloc(N, N); del_LU = true; }
int s;
int status = 1;
int count = 0;
while(status) {
if(count > 5) { std::cerr << "! Error inverting matrix." << std::endl; abort(); }
// Invert A using LU decomposition
gsl_matrix_memcpy(LU, A);
if(count != 0) { // If inversion fails the first time, add small constant to diagonal
gsl_matrix_add_diagonal(LU, pow10((double)count - 6.));
std::cerr << "Invert matrix: Added 10^" << count - 6 << " to diagonal." << std::endl;
}
gsl_linalg_LU_decomp(LU, p, &s);
if(inv_A == NULL) {
status = gsl_linalg_LU_invert(LU, p, A);
} else {
assert(N == inv_A->size1);
assert(N == inv_A->size2);
status = gsl_linalg_LU_invert(LU, p, inv_A);
}
count++;
}
// Get the determinant of A
double det_A = gsl_linalg_LU_det(LU, s);
// Free workspaces if none were provided
if(del_p) { gsl_permutation_free(p); }
if(del_LU) { gsl_matrix_free(LU); }
return det_A;
}
static VALUE rb_gsl_linalg_complex_LU_lndet(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
double lndet;
int flagm = 0, signum, itmp;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
p = gsl_permutation_alloc(m->size1);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
}
lndet = gsl_linalg_complex_LU_lndet(mtmp);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return rb_float_new(lndet);
}
int matrix_inverse(long double **output,int row,int col,long double **input)
{
register int i,j;
gsl_matrix *m;
m=gsl_matrix_calloc (row,col);
for (i=0;i<row;i++)
{
for (j=0;j<col;j++)
{
gsl_matrix_set(m,i,j,input[i][j]);
}
}
gsl_matrix *inv;
gsl_permutation *p;
int *signum;
inv=gsl_matrix_calloc (row,col);
p=gsl_permutation_calloc(row);
signum=(int *)malloc( sizeof(int)*row);
gsl_linalg_LU_decomp(m,p,signum);
gsl_linalg_LU_invert(m,p,inv);
for (i=0;i<row;i++)
{
for (j=0;j<col;j++)
{
output[i][j]=(long double) gsl_matrix_get(inv,i,j);;
}
}
free(signum);
gsl_matrix_free (m);
gsl_matrix_free (inv);
gsl_permutation_free(p);
return OK;
}
int
gsl_multifit_nlinear_covar (const gsl_matrix * J, const double epsrel,
gsl_matrix * covar)
{
int status;
gsl_matrix * r;
gsl_vector * tau;
gsl_vector * norm;
gsl_permutation * perm;
const size_t m = J->size1;
const size_t n = J->size2;
if (m < n)
{
GSL_ERROR ("Jacobian be rectangular M x N with M >= N", GSL_EBADLEN);
}
if (covar->size1 != covar->size2 || covar->size1 != n)
{
GSL_ERROR ("covariance matrix must be square and match second dimension of jacobian", GSL_EBADLEN);
}
r = gsl_matrix_alloc (m, n);
tau = gsl_vector_alloc (n);
perm = gsl_permutation_alloc (n) ;
norm = gsl_vector_alloc (n) ;
{
int signum = 0;
gsl_matrix_memcpy (r, J);
gsl_linalg_QRPT_decomp (r, tau, perm, &signum, norm);
}
status = covar_QRPT(r, perm, epsrel, covar);
gsl_matrix_free (r);
gsl_permutation_free (perm);
gsl_vector_free (tau);
gsl_vector_free (norm);
return status;
}
void orderMatrix(const gsl_matrix* x, gsl_matrix* y)
{
int n = x->size1;
int m = x->size2;
gsl_vector* x_norms = gsl_vector_alloc(m);
for (int i =0;i<m;i++)
{
gsl_vector_const_view xcol = gsl_matrix_const_column(x,i);
gsl_vector_set(x_norms, i, -norm2(&xcol.vector));
}
gsl_permutation* p = gsl_permutation_alloc(m);
gsl_sort_vector_index(p, x_norms);
for (int i=0; i<n; i++) {
for (int j=0; j<m; j++) {
gsl_matrix_set(y, i, j, gsl_matrix_get(x, i, gsl_permutation_get(p, j)));
}
}
gsl_vector_free(x_norms);
gsl_permutation_free(p);
}
TGaussianMixture::~TGaussianMixture() {
delete[] w;
delete[] mu;
for(unsigned int k=0; k<nclusters; k++) {
gsl_matrix_free(cov[k]);
gsl_matrix_free(inv_cov[k]);
gsl_matrix_free(sqrt_cov[k]);
}
delete[] cov;
delete[] inv_cov;
delete[] sqrt_cov;
delete[] det_cov;
gsl_matrix_free(LU);
gsl_permutation_free(p);
gsl_eigen_symmv_free(esv);
gsl_vector_free(eival);
gsl_matrix_free(eivec);
gsl_matrix_free(sqrt_eival);
gsl_rng_free(r);
}
void CNumMat::SetToInverse(const CNumMat & mat)
{
assert(mat.NumRows()==mat.NumCols());
const unsigned N=mat.NumRows();
CNumMat LU(mat);
gsl_permutation *p=gsl_permutation_alloc(N);
int signum;
if(gsl_linalg_LU_decomp(LU.m_mat, p, &signum))
throw BPException("gsl_linalg_LU_decomp");
resize(N,N);
if(gsl_linalg_LU_invert(LU.m_mat,p,m_mat))
throw BPException("gsl_linalg_LU_invert");
gsl_permutation_free(p);
}
static void
lmder_free (void *vstate)
{
lmder_state_t *state = (lmder_state_t *) vstate;
gsl_permutation_free (state->perm);
gsl_vector_free (state->work1);
gsl_vector_free (state->w);
gsl_vector_free (state->rptdx);
gsl_vector_free (state->sdiag);
gsl_vector_free (state->df);
gsl_vector_free (state->f_trial);
gsl_vector_free (state->x_trial);
gsl_vector_free (state->gradient);
gsl_vector_free (state->newton);
gsl_vector_free (state->qtf);
gsl_vector_free (state->diag);
gsl_vector_free (state->tau);
gsl_matrix_free (state->r);
}
double Matrix::determinant()
{
int rows = numRows();
int cols = numCols();
if (rows != cols){
QMessageBox::critical((ApplicationWindow *)applicationWindow(), tr("QtiPlot - Error"),
tr("Calculation failed, the matrix is not square!"));
return GSL_POSINF;
}
gsl_set_error_handler_off();
gsl_matrix *A = gsl_matrix_alloc(rows, cols);
gsl_permutation * p = gsl_permutation_alloc(rows);
if (!A || !p){
QApplication::restoreOverrideCursor();
QMessageBox::critical((ApplicationWindow *)applicationWindow(),
tr("QtiPlot") + " - " + tr("Memory Allocation Error"),
tr("Not enough memory, operation aborted!"));
return 0.0;
}
QApplication::setOverrideCursor(QCursor(Qt::WaitCursor));
double *data = d_matrix_model->dataVector();
int i, cell = 0;
for(i=0; i<rows; i++)
for(int j=0; j<cols; j++)
gsl_matrix_set(A, i, j, data[cell++]);
gsl_linalg_LU_decomp(A, p, &i);
double det = gsl_linalg_LU_det(A, i);
gsl_matrix_free(A);
gsl_permutation_free(p);
QApplication::restoreOverrideCursor();
return det;
}
static void *matrix_invert(void *m, bool complex)
{
int sign = 0;
int size = ((gsl_matrix *)m)->size1;
void *result;
if (size != ((gsl_matrix *)m)->size2)
return NULL;
gsl_permutation *p = gsl_permutation_calloc(size);
if (!complex)
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
result = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, (gsl_matrix *)m);
gsl_linalg_LU_decomp(tmp, p, &sign);
if (gsl_linalg_LU_invert(tmp, p, (gsl_matrix *)result) != GSL_SUCCESS)
{
gsl_matrix_free(result);
return NULL;
}
gsl_matrix_free(tmp);
}
else
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
result = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, (gsl_matrix_complex *)m);
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
if (gsl_linalg_complex_LU_invert(tmp, p, (gsl_matrix_complex *)result) != GSL_SUCCESS)
{
gsl_matrix_complex_free(result);
return NULL;
}
gsl_matrix_complex_free(tmp);
}
gsl_permutation_free(p);
return result;
}
static int
dnewton_alloc (void * vstate, size_t n)
{
dnewton_state_t * state = (dnewton_state_t *) vstate;
gsl_permutation * p;
gsl_matrix * m, * J;
m = gsl_matrix_calloc (n,n);
if (m == 0)
{
GSL_ERROR ("failed to allocate space for lu", GSL_ENOMEM);
}
state->lu = m ;
p = gsl_permutation_calloc (n);
if (p == 0)
{
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for permutation", GSL_ENOMEM);
}
state->permutation = p ;
J = gsl_matrix_calloc (n,n);
if (J == 0)
{
gsl_permutation_free(p);
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for d", GSL_ENOMEM);
}
state->J = J;
return GSL_SUCCESS;
}
void Module_Rectifier::linear_multiple_regression(double a_data[NUM_EQU*8], double b_data[NUM_EQU]){
gsl_matrix_view m = gsl_matrix_view_array (a_data, 8, 8);
gsl_vector_view b = gsl_vector_view_array (b_data, 8);
gsl_vector *x = gsl_vector_alloc (8);
int s;
gsl_permutation * p = gsl_permutation_alloc (8);
gsl_linalg_LU_decomp (&m.matrix, p, &s);
gsl_linalg_LU_solve (&m.matrix, p, &b.vector, x);
for (int i=0; i<8; i++)
{
solution_matrix[i] = gsl_vector_get(x,i);
}
solution_matrix[8] = 1;
gsl_permutation_free (p);
gsl_vector_free (x);
}
/////////////////////INVERSE/////////////////////////
gsl_matrix* inverse(gsl_matrix *matriz,int filas){
int s;
gsl_matrix *inversa = gsl_matrix_alloc (filas, filas);
gsl_permutation * p = gsl_permutation_alloc (filas);
gsl_linalg_LU_decomp (matriz, p, &s);
gsl_linalg_LU_invert (matriz, p, inversa);
gsl_permutation_free (p);
return inversa;
}
void sort_mask_resolution_weight(gsl_vector_int *resolution_array,
gsl_vector_ulong *pixnum_array,
gsl_vector *weight_array,
unsigned long n_mask)
{
gsl_permutation *pixel_index;
gsl_vector_ulong *tmp_pixnum_array;
gsl_vector *tmp_weight_array;
gsl_vector_int *tmp_resolution_array;
unsigned long i, j;
/* Given a list of masks and resolutions, return each list sorted by the
resolution. This routine is needed to make the resolution structure. */
tmp_pixnum_array = gsl_vector_ulong_alloc(n_mask);
tmp_weight_array = gsl_vector_alloc(n_mask);
tmp_resolution_array = gsl_vector_int_alloc(n_mask);
pixel_index = gsl_permutation_alloc(n_mask);
gsl_sort_vector_int_index(pixel_index,resolution_array);
for (i=0;i<n_mask;i++) {
j = pixel_index->data[i];
tmp_pixnum_array->data[i] = pixnum_array->data[j];
tmp_weight_array->data[i] = weight_array->data[j];
tmp_resolution_array->data[i] = resolution_array->data[j];
}
for (i=0;i<n_mask;i++) {
pixnum_array->data[i] = tmp_pixnum_array->data[i];
weight_array->data[i] = tmp_weight_array->data[i];
resolution_array->data[i] = tmp_resolution_array->data[i];
}
gsl_vector_int_free(tmp_resolution_array);
gsl_vector_ulong_free(tmp_pixnum_array);
gsl_vector_free(tmp_weight_array);
gsl_permutation_free(pixel_index);
}
double ran_wishart_pdf(const gsl_matrix *X, const double nu, const gsl_matrix *V)
{
const int k = X->size1;
double detX, detV, den, temp;
int s, i;
gsl_matrix *work_k_k = gsl_matrix_alloc(k, k);
gsl_matrix *Vinv = gsl_matrix_alloc(k, k);
gsl_permutation *p = gsl_permutation_alloc(k);
gsl_matrix_memcpy(work_k_k, X);
gsl_linalg_LU_decomp(work_k_k, p, &s);
detX = gsl_linalg_LU_det(work_k_k, s);
gsl_matrix_memcpy(work_k_k, V);
gsl_linalg_LU_decomp(work_k_k, p, &s);
detV = gsl_linalg_LU_det(work_k_k, s);
gsl_linalg_LU_invert(work_k_k, p, Vinv);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Vinv, X, 0.0, work_k_k);
den = 0;
for (i=0; i<k; i++)
{
den -= 0.5 * gsl_matrix_get(work_k_k, i, i);
}
//den = exp(den);
temp = 0.5*(nu-k-1)*log(detX) - 0.5*nu*k*log(2) -0.5*nu*log(detV);
temp -= sf_mv_lngamma(nu/2, k);
den += temp;
den = exp(den);
gsl_matrix_free(work_k_k);
gsl_matrix_free(Vinv);
gsl_permutation_free(p);
return den;
}
static int
md_det(lua_State *L) /* (-1,+1,e) */
{
mMatReal *m = qlua_checkMatReal(L, 1);
mMatReal *lu;
gsl_permutation *p;
int signum;
double d;
if (m->l_size != m->r_size)
return luaL_error(L, "square matrix expected");
p = new_permutation(L, m->l_size);
lu = qlua_newMatReal(L, m->l_size, m->l_size);
gsl_matrix_memcpy(lu->m, m->m);
gsl_linalg_LU_decomp(lu->m, p, &signum);
d = gsl_linalg_LU_det(lu->m, signum);
gsl_permutation_free(p);
lua_pushnumber(L, d);
return 1;
}
static void diagonalize_covariance(void)
{
gsl_vector *vec_dum=gsl_vector_alloc(glob_n_nu);
gsl_matrix *evec_dum=gsl_matrix_alloc(glob_n_nu,glob_n_nu);
gsl_vector *eval_dum=gsl_vector_alloc(glob_n_nu);
eigenvals=gsl_vector_alloc(glob_n_nu);
eigenvecs=gsl_matrix_alloc(glob_n_nu,glob_n_nu);
//Diagonalize
gsl_eigen_symmv_workspace *w=gsl_eigen_symmv_alloc(glob_n_nu);
gsl_eigen_symmv(covariance,eval_dum,evec_dum,w);
gsl_eigen_symmv_free(w);
//Sort eigenvalues
gsl_permutation *p=gsl_permutation_alloc(glob_n_nu);
gsl_sort_vector_index(p,eval_dum);
int ii;
for(ii=0;ii<glob_n_nu;ii++) {
int inew=gsl_permutation_get(p,ii);
gsl_vector_set(eigenvals,ii,gsl_vector_get(eval_dum,inew));
gsl_matrix_get_col(vec_dum,evec_dum,inew);
gsl_matrix_set_col(eigenvecs,ii,vec_dum);
}
gsl_permutation_free(p);
gsl_vector_free(vec_dum);
gsl_vector_free(eval_dum);
gsl_matrix_free(evec_dum);
FILE *fo;
char fname[256];
sprintf(fname,"%s_pca_eigvals.dat",glob_prefix_out);
fo=my_fopen(fname,"w");
for(ii=0;ii<glob_n_nu;ii++) {
double lambda=gsl_vector_get(eigenvals,ii);
fprintf(fo,"%d %lE\n",ii,lambda);
}
fclose(fo);
}
double ran_mv_t_pdf(const gsl_vector *x, const gsl_vector *mu,
const gsl_matrix *Sigma, const double nu)
{
const int k = x->size;
int s;
double det,temp, den;
gsl_vector *y = gsl_vector_alloc(k);
gsl_vector *work_k = gsl_vector_alloc(k);
gsl_matrix *work_k_k = gsl_matrix_alloc(k, k);
gsl_matrix *Sigmainv = gsl_matrix_alloc(k, k);
gsl_permutation *p = gsl_permutation_alloc(k);
gsl_vector_memcpy(y, x);
gsl_vector_sub(y, mu);
gsl_matrix_memcpy(work_k_k, Sigma);
gsl_linalg_LU_decomp(work_k_k, p, &s);
gsl_linalg_LU_invert(work_k_k, p, Sigmainv);
det = gsl_linalg_LU_det(work_k_k, s);
gsl_blas_dgemv(CblasNoTrans, 1.0/k, Sigmainv, y, 0.0, work_k);
gsl_blas_ddot(y, work_k, &temp);
temp = pow((1+temp), (nu+ (double) k)/2 );
temp *= gsl_sf_gamma(nu/2) * pow(nu, k/2) * pow(M_PI, k/2) * sqrt(det);
den = gsl_sf_gamma((nu+ (double) k)/2);
den /= temp;
gsl_vector_free(y);
gsl_vector_free(work_k);
gsl_matrix_free(work_k_k);
gsl_matrix_free(Sigmainv);
gsl_permutation_free(p);
return den;
}
void GenericSolver::solve(ReactiveSet& R) {
buildInteractionMatrix(R);
#ifdef WITH_LAPACKE
// calculate SVD of interaction matrix
if(my_SVD) delete my_SVD;
mmat GFI = mmat::identity(the_ixn.nRows()) - the_ixn;
my_SVD = new LAPACKE_Matrix_SVD<double,double>(GFI);
print_singular_values();
#else
// invert matrix
int sig;
gsl_permutation* P = gsl_permutation_alloc(R.nDF());
gsl_matrix* GFI = gsl_matrix_alloc(R.nDF(),R.nDF());
assert(!gsl_linalg_LU_decomp (the_GF, P, &sig));
assert(!gsl_linalg_LU_invert (the_GF, P, GFI));
gsl_permutation_free(P);
gsl_matrix_free(the_GF);
the_GF = GFI;
#endif
}
int gslutils_invert_3x3(const double* A, double* B) {
gsl_matrix* LU;
gsl_permutation *p;
gsl_matrix_view mB;
int rtn = 0;
int signum;
p = gsl_permutation_alloc(3);
gsl_matrix_const_view mA = gsl_matrix_const_view_array(A, 3, 3);
mB = gsl_matrix_view_array(B, 3, 3);
LU = gsl_matrix_alloc(3, 3);
gsl_matrix_memcpy(LU, &mA.matrix);
if (gsl_linalg_LU_decomp(LU, p, &signum) ||
gsl_linalg_LU_invert(LU, p, &mB.matrix)) {
ERROR("gsl_linalg_LU_decomp() or _invert() failed.");
rtn = -1;
}
gsl_permutation_free(p);
gsl_matrix_free(LU);
return rtn;
}
/// Solve system of linear equations M*x == rhs, M is this matrix
/// This matrix is destroyed.
/// @param rhs :: The right-hand-side vector
/// @param x :: The solution vector
/// @throws std::invalid_argument if the input vectors have wrong sizes.
/// @throws std::runtime_error if the GSL fails to solve the equations.
void GSLMatrix::solve(const GSLVector &rhs, GSLVector &x) {
if (size1() != size2()) {
throw std::invalid_argument(
"System of linear equations: the matrix must be square.");
}
size_t n = size1();
if (rhs.size() != n) {
throw std::invalid_argument(
"System of linear equations: right-hand side vector has wrong size.");
}
x.resize(n);
int s;
gsl_permutation *p = gsl_permutation_alloc(n);
gsl_linalg_LU_decomp(gsl(), p, &s); // matrix is modified at this moment
int res = gsl_linalg_LU_solve(gsl(), p, rhs.gsl(), x.gsl());
gsl_permutation_free(p);
if (res != GSL_SUCCESS) {
std::string message = "Failed to solve system of linear equations.\n"
"Error message returned by the GSL:\n" +
std::string(gsl_strerror(res));
throw std::runtime_error(message);
}
}
static int
mc_inverse(lua_State *L)
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
mMatComplex *lu;
mMatComplex *r;
gsl_permutation *p;
int signum;
if (m->l_size != m->r_size)
return luaL_error(L, "square matrix expected");
p = new_permutation(L, m->l_size);
lu = qlua_newMatComplex(L, m->l_size, m->l_size);
r = qlua_newMatComplex(L, m->l_size, m->l_size);
gsl_matrix_complex_memcpy(lu->m, m->m);
gsl_linalg_complex_LU_decomp(lu->m, p, &signum);
if (gsl_linalg_complex_LU_invert(lu->m, p, r->m))
luaL_error(L, "matrix:inverse() failed");
gsl_permutation_free(p);
return 1;
}
double Matrix::determinant()
{
int rows = d_table->numRows();
int cols = d_table->numCols();
if (rows != cols)
{
QMessageBox::critical(0,tr("QtiPlot - Error"),
tr("Calculation failed, the matrix is not square!"));
return GSL_POSINF;
}
QApplication::setOverrideCursor(waitCursor);
gsl_matrix *A = gsl_matrix_alloc (rows, cols);
int i, j;
for (i=0; i<rows; i++)
{
for (j=0; j<cols; j++)
{
QString s = d_table->text(i,j);
gsl_matrix_set (A, i, j, s.toDouble());
}
}
int s;
gsl_permutation * p = gsl_permutation_alloc (rows);
gsl_linalg_LU_decomp (A, p, &s);
double det = gsl_linalg_LU_det (A, s);
gsl_matrix_free (A);
gsl_permutation_free (p);
QApplication::restoreOverrideCursor();
return det;
}
void orderMatrix(const gsl_matrix* x, gsl_matrix* y, const gsl_matrix* M)
{
int n = x->size1;
int m = x->size2;
gsl_matrix* invM = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(invM,M);
int info=0;
char lower = 'U';
int lda = invM->tda;
dpotrf_(&lower, &n, invM->data, &lda, &info);
dpotri_(&lower, &n, invM->data, &lda, &info);
for (int i=0; i<n; i++) {
for (int j=i+1 ; j<n; j++) {
gsl_matrix_set(invM,i,j,gsl_matrix_get(invM,j,i)) ;
}
}
gsl_vector* x_ell_norms = gsl_vector_alloc(m);
gsl_vector* temp = gsl_vector_alloc(n);
for (int i =0;i<m;i++)
{
gsl_vector_const_view xcol = gsl_matrix_const_column(x,i);
My_dgemv(CblasNoTrans, 1.0, invM, &xcol.vector, 0.0, temp);
gsl_vector_set(x_ell_norms, i, -My_ddot(&xcol.vector, temp));
}
gsl_permutation* p = gsl_permutation_alloc(m);
gsl_sort_vector_index(p, x_ell_norms);
for (int i=0; i<n; i++) {
for (int j=0; j<m; j++) {
gsl_matrix_set(y, i, j, gsl_matrix_get(x, i, gsl_permutation_get(p, j)));
}
}
gsl_vector_free(x_ell_norms);
gsl_vector_free(temp);
gsl_matrix_free(invM);
gsl_permutation_free(p);
}
static void
bsimp_free (void * vstate)
{
bsimp_state_t *state = (bsimp_state_t *) vstate;
free (state->delta);
free (state->rhs_temp);
gsl_matrix_free (state->dfdy);
free (state->weight);
free (state->delta_temp);
free (state->y_temp);
free (state->dfdt);
free (state->extrap_work);
free (state->y_extrap_sequence);
free (state->y_extrap_save);
free (state->yp);
gsl_permutation_free (state->p_vec);
gsl_matrix_free (state->a_mat);
gsl_matrix_free (state->d);
free (state);
}
/****************************************************
LU分解を用い共分散行列の行列式・逆行列を計算
gaussian_params のメンバ double *cov から
行列式と逆行列を計算し、メンバ double detcov
と double *icov に計算結果をそれぞれ格納する。
****************************************************/
void
gaussian_params_det_and_inv_covariance (gaussian_params *par)
{
int s;
// Permutation
gsl_permutation *p;
gsl_matrix *lu;
// 1次元配列 par->cov に対する行列の像
// Matrix_view
gsl_matrix_view cov;
// 1次元配列 par->icov に対する行列の像
gsl_matrix_view icov;
cov = gsl_matrix_view_array (par->cov, par->ndim, par->ndim);
if (par->icov == NULL)
par->icov = (double *) malloc (par->ndim * par->ndim * sizeof (double));
icov = gsl_matrix_view_array (par->icov, par->ndim, par->ndim);
p = gsl_permutation_alloc (par->ndim);
// LU分解を計算するために用いるテンポラリな行列 *lu に cov.matrix をコピー
lu = gsl_matrix_alloc (par->ndim, par->ndim);
gsl_matrix_memcpy (lu, &cov.matrix);
// LU-Decomposition
gsl_linalg_LU_decomp (lu, p, &s); // LU分解
par->detcov = gsl_linalg_LU_det (lu, s); // 行列式
gsl_linalg_LU_invert (lu, p, &icov.matrix); // 逆行列
gsl_permutation_free (p);
gsl_matrix_free (lu);
return;
}
static VALUE rb_gsl_linalg_complex_LU_solve(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_vector_complex *b = NULL, *x = NULL;
int flagm = 0, flagx = 0, itmp, signum;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc < 2 || argc > 4)
rb_raise(rb_eArgError, "Usage: solve(m, b), solve(m, b, x), solve(lu, p, b), solve(lu, p, b, x)");
CHECK_MATRIX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 1;
break;
default:
if (argc < 1 || argc > 3)
rb_raise(rb_eArgError, "Usage: LU_solve(b), LU_solve(p, b), LU_solve(b, x), solve(p, b, x)");
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
x = gsl_vector_complex_alloc(b->size);
p = gsl_permutation_alloc(b->size);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
Data_Get_Struct(argv[itmp], gsl_permutation, p);
itmp++;
Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
itmp++;
if (itmp == argc-1) {
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
flagx = 1;
} else {
x = gsl_vector_complex_alloc(m->size1);
}
}
gsl_linalg_complex_LU_solve(mtmp, p, b, x);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
if (flagx == 0) return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, x);
else return argv[argc-1];
}
/* read the configuration file and the graph */
chaincolln chaincolln_readdata(void) {
FILE *fileptr, *initzsfile;
int i, j, k, ndom, nreln, d, r, nitem, dim, maxclass, initclass, relcl, ndim,
domlabel, clusterflag, itemind, nchains, cind, zind;
int *domlabels, *participants, participant;
double val;
double nig[DISTSIZE];
domain *doms;
relation rn;
int *initclasses, ***edgecounts, *relsizes;
char prefix[MAXSTRING];
chaincolln cc;
chain c, c0;
#ifdef GSL
gsl_rng *rng;
const gsl_rng_type *T;
gsl_permutation *perm ;
size_t N;
gsl_rng_env_setup();
T = gsl_rng_default;
rng = gsl_rng_alloc(T);
#endif
fprintf(stdout,"A\n");
nchains = ps.nchains+1;
nig[0] = ps.m; nig[1] = ps.v; nig[2] = ps.a; nig[3] = ps.b;
fileptr = fopen(ps.configfile,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read config file\n"); exit(1);
}
/* initial read of ps.configfile to get ps.maxdim, ps.maxrel, ps.maxitem,
ps.maxclass */
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
relsizes= (int *) my_malloc(nreln*sizeof(int));
ps.maxrel = nreln;
ps.maxitem = 0; ps.maxclass = 0;
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
if (nitem > ps.maxitem) {
ps.maxitem = nitem;
}
if (maxclass > ps.maxclass) {
ps.maxclass= maxclass;
}
}
fprintf(stdout,"B\n");
ps.maxdim = 0;
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
relsizes[r] = ndim;
if (ndim > ps.maxdim) {
ps.maxdim = ndim;
}
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
}
}
fclose(fileptr);
fprintf(stdout,"C\n");
domlabels= (int *) my_malloc(ps.maxdim*sizeof(int));
participants= (int *) my_malloc(ps.maxdim*sizeof(int));
initclasses = (int *) my_malloc(ps.maxitem*sizeof(int));
fprintf(stdout,"D \n");
/* initial read of ps.graphname to get ps.maxobjtuples */
edgecounts = (int ***) my_malloc(ps.maxrel*sizeof(int **));
for (i = 0; i < ps.maxrel; i++) {
edgecounts[i] = (int **) my_malloc(ps.maxdim*sizeof(int *));
for (j = 0; j < ps.maxdim; j++) {
edgecounts[i][j] = (int *) my_malloc(ps.maxitem*sizeof(int));
for (k = 0; k < ps.maxitem; k++) {
edgecounts[i][j][k] = 0;
}
}
}
ps.maxobjtuples = 0;
fprintf(stdout,"D2 \n");
fileptr = fopen(ps.graphname,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read graph\n"); exit(1);
}
while( fscanf( fileptr, " %d", &r)!=EOF ) {
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,r);
ndim = relsizes[r];
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,ndim);
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
participants[dim] = participant;
}
fscanf(fileptr, "%lf", &val);
for (dim = 0; dim < ndim; dim++) {
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
edgecounts[r][dim][participants[dim]]++;
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
}
}
fprintf(stdout,"E\n");
fclose(fileptr);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
for (k = 0; k < ps.maxitem; k++) {
if (edgecounts[i][j][k] > ps.maxobjtuples) {
ps.maxobjtuples = edgecounts[i][j][k];
}
edgecounts[i][j][k]= 0;
}
}
}
fprintf(stdout,"F\n");
free(relsizes);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
free(edgecounts[i][j]);
}
free(edgecounts[i]);
}
free(edgecounts);
fprintf(stdout,"G\n");
/* second read of ps.configfile where we set up datastructures */
fileptr = fopen(ps.configfile,"r");
if (ps.outsideinit) {
initzsfile= fopen(ps.initfile,"r");
if (initzsfile == NULL) {
fprintf(stderr, "couldn't read initzsfile\n"); exit(1);
}
} else {
initzsfile = NULL;
}
fprintf(stdout,"H\n");
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
cc = chaincolln_create(nchains, ndom, nreln, prefix);
c0 = chaincolln_getchain(cc, 0);
fprintf(stdout,"I\n");
/* read domains */
/* input file: nitem maxclass initclass clusterflag*/
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
#ifdef GSL
N = nitem;
#endif
if (ps.outsideinit) {
for (zind = 0; zind < nitem; zind++) {
fscanf(initzsfile, "%d", &initclasses[zind]);
}
}
fprintf(stdout,"J\n");
/* add domains and items to chains */
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_adddomain(c, d, nitem, maxclass, clusterflag, ps.alpha,
ps.alphahyp, initclasses);
#ifdef GSL
perm = gsl_permutation_alloc(N);
gsl_permutation_init(perm);
gsl_ran_shuffle(rng, perm->data, N, sizeof(size_t));
#endif
/* assign items to classes */
relcl = 0;
for (i = 0; i < nitem; i++) {
if (ps.outsideinit) {
chain_additemtoclass(c, d, i, initclasses[i]);
} else {
if (relcl == initclass) relcl = 0;
/* without the GNUSL, each chain gets initialized the same way. This
* is suboptimal */
itemind = i;
#ifdef GSL
itemind = gsl_permutation_get(perm, i);
#endif
chain_additemtoclass(c, d, itemind, relcl);
relcl++;
}
}
#ifdef GSL
gsl_permutation_free(perm);
#endif
}
}
#ifdef GSL
gsl_rng_free(rng);
#endif
fprintf(stdout,"K\n");
/* read relations*/
/* input file: ndim d0 ... dn */
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
domlabels[dim] = domlabel;
}
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addrelation(c, r, ndim, ps.betaprop, ps.betamag, nig, domlabels);
}
}
if (ps.outsideinit) {
fclose(initzsfile);
}
fprintf(stdout,"L\n");
fclose(fileptr);
/* second read of ps.graphname: store edges*/
fileptr = fopen(ps.graphname,"r");
/* input file: relind p0 p1 p2 .. pn val */
while( fscanf( fileptr, " %d", &r)!= EOF ) {
ndim = relation_getdim( chain_getrelation(c0, r) );
doms = relation_getdoms( chain_getrelation(c0, r) );
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
fprintf(stdout,"M %d %d\n",dim,participant);
participants[dim] = participant;
domlabels[dim] = domain_getlabel(doms[dim]);
}
for (i = 0; i < ndim; i++) {
for (j = 0; j < i; j++) {
if (participants[i] == participants[j] &&
domlabels[i] == domlabels[j]) {
fprintf(stderr, "Self links not allowed.\n"); exit(1);
}
}
}
fscanf(fileptr, "%lf", &val);
fprintf(stderr,"%d\n",nchains);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addedge(c, r, val, participants);
rn = chain_getrelation(c, r);
if (doubleeq(val, 0)) {
relation_setmissing(rn, 1);
}
if (val > 1.5 && relation_getdtype(rn) != CONT) {
relation_setdtype(rn, FREQ);
}
if (!doubleeq(val, (int) val)) {
relation_setdtype(rn, CONT);
relation_setmissing(rn, 1); /* XXX: no sparse continuous matrices */
}
}
}
fprintf(stderr,"N\n");
fclose(fileptr);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
for (i = 0; i < chain_getndomains(c); i++) {
chain_updatedomprobs(c, i);
}
}
fprintf(stderr,"O\n");
free(domlabels); free(participants); free(initclasses);
return cc;
}
