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



#include "sparseQR.h"
 
SEXP sparseQR_validate(SEXP x)
{
    CSP V = AS_CSP(GET_SLOT(x, install("V"))),
	R = AS_CSP(GET_SLOT(x, install("R")));
    SEXP beta = GET_SLOT(x, install("beta")),
	p = GET_SLOT(x, Matrix_pSym),
	q = GET_SLOT(x, install("q"));
    int	lq = LENGTH(q);
 

 
 
SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)
{
    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));
    CSP V = AS_CSP(GET_SLOT(qr, install("V")));
 
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
		   INTEGER(GET_SLOT(qr, Matrix_pSym)),
		   asLogical(trans),
		   REAL(GET_SLOT(ans, Matrix_xSym)),
		   INTEGER(GET_SLOT(ans, Matrix_DimSym)));
 
 
    UNPROTECT(1);
    return ans;
}
 
SEXP sparseQR_coef(SEXP qr, SEXP y)
{
    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y)),
	qslot = GET_SLOT(qr, install("q"));
    CSP V = AS_CSP(GET_SLOT(qr, install("V"))),
	R = AS_CSP(GET_SLOT(qr, install("R")));
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
	*q = INTEGER(qslot),
	j, lq = LENGTH(qslot), m = R->m, n = R->n;
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
	*x = Calloc(m, double);

	if (lq) {
	    cs_ipvec(q, aj, x, n);
	    Memcpy(aj, x, n);
	}
    }
    Free(x);
    UNPROTECT(1);
    return ans;
}
 
SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid)
{
    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));
    CSP V = AS_CSP(GET_SLOT(qr, install("V")));
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
	*p = INTEGER(GET_SLOT(qr, Matrix_pSym)),
	i, j, m = V->m, n = V->n, res = asLogical(resid);
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
	*beta = REAL(GET_SLOT(qr, install("beta")));

	else 			/* zero last m - n rows */
	    for (i = n; i < m; i++) ax[i + j * m] = 0;
    }
    /* multiply by Q and apply inverse row permutation */
    sparseQR_Qmult(V, beta, p, 0, ax, ydims);
 
    UNPROTECT(1);
    return ans;
}

Rev 4529	Rev 4543
Line 1...	Line 1...
1	`#include "sparseQR.h"`	1	`#include "sparseQR.h"`
2		2
3	`SEXP sparseQR_validate(SEXP x)`	3	`SEXP sparseQR_validate(SEXP x)`
4	`{`	4	`{`
5	`cs *V = Matrix_as_cs(GET_SLOT(x, install("V"))),`	5	`CSP V = AS_CSP(GET_SLOT(x, install("V"))),`
6	`*R = Matrix_as_cs(GET_SLOT(x, install("R")));`	6	`R = AS_CSP(GET_SLOT(x, install("R")));`
7	`SEXP beta = GET_SLOT(x, install("beta")),`	7	`SEXP beta = GET_SLOT(x, install("beta")),`
8	`p = GET_SLOT(x, Matrix_pSym),`	8	`p = GET_SLOT(x, Matrix_pSym),`
9	`q = GET_SLOT(x, install("q"));`	9	`q = GET_SLOT(x, install("q"));`
10	`int lq = LENGTH(q);`	10	`int lq = LENGTH(q);`
11		11
Line 60...	Line 60...
60		60
61		61
62	`SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)`	62	`SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)`
63	`{`	63	`{`
64	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));`	64	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));`
65	`cs *V = Matrix_as_cs(GET_SLOT(qr, install("V")));`	65	`CSP V = AS_CSP(GET_SLOT(qr, install("V")));`
66		66
67	`sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),`	67	`sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),`
68	`INTEGER(GET_SLOT(qr, Matrix_pSym)),`	68	`INTEGER(GET_SLOT(qr, Matrix_pSym)),`
69	`asLogical(trans),`	69	`asLogical(trans),`
70	`REAL(GET_SLOT(ans, Matrix_xSym)),`	70	`REAL(GET_SLOT(ans, Matrix_xSym)),`
71	`INTEGER(GET_SLOT(ans, Matrix_DimSym)));`	71	`INTEGER(GET_SLOT(ans, Matrix_DimSym)));`
72		-
73	`Free(V);`	-
74	`UNPROTECT(1);`	72	`UNPROTECT(1);`
75	`return ans;`	73	`return ans;`
76	`}`	74	`}`
77		75
78	`SEXP sparseQR_coef(SEXP qr, SEXP y)`	76	`SEXP sparseQR_coef(SEXP qr, SEXP y)`
79	`{`	77	`{`
80	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y)),`	78	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y)),`
81	`qslot = GET_SLOT(qr, install("q"));`	79	`qslot = GET_SLOT(qr, install("q"));`
82	`cs *V = Matrix_as_cs(GET_SLOT(qr, install("V"))),`	80	`CSP V = AS_CSP(GET_SLOT(qr, install("V"))),`
83	`*R = Matrix_as_cs(GET_SLOT(qr, install("R")));`	81	`R = AS_CSP(GET_SLOT(qr, install("R")));`
84	`int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),`	82	`int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),`
85	`*q = INTEGER(qslot),`	83	`*q = INTEGER(qslot),`
86	`j, lq = LENGTH(qslot), m = R->m, n = R->n;`	84	`j, lq = LENGTH(qslot), m = R->m, n = R->n;`
87	`double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),`	85	`double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),`
88	`*x = Calloc(m, double);`	86	`*x = Calloc(m, double);`
Line 97...	Line 95...
97	`if (lq) {`	95	`if (lq) {`
98	`cs_ipvec(q, aj, x, n);`	96	`cs_ipvec(q, aj, x, n);`
99	`Memcpy(aj, x, n);`	97	`Memcpy(aj, x, n);`
100	`}`	98	`}`
101	`}`	99	`}`
102	`Free(V); Free(R); Free(x);`	100	`Free(x);`
103	`UNPROTECT(1);`	101	`UNPROTECT(1);`
104	`return ans;`	102	`return ans;`
105	`}`	103	`}`
106		104
107	`SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid)`	105	`SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid)`
108	`{`	106	`{`
109	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));`	107	`SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));`
110	`cs *V = Matrix_as_cs(GET_SLOT(qr, install("V")));`	108	`CSP V = AS_CSP(GET_SLOT(qr, install("V")));`
111	`int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),`	109	`int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),`
112	`*p = INTEGER(GET_SLOT(qr, Matrix_pSym)),`	110	`*p = INTEGER(GET_SLOT(qr, Matrix_pSym)),`
113	`i, j, m = V->m, n = V->n, res = asLogical(resid);`	111	`i, j, m = V->m, n = V->n, res = asLogical(resid);`
114	`double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),`	112	`double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),`
115	`*beta = REAL(GET_SLOT(qr, install("beta")));`	113	`*beta = REAL(GET_SLOT(qr, install("beta")));`
Line 122...	Line 120...
122	`else /* zero last m - n rows */`	120	`else /* zero last m - n rows */`
123	`for (i = n; i < m; i++) ax[i + j * m] = 0;`	121	`for (i = n; i < m; i++) ax[i + j * m] = 0;`
124	`}`	122	`}`
125	`/* multiply by Q and apply inverse row permutation */`	123	`/* multiply by Q and apply inverse row permutation */`
126	`sparseQR_Qmult(V, beta, p, 0, ax, ydims);`	124	`sparseQR_Qmult(V, beta, p, 0, ax, ydims);`
-		125
127	`UNPROTECT(1);`	126	`UNPROTECT(1);`
128	`return ans;`	127	`return ans;`
129	`}`	128	`}`

The R Project SVN R-packages

(root)/branches/Matrix-APIchange/src/sparseQR.c – Rev 4529 → 4543