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 3069, Thu Mar 26 10:00:49 2015 UTC revision 3072, Fri Mar 27 15:10:48 2015 UTC
# Line 186  Line 186 
186  }  }
187    
188  // FIXME: do not go via CHM (should not be too hard, to just *drop* the x-slot, right?  // FIXME: do not go via CHM (should not be too hard, to just *drop* the x-slot, right?
189  SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)  SEXP Csparse2nz(SEXP x, Rboolean tri)
190  {  {
191      CHM_SP chxs = AS_CHM_SP__(x);      CHM_SP chxs = AS_CHM_SP__(x);
192      CHM_SP chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);      CHM_SP chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);
     int tr = asLogical(tri);  
193      R_CheckStack();      R_CheckStack();
194    
195      return chm_sparse_to_SEXP(chxcp, 1/*do_free*/,      return chm_sparse_to_SEXP(chxcp, 1/*do_free*/,
196                                tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0,                                tri ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0,
197                                /* Rkind: pattern */ 0,                                /* Rkind: pattern */ 0,
198                                /* diag = */ tr ? diag_P(x) : "",                                /* diag = */ tri ? diag_P(x) : "",
199                                GET_SLOT(x, Matrix_DimNamesSym));                                GET_SLOT(x, Matrix_DimNamesSym));
200  }  }
201    SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)
202    {
203        int tr_ = asLogical(tri);
204        if(tr_ == NA_LOGICAL) {
205            warning(_("Csparse_to_nz_pattern(x, tri = NA): 'tri' is taken as TRUE"));
206            tr_ = TRUE;
207        }
208        return Csparse2nz(x, (Rboolean) tr_);
209    }
210    
211  // n.CMatrix --> [dli].CMatrix  (not going through CHM!)  // n.CMatrix --> [dli].CMatrix  (not going through CHM!)
212  SEXP nz_pattern_to_Csparse(SEXP x, SEXP res_kind)  SEXP nz_pattern_to_Csparse(SEXP x, SEXP res_kind)
# Line 487  Line 495 
495          chb = AS_CHM_SP(b),          chb = AS_CHM_SP(b),
496          chTr, chc;          chTr, chc;
497      R_CheckStack();      R_CheckStack();
     // const char *cl_a = class_P(a), *cl_b = class_P(b);  
498      static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };      static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };
499      char diag[] = {'\0', '\0'};      char diag[] = {'\0', '\0'};
500      int uploT = 0;      int uploT = 0;
# Line 502  Line 509 
509          SEXP da = PROTECT(nz2Csparse(a, x_double)); nprot++;          SEXP da = PROTECT(nz2Csparse(a, x_double)); nprot++;
510          cha = AS_CHM_SP(da);          cha = AS_CHM_SP(da);
511          R_CheckStack();          R_CheckStack();
512          a_is_n = FALSE;          // a_is_n = FALSE;
513      }      }
514      else if(b_is_n && (force_num || (maybe_bool && !a_is_n))) {      else if(b_is_n && (force_num || (maybe_bool && !a_is_n))) {
515          // coerce 'b' to  double          // coerce 'b' to  double
516          SEXP db = PROTECT(nz2Csparse(b, x_double)); nprot++;          SEXP db = PROTECT(nz2Csparse(b, x_double)); nprot++;
517          chb = AS_CHM_SP(db);          chb = AS_CHM_SP(db);
518          R_CheckStack();          R_CheckStack();
519          b_is_n = FALSE;          // b_is_n = FALSE;
520        }
521        else if(do_bool == TRUE) { // Want boolean arithmetic: sufficient if *one* is pattern:
522            if(!a_is_n && !b_is_n) {
523                // coerce 'a' to pattern
524                SEXP da = PROTECT(Csparse2nz(a, /* tri = */
525                                             Matrix_check_class_etc(a, valid_tri) >= 0)); nprot++;
526                cha = AS_CHM_SP(da);
527                R_CheckStack();
528                // a_is_n = TRUE;
529            }
530      }      }
   
531      chTr = cholmod_transpose((tr) ? chb : cha, chb->xtype, &c);      chTr = cholmod_transpose((tr) ? chb : cha, chb->xtype, &c);
532      chc = cholmod_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb,      chc = cholmod_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb,
533                           /*out_stype:*/ 0, /* values : */ do_bool != TRUE,                           /*out_stype:*/ 0, /* values : */ do_bool != TRUE,
# Line 699  Line 715 
715          chx = AS_CHM_SP(dx);          chx = AS_CHM_SP(dx);
716          R_CheckStack();          R_CheckStack();
717      }      }
718        else if(do_bool == TRUE && !x_is_n) { // Want boolean arithmetic; need patter[n]
719            // coerce 'x' to pattern
720            static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" };
721            SEXP dx = PROTECT(Csparse2nz(x, /* tri = */
722                                         Matrix_check_class_etc(x, valid_tri) >= 0)); nprot++;
723            chx = AS_CHM_SP(dx);
724            R_CheckStack();
725        }
726    
727      if (!tr) chxt = cholmod_transpose(chx, chx->xtype, &c);      if (!tr) chxt = cholmod_transpose(chx, chx->xtype, &c);
728    

Legend:
Removed from v.3069  
changed lines
  Added in v.3072

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