Diff of /pkg/src/Csparse.c

Parent Directory | Revision Log | Patch

	revision 2222, Fri Jul 18 10:00:25 2008 UTC	revision 2223, Fri Jul 18 23:04:48 2008 UTC
#	Line 40	Line 40
40	}	}
41	}	}
42	if (!sorted) {	if (!sorted) {
43	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
44	R_CheckStack();	R_CheckStack();
45
46	cholmod_sort(chx, &c);	cholmod_sort(chx, &c);
#	Line 109	Line 109
109	* FIXME: replace by non-CHOLMOD code ! */	* FIXME: replace by non-CHOLMOD code ! */
110	SEXP Csparse_to_dense(SEXP x)	SEXP Csparse_to_dense(SEXP x)
111	{	{
112	CHM_SP chxs = AS_CHM_SP(x);	CHM_SP chxs = AS_CHM_SP__(x);
113	/* This loses the symmetry property, since cholmod_dense has none,	/* This loses the symmetry property, since cholmod_dense has none,
114	* BUT, much worse (FIXME!), it also transforms CHOLMOD_PATTERN ("n") matrices	* BUT, much worse (FIXME!), it also transforms CHOLMOD_PATTERN ("n") matrices
115	* to numeric (CHOLMOD_REAL) ones : */	* to numeric (CHOLMOD_REAL) ones : */
#	Line 122	Line 122
122
123	SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)	SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)
124	{	{
125	CHM_SP chxs = AS_CHM_SP(x);	CHM_SP chxs = AS_CHM_SP__(x);
126	CHM_SP chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);	CHM_SP chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);
127	int tr = asLogical(tri);	int tr = asLogical(tri);
128	R_CheckStack();	R_CheckStack();
#	Line 135	Line 135
135
136	SEXP Csparse_to_matrix(SEXP x)	SEXP Csparse_to_matrix(SEXP x)
137	{	{
138	return chm_dense_to_matrix(cholmod_sparse_to_dense(AS_CHM_SP(x), &c),	return chm_dense_to_matrix(cholmod_sparse_to_dense(AS_CHM_SP__(x), &c),
139	1 /*do_free*/, GET_SLOT(x, Matrix_DimNamesSym));	1 /*do_free*/, GET_SLOT(x, Matrix_DimNamesSym));
140	}	}
141
142	SEXP Csparse_to_Tsparse(SEXP x, SEXP tri)	SEXP Csparse_to_Tsparse(SEXP x, SEXP tri)
143	{	{
144	CHM_SP chxs = AS_CHM_SP(x);	CHM_SP chxs = AS_CHM_SP__(x);
145	CHM_TR chxt = cholmod_sparse_to_triplet(chxs, &c);	CHM_TR chxt = cholmod_sparse_to_triplet(chxs, &c);
146	int tr = asLogical(tri);	int tr = asLogical(tri);
147	int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
#	Line 156	Line 156
156	/* this used to be called  sCMatrix_to_gCMatrix(..)   [in ./dsCMatrix.c ]: */	/* this used to be called  sCMatrix_to_gCMatrix(..)   [in ./dsCMatrix.c ]: */
157	SEXP Csparse_symmetric_to_general(SEXP x)	SEXP Csparse_symmetric_to_general(SEXP x)
158	{	{
159	CHM_SP chx = AS_CHM_SP(x), chgx;	CHM_SP chx = AS_CHM_SP__(x), chgx;
160	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
161	R_CheckStack();	R_CheckStack();
162
#	Line 170	Line 170
170
171	SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)	SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)
172	{	{
173	CHM_SP chx = AS_CHM_SP(x), chgx;	CHM_SP chx = AS_CHM_SP__(x), chgx;
174	int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;	int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;
175	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
176	R_CheckStack();	R_CheckStack();
#	Line 185	Line 185
185	{	{
186	/* TODO: lgCMatrix & igC* currently go via double prec. cholmod -	/* TODO: lgCMatrix & igC* currently go via double prec. cholmod -
187	*       since cholmod (& cs) lacks sparse 'int' matrices */	*       since cholmod (& cs) lacks sparse 'int' matrices */
188	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
189	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
190	CHM_SP chxt = cholmod_transpose(chx, chx->xtype, &c);	CHM_SP chxt = cholmod_transpose(chx, chx->xtype, &c);
191	SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;	SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;
#	Line 204	Line 204
204	SEXP Csparse_Csparse_prod(SEXP a, SEXP b)	SEXP Csparse_Csparse_prod(SEXP a, SEXP b)
205	{	{
206	CHM_SP	CHM_SP
207	cha = AS_CHM_SP(Csparse_diagU2N(a)),	cha = AS_CHM_SP(a),
208	chb = AS_CHM_SP(Csparse_diagU2N(b)),	chb = AS_CHM_SP(b),
209	chc = cholmod_ssmult(cha, chb, /*out_stype:*/ 0,	chc = cholmod_ssmult(cha, chb, /*out_stype:*/ 0,
210	cha->xtype, /*out sorted:*/ 1, &c);	cha->xtype, /*out sorted:*/ 1, &c);
211	const char *cl_a = class_P(a), *cl_b = class_P(b);	const char *cl_a = class_P(a), *cl_b = class_P(b);
#	Line 242	Line 242
242	{	{
243	int tr = asLogical(trans);	int tr = asLogical(trans);
244	CHM_SP	CHM_SP
245	cha = AS_CHM_SP(Csparse_diagU2N(a)),	cha = AS_CHM_SP(a),
246	chb = AS_CHM_SP(Csparse_diagU2N(b)),	chb = AS_CHM_SP(b),
247	chTr, chc;	chTr, chc;
248	const char *cl_a = class_P(a), *cl_b = class_P(b);	const char *cl_a = class_P(a), *cl_b = class_P(b);
249	char diag[] = {'\0', '\0'};	char diag[] = {'\0', '\0'};
#	Line 277	Line 277
277
278	SEXP Csparse_dense_prod(SEXP a, SEXP b)	SEXP Csparse_dense_prod(SEXP a, SEXP b)
279	{	{
280	CHM_SP cha = AS_CHM_SP(Csparse_diagU2N(a));	CHM_SP cha = AS_CHM_SP(a);
281	SEXP b_M = PROTECT(mMatrix_as_dgeMatrix(b));	SEXP b_M = PROTECT(mMatrix_as_dgeMatrix(b));
282	CHM_DN chb = AS_CHM_DN(b_M);	CHM_DN chb = AS_CHM_DN(b_M);
283	CHM_DN chc = cholmod_allocate_dense(cha->nrow, chb->ncol, cha->nrow,	CHM_DN chc = cholmod_allocate_dense(cha->nrow, chb->ncol, cha->nrow,
#	Line 297	Line 297
297
298	SEXP Csparse_dense_crossprod(SEXP a, SEXP b)	SEXP Csparse_dense_crossprod(SEXP a, SEXP b)
299	{	{
300	CHM_SP cha = AS_CHM_SP(Csparse_diagU2N(a));	CHM_SP cha = AS_CHM_SP(a);
301	SEXP b_M = PROTECT(mMatrix_as_dgeMatrix(b));	SEXP b_M = PROTECT(mMatrix_as_dgeMatrix(b));
302	CHM_DN chb = AS_CHM_DN(b_M);	CHM_DN chb = AS_CHM_DN(b_M);
303	CHM_DN chc = cholmod_allocate_dense(cha->ncol, chb->ncol, cha->ncol,	CHM_DN chc = cholmod_allocate_dense(cha->ncol, chb->ncol, cha->ncol,
#	Line 321	Line 321
321	{	{
322	int trip = asLogical(triplet),	int trip = asLogical(triplet),
323	tr   = asLogical(trans); /* gets reversed because _aat is tcrossprod */	tr   = asLogical(trans); /* gets reversed because _aat is tcrossprod */
324	CHM_TR cht = trip ? AS_CHM_TR(Tsparse_diagU2N(x)) : (CHM_TR) NULL;	CHM_TR cht = trip ? AS_CHM_TR(x) : (CHM_TR) NULL;
325	CHM_SP chcp, chxt,	CHM_SP chcp, chxt,
326	chx = (trip ?	chx = (trip ?
327	cholmod_triplet_to_sparse(cht, cht->nnz, &c) :	cholmod_triplet_to_sparse(cht, cht->nnz, &c) :
328	AS_CHM_SP(Csparse_diagU2N(x)));	AS_CHM_SP(x));
329	SEXP dn = PROTECT(allocVector(VECSXP, 2));	SEXP dn = PROTECT(allocVector(VECSXP, 2));
330	R_CheckStack();	R_CheckStack();
331
#	Line 352	Line 352
352	const char *cl = class_P(x);	const char *cl = class_P(x);
353	/* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */	/* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */
354	int tr = (cl[1] == 't');	int tr = (cl[1] == 't');
355	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
356	CHM_SP ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);	CHM_SP ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);
357	double dtol = asReal(tol);	double dtol = asReal(tol);
358	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
#	Line 368	Line 368
368
369	SEXP Csparse_horzcat(SEXP x, SEXP y)	SEXP Csparse_horzcat(SEXP x, SEXP y)
370	{	{
371	CHM_SP chx = AS_CHM_SP(x), chy = AS_CHM_SP(y);	CHM_SP chx = AS_CHM_SP__(x), chy = AS_CHM_SP__(y);
372	int Rkind = 0; /* only for "d" - FIXME */	int Rkind = 0; /* only for "d" - FIXME */
373	R_CheckStack();	R_CheckStack();
374
#	Line 379	Line 379
379
380	SEXP Csparse_vertcat(SEXP x, SEXP y)	SEXP Csparse_vertcat(SEXP x, SEXP y)
381	{	{
382	CHM_SP chx = AS_CHM_SP(x), chy = AS_CHM_SP(y);	CHM_SP chx = AS_CHM_SP__(x), chy = AS_CHM_SP__(y);
383	int Rkind = 0; /* only for "d" - FIXME */	int Rkind = 0; /* only for "d" - FIXME */
384	R_CheckStack();	R_CheckStack();
385
#	Line 390	Line 390
390
391	SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2)	SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2)
392	{	{
393	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
394	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
395	CHM_SP ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c);	CHM_SP ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c);
396	R_CheckStack();	R_CheckStack();
#	Line 409	Line 409
409	return (x);	return (x);
410	}	}
411	else { /* unit triangular (diag='U'): "fill the diagonal" & diag:= "N" */	else { /* unit triangular (diag='U'): "fill the diagonal" & diag:= "N" */
412	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
413	CHM_SP eye = cholmod_speye(chx->nrow, chx->ncol, chx->xtype, &c);	CHM_SP eye = cholmod_speye(chx->nrow, chx->ncol, chx->xtype, &c);
414	double one[] = {1, 0};	double one[] = {1, 0};
415	CHM_SP ans = cholmod_add(chx, eye, one, one, TRUE, TRUE, &c);	CHM_SP ans = cholmod_add(chx, eye, one, one, TRUE, TRUE, &c);
#	Line 434	Line 434
434	}	}
435	else { /* triangular with diag='N'): now drop the diagonal */	else { /* triangular with diag='N'): now drop the diagonal */
436	/* duplicate, since chx will be modified: */	/* duplicate, since chx will be modified: */
437	CHM_SP chx = AS_CHM_SP(duplicate(x));	CHM_SP chx = AS_CHM_SP__(duplicate(x));
438	int uploT = (*uplo_P(x) == 'U') ? 1 : -1,	int uploT = (*uplo_P(x) == 'U') ? 1 : -1,
439	Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
440	R_CheckStack();	R_CheckStack();
#	Line 449	Line 449
449
450	SEXP Csparse_submatrix(SEXP x, SEXP i, SEXP j)	SEXP Csparse_submatrix(SEXP x, SEXP i, SEXP j)
451	{	{
452	CHM_SP chx = AS_CHM_SP(x);	CHM_SP chx = AS_CHM_SP__(x);
453	int rsize = (isNull(i)) ? -1 : LENGTH(i),	int rsize = (isNull(i)) ? -1 : LENGTH(i),
454	csize = (isNull(j)) ? -1 : LENGTH(j);	csize = (isNull(j)) ? -1 : LENGTH(j);
455	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;	int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
#	Line 474	Line 474
474	if (!f)	if (!f)
475	error(_("failure to open file \"%s\" for writing"),	error(_("failure to open file \"%s\" for writing"),
476	CHAR(asChar(fname)));	CHAR(asChar(fname)));
477	if (!cholmod_write_sparse(f, AS_CHM_SP(Csparse_diagU2N(x)),	if (!cholmod_write_sparse(f, AS_CHM_SP(x),
478	(CHM_SP)NULL, (char*) NULL, &c))	(CHM_SP)NULL, (char*) NULL, &c))
479	error(_("cholmod_write_sparse returned error code"));	error(_("cholmod_write_sparse returned error code"));
480	fclose(f);	fclose(f);

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.2222   changed lines   Added in v.2223

---

R-Forge@R-project.org	ViewVC Help
Powered by ViewVC 1.0.0