Diff of /pkg/src/Csparse.c

Parent Directory | Revision Log | Patch

	revision 1029, Wed Nov 9 15:26:22 2005 UTC	revision 1059, Wed Nov 23 22:20:13 2005 UTC
#	Line 1	Line 1
1	/* Sparse matrices in compress column-oriented form */	/* Sparse matrices in compress column-oriented form */
2	#include "Csparse.h"	#include "Csparse.h"
	#ifdef USE_CHOLMOD
3	#include "chm_common.h"	#include "chm_common.h"
	#endif  /* USE_CHOLMOD */
4
5	SEXP Csparse_validate(SEXP x)	SEXP Csparse_validate(SEXP x)
6	{	{
#	Line 31	Line 29
29	return ScalarLogical(1);	return ScalarLogical(1);
30	}	}
31
32		SEXP Csparse_to_dense(SEXP x)
33		{
34		cholmod_sparse *chxs = as_cholmod_sparse(x);
35		cholmod_dense *chxd = cholmod_sparse_to_dense(chxs, &c);
36
37		free(chxs);
38		return chm_dense_to_SEXP(chxd, 1);
39		}
40
41	SEXP Csparse_to_Tsparse(SEXP x)	SEXP Csparse_to_Tsparse(SEXP x)
42	{	{
	#ifdef USE_CHOLMOD
43	cholmod_sparse *chxs = as_cholmod_sparse(x);	cholmod_sparse *chxs = as_cholmod_sparse(x);
44	cholmod_triplet *chxt = cholmod_sparse_to_triplet(chxs, &c);	cholmod_triplet *chxt = cholmod_sparse_to_triplet(chxs, &c);
45
46	free(chxs);	free(chxs);
47	return chm_triplet_to_SEXP(chxt, 1);	return chm_triplet_to_SEXP(chxt, 1);
	#else
	error("General conversion requires CHOLMOD");
	return R_NilValue;          /* -Wall */
	#endif  /* USE_CHOLMOD */
48	}	}
49
50	SEXP Csparse_transpose(SEXP x)	SEXP Csparse_transpose(SEXP x)
51	{	{
	#ifdef USE_CHOLMOD
52	cholmod_sparse *chx = as_cholmod_sparse(x);	cholmod_sparse *chx = as_cholmod_sparse(x);
53	cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);	cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);
54
55	free(chx);	free(chx);
56	return chm_sparse_to_SEXP(chxt, 1);	return chm_sparse_to_SEXP(chxt, 1);
	#else
	error("General conversion requires CHOLMOD");
	return R_NilValue;          /* -Wall */
	#endif  /* USE_CHOLMOD */
57	}	}
58
59	SEXP Csparse_Csparse_prod(SEXP a, SEXP b)	SEXP Csparse_Csparse_prod(SEXP a, SEXP b)
60	{	{
61	#ifdef USE_CHOLMOD	cholmod_sparse *cha = as_cholmod_sparse(a),
62	cholmod_sparse *cha = as_cholmod_sparse(a), *chb = as_cholmod_sparse(b);	*chb = as_cholmod_sparse(b);
63	cholmod_sparse *chc = cholmod_ssmult(cha, chb, 0, (int) cha->xtype, 1, &c);	cholmod_sparse *chc = cholmod_ssmult(cha, chb, 0, cha->xtype, 1, &c);
64
65	free(cha); free(chb);	free(cha); free(chb);
66	return chm_sparse_to_SEXP(chc, 1);	return chm_sparse_to_SEXP(chc, 1);
	#else
	error("General multiplication requires CHOLMOD");
	return R_NilValue;          /* -Wall */
	#endif  /* USE_CHOLMOD */
67	}	}
68
69	SEXP Csparse_dense_prod(SEXP a, SEXP b)	SEXP Csparse_dense_prod(SEXP a, SEXP b)
70	{	{
	#ifdef USE_CHOLMOD
71	cholmod_sparse *cha = as_cholmod_sparse(a);	cholmod_sparse *cha = as_cholmod_sparse(a);
72	cholmod_dense *chb = as_cholmod_dense(b);	cholmod_dense *chb = as_cholmod_dense(b);
73	cholmod_dense *chc = cholmod_allocate_dense(cha->nrow, chb->ncol,	cholmod_dense *chc = cholmod_allocate_dense(cha->nrow, chb->ncol,
#	Line 86	Line 77
77	cholmod_sdmult(cha, 0, &alpha, &beta, chb, chc, &c);	cholmod_sdmult(cha, 0, &alpha, &beta, chb, chc, &c);
78	free(cha); free(chb);	free(cha); free(chb);
79	return chm_dense_to_SEXP(chc, 1);	return chm_dense_to_SEXP(chc, 1);
	#else
	error("General multiplication requires CHOLMOD");
	return R_NilValue;          /* -Wall */
	#endif  /* USE_CHOLMOD */
80	}	}
81
82	SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet)	SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet)
83	{	{
	#ifdef USE_CHOLMOD
84	int trip = asLogical(triplet),	int trip = asLogical(triplet),
85	tr   = asLogical(trans); /* gets reversed because _aat is tcrossprod */	tr   = asLogical(trans); /* gets reversed because _aat is tcrossprod */
86	cholmod_triplet	cholmod_triplet
#	Line 117	Line 103
103	}	}
104	if (!tr) cholmod_free_sparse(&chxt, &c);	if (!tr) cholmod_free_sparse(&chxt, &c);
105	return chm_sparse_to_SEXP(chcp, 1);	return chm_sparse_to_SEXP(chcp, 1);
	#else
	error("General crossproduct requires CHOLMOD");
	return R_NilValue;          /* -Wall */
	#endif  /* USE_CHOLMOD */
106	}	}
107

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.1029   changed lines   Added in v.1059

---

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