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 2725, Sat Oct 8 19:48:44 2011 UTC revision 2834, Mon Sep 3 10:30:03 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 266  Line 267 
267    
268  SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)  SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)
269  {  {
270        int *adims = INTEGER(GET_SLOT(x, Matrix_DimSym)), n = adims[0];
271        if(n != adims[1]) {
272            error(_("Csparse_general_to_symmetric(): matrix is not square!"));
273            return R_NilValue; /* -Wall */
274        }
275      CHM_SP chx = AS_CHM_SP__(x), chgx;      CHM_SP chx = AS_CHM_SP__(x), chgx;
276      int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;      int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;
277      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
278      R_CheckStack();      R_CheckStack();
   
279      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);
280      /* xtype: pattern, "real", complex or .. */      /* xtype: pattern, "real", complex or .. */
281      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",
# Line 566  Line 571 
571      }      }
572      else { /* triangular with diag='N'): now drop the diagonal */      else { /* triangular with diag='N'): now drop the diagonal */
573          /* duplicate, since chx will be modified: */          /* duplicate, since chx will be modified: */
574          CHM_SP chx = AS_CHM_SP__(duplicate(x));          SEXP xx = PROTECT(duplicate(x));
575            CHM_SP chx = AS_CHM_SP__(xx);
576          int uploT = (*uplo_P(x) == 'U') ? 1 : -1,          int uploT = (*uplo_P(x) == 'U') ? 1 : -1,
577              Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;              Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
578          R_CheckStack();          R_CheckStack();
579    
580          chm_diagN2U(chx, uploT, /* do_realloc */ FALSE);          chm_diagN2U(chx, uploT, /* do_realloc */ FALSE);
581    
582          return chm_sparse_to_SEXP(chx, /*dofree*/ 0/* or 1 ?? */,          SEXP ans = chm_sparse_to_SEXP(chx, /*dofree*/ 0/* or 1 ?? */,
583                                    uploT, Rkind, "U",                                    uploT, Rkind, "U",
584                                    GET_SLOT(x, Matrix_DimNamesSym));                                    GET_SLOT(x, Matrix_DimNamesSym));
585            UNPROTECT(1);// only now !
586            return ans;
587      }      }
588  }  }
589    
# Line 601  Line 609 
609      if (csize >= 0 && !isInteger(j))      if (csize >= 0 && !isInteger(j))
610          error(_("Index j must be NULL or integer"));          error(_("Index j must be NULL or integer"));
611    
612      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);  
   
613      return chm_sparse_to_SEXP(cholmod_submatrix(chx,      return chm_sparse_to_SEXP(cholmod_submatrix(chx,
614                                  (rsize < 0) ? NULL : INTEGER(i), rsize,                                  (rsize < 0) ? NULL : INTEGER(i), rsize,
615                                  (csize < 0) ? NULL : INTEGER(j), csize,                                  (csize < 0) ? NULL : INTEGER(j), csize,
# Line 612  Line 617 
617                                1, 0, Rkind, "",                                1, 0, Rkind, "",
618                                /* FIXME: drops dimnames */ R_NilValue);                                /* FIXME: drops dimnames */ R_NilValue);
619  }  }
620                                    /* for now, cholmod_submatrix() only accepts "generalMatrix" */
621        CHM_SP tmp = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);
622        CHM_SP ans = cholmod_submatrix(tmp,
623                                       (rsize < 0) ? NULL : INTEGER(i), rsize,
624                                       (csize < 0) ? NULL : INTEGER(j), csize,
625                                       TRUE, TRUE, &c);
626        cholmod_free_sparse(&tmp, &c);
627        return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);
628    }
629    
630  #define _d_Csp_  #define _d_Csp_
631  #include "t_Csparse_subassign.c"  #include "t_Csparse_subassign.c"
# Line 712  Line 726 
726      case diag_backpermuted:      case diag_backpermuted:
727          for_DIAG(v[i] = x_x[i_from]);          for_DIAG(v[i] = x_x[i_from]);
728    
729          warning(_("resultKind = 'diagBack' (back-permuted) is experimental"));          warning(_("%s = '%s' (back-permuted) is experimental"),
730                    "resultKind", "diagBack");
731          /* now back_permute : */          /* now back_permute : */
732          for(i = 0; i < n; i++) {          for(i = 0; i < n; i++) {
733              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.2725  
changed lines
  Added in v.2834

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge