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 2685, Fri Aug 5 19:52:10 2011 UTC revision 2804, Thu Jun 28 13:45:01 2012 UTC
# Line 189  Line 189 
189      if(cl_x[2] != 'C') error(_("not a CsparseMatrix"));      if(cl_x[2] != 'C') error(_("not a CsparseMatrix"));
190      int nnz = LENGTH(GET_SLOT(x, Matrix_iSym));      int nnz = LENGTH(GET_SLOT(x, Matrix_iSym));
191      SEXP ans;      SEXP ans;
192      char *ncl = strdup(cl_x);      char *ncl = alloca(strlen(cl_x) + 1); /* not much memory required */
193        strcpy(ncl, cl_x);
194      double *dx_x; int *ix_x;      double *dx_x; int *ix_x;
195      ncl[0] = (r_kind == x_double ? 'd' :      ncl[0] = (r_kind == x_double ? 'd' :
196                (r_kind == x_logical ? 'l' :                (r_kind == x_logical ? 'l' :
# Line 566  Line 567 
567      }      }
568      else { /* triangular with diag='N'): now drop the diagonal */      else { /* triangular with diag='N'): now drop the diagonal */
569          /* duplicate, since chx will be modified: */          /* duplicate, since chx will be modified: */
570          CHM_SP chx = AS_CHM_SP__(duplicate(x));          SEXP xx = PROTECT(duplicate(x));
571            CHM_SP chx = AS_CHM_SP__(xx);
572          int uploT = (*uplo_P(x) == 'U') ? 1 : -1,          int uploT = (*uplo_P(x) == 'U') ? 1 : -1,
573              Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;              Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
574          R_CheckStack();          R_CheckStack();
575    
576          chm_diagN2U(chx, uploT, /* do_realloc */ FALSE);          chm_diagN2U(chx, uploT, /* do_realloc */ FALSE);
577    
578            UNPROTECT(1);
579          return chm_sparse_to_SEXP(chx, /*dofree*/ 0/* or 1 ?? */,          return chm_sparse_to_SEXP(chx, /*dofree*/ 0/* or 1 ?? */,
580                                    uploT, Rkind, "U",                                    uploT, Rkind, "U",
581                                    GET_SLOT(x, Matrix_DimNamesSym));                                    GET_SLOT(x, Matrix_DimNamesSym));
# Line 601  Line 604 
604      if (csize >= 0 && !isInteger(j))      if (csize >= 0 && !isInteger(j))
605          error(_("Index j must be NULL or integer"));          error(_("Index j must be NULL or integer"));
606    
607      if (chx->stype) /* symmetricMatrix */      if (!chx->stype) {/* non-symmetric Matrix */
         /* for now, cholmod_submatrix() only accepts "generalMatrix" */  
         chx = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);  
   
608      return chm_sparse_to_SEXP(cholmod_submatrix(chx,      return chm_sparse_to_SEXP(cholmod_submatrix(chx,
609                                  (rsize < 0) ? NULL : INTEGER(i), rsize,                                  (rsize < 0) ? NULL : INTEGER(i), rsize,
610                                  (csize < 0) ? NULL : INTEGER(j), csize,                                  (csize < 0) ? NULL : INTEGER(j), csize,
# Line 612  Line 612 
612                                1, 0, Rkind, "",                                1, 0, Rkind, "",
613                                /* FIXME: drops dimnames */ R_NilValue);                                /* FIXME: drops dimnames */ R_NilValue);
614  }  }
615                                    /* for now, cholmod_submatrix() only accepts "generalMatrix" */
616        CHM_SP tmp = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);
617        CHM_SP ans = cholmod_submatrix(tmp,
618                                       (rsize < 0) ? NULL : INTEGER(i), rsize,
619                                       (csize < 0) ? NULL : INTEGER(j), csize,
620                                       TRUE, TRUE, &c);
621        cholmod_free_sparse(&tmp, &c);
622        return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);
623    }
624    
625  #define _d_Csp_  #define _d_Csp_
626  #include "t_Csparse_subassign.c"  #include "t_Csparse_subassign.c"
# Line 712  Line 721 
721      case diag_backpermuted:      case diag_backpermuted:
722          for_DIAG(v[i] = x_x[i_from]);          for_DIAG(v[i] = x_x[i_from]);
723    
724          warning(_("resultKind = 'diagBack' (back-permuted) is experimental"));          warning(_("%s = '%s' (back-permuted) is experimental"),
725                    "resultKind", "diagBack");
726          /* now back_permute : */          /* now back_permute : */
727          for(i = 0; i < n; i++) {          for(i = 0; i < n; i++) {
728              double tmp = v[i]; v[i] = v[perm[i]]; v[perm[i]] = tmp;              double tmp = v[i]; v[i] = v[perm[i]]; v[perm[i]] = tmp;

Legend:
Removed from v.2685  
changed lines
  Added in v.2804

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