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 3143, Wed Sep 2 21:29:32 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 226  Line 226 
226      if(cl_x[0] != 'n' || cl_x[2] != 'C') {      if(cl_x[0] != 'n' || cl_x[2] != 'C') {
227          // e.g. class = "A", from  setClass("A", contains = "ngCMatrix")          // e.g. class = "A", from  setClass("A", contains = "ngCMatrix")
228          static const char *valid[] = { MATRIX_VALID_nCsparse, ""};          static const char *valid[] = { MATRIX_VALID_nCsparse, ""};
229          int ctype = Matrix_check_class_etc(x, valid);          int ctype = R_check_class_etc(x, valid);
230          if(ctype < 0)          if(ctype < 0)
231              error(_("not a 'n.CMatrix'"));              error(_("not a 'n.CMatrix'"));
232          else // fine : get a valid  cl_x  class_P()-like string :          else // fine : get a valid  cl_x  class_P()-like string :
# Line 280  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 480  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 547  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 561  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 630  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 746  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 782  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'); // FIXME - rather  Matrix_check_class_etc(..)      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.3143  
changed lines
  Added in v.3147

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