SCM

SCM Repository

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

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

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

revision 3019, Sat Oct 11 20:51:53 2014 UTC revision 3020, Tue Oct 14 16:14:02 2014 UTC
# Line 233  Line 233 
233          return R_NilValue; /* -Wall */          return R_NilValue; /* -Wall */
234      }      }
235      CHM_SP chx = AS_CHM_SP__(x), chgx;      CHM_SP chx = AS_CHM_SP__(x), chgx;
236      int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;      int uploT = (*CHAR(asChar(uplo)) == 'U') ? 1 : -1;
237      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
238      R_CheckStack();      R_CheckStack();
239      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);
240    
241        /* need _symmetric_ dimnames */
242        SEXP dns = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))),
243            nms_dns = getAttrib(dns, R_NamesSymbol);
244        if(!equal_string_vectors(VECTOR_ELT(dns, 0),
245                                 VECTOR_ELT(dns, 1))) {
246            if(uploT == 1)
247                SET_VECTOR_ELT(dns, 0, VECTOR_ELT(dns,1));
248            else
249                SET_VECTOR_ELT(dns, 1, VECTOR_ELT(dns,0));
250        }
251        if(!isNull(nms_dns) &&  // names(dimnames(.)) :
252           !R_compute_identical(STRING_ELT(nms_dns, 0),
253                                STRING_ELT(nms_dns, 1), 15)) {
254            if(uploT == 1)
255                SET_STRING_ELT(nms_dns, 0, STRING_ELT(nms_dns,1));
256            else
257                SET_STRING_ELT(nms_dns, 1, STRING_ELT(nms_dns,0));
258            setAttrib(dns, R_NamesSymbol, nms_dns);
259        }
260    
261        UNPROTECT(1);
262      /* xtype: pattern, "real", complex or .. */      /* xtype: pattern, "real", complex or .. */
263      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "", dns);
                               GET_SLOT(x, Matrix_DimNamesSym));  
264  }  }
265    
266  SEXP Csparse_transpose(SEXP x, SEXP tri)  SEXP Csparse_transpose(SEXP x, SEXP tri)
# Line 256  Line 277 
277      tmp = VECTOR_ELT(dn, 0);    /* swap the dimnames */      tmp = VECTOR_ELT(dn, 0);    /* swap the dimnames */
278      SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1));      SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1));
279      SET_VECTOR_ELT(dn, 1, tmp);      SET_VECTOR_ELT(dn, 1, tmp);
280        if(!isNull(tmp = getAttrib(dn, R_NamesSymbol))) { // swap names(dimnames(.)):
281            SEXP nms_dns = PROTECT(allocVector(VECSXP, 2));
282            SET_VECTOR_ELT(nms_dns, 1, STRING_ELT(tmp, 0));
283            SET_VECTOR_ELT(nms_dns, 0, STRING_ELT(tmp, 1));
284            setAttrib(dn, R_NamesSymbol, nms_dns);
285            UNPROTECT(1);
286        }
287      UNPROTECT(1);      UNPROTECT(1);
288      return chm_sparse_to_SEXP(chxt, 1, /* SWAP 'uplo' for triangular */      return chm_sparse_to_SEXP(chxt, 1, /* SWAP 'uplo' for triangular */
289                                tr ? ((*uplo_P(x) == 'U') ? -1 : 1) : 0,                                tr ? ((*uplo_P(x) == 'U') ? -1 : 1) : 0,

Legend:
Removed from v.3019  
changed lines
  Added in v.3020

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