SEXP Csparse_Csparse_prod(SEXP a, SEXP b) { CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chc = cholmod_ssmult(cha, chb, /*out_stype:*/ 0, /* values:= is_numeric (T/F) */ cha->xtype > 0, /*out sorted:*/ 1, &c); const char *cl_a = class_P(a), *cl_b = class_P(b); char diag[] = {'\0', '\0'}; int uploT = 0; SEXP dn = PROTECT(allocVector(VECSXP, 2)); R_CheckStack(); #ifdef DEBUG_Matrix_verbose Rprintf("DBG Csparse_C*_prod(%s, %s)\n", cl_a, cl_b); #endif /* Preserve triangularity and even unit-triangularity if appropriate. * Note that in that case, the multiplication itself should happen * faster. But there's no support for that in CHOLMOD */ /* UGLY hack -- rather should have (fast!) C-level version of * is(a, "triangularMatrix") etc */ if (cl_a[1] == 't' && cl_b[1] == 't') /* FIXME: fails for "Cholesky","BunchKaufmann"..*/ if(*uplo_P(a) == *uplo_P(b)) { /* both upper, or both lower tri. */ uploT = (*uplo_P(a) == 'U') ? 1 : -1; if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */ /* "remove the diagonal entries": */ chm_diagN2U(chc, uploT, /* do_realloc */ FALSE); diag[0]= 'U'; } else diag[0]= 'N'; } SET_VECTOR_ELT(dn, 0, /* establish dimnames */ duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), 0))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), 1))); UNPROTECT(1); return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn); }
SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans) { int tr = asLogical(trans); CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chTr, chc; const char *cl_a = class_P(a), *cl_b = class_P(b); char diag[] = {'\0', '\0'}; int uploT = 0; SEXP dn = PROTECT(allocVector(VECSXP, 2)); R_CheckStack(); chTr = cholmod_transpose((tr) ? chb : cha, chb->xtype, &c); chc = cholmod_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb, /*out_stype:*/ 0, cha->xtype, /*out sorted:*/ 1, &c); cholmod_free_sparse(&chTr, &c); /* Preserve triangularity and unit-triangularity if appropriate; * see Csparse_Csparse_prod() for comments */ if (cl_a[1] == 't' && cl_b[1] == 't') if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */ uploT = (*uplo_P(b) == 'U') ? 1 : -1; if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */ chm_diagN2U(chc, uploT, /* do_realloc */ FALSE); diag[0]= 'U'; } else diag[0]= 'N'; } SET_VECTOR_ELT(dn, 0, /* establish dimnames */ duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), (tr) ? 0 : 1))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), (tr) ? 0 : 1))); UNPROTECT(1); return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn); }
BasicMesh MeshTransferer::transfer(const vector<PhGUtils::Matrix3x3d> &S1grad) { if( !(S0set && T0set) ) { throw "S0 or T0 not set."; } auto &S = S1grad; auto &T = T0grad; int nfaces = S0.faces.nrow; int nverts = S0.verts.nrow; // assemble sparse matrix A int nrowsA = nfaces * 3; int nsv = stationary_vertices.size(); int nrowsC = nsv; int nrows = nrowsA + nrowsC; int ncols = nverts; int ntermsA = nfaces*9; int ntermsC = stationary_vertices.size(); int nterms = ntermsA + ntermsC; SparseMatrix A(nrows, ncols, nterms); // fill in the deformation gradient part for(int i=0, ioffset=0;i<nfaces;++i) { /* * Ai: * 1 2 3 4 5 ... nfaces*3 * 1 2 3 4 5 ... nfaces*3 * 1 2 3 4 5 ... nfaces*3 * Ai = reshape(Ai, 1, nfaces*9) * * Aj = reshape(repmat(S0.faces', 3, 1), 1, nfaces*9) * Av = reshape(cell2mat(T)', 1, nfaces*9) */ int *f = S0.faces.rowptr(i); auto Ti = T[i]; A.append(ioffset, f[0], Ti(0)); A.append(ioffset, f[1], Ti(1)); A.append(ioffset, f[2], Ti(2)); ++ioffset; A.append(ioffset, f[0], Ti(3)); A.append(ioffset, f[1], Ti(4)); A.append(ioffset, f[2], Ti(5)); ++ioffset; A.append(ioffset, f[0], Ti(6)); A.append(ioffset, f[1], Ti(7)); A.append(ioffset, f[2], Ti(8)); ++ioffset; } // fill in the lower part of A, stationary vertices part for(int i=0;i<nsv;++i) { A.append(nrowsA+i, stationary_vertices[i], 1); } ofstream fA("A.txt"); fA<<A; fA.close(); // fill in c matrix DenseMatrix c(nrows, 3); for(int i=0;i<3;++i) { for(int j=0, joffset=0;j<nfaces;++j) { auto &Sj = S[j]; c(joffset, i) = Sj(0, i); ++joffset; c(joffset, i) = Sj(1, i); ++joffset; c(joffset, i) = Sj(2, i); ++joffset; } } for(int i=0;i<3;++i) { for(int j=0, joffset=nrowsA;j<nsv;++j,++joffset) { auto vj = T0.verts.rowptr(stationary_vertices[j]); c(joffset, i) = vj[i]; } } cholmod_sparse *G = A.to_sparse(); cholmod_sparse *Gt = cholmod_transpose(G, 2, global::cm); // compute GtD // just multiply Dsi to corresponding elemenets double *Gtx = (double*)Gt->x; const int* Gtp = (const int*)(Gt->p); for(int i=0;i<nrowsA;++i) { int fidx = i/3; for(int j=Gtp[i];j<Gtp[i+1];++j) { Gtx[j] *= Ds(fidx); } } // compute GtDG cholmod_sparse *GtDG = cholmod_ssmult(Gt, G, 0, 1, 1, global::cm); GtDG->stype = 1; // compute GtD * c cholmod_dense *GtDc = cholmod_allocate_dense(ncols, 3, ncols, CHOLMOD_REAL, global::cm); double alpha[2] = {1, 0}; double beta[2] = {0, 0}; cholmod_sdmult(Gt, 0, alpha, beta, c.to_dense(), GtDc, global::cm); // solve for GtDG \ GtDc cholmod_factor *L = cholmod_analyze(GtDG, global::cm); cholmod_factorize(GtDG, L, global::cm); cholmod_dense *x = cholmod_solve(CHOLMOD_A, L, GtDc, global::cm); // make a copy of T0 BasicMesh Td = T0; // change the vertices with x double *Vx = (double*)x->x; for(int i=0;i<nverts;++i) { Td.verts(i, 0) = Vx[i]; Td.verts(i, 1) = Vx[i+nverts]; Td.verts(i, 2) = Vx[i+nverts*2]; } // release memory cholmod_free_sparse(&G, global::cm); cholmod_free_sparse(&Gt, global::cm); cholmod_free_sparse(&GtDG, global::cm); cholmod_free_dense(&GtDc, global::cm); cholmod_free_factor(&L, global::cm); cholmod_free_dense(&x, global::cm); return Td; }