Annotation of /pkg/src/Csparse.c

Parent Directory | Revision Log

---

Revision 1265 - (view) (download) (as text)

1 :	bates	1218	/* Sparse matrices in compressed column-oriented form */
2 :	bates	922	#include "Csparse.h"
3 :			#include "chm_common.h"
4 :
5 :			SEXP Csparse_validate(SEXP x)
6 :			{
7 :			SEXP pslot = GET_SLOT(x, Matrix_pSym),
8 :			islot = GET_SLOT(x, Matrix_iSym);
9 :			int j, ncol = length(pslot) - 1,
10 :			*dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
11 :			nrow, *xp = INTEGER(pslot),
12 :			*xi = INTEGER(islot);
13 :
14 :			nrow = dims[0];
15 :			if (length(pslot) <= 0)
16 :			return mkString(_("slot p must have length > 0"));
17 :			if (xp[0] != 0)
18 :			return mkString(_("first element of slot p must be zero"));
19 :			if (length(islot) != xp[ncol])
20 :			return mkString(_("last element of slot p must match length of slots i and x"));
21 :			for (j = 0; j < ncol; j++) {
22 :			if (xp[j] > xp[j+1])
23 :			return mkString(_("slot p must be non-decreasing"));
24 :			}
25 :			for (j = 0; j < length(islot); j++) {
26 :			if (xi[j] < 0 || xi[j] >= nrow)
27 :			return mkString(_("all row indices must be between 0 and nrow-1"));
28 :			}
29 :			return ScalarLogical(1);
30 :			}
31 :
32 :	bates	1059	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 :	bates	1141	Free(chxs);
38 :	bates	1059	return chm_dense_to_SEXP(chxd, 1);
39 :			}
40 :
41 :	bates	922	SEXP Csparse_to_Tsparse(SEXP x)
42 :			{
43 :	maechler	925	cholmod_sparse *chxs = as_cholmod_sparse(x);
44 :	bates	922	cholmod_triplet *chxt = cholmod_sparse_to_triplet(chxs, &c);
45 :
46 :	bates	1141	Free(chxs);
47 :	bates	922	return chm_triplet_to_SEXP(chxt, 1);
48 :			}
49 :
50 :			SEXP Csparse_transpose(SEXP x)
51 :			{
52 :			cholmod_sparse *chx = as_cholmod_sparse(x);
53 :			cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);
54 :
55 :	bates	1141	Free(chx);
56 :	bates	922	return chm_sparse_to_SEXP(chxt, 1);
57 :			}
58 :
59 :			SEXP Csparse_Csparse_prod(SEXP a, SEXP b)
60 :			{
61 :	bates	1059	cholmod_sparse *cha = as_cholmod_sparse(a),
62 :			*chb = as_cholmod_sparse(b);
63 :			cholmod_sparse *chc = cholmod_ssmult(cha, chb, 0, cha->xtype, 1, &c);
64 :	bates	922
65 :	bates	1141	Free(cha); Free(chb);
66 :	bates	922	return chm_sparse_to_SEXP(chc, 1);
67 :			}
68 :
69 :			SEXP Csparse_dense_prod(SEXP a, SEXP b)
70 :			{
71 :			cholmod_sparse *cha = as_cholmod_sparse(a);
72 :			cholmod_dense *chb = as_cholmod_dense(b);
73 :			cholmod_dense *chc = cholmod_allocate_dense(cha->nrow, chb->ncol,
74 :			cha->nrow, chb->xtype, &c);
75 :			double alpha = 1, beta = 0;
76 :
77 :			cholmod_sdmult(cha, 0, &alpha, &beta, chb, chc, &c);
78 :	bates	1141	Free(cha); Free(chb);
79 :	bates	923	return chm_dense_to_SEXP(chc, 1);
80 :	bates	922	}
81 :	maechler	925
82 :	bates	1067	SEXP Csparse_dense_crossprod(SEXP a, SEXP b)
83 :			{
84 :			cholmod_sparse *cha = as_cholmod_sparse(a);
85 :			cholmod_dense *chb = as_cholmod_dense(b);
86 :			cholmod_dense *chc = cholmod_allocate_dense(cha->ncol, chb->ncol,
87 :			cha->ncol, chb->xtype, &c);
88 :			double alpha = 1, beta = 0;
89 :
90 :			cholmod_sdmult(cha, 1, &alpha, &beta, chb, chc, &c);
91 :			Free(cha); Free(chb);
92 :			return chm_dense_to_SEXP(chc, 1);
93 :			}
94 :
95 :	bates	928	SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet)
96 :	bates	922	{
97 :	maechler	957	int trip = asLogical(triplet),
98 :			tr = asLogical(trans); /* gets reversed because _aat is tcrossprod */
99 :	bates	928	cholmod_triplet
100 :			*cht = trip ? as_cholmod_triplet(x) : (cholmod_triplet*) NULL;
101 :			cholmod_sparse *chcp, *chxt,
102 :			*chx = trip ? cholmod_triplet_to_sparse(cht, cht->nnz, &c)
103 :			: as_cholmod_sparse(x);
104 :	bates	922
105 :	bates	923	if (!tr)
106 :			chxt = cholmod_transpose(chx, (int) chx->xtype, &c);
107 :	bates	928	chcp = cholmod_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);
108 :	maechler	957	if(!chcp)
109 :			error("Csparse_crossprod(): error return from cholmod_aat()");
110 :	bates	923
111 :	bates	930	if (trip) {
112 :			cholmod_free_sparse(&chx, &c);
113 :	bates	1141	Free(cht);
114 :	bates	930	} else {
115 :	bates	1141	Free(chx);
116 :	bates	930	}
117 :	bates	923	if (!tr) cholmod_free_sparse(&chxt, &c);
118 :			return chm_sparse_to_SEXP(chcp, 1);
119 :	bates	922	}
120 :	bates	923
121 :	bates	1218	SEXP Csparse_horzcat(SEXP x, SEXP y)
122 :			{
123 :			cholmod_sparse *chx = as_cholmod_sparse(x),
124 :			*chy = as_cholmod_sparse(y), *ans;
125 :
126 :			ans = cholmod_horzcat(chx, chy, 1, &c);
127 :			Free(chx); Free(chy);
128 :			return chm_sparse_to_SEXP(ans, 1);
129 :			}
130 :
131 :			SEXP Csparse_vertcat(SEXP x, SEXP y)
132 :			{
133 :			cholmod_sparse *chx = as_cholmod_sparse(x),
134 :			*chy = as_cholmod_sparse(y), *ans;
135 :
136 :			ans = cholmod_vertcat(chx, chy, 1, &c);
137 :			Free(chx); Free(chy);
138 :			return chm_sparse_to_SEXP(ans, 1);
139 :			}
140 :	bates	1265
141 :			SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2)
142 :			{
143 :			cholmod_sparse *chx = as_cholmod_sparse(x), *ans;
144 :
145 :			ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c);
146 :			Free(chx);
147 :			return chm_sparse_to_SEXP(ans, 1);
148 :			}

---

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