static bool matrix_determinant(CMATRIX *m, COMPLEX_VALUE *det)
{
int sign = 0;
int size = WIDTH(m);
if (size != HEIGHT(m))
return TRUE;
gsl_permutation *p = gsl_permutation_calloc(size);
if (COMPLEX(m))
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, CMAT(m));
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
det->z = gsl_linalg_complex_LU_det(tmp, sign);
gsl_matrix_complex_free(tmp);
}
else
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, MAT(m));
gsl_linalg_LU_decomp(tmp, p, &sign);
det->x = gsl_linalg_LU_det(tmp, sign);
det->z.dat[1] = 0;
gsl_matrix_free(tmp);
}
gsl_permutation_free(p);
return FALSE;
}
static int
mc_det(lua_State *L)
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
mMatComplex *lu;
mMatComplex *r;
gsl_permutation *p;
int signum;
gsl_complex d;
QLA_D_Complex *z;
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);
d = gsl_linalg_complex_LU_det(lu->m, signum);
gsl_permutation_free(p);
z = qlua_newComplex(L);
QLA_real(*z) = GSL_REAL(d);
QLA_imag(*z) = GSL_IMAG(d);
return 1;
}
void
qpb_sun_project(qpb_link *u, int n)
{
gsl_eigen_hermv_workspace *gsl_work = gsl_eigen_hermv_alloc(NC);
gsl_matrix_complex *B = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *A = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *V = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *U = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *D = gsl_matrix_complex_alloc(NC, NC);
gsl_vector *S = gsl_vector_alloc(NC);
gsl_permutation *perm = gsl_permutation_alloc(NC);
for(int k=0; k<n; k++){
qpb_complex *a = (qpb_complex *)(u + k);
for(int i=0; i<NC; i++)
for(int j=0; j<NC; j++)
gsl_matrix_complex_set(A, i, j, gsl_complex_rect(a[j + i*NC].re, a[j + i*NC].im));
gsl_matrix_complex_memcpy(U, A);
int sgn;
gsl_linalg_complex_LU_decomp(U, perm, &sgn);
gsl_complex det_A = gsl_linalg_complex_LU_det(U, sgn);
qpb_double phi = gsl_complex_arg(det_A);
gsl_complex one = gsl_complex_rect(1., 0.);
gsl_complex zero = gsl_complex_rect(0., 0.);
gsl_matrix_complex_memcpy(U, A);
svd(U, V, S);
get_theta_matrix(D, S, phi);
gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, one, U, D, zero, B);
gsl_blas_zgemm(CblasNoTrans, CblasConjTrans, one, B, V, zero, A);
for(int i=0; i<NC; i++)
for(int j=0; j<NC; j++){
a[j + i*NC].re = GSL_REAL(gsl_matrix_complex_get(A, i, j));
a[j + i*NC].im = GSL_IMAG(gsl_matrix_complex_get(A, i, j));
}
}
gsl_matrix_complex_free(A);
gsl_matrix_complex_free(B);
gsl_matrix_complex_free(V);
gsl_matrix_complex_free(U);
gsl_matrix_complex_free(D);
gsl_permutation_free(perm);
gsl_vector_free(S);
gsl_eigen_hermv_free(gsl_work);
return;
}
static VALUE rb_gsl_linalg_complex_LU_det(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_complex *z = NULL;
VALUE vz;
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);
} else {
if (itmp != argc-1) rb_raise(rb_eArgError, "signum not given");
signum = NUM2DBL(argv[itmp]);
}
vz = Data_Make_Struct(cgsl_complex, gsl_complex, 0, free, z);
*z = gsl_linalg_complex_LU_det(mtmp, signum);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return vz;
}
/**
* C++ version of gsl_linalg_complex_LU_det().
* @param LU An LU decomposition matrix
* @param signum The sign of the permutation
* @return Error code on failure
*/
inline complex complex_LU_det( matrix_complex& LU, int signum ){
return gsl_linalg_complex_LU_det( LU.get(), signum ); }