The R Project SVN R-packages

Rev

Rev 4543 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4543 Rev 4558
Line 6... Line 6...
6
	R = AS_CSP(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
    R_CheckStack();
11
 
12
 
12
    if (LENGTH(p) != V->m)
13
    if (LENGTH(p) != V->m)
13
	return mkString(_("length(p) must match nrow(V)"));
14
	return mkString(_("length(p) must match nrow(V)"));
14
    if (LENGTH(beta) != V->m)
15
    if (LENGTH(beta) != V->m)
15
	return mkString(_("length(beta) must match nrow(V)"));
16
	return mkString(_("length(beta) must match nrow(V)"));
Line 61... Line 62...
61
 
62
 
62
SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)
63
SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)
63
{
64
{
64
    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));
65
    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y));
65
    CSP V = AS_CSP(GET_SLOT(qr, install("V")));
66
    CSP V = AS_CSP(GET_SLOT(qr, install("V")));
-
 
67
    R_CheckStack();
66
 
68
 
67
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
69
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
68
		   INTEGER(GET_SLOT(qr, Matrix_pSym)),
70
		   INTEGER(GET_SLOT(qr, Matrix_pSym)),
69
		   asLogical(trans),
71
		   asLogical(trans),
70
		   REAL(GET_SLOT(ans, Matrix_xSym)),
72
		   REAL(GET_SLOT(ans, Matrix_xSym)),
Line 82... Line 84...
82
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
84
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
83
	*q = INTEGER(qslot),
85
	*q = INTEGER(qslot),
84
	j, lq = LENGTH(qslot), m = R->m, n = R->n;
86
	j, lq = LENGTH(qslot), m = R->m, n = R->n;
85
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
87
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
86
	*x = Calloc(m, double);
88
	*x = Calloc(m, double);
-
 
89
    R_CheckStack();
87
 
90
 
88
    /* apply row permutation and multiply by Q' */
91
    /* apply row permutation and multiply by Q' */
89
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
92
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
90
		   INTEGER(GET_SLOT(qr, Matrix_pSym)), 1,
93
		   INTEGER(GET_SLOT(qr, Matrix_pSym)), 1,
91
		   REAL(GET_SLOT(ans, Matrix_xSym)), ydims);
94
		   REAL(GET_SLOT(ans, Matrix_xSym)), ydims);
Line 109... Line 112...
109
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
112
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
110
	*p = INTEGER(GET_SLOT(qr, Matrix_pSym)),
113
	*p = INTEGER(GET_SLOT(qr, Matrix_pSym)),
111
	i, j, m = V->m, n = V->n, res = asLogical(resid);
114
	i, j, m = V->m, n = V->n, res = asLogical(resid);
112
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
115
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
113
	*beta = REAL(GET_SLOT(qr, install("beta")));
116
	*beta = REAL(GET_SLOT(qr, install("beta")));
-
 
117
    R_CheckStack();
114
 
118
 
115
    /* apply row permutation and multiply by Q' */
119
    /* apply row permutation and multiply by Q' */
116
    sparseQR_Qmult(V, beta, p, 1, ax, ydims);
120
    sparseQR_Qmult(V, beta, p, 1, ax, ydims);
117
    for (j = 0; j < ydims[1]; j++) {
121
    for (j = 0; j < ydims[1]; j++) {
118
	if (res)		/* zero first n rows */
122
	if (res)		/* zero first n rows */