SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/src/dense.c
ViewVC logotype

Diff of /pkg/Matrix/src/dense.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1452, Sat Aug 26 18:24:13 2006 UTC revision 1453, Sun Aug 27 16:16:35 2006 UTC
# Line 255  Line 255 
255                                isMatrix(x) ? getAttrib(x, R_DimNamesSymbol)                                isMatrix(x) ? getAttrib(x, R_DimNamesSymbol)
256                                : GET_SLOT(x, Matrix_DimNamesSym));                                : GET_SLOT(x, Matrix_DimNamesSym));
257  }  }
258    
259    
260    /* Always returns a full matrix with entries outside the band zeroed
261     * Class of the value can be dtrMatrix or dgeMatrix
262     *
263     */
264    
265    SEXP ddense_band(SEXP x, SEXP k1P, SEXP k2P)
266    {
267        SEXP aa, ans = PROTECT(dup_mMatrix_as_dgeMatrix(x));
268        int *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
269            i, j, k1 = asInteger(k1P), k2 = asInteger(k2P);
270        int m = adims[0], n = adims[1], sqr = (adims[0] == adims[1]),
271            tru = (k1 >= 0), trl = (k2 <= 0);
272        double *aax, *ax = REAL(GET_SLOT(ans, Matrix_xSym));
273    
274        if (k1 > k2)
275            error(_("Lower band %d > upper band %d"), k1, k2);
276        for (j = 0; j < n; j++) {
277            int i1 = j - k2, i2 = j + 1 - k1;
278            for (i = 0; i < i1; i++) ax[i + j * m] = 0.;
279            for (i = i2; i < m; i++) ax[i + j * m] = 0.;
280        }
281        if (!sqr || (!tru && !trl)) { /* return the dgeMatrix */
282            UNPROTECT(1);
283            return ans;
284        }
285        /* Copy ans to a dtrMatrix object (must be square) */
286        /* Because slots of ans are freshly allocated and ans will not be
287         * used with use the slots themselves and don't duplicate */
288        aa = PROTECT(NEW_OBJECT(MAKE_CLASS("dtrMatrix")));
289        SET_SLOT(aa, Matrix_xSym, GET_SLOT(ans, Matrix_xSym));
290        SET_SLOT(aa, Matrix_DimSym, GET_SLOT(ans, Matrix_DimSym));
291        SET_SLOT(aa, Matrix_DimNamesSym, GET_SLOT(ans, Matrix_DimNamesSym));
292        SET_SLOT(aa, Matrix_diagSym, mkString("N"));
293        SET_SLOT(aa, Matrix_uploSym, mkString(tru ? "U" : "L"));
294        UNPROTECT(2);
295        return aa;
296    }

Legend:
Removed from v.1452  
changed lines
  Added in v.1453

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge