void expm(gsl_matrix_complex * L, gsl_complex t, gsl_matrix * m) { int i,j,s; gsl_vector_complex *eval = gsl_vector_complex_alloc(4); gsl_matrix_complex *evec = gsl_matrix_complex_alloc(4, 4); gsl_eigen_nonsymmv_workspace * w = gsl_eigen_nonsymmv_alloc(4); gsl_matrix_complex *evalmat = gsl_matrix_complex_alloc(4, 4); gsl_matrix_complex *vd = gsl_matrix_complex_alloc(4, 4); gsl_complex one = gsl_complex_rect(1, 0); gsl_complex zero = gsl_complex_rect(0, 0); gsl_matrix_complex *K = gsl_matrix_complex_alloc(4, 4); gsl_permutation *p = gsl_permutation_alloc(4); gsl_vector_complex *x = gsl_vector_complex_alloc(4); gsl_vector_complex_view bp; gsl_complex z; gsl_eigen_nonsymmv(m, eval, evec, w); gsl_eigen_nonsymmv_sort(eval, evec, GSL_EIGEN_SORT_ABS_DESC); gsl_eigen_nonsymmv_free(w); // clear workspace for (i = 0; i < 4; i++) { gsl_complex eval_i = gsl_vector_complex_get(eval, i); gsl_complex expeval = gsl_complex_mul(eval_i,t); expeval = gsl_complex_exp(expeval); gsl_matrix_complex_set(evalmat, i, i, expeval); } gsl_vector_complex_free(eval); // clear vector for eigenvalues // v'L'=De'v' gsl_blas_zgemm(CblasTrans, CblasTrans, one, evalmat, evec, zero, vd); gsl_matrix_complex_transpose(evec);//transpose v gsl_matrix_complex_memcpy(K,evec); for (i = 0; i < 4; i++) { bp = gsl_matrix_complex_column(vd, i); gsl_linalg_complex_LU_decomp(evec, p, &s); gsl_linalg_complex_LU_solve(evec, p, &bp.vector, x); for (j = 0; j < 4; j++) { z = gsl_vector_complex_get(x, j); gsl_matrix_complex_set(L,i,j,z); //'through the looking glass' transpose } gsl_matrix_complex_memcpy(evec,K); } gsl_permutation_free(p); gsl_vector_complex_free(x); gsl_matrix_complex_free(vd); gsl_matrix_complex_free(evec); gsl_matrix_complex_free(evalmat); gsl_matrix_complex_free(K); }
void test_eigen_herm_matrix(const gsl_matrix_complex * m, size_t count, const char * desc) { const size_t N = m->size1; gsl_matrix_complex * A = gsl_matrix_complex_alloc(N, N); gsl_vector * eval = gsl_vector_alloc(N); gsl_vector * evalv = gsl_vector_alloc(N); gsl_vector * x = gsl_vector_alloc(N); gsl_vector * y = gsl_vector_alloc(N); gsl_matrix_complex * evec = gsl_matrix_complex_alloc(N, N); gsl_eigen_herm_workspace * w = gsl_eigen_herm_alloc(N); gsl_eigen_hermv_workspace * wv = gsl_eigen_hermv_alloc(N); gsl_matrix_complex_memcpy(A, m); gsl_eigen_hermv(A, evalv, evec, wv); test_eigen_herm_results(m, evalv, evec, count, desc, "unsorted"); gsl_matrix_complex_memcpy(A, m); gsl_eigen_herm(A, eval, w); /* sort eval and evalv */ gsl_vector_memcpy(x, eval); gsl_vector_memcpy(y, evalv); gsl_sort_vector(x); gsl_sort_vector(y); test_eigenvalues_real(y, x, desc, "unsorted"); gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_ASC); test_eigen_herm_results(m, evalv, evec, count, desc, "val/asc"); gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_DESC); test_eigen_herm_results(m, evalv, evec, count, desc, "val/desc"); gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_ASC); test_eigen_herm_results(m, evalv, evec, count, desc, "abs/asc"); gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_DESC); test_eigen_herm_results(m, evalv, evec, count, desc, "abs/desc"); gsl_matrix_complex_free(A); gsl_vector_free(eval); gsl_vector_free(evalv); gsl_vector_free(x); gsl_vector_free(y); gsl_matrix_complex_free(evec); gsl_eigen_herm_free(w); gsl_eigen_hermv_free(wv); } /* test_eigen_herm_matrix() */
static VALUE rb_gsl_linalg_complex_LU_svx(int argc, VALUE *argv, VALUE obj) { gsl_matrix_complex *m = NULL, *mtmp = NULL; gsl_permutation *p = NULL; gsl_vector_complex *x = NULL; int flagm = 0, itmp, signum; switch (TYPE(obj)) { case T_MODULE: case T_CLASS: case T_OBJECT: 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: 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, x); p = gsl_permutation_alloc(x->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, x); itmp++; } gsl_linalg_complex_LU_svx(mtmp, p, x); if (flagm == 1) { gsl_matrix_complex_free(mtmp); gsl_permutation_free(p); } return argv[argc-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_sgndet(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_sgndet(mtmp, signum); if (flagm == 1) { gsl_matrix_complex_free(mtmp); gsl_permutation_free(p); } return vz; }
static int mc_qr(lua_State *L) /* (-1,+2,e) */ { mMatComplex *m = qlua_checkMatComplex(L, 1); mMatComplex *qr = qlua_newMatComplex(L, m->l_size, m->r_size); mMatComplex *q = qlua_newMatComplex(L, m->l_size, m->l_size); mMatComplex *r = qlua_newMatComplex(L, m->l_size, m->r_size); int nm = m->l_size < m->r_size? m->l_size: m->r_size; gsl_vector_complex *tau; gsl_matrix_complex_memcpy(qr->m, m->m); tau = gsl_vector_complex_alloc(nm); if (tau == 0) { lua_gc(L, LUA_GCCOLLECT, 0); tau = gsl_vector_complex_alloc(nm); if (tau == 0) luaL_error(L, "not enough memory"); } if (gsl_linalg_complex_QR_decomp(qr->m, tau)) luaL_error(L, "matrix:qr() failed"); if (gsl_linalg_complex_QR_unpack(qr->m, tau, q->m, r->m)) luaL_error(L, "matrix:qr() failed"); gsl_vector_complex_free(tau); return 2; }
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; }
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 VALUE rb_gsl_blas_ztrsm2(VALUE obj, VALUE s, VALUE u, VALUE ta, VALUE d, VALUE a, VALUE aa, VALUE bb) { gsl_matrix_complex *A = NULL, *B = NULL, *Bnew = NULL; gsl_complex *pa = NULL; CBLAS_SIDE_t Side; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t TransA; CBLAS_DIAG_t Diag; CHECK_FIXNUM(s); CHECK_FIXNUM(u); CHECK_FIXNUM(ta); CHECK_FIXNUM(d); CHECK_COMPLEX(a); CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(bb); Side = FIX2INT(s); Uplo = FIX2INT(u); TransA = FIX2INT(ta); Diag = FIX2INT(d); Data_Get_Struct(a, gsl_complex, pa); Data_Get_Struct(aa, gsl_matrix_complex, A); Data_Get_Struct(bb, gsl_matrix_complex, B); Bnew = gsl_matrix_complex_alloc(B->size1, B->size2); gsl_matrix_complex_memcpy(Bnew, B); gsl_blas_ztrsm(Side, Uplo, TransA, Diag, *pa, A, Bnew); return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Bnew); }
/* * Calculate the matrix exponent of A and store in eA. * Algorithm: Truncated Talyor series. * * WARNING: Large errors possible and it's slow. */ int gsl_ext_expm_complex(gsl_matrix_complex *A, gsl_matrix_complex *eA) { int i; gsl_complex alpha, beta, z; gsl_matrix_complex *I, *T; I = gsl_matrix_complex_alloc(A->size1, A->size2); T = gsl_matrix_complex_alloc(A->size1, A->size2); GSL_SET_COMPLEX(&alpha, 1.0, 0.0); GSL_SET_COMPLEX(&beta, 0.0, 0.0); gsl_matrix_complex_set_identity(I); gsl_matrix_complex_set_identity(eA); for (i = 50; i > 0; i--) { GSL_SET_COMPLEX(&z, 1.0 / i, 0.0); gsl_matrix_complex_scale(eA, z); gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, alpha, eA, A, beta, T); gsl_matrix_complex_add(T, I); gsl_matrix_complex_memcpy(eA, T); } return 0; }
static int mc_solve(lua_State *L) { mMatComplex *m = qlua_checkMatComplex(L, 1); mVecComplex *v = qlua_checkVecComplex(L, 2); mMatComplex *lu; mVecComplex *x; gsl_permutation *p; /* XXX assume GSL and QLA_D_Complex use compatible layout */ gsl_vector_complex_view vb = gsl_vector_complex_view_array((void *)&v->val[0], v->size); gsl_vector_complex_view vx; int signum; if (m->l_size != m->r_size) return luaL_error(L, "square matrix expected"); if (m->l_size != v->size) return luaL_error(L, "vector dim mismatch matrix size"); p = new_permutation(L, m->l_size); lu = qlua_newMatComplex(L, m->l_size, m->l_size); x = qlua_newVecComplex(L, m->l_size); /* XXX assume GSL and QLA_D_Complex use compatible layout */ vx = gsl_vector_complex_view_array((void *)&x->val[0], x->size); gsl_matrix_complex_memcpy(lu->m, m->m); gsl_linalg_complex_LU_decomp(lu->m, p, &signum); if (gsl_linalg_complex_LU_solve(lu->m, p, &vb.vector, &vx.vector)) luaL_error(L, "matrix:solve() failed"); gsl_permutation_free(p); return 1; }
static VALUE rb_gsl_linalg_complex_LU_invert(int argc, VALUE *argv, VALUE obj) { gsl_matrix_complex *m = NULL, *mtmp = NULL, *inverse = NULL; gsl_permutation *p = NULL; 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 { Data_Get_Struct(argv[itmp], gsl_permutation, p); } inverse = gsl_matrix_complex_alloc(m->size1, m->size2); gsl_linalg_complex_LU_invert(mtmp, p, inverse); if (flagm == 1) { gsl_matrix_complex_free(mtmp); gsl_permutation_free(p); } return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, inverse); }
static CMATRIX *MATRIX_copy(CMATRIX *_object) { CMATRIX *copy = MATRIX_create(WIDTH(THIS), HEIGHT(THIS), COMPLEX(THIS), FALSE); if (COMPLEX(THIS)) gsl_matrix_complex_memcpy(CMAT(copy), CMAT(THIS)); else gsl_matrix_memcpy(MAT(copy), MAT(THIS)); return copy; }
void qdpack_matrix_memcpy(qdpack_matrix_t *dst, qdpack_matrix_t *src) { if (src == NULL || dst == NULL) return; dst->n = src->n; dst->m = src->m; gsl_matrix_complex_memcpy(dst->data, src->data); }
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; 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; } 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; } } 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); }
static int do_ccmul(lua_State *L, mMatComplex *a, double b_re, double b_im) { mMatComplex *r = qlua_newMatComplex(L, a->l_size, a->r_size); gsl_complex z; gsl_matrix_complex_memcpy(r->m, a->m); GSL_SET_COMPLEX(&z, b_re, b_im); gsl_matrix_complex_scale(r->m, z); return 1; }
void gsl_matrix_complex_change_basis_UCMU(gsl_matrix_complex* U, gsl_matrix_complex* M){ unsigned int numneu = U->size1; gsl_matrix_complex *U1 = gsl_matrix_complex_alloc(numneu,numneu); gsl_matrix_complex *U2 = gsl_matrix_complex_alloc(numneu,numneu); gsl_matrix_complex_memcpy(U1,U); gsl_matrix_complex_memcpy(U2,U); gsl_matrix_complex *T1 = gsl_matrix_complex_alloc(numneu,numneu); // doing : U M U^dagger gsl_blas_zgemm(CblasNoTrans,CblasNoTrans, gsl_complex_rect(1.0,0.0),M, U1,gsl_complex_rect(0.0,0.0),T1); gsl_blas_zgemm(CblasConjTrans,CblasNoTrans, gsl_complex_rect(1.0,0.0),U2, T1,gsl_complex_rect(0.0,0.0),M); // now H_current is in the interaction basis of the mass basis gsl_matrix_complex_free(U1); gsl_matrix_complex_free(U2); gsl_matrix_complex_free(T1); }
static int cm_sub_cm(lua_State *L) { mMatComplex *a = qlua_checkMatComplex(L, 1); mMatComplex *b = qlua_checkMatComplex(L, 2); int al = a->l_size; int ar = a->r_size; mMatComplex *r = qlua_newMatComplex(L, al, ar); if ((al != b->l_size) || (ar != b->r_size)) return luaL_error(L, "matrix sizes mismatch in m + m"); gsl_matrix_complex_memcpy(r->m, a->m); gsl_matrix_complex_sub(r->m, b->m); return 1; }
bool Matrix_Inverse(gsl_matrix_complex *A, gsl_matrix_complex *B){ int s; gsl_matrix_complex *T; gsl_permutation *p; T=gsl_matrix_complex_alloc(B->size1,B->size2); gsl_matrix_complex_memcpy(T, B); p=gsl_permutation_alloc (T->size1); gsl_linalg_complex_LU_decomp (T, p, &s); gsl_linalg_complex_LU_invert (T, p,A); gsl_permutation_free(p); gsl_matrix_complex_free(T); return true; }
VALUE rb_gsl_linalg_complex_LU_decomp2(int argc, VALUE *argv, VALUE obj) { gsl_matrix_complex *m = NULL, *mnew = NULL; gsl_permutation *p = NULL; int signum, itmp; size_t size; VALUE objm, obj2; switch (TYPE(obj)) { case T_MODULE: case T_CLASS: case T_OBJECT: if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc); CHECK_MATRIX_COMPLEX(argv[0]); Data_Get_Struct(argv[0], gsl_matrix_complex, m); itmp = 1; break; default: CHECK_MATRIX_COMPLEX(obj); Data_Get_Struct(obj, gsl_matrix_complex, m); itmp = 0; } size = m->size1; mnew = gsl_matrix_complex_alloc(m->size1, m->size2); gsl_matrix_complex_memcpy(mnew, m); objm = Data_Wrap_Struct(cgsl_matrix_complex_LU, 0, gsl_matrix_complex_free, mnew); switch (argc-itmp) { case 0: p = gsl_permutation_alloc(size); gsl_linalg_complex_LU_decomp(mnew, p, &signum); obj2 = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p); return rb_ary_new3(3, objm ,obj2, INT2FIX(signum)); break; case 1: /* when a permutation object is given */ CHECK_PERMUTATION(argv[itmp]); Data_Get_Struct(argv[itmp], gsl_permutation, p); gsl_linalg_complex_LU_decomp(m, p, &signum); return rb_ary_new3(3, objm , argv[itmp], INT2FIX(signum)); break; default: rb_raise(rb_eArgError, "Usage: LU_decomp!() or LU_decomp!(permutation)"); } }
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 VALUE rb_gsl_blas_zsyrk2(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa, VALUE b, VALUE cc) { gsl_matrix_complex *A = NULL, *C = NULL, *Cnew = NULL; gsl_complex *pa = NULL, *pb = NULL; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t Trans; CHECK_FIXNUM(u); CHECK_FIXNUM(t); CHECK_COMPLEX(a); CHECK_COMPLEX(b); CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(cc); Uplo = FIX2INT(u); Trans = FIX2INT(t); Data_Get_Struct(a, gsl_complex, pa); Data_Get_Struct(b, gsl_complex, pb); Data_Get_Struct(aa, gsl_matrix_complex, A); Data_Get_Struct(cc, gsl_matrix_complex, C); Cnew = gsl_matrix_complex_alloc(C->size1, C->size2); gsl_matrix_complex_memcpy(Cnew, C); gsl_blas_zsyrk(Uplo, Trans, *pa, A, *pb, Cnew); return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Cnew); }
static VALUE rb_gsl_blas_zherk2(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa, VALUE b, VALUE cc) { gsl_matrix_complex *A = NULL, *C = NULL, *Cnew = NULL; double alpha, beta; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t Trans; CHECK_FIXNUM(u); CHECK_FIXNUM(t); Need_Float(a); Need_Float(b); CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(cc); Uplo = FIX2INT(u); Trans = FIX2INT(t); alpha = NUM2DBL(a); beta = NUM2DBL(b); Data_Get_Struct(aa, gsl_matrix_complex, A); Data_Get_Struct(cc, gsl_matrix_complex, C); Cnew = gsl_matrix_complex_alloc(C->size1, C->size2); gsl_matrix_complex_memcpy(Cnew, C); gsl_blas_zherk(Uplo, Trans, alpha, A, beta, Cnew); return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Cnew); }
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; }
/* computes the svd of a complex matrix. Missing in gsl. */ int svd(gsl_matrix_complex *A, gsl_matrix_complex *V, gsl_vector *S) { int n = A->size1; gsl_eigen_hermv_workspace *gsl_work = gsl_eigen_hermv_alloc(n); gsl_matrix_complex *Asq = gsl_matrix_complex_alloc(n, n); gsl_complex zero = gsl_complex_rect(0., 0.); gsl_complex one = gsl_complex_rect(1., 0.); gsl_vector *e = gsl_vector_alloc(n); gsl_matrix_complex *U = gsl_matrix_complex_alloc(n, n); gsl_blas_zgemm(CblasNoTrans, CblasConjTrans, one, A, A, zero, Asq); gsl_eigen_hermv(Asq, e, U, gsl_work); gsl_eigen_hermv_sort(e, U, GSL_EIGEN_SORT_VAL_DESC); gsl_blas_zgemm(CblasConjTrans, CblasNoTrans, one, A, A, zero, Asq); gsl_eigen_hermv(Asq, e, V, gsl_work); gsl_eigen_hermv_sort(e, V, GSL_EIGEN_SORT_VAL_DESC); gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, one, A, V, zero, Asq); gsl_blas_zgemm(CblasConjTrans, CblasNoTrans, one, U, Asq, zero, A); for(int i=0; i<n; i++){ gsl_complex x = gsl_matrix_complex_get(A, i, i); double phase = gsl_complex_arg(gsl_complex_mul_real(x, 1./sqrt(e->data[i]))); gsl_vector_complex_view U_col = gsl_matrix_complex_column(U, i); gsl_vector_complex_scale(&U_col.vector, gsl_complex_polar(1., phase)); gsl_vector_set(S, i, sqrt(gsl_vector_get(e, i))); } gsl_matrix_complex_memcpy(A, U); gsl_vector_free(e); gsl_matrix_complex_free(U); gsl_matrix_complex_free(Asq); gsl_eigen_hermv_free(gsl_work); return 0; }
static int mc_eigen(lua_State *L) /* (-1,+2,e) */ { mMatComplex *m = qlua_checkMatComplex(L, 1); gsl_matrix_complex_view mx; gsl_eigen_hermv_workspace *w; gsl_vector *ev; mVecReal *lambda; mMatComplex *trans; mMatComplex *tmp; int n; int i; int lo, hi; switch (lua_gettop(L)) { case 1: if (m->l_size != m->r_size) return luaL_error(L, "matrix:eigen() expects square matrix"); lo = 0; hi = m->l_size; break; case 2: lo = 0; hi = luaL_checkint(L, 2); if ((hi > m->l_size) || (hi > m->r_size)) return slice_out(L); break; case 3: lo = luaL_checkint(L, 2); hi = luaL_checkint(L, 3); if ((lo >= hi) || (lo > m->l_size) || (lo > m->r_size) || (hi > m->l_size) || (hi > m->r_size)) return slice_out(L); break; default: return luaL_error(L, "matrix:eigen(): illegal arguments"); } n = hi - lo; mx = gsl_matrix_complex_submatrix(m->m, lo, lo, n, n); tmp = qlua_newMatComplex(L, n, n); gsl_matrix_complex_memcpy(tmp->m, &mx.matrix); lambda = qlua_newVecReal(L, n); trans = qlua_newMatComplex(L, n, n); ev = new_gsl_vector(L, n); w = gsl_eigen_hermv_alloc(n); if (w == 0) { lua_gc(L, LUA_GCCOLLECT, 0); w = gsl_eigen_hermv_alloc(n); if (w == 0) luaL_error(L, "not enough memory"); } if (gsl_eigen_hermv(tmp->m, ev, trans->m, w)) luaL_error(L, "matrix:eigen() failed"); if (gsl_eigen_hermv_sort(ev, trans->m, GSL_EIGEN_SORT_VAL_ASC)) luaL_error(L, "matrix:eigen() eigenvalue ordering failed"); for (i = 0; i < n; i++) lambda->val[i] = gsl_vector_get(ev, i); gsl_vector_free(ev); gsl_eigen_hermv_free(w); return 2; }
void test_eigen_genherm(void) { size_t N_max = 20; size_t n, i; gsl_rng *r = gsl_rng_alloc(gsl_rng_default); for (n = 1; n <= N_max; ++n) { gsl_matrix_complex * A = gsl_matrix_complex_alloc(n, n); gsl_matrix_complex * B = gsl_matrix_complex_alloc(n, n); gsl_matrix_complex * ma = gsl_matrix_complex_alloc(n, n); gsl_matrix_complex * mb = gsl_matrix_complex_alloc(n, n); gsl_vector * eval = gsl_vector_alloc(n); gsl_vector * evalv = gsl_vector_alloc(n); gsl_vector * x = gsl_vector_alloc(n); gsl_vector * y = gsl_vector_alloc(n); gsl_vector_complex * work = gsl_vector_complex_alloc(n); gsl_matrix_complex * evec = gsl_matrix_complex_alloc(n, n); gsl_eigen_genherm_workspace * w = gsl_eigen_genherm_alloc(n); gsl_eigen_genhermv_workspace * wv = gsl_eigen_genhermv_alloc(n); for (i = 0; i < 5; ++i) { create_random_herm_matrix(A, r, -10, 10); create_random_complex_posdef_matrix(B, r, work); gsl_matrix_complex_memcpy(ma, A); gsl_matrix_complex_memcpy(mb, B); gsl_eigen_genhermv(ma, mb, evalv, evec, wv); test_eigen_genherm_results(A, B, evalv, evec, i, "random", "unsorted"); gsl_matrix_complex_memcpy(ma, A); gsl_matrix_complex_memcpy(mb, B); gsl_eigen_genherm(ma, mb, eval, w); /* eval and evalv have to be sorted? not sure why */ gsl_vector_memcpy(x, eval); gsl_vector_memcpy(y, evalv); gsl_sort_vector(x); gsl_sort_vector(y); test_eigenvalues_real(y, x, "genherm, random", "unsorted"); gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_ASC); test_eigen_genherm_results(A, B, evalv, evec, i, "random", "val/asc"); gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_DESC); test_eigen_genherm_results(A, B, evalv, evec, i, "random", "val/desc"); gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_ASC); test_eigen_genherm_results(A, B, evalv, evec, i, "random", "abs/asc"); gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_DESC); test_eigen_genherm_results(A, B, evalv, evec, i, "random", "abs/desc"); } gsl_matrix_complex_free(A); gsl_matrix_complex_free(B); gsl_matrix_complex_free(ma); gsl_matrix_complex_free(mb); gsl_vector_free(eval); gsl_vector_free(evalv); gsl_vector_free(x); gsl_vector_free(y); gsl_vector_complex_free(work); gsl_matrix_complex_free(evec); gsl_eigen_genherm_free(w); gsl_eigen_genhermv_free(wv); } gsl_rng_free(r); } /* test_eigen_genherm() */
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]; }
bool Matrix_Copy(gsl_matrix_complex *A, gsl_matrix_complex *B){ gsl_matrix_complex_memcpy(A,B); return true; }
/** ---------------------------------------------------------------------------- * Sort eigenvectors */ int gsl_ext_eigen_sort(gsl_matrix_complex *evec, gsl_vector_complex *eval, int sort_order) { gsl_complex z; gsl_matrix_complex *evec_copy; gsl_vector_complex *eval_copy; int *idx_map, i, j, idx_temp; double p1, p2; if ((evec->size1 != evec->size2) || (evec->size1 != eval->size)) { return -1; } evec_copy = gsl_matrix_complex_alloc(evec->size1, evec->size2); eval_copy = gsl_vector_complex_alloc(eval->size); idx_map = (int *)malloc(sizeof(int) * eval->size); gsl_matrix_complex_memcpy(evec_copy, evec); gsl_vector_complex_memcpy(eval_copy, eval); // calculate new eigenvalue order for (i = 0; i < eval->size; i++) { idx_map[i] = i; } for (i = 0; i < eval->size - 1; i++) { for (j = i+1; j < eval->size; j++) { idx_temp = -1; if (sort_order == GSL_EXT_EIGEN_SORT_ABS) { p1 = gsl_complex_abs(gsl_vector_complex_get(eval, idx_map[i])); p2 = gsl_complex_abs(gsl_vector_complex_get(eval, idx_map[j])); if (p1 > p2) { idx_temp = idx_map[i]; } } if (sort_order == GSL_EXT_EIGEN_SORT_PHASE) { p1 = gsl_complex_arg(gsl_vector_complex_get(eval, idx_map[i])); p2 = gsl_complex_arg(gsl_vector_complex_get(eval, idx_map[j])); if (p1 > M_PI) p1 -= 2*M_PI; if (p1 <= -M_PI) p1 += 2*M_PI; if (p2 > M_PI) p2 -= 2*M_PI; if (p2 <= -M_PI) p2 += 2*M_PI; //if (((p2 < p1) && (p1 - p2 < M_PI)) || ) if (p2 < p1) { idx_temp = idx_map[i]; } } if (idx_temp != -1) { // swap //idx_temp = idx_map[i]; idx_map[i] = idx_map[j]; idx_map[j] = idx_temp; } } } // reshuffle the eigenvectors and eigenvalues for (i = 0; i < eval->size; i++) { for (j = 0; j < eval->size; j++) { z = gsl_matrix_complex_get(evec_copy, idx_map[i], j); gsl_matrix_complex_set(evec, i, j, z); //z = gsl_matrix_complex_get(evec_copy, i, idx_map[j]); //gsl_matrix_complex_set(evec, i, j, z); } z = gsl_vector_complex_get(eval_copy, idx_map[i]); gsl_vector_complex_set(eval, i, z); } gsl_matrix_complex_free(evec_copy); gsl_vector_complex_free(eval_copy); free(idx_map); return 0; }