The R Project SVN R-packages

Rev

Rev 4558 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4558 Rev 4560
Line 36... Line 36...
36 
static
 36 
static
37 
void sparseQR_Qmult(cs *V, double *beta, int *p, int trans,
 37 
void sparseQR_Qmult(cs *V, double *beta, int *p, int trans,
38 
		    double *y, int *ydims)
 38 
		    double *y, int *ydims)
39 
{
 39 
{
40 
    int j, k, m = V->m, n = V->n;
 40 
    int j, k, m = V->m, n = V->n;
41 
    double *x = Calloc(m, double);	/* workspace */
 41 
    double *x = Alloca(m, double);	/* workspace */
- 
 
 42 
    R_CheckStack();
42 
 
 43 
 
43 
    if (ydims[0] != m)
 44 
    if (ydims[0] != m)
44 
	error(_("Dimensions of system are inconsistent"));
 45 
	error(_("Dimensions of system are inconsistent"));
45 
    for (j = 0; j < ydims[1]; j++) {
 46 
    for (j = 0; j < ydims[1]; j++) {
46 
	double *yj = y + j * m;
 47 
	double *yj = y + j * m;
Line 54... Line 55...
54 
		cs_happly(V, k, beta[k], yj);
 55 
		cs_happly(V, k, beta[k], yj);
55 
	    cs_ipvec(p, yj, x, m); /* inverse permutation */
 56 
	    cs_ipvec(p, yj, x, m); /* inverse permutation */
56 
	    Memcpy(yj, x, m);
 57 
	    Memcpy(yj, x, m);
57 
	}
 58 
	}
58 
    }
 59 
    }
59 
    Free(x);
 - 
 
60 
}
 60 
}
61 
 
 61 
 
62 
 
 62 
 
63 
SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)
 63 
SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans)
64 
{
 64 
{
Line 83... Line 83...
83 
	R = AS_CSP(GET_SLOT(qr, install("R")));
 83 
	R = AS_CSP(GET_SLOT(qr, install("R")));
84 
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
 84 
    int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
85 
	*q = INTEGER(qslot),
 85 
	*q = INTEGER(qslot),
86 
	j, lq = LENGTH(qslot), m = R->m, n = R->n;
 86 
	j, lq = LENGTH(qslot), m = R->m, n = R->n;
87 
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
 87 
    double *ax = REAL(GET_SLOT(ans, Matrix_xSym)),
88 
	*x = Calloc(m, double);
 88 
	*x = Alloca(m, double);
- 
 
 89 
    R_CheckStack();
89 
    R_CheckStack();
 90 
    R_CheckStack();
90 
 
 91 
 
91 
    /* apply row permutation and multiply by Q' */
 92 
    /* apply row permutation and multiply by Q' */
92 
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
 93 
    sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))),
93 
		   INTEGER(GET_SLOT(qr, Matrix_pSym)), 1,
 94 
		   INTEGER(GET_SLOT(qr, Matrix_pSym)), 1,
Line 98... Line 99...
98 
	if (lq) {
 99 
	if (lq) {
99 
	    cs_ipvec(q, aj, x, n);
 100 
	    cs_ipvec(q, aj, x, n);
100 
	    Memcpy(aj, x, n);
 101 
	    Memcpy(aj, x, n);
101 
	}
 102 
	}
102 
    }
 103 
    }
103 
    Free(x);
 - 
 
104 
    UNPROTECT(1);
 104 
    UNPROTECT(1);
105 
    return ans;
 105 
    return ans;
106 
}
 106 
}
107 
 
 107 
 
108 
SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid)
 108 
SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid)