Matrix $Rev: 2718 $ at $LastChangedDate: 2011-10-06 11:45:17 +0200 (Thu, 06 Oct 2011) $
lgCMatrix.c
Go to the documentation of this file.
00001 #include "lgCMatrix.h"
00002 
00003 #include "dgCMatrix.h"
00004 /* validate: -> xCMatrix_validate() in ./dgCMatrix.c */
00005 
00006 SEXP lcsc_to_matrix(SEXP x)/* <- now a misnomer, rename to lgC_to_matrix() */
00007 {
00008     SEXP ans, pslot = GET_SLOT(x, Matrix_pSym),
00009         dn = GET_SLOT(x, Matrix_DimNamesSym);
00010     int j, ncol = length(pslot) - 1,
00011         nrow = INTEGER(GET_SLOT(x, Matrix_DimSym))[0],
00012         *xp = INTEGER(pslot),
00013         *xi = INTEGER(GET_SLOT(x, Matrix_iSym));
00014     int *xx = LOGICAL(GET_SLOT(x, Matrix_xSym)), *ax;
00015 
00016     ax = LOGICAL(ans = PROTECT(allocMatrix(LGLSXP, nrow, ncol)));
00017     for (j = 0; j < (nrow * ncol); j++) ax[j] = 0;
00018     for (j = 0; j < ncol; j++) {
00019         int ind;
00020         for (ind = xp[j]; ind < xp[j+1]; ind++)
00021             ax[j * nrow + xi[ind]] = xx[ind];
00022     }
00023     if (!(isNull(VECTOR_ELT(dn,0)) && isNull(VECTOR_ELT(dn,1))))
00024         setAttrib(ans, R_DimNamesSymbol, duplicate(dn));
00025     UNPROTECT(1);
00026     return ans;
00027 }
00028 
00029 /* as above,  '1' instead of 'x' slot: */
00030 SEXP ncsc_to_matrix(SEXP x)/* << rename to ngC_to_matrix() */
00031 {
00032     SEXP ans, pslot = GET_SLOT(x, Matrix_pSym),
00033         dn = GET_SLOT(x, Matrix_DimNamesSym);
00034     int j, ncol = length(pslot) - 1,
00035         nrow = INTEGER(GET_SLOT(x, Matrix_DimSym))[0],
00036         *xp = INTEGER(pslot),
00037         *xi = INTEGER(GET_SLOT(x, Matrix_iSym));
00038     int *ax;
00039 
00040     ax = LOGICAL(ans = PROTECT(allocMatrix(LGLSXP, nrow, ncol)));
00041     for (j = 0; j < (nrow * ncol); j++) ax[j] = 0;
00042     for (j = 0; j < ncol; j++) {
00043         int ind;
00044         for (ind = xp[j]; ind < xp[j+1]; ind++)
00045             ax[j * nrow + xi[ind]] = 1;
00046     }
00047     if (!(isNull(VECTOR_ELT(dn,0)) && isNull(VECTOR_ELT(dn,1))))
00048         setAttrib(ans, R_DimNamesSymbol, duplicate(dn));
00049     UNPROTECT(1);
00050     return ans;
00051 }
00052 
00053 #ifdef _NEED_logical_to_csc_FIRST_
00054 /* very parallel to matrix_to_csc() in ./dgCMatrix.c */
00055 SEXP matrix_to_lcsc(SEXP A)
00056 {
00057     if (!(isMatrix(A) && isLogical(A)))
00058         error(_("A must be a logical matrix"));
00059     return logical_to_csc(LOGICAL(A),
00060                           INTEGER(getAttrib(A, R_DimSymbol)));
00061 }
00062 #endif