The R Project SVN – R-packages – Diff – /branches/Matrix-APIchange/src/cs_utils.c



	}
    }
    return (is_upper ? 1 : (is_lower ? -1 : 0)) ;
}
 
 
 
 
 
 
 
 
 
 
 
/**
 * Create a cs object with the contents of x.
 *
 * @param x pointer to an object that inherits from CsparseMatrix
 *

 */
cs *Matrix_as_cs(cs *ans, SEXP x)
{
    char *valid[] = {"dgCMatrix", "dtCMatrix", ""};/* had also "dsCMatrix", but that
						    * only stores one triangle */
    int *dims, ctype = Matrix_check_class(class_P(x), valid);
    SEXP islot;
 
    if (ctype < 0) error("invalid class of object to Matrix_as_cs");
				/* dimensions and nzmax */
    dims = INTEGER(GET_SLOT(x, Matrix_DimSym));

 */
SEXP Matrix_cs_to_SEXP(cs *a, char *cl, int dofree)
{
    SEXP ans;
    char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};
    int *dims, ctype = Matrix_check_class(cl, valid), nz;
 
    if (ctype < 0)
	error("invalid class of object to Matrix_cs_to_SEXP");
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
				/* allocate and copy common slots */

css *Matrix_as_css(css *ans, SEXP x)
{
    char *cl = class_P(x);
	*valid[] = {"css_LU", "css_QR", ""};
    int *nz = INTEGER(GET_SLOT(x, install("nz"))),
	ctype = Matrix_check_class(cl, valid);
 
    if (ctype < 0) error("invalid class of object to Matrix_as_css");
    ans->q = INTEGER(GET_SLOT(x, install("Q")));
    ans->m2 = nz[0]; ans->lnz = nz[1]; ans->unz = nz[2];
    switch(ctype) {

 * to the slots of x.
 */
csn *Matrix_as_csn(csn *ans, SEXP x)
{
    char *valid[] = {"csn_LU", "csn_QR", ""};
    int ctype = Matrix_check_class(class_P(x), valid);
 
    if (ctype < 0) error("invalid class of object to Matrix_as_csn");
    ans->U = Matrix_as_cs(GET_SLOT(x, install("U")));
    ans->L = Matrix_as_cs(GET_SLOT(x, install("L")));
    switch(ctype) {

 */
SEXP Matrix_css_to_SEXP(css *S, char *cl, int dofree, int m, int n)
{
    SEXP ans;
    char *valid[] = {"css_LU", "css_QR", ""};
    int *nz, ctype = Matrix_check_class(cl, valid);
 
    if (ctype < 0)
	error("Inappropriate class '%s' for Matrix_css_to_SEXP", cl);
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
				/* allocate and copy common slots */

 */
SEXP Matrix_csn_to_SEXP(csn *N, char *cl, int dofree)
{
    SEXP ans;
    char *valid[] = {"csn_LU", "csn_QR", ""};
    int ctype = Matrix_check_class(cl, valid), n = (N->U)->n;
 
    if (ctype < 0)
	error("Inappropriate class '%s' for Matrix_csn_to_SEXP", cl);
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
				/* allocate and copy common slots */

Rev 4543	Rev 4549
Line 17...	Line 17...
17	`}`	17	`}`
18	`}`	18	`}`
19	`return (is_upper ? 1 : (is_lower ? -1 : 0)) ;`	19	`return (is_upper ? 1 : (is_lower ? -1 : 0)) ;`
20	`}`	20	`}`
21		21
22	`static R_INLINE int`	-
23	`check_class(const char class, char *valid)`	-
24	`{`	-
25	`int ans;`	-
26	`for (ans = 0; ; ans++) {`	-
27	`if (!strlen(valid[ans])) return -1;`	-
28	`if (!strcmp(class, valid[ans])) return ans;`	-
29	`}`	-
30	`}`	-
31		-
32	`/**`	22	`/**`
33	`* Create a cs object with the contents of x.`	23	`* Create a cs object with the contents of x.`
34	`*`	24	`*`
35	`* @param x pointer to an object that inherits from CsparseMatrix`	25	`* @param x pointer to an object that inherits from CsparseMatrix`
36	`*`	26	`*`
Line 39...	Line 29...
39	`*/`	29	`*/`
40	`cs Matrix_as_cs(cs ans, SEXP x)`	30	`cs Matrix_as_cs(cs ans, SEXP x)`
41	`{`	31	`{`
42	`char valid[] = {"dgCMatrix", "dtCMatrix", ""};/ had also "dsCMatrix", but that`	32	`char valid[] = {"dgCMatrix", "dtCMatrix", ""};/ had also "dsCMatrix", but that`
43	`* only stores one triangle */`	33	`* only stores one triangle */`
44	`int *dims, ctype = check_class(class_P(x), valid);`	34	`int *dims, ctype = Matrix_check_class(class_P(x), valid);`
45	`SEXP islot;`	35	`SEXP islot;`
46		36
47	`if (ctype < 0) error("invalid class of object to Matrix_as_cs");`	37	`if (ctype < 0) error("invalid class of object to Matrix_as_cs");`
48	`/* dimensions and nzmax */`	38	`/* dimensions and nzmax */`
49	`dims = INTEGER(GET_SLOT(x, Matrix_DimSym));`	39	`dims = INTEGER(GET_SLOT(x, Matrix_DimSym));`
Line 70...	Line 60...
70	`*/`	60	`*/`
71	`SEXP Matrix_cs_to_SEXP(cs a, char cl, int dofree)`	61	`SEXP Matrix_cs_to_SEXP(cs a, char cl, int dofree)`
72	`{`	62	`{`
73	`SEXP ans;`	63	`SEXP ans;`
74	`char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};`	64	`char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};`
75	`int *dims, ctype = check_class(cl, valid), nz;`	65	`int *dims, ctype = Matrix_check_class(cl, valid), nz;`
76		66
77	`if (ctype < 0)`	67	`if (ctype < 0)`
78	`error("invalid class of object to Matrix_cs_to_SEXP");`	68	`error("invalid class of object to Matrix_cs_to_SEXP");`
79	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`	69	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`
80	`/* allocate and copy common slots */`	70	`/* allocate and copy common slots */`
Line 110...	Line 100...
110	`css Matrix_as_css(css ans, SEXP x)`	100	`css Matrix_as_css(css ans, SEXP x)`
111	`{`	101	`{`
112	`char *cl = class_P(x);`	102	`char *cl = class_P(x);`
113	`*valid[] = {"css_LU", "css_QR", ""};`	103	`*valid[] = {"css_LU", "css_QR", ""};`
114	`int *nz = INTEGER(GET_SLOT(x, install("nz"))),`	104	`int *nz = INTEGER(GET_SLOT(x, install("nz"))),`
115	`ctype = check_class(cl, valid);`	105	`ctype = Matrix_check_class(cl, valid);`
116		106
117	`if (ctype < 0) error("invalid class of object to Matrix_as_css");`	107	`if (ctype < 0) error("invalid class of object to Matrix_as_css");`
118	`ans->q = INTEGER(GET_SLOT(x, install("Q")));`	108	`ans->q = INTEGER(GET_SLOT(x, install("Q")));`
119	`ans->m2 = nz[0]; ans->lnz = nz[1]; ans->unz = nz[2];`	109	`ans->m2 = nz[0]; ans->lnz = nz[1]; ans->unz = nz[2];`
120	`switch(ctype) {`	110	`switch(ctype) {`
Line 144...	Line 134...
144	`* to the slots of x.`	134	`* to the slots of x.`
145	`*/`	135	`*/`
146	`csn Matrix_as_csn(csn ans, SEXP x)`	136	`csn Matrix_as_csn(csn ans, SEXP x)`
147	`{`	137	`{`
148	`char *valid[] = {"csn_LU", "csn_QR", ""};`	138	`char *valid[] = {"csn_LU", "csn_QR", ""};`
149	`int ctype = check_class(class_P(x), valid);`	139	`int ctype = Matrix_check_class(class_P(x), valid);`
150		140
151	`if (ctype < 0) error("invalid class of object to Matrix_as_csn");`	141	`if (ctype < 0) error("invalid class of object to Matrix_as_csn");`
152	`ans->U = Matrix_as_cs(GET_SLOT(x, install("U")));`	142	`ans->U = Matrix_as_cs(GET_SLOT(x, install("U")));`
153	`ans->L = Matrix_as_cs(GET_SLOT(x, install("L")));`	143	`ans->L = Matrix_as_cs(GET_SLOT(x, install("L")));`
154	`switch(ctype) {`	144	`switch(ctype) {`
Line 180...	Line 170...
180	`*/`	170	`*/`
181	`SEXP Matrix_css_to_SEXP(css S, char cl, int dofree, int m, int n)`	171	`SEXP Matrix_css_to_SEXP(css S, char cl, int dofree, int m, int n)`
182	`{`	172	`{`
183	`SEXP ans;`	173	`SEXP ans;`
184	`char *valid[] = {"css_LU", "css_QR", ""};`	174	`char *valid[] = {"css_LU", "css_QR", ""};`
185	`int *nz, ctype = check_class(cl, valid);`	175	`int *nz, ctype = Matrix_check_class(cl, valid);`
186		176
187	`if (ctype < 0)`	177	`if (ctype < 0)`
188	`error("Inappropriate class '%s' for Matrix_css_to_SEXP", cl);`	178	`error("Inappropriate class '%s' for Matrix_css_to_SEXP", cl);`
189	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`	179	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`
190	`/* allocate and copy common slots */`	180	`/* allocate and copy common slots */`
Line 223...	Line 213...
223	`*/`	213	`*/`
224	`SEXP Matrix_csn_to_SEXP(csn N, char cl, int dofree)`	214	`SEXP Matrix_csn_to_SEXP(csn N, char cl, int dofree)`
225	`{`	215	`{`
226	`SEXP ans;`	216	`SEXP ans;`
227	`char *valid[] = {"csn_LU", "csn_QR", ""};`	217	`char *valid[] = {"csn_LU", "csn_QR", ""};`
228	`int ctype = check_class(cl, valid), n = (N->U)->n;`	218	`int ctype = Matrix_check_class(cl, valid), n = (N->U)->n;`
229		219
230	`if (ctype < 0)`	220	`if (ctype < 0)`
231	`error("Inappropriate class '%s' for Matrix_csn_to_SEXP", cl);`	221	`error("Inappropriate class '%s' for Matrix_csn_to_SEXP", cl);`
232	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`	222	`ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));`
233	`/* allocate and copy common slots */`	223	`/* allocate and copy common slots */`

The R Project SVN R-packages

(root)/branches/Matrix-APIchange/src/cs_utils.c – Rev 4543 → 4549