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 3076, Mon Mar 30 10:23:42 2015 UTC revision 3147, Thu Oct 29 16:56:10 2015 UTC
# Line 125  Line 125 
125          ctype = 0; // <- default = "dgC"          ctype = 0; // <- default = "dgC"
126      static const char *valid[] = { MATRIX_VALID_Csparse, ""};      static const char *valid[] = { MATRIX_VALID_Csparse, ""};
127      if(is_sym_or_tri == NA_INTEGER) { // find if  is(x, "symmetricMatrix") :      if(is_sym_or_tri == NA_INTEGER) { // find if  is(x, "symmetricMatrix") :
128          ctype = Matrix_check_class_etc(x, valid);          ctype = R_check_class_etc(x, valid);
129          is_sym = (ctype % 3 == 1);          is_sym = (ctype % 3 == 1);
130          is_tri = (ctype % 3 == 2);          is_tri = (ctype % 3 == 2);
131      } else {      } else {
# Line 133  Line 133 
133          is_tri = is_sym_or_tri < 0;          is_tri = is_sym_or_tri < 0;
134          // => both are FALSE  iff  is_.. == 0          // => both are FALSE  iff  is_.. == 0
135          if(is_sym || is_tri)          if(is_sym || is_tri)
136              ctype = Matrix_check_class_etc(x, valid);              ctype = R_check_class_etc(x, valid);
137      }      }
138      CHM_SP chxs = AS_CHM_SP__(x);// -> chxs->stype = +- 1 <==> symmetric      CHM_SP chxs = AS_CHM_SP__(x);// -> chxs->stype = +- 1 <==> symmetric
139      R_CheckStack();      R_CheckStack();
# Line 222  Line 222 
222  SEXP nz2Csparse(SEXP x, enum x_slot_kind r_kind)  SEXP nz2Csparse(SEXP x, enum x_slot_kind r_kind)
223  {  {
224      const char *cl_x = class_P(x);      const char *cl_x = class_P(x);
225      if(cl_x[0] != 'n') error(_("not a 'n.CMatrix'"));      // quick check - if ok, fast
226      if(cl_x[2] != 'C') error(_("not a CsparseMatrix"));      if(cl_x[0] != 'n' || cl_x[2] != 'C') {
227            // e.g. class = "A", from  setClass("A", contains = "ngCMatrix")
228            static const char *valid[] = { MATRIX_VALID_nCsparse, ""};
229            int ctype = R_check_class_etc(x, valid);
230            if(ctype < 0)
231                error(_("not a 'n.CMatrix'"));
232            else // fine : get a valid  cl_x  class_P()-like string :
233                cl_x = valid[ctype];
234        }
235      int nnz = LENGTH(GET_SLOT(x, Matrix_iSym));      int nnz = LENGTH(GET_SLOT(x, Matrix_iSym));
236      SEXP ans;      SEXP ans;
237      char *ncl = alloca(strlen(cl_x) + 1); /* not much memory required */      char *ncl = alloca(strlen(cl_x) + 1); /* not much memory required */
# Line 272  Line 280 
280      int is_sym = asLogical(symm);      int is_sym = asLogical(symm);
281      if(is_sym == NA_LOGICAL) { // find if  is(x, "symmetricMatrix") :      if(is_sym == NA_LOGICAL) { // find if  is(x, "symmetricMatrix") :
282          static const char *valid[] = { MATRIX_VALID_Csparse, ""};          static const char *valid[] = { MATRIX_VALID_Csparse, ""};
283          int ctype = Matrix_check_class_etc(x, valid);          int ctype = R_check_class_etc(x, valid);
284          is_sym = (ctype % 3 == 1);          is_sym = (ctype % 3 == 1);
285      }      }
286      return chm_dense_to_matrix(      return chm_dense_to_matrix(
# Line 435  Line 443 
443          cha = AS_CHM_SP(a),          cha = AS_CHM_SP(a),
444          chb = AS_CHM_SP(b), chc;          chb = AS_CHM_SP(b), chc;
445      R_CheckStack();      R_CheckStack();
     // const char *cl_a = class_P(a), *cl_b = class_P(b);  
446      static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };      static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };
447      char diag[] = {'\0', '\0'};      char diag[] = {'\0', '\0'};
448      int uploT = 0, nprot = 1,      int uploT = 0, nprot = 1,
# Line 473  Line 480 
480       * Note that in that case, the multiplication itself should happen       * Note that in that case, the multiplication itself should happen
481       * faster.  But there's no support for that in CHOLMOD */       * faster.  But there's no support for that in CHOLMOD */
482    
483      if(Matrix_check_class_etc(a, valid_tri) >= 0 &&      if(R_check_class_etc(a, valid_tri) >= 0 &&
484         Matrix_check_class_etc(b, valid_tri) >= 0)         R_check_class_etc(b, valid_tri) >= 0)
485          if(*uplo_P(a) == *uplo_P(b)) { /* both upper, or both lower tri. */          if(*uplo_P(a) == *uplo_P(b)) { /* both upper, or both lower tri. */
486              uploT = (*uplo_P(a) == 'U') ? 1 : -1;              uploT = (*uplo_P(a) == 'U') ? 1 : -1;
487              if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */              if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */
# Line 540  Line 547 
547          if(!a_is_n && !b_is_n) {          if(!a_is_n && !b_is_n) {
548              // coerce 'a' to pattern              // coerce 'a' to pattern
549              SEXP da = PROTECT(Csparse2nz(a, /* tri = */              SEXP da = PROTECT(Csparse2nz(a, /* tri = */
550                                           Matrix_check_class_etc(a, valid_tri) >= 0)); nprot++;                                           R_check_class_etc(a, valid_tri) >= 0)); nprot++;
551              cha = AS_CHM_SP(da);              cha = AS_CHM_SP(da);
552              R_CheckStack();              R_CheckStack();
553              // a_is_n = TRUE;              // a_is_n = TRUE;
# Line 554  Line 561 
561    
562      /* Preserve triangularity and unit-triangularity if appropriate;      /* Preserve triangularity and unit-triangularity if appropriate;
563       * see Csparse_Csparse_prod() for comments */       * see Csparse_Csparse_prod() for comments */
564      if(Matrix_check_class_etc(a, valid_tri) >= 0 &&      if(R_check_class_etc(a, valid_tri) >= 0 &&
565         Matrix_check_class_etc(b, valid_tri) >= 0)         R_check_class_etc(b, valid_tri) >= 0)
566          if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */          if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */
567              uploT = (*uplo_P(b) == 'U') ? 1 : -1;              uploT = (*uplo_P(b) == 'U') ? 1 : -1;
568              if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */              if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */
# Line 623  Line 630 
630      /* repeating a "cheap part" of  mMatrix_as_dgeMatrix2(b, .)  to see if      /* repeating a "cheap part" of  mMatrix_as_dgeMatrix2(b, .)  to see if
631       * we have a vector that we might 'transpose_if_vector' : */       * we have a vector that we might 'transpose_if_vector' : */
632      static const char *valid[] = {"_NOT_A_CLASS_", MATRIX_VALID_ddense, ""};      static const char *valid[] = {"_NOT_A_CLASS_", MATRIX_VALID_ddense, ""};
633      /* int ctype = Matrix_check_class_etc(b, valid);      /* int ctype = R_check_class_etc(b, valid);
634       * if (ctype > 0)   /.* a ddenseMatrix object */       * if (ctype > 0)   /.* a ddenseMatrix object */
635      if (Matrix_check_class_etc(b, valid) < 0) {      if (R_check_class_etc(b, valid) < 0) {
636          // not a ddenseM*:  is.matrix() or vector:          // not a ddenseM*:  is.matrix() or vector:
637          b_is_vector = !isMatrix(b);          b_is_vector = !isMatrix(b);
638      }      }
# Line 739  Line 746 
746          // coerce 'x' to pattern          // coerce 'x' to pattern
747          static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };          static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };
748          SEXP dx = PROTECT(Csparse2nz(x, /* tri = */          SEXP dx = PROTECT(Csparse2nz(x, /* tri = */
749                                       Matrix_check_class_etc(x, valid_tri) >= 0)); nprot++;                                       R_check_class_etc(x, valid_tri) >= 0)); nprot++;
750          chx = AS_CHM_SP(dx);          chx = AS_CHM_SP(dx);
751          R_CheckStack();          R_CheckStack();
752      }      }
# Line 775  Line 782 
782  {  {
783      const char *cl = class_P(x);      const char *cl = class_P(x);
784      /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */      /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */
785      int tr = (cl[1] == 't');      int tr = (cl[1] == 't'); // FIXME - rather  R_check_class_etc(..)
786      CHM_SP chx = AS_CHM_SP__(x);      CHM_SP chx = AS_CHM_SP__(x);
787      CHM_SP ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);      CHM_SP ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);
788      double dtol = asReal(tol);      double dtol = asReal(tol);

Legend:
Removed from v.3076  
changed lines
  Added in v.3147

root@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