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 1710, Tue Dec 26 15:57:06 2006 UTC revision 1736, Tue Jan 23 17:09:41 2007 UTC
# Line 44  Line 44 
44  {  {
45      cholmod_sparse *chxs = as_cholmod_sparse(x);      cholmod_sparse *chxs = as_cholmod_sparse(x);
46      cholmod_dense *chxd = cholmod_sparse_to_dense(chxs, &c);      cholmod_dense *chxd = cholmod_sparse_to_dense(chxs, &c);
47        int Rkind = (chxs->xtype == CHOLMOD_PATTERN)? 0 : Real_kind(x);
48    
49      Free(chxs);      Free(chxs);
50      return chm_dense_to_SEXP(chxd, 1, Real_kind(x),      return chm_dense_to_SEXP(chxd, 1, Rkind, GET_SLOT(x, Matrix_DimNamesSym));
                              GET_SLOT(x, Matrix_DimNamesSym));  
51  }  }
52    
53  SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)  SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)
# Line 82  Line 82 
82      cholmod_triplet *chxt = cholmod_sparse_to_triplet(chxs, &c);      cholmod_triplet *chxt = cholmod_sparse_to_triplet(chxs, &c);
83      int uploT = 0;      int uploT = 0;
84      char *diag = "";      char *diag = "";
85      int Rkind = (chxs->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
86    
87      Free(chxs);      Free(chxs);
88      if (asLogical(tri)) {       /* triangular sparse matrices */      if (asLogical(tri)) {       /* triangular sparse matrices */
# Line 97  Line 97 
97  SEXP Csparse_symmetric_to_general(SEXP x)  SEXP Csparse_symmetric_to_general(SEXP x)
98  {  {
99      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;
100      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
101    
102      if (!(chx->stype))      if (!(chx->stype))
103          error(_("Nonsymmetric matrix in Csparse_symmetric_to_general"));          error(_("Nonsymmetric matrix in Csparse_symmetric_to_general"));
# Line 112  Line 112 
112  {  {
113      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;
114      int uploT = (*CHAR(asChar(uplo)) == 'U') ? 1 : -1;      int uploT = (*CHAR(asChar(uplo)) == 'U') ? 1 : -1;
115      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
116    
117      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);
118      /* xtype: pattern, "real", complex or .. */      /* xtype: pattern, "real", complex or .. */
# Line 124  Line 124 
124  SEXP Csparse_transpose(SEXP x, SEXP tri)  SEXP Csparse_transpose(SEXP x, SEXP tri)
125  {  {
126      cholmod_sparse *chx = as_cholmod_sparse(x);      cholmod_sparse *chx = as_cholmod_sparse(x);
127      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
128      cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);      cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);
129      SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;      SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;
130      int uploT = 0; char *diag = "";      int uploT = 0; char *diag = "";
# Line 265  Line 265 
265      cholmod_sparse *chx = as_cholmod_sparse(x),      cholmod_sparse *chx = as_cholmod_sparse(x),
266          *ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);          *ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);
267      double dtol = asReal(tol);      double dtol = asReal(tol);
268      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
269    
270      if(!cholmod_drop(dtol, ans, &c))      if(!cholmod_drop(dtol, ans, &c))
271          error(_("cholmod_drop() failed"));          error(_("cholmod_drop() failed"));
272      Free(chx);      Free(chx);
273      /* FIXME: currently drops dimnames */      return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "",
274      return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);                                GET_SLOT(x, Matrix_DimNamesSym));
275  }  }
276    
277    
# Line 302  Line 302 
302  SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2)  SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2)
303  {  {
304      cholmod_sparse *chx = as_cholmod_sparse(x), *ans;      cholmod_sparse *chx = as_cholmod_sparse(x), *ans;
305      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
306    
307      ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c);      ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c);
308      Free(chx);      Free(chx);
309      return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);      return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "",
310                                  GET_SLOT(x, Matrix_DimNamesSym));
311  }  }
312    
313  SEXP Csparse_diagU2N(SEXP x)  SEXP Csparse_diagU2N(SEXP x)
# Line 320  Line 321 
321          double one[] = {1, 0};          double one[] = {1, 0};
322          cholmod_sparse *ans = cholmod_add(chx, eye, one, one, TRUE, TRUE, &c);          cholmod_sparse *ans = cholmod_add(chx, eye, one, one, TRUE, TRUE, &c);
323          int uploT = (*uplo_P(x) == 'U') ? 1 : -1;          int uploT = (*uplo_P(x) == 'U') ? 1 : -1;
324          int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;          int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
325    
326          Free(chx); cholmod_free_sparse(&eye, &c);          Free(chx); cholmod_free_sparse(&eye, &c);
327          return chm_sparse_to_SEXP(ans, 1, uploT, Rkind, "N",          return chm_sparse_to_SEXP(ans, 1, uploT, Rkind, "N",
328                                    duplicate(GET_SLOT(x, Matrix_DimNamesSym)));                                    GET_SLOT(x, Matrix_DimNamesSym));
329      }      }
330  }  }
331    
# Line 333  Line 334 
334      cholmod_sparse *chx = as_cholmod_sparse(x);      cholmod_sparse *chx = as_cholmod_sparse(x);
335      int rsize = (isNull(i)) ? -1 : LENGTH(i),      int rsize = (isNull(i)) ? -1 : LENGTH(i),
336          csize = (isNull(j)) ? -1 : LENGTH(j);          csize = (isNull(j)) ? -1 : LENGTH(j);
337      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
338    
339      if (rsize >= 0 && !isInteger(i))      if (rsize >= 0 && !isInteger(i))
340          error(_("Index i must be NULL or integer"));          error(_("Index i must be NULL or integer"));
341      if (csize >= 0 && !isInteger(j))      if (csize >= 0 && !isInteger(j))
342          error(_("Index j must be NULL or integer"));          error(_("Index j must be NULL or integer"));
343    
344      return chm_sparse_to_SEXP(cholmod_submatrix(chx, INTEGER(i), rsize,      return chm_sparse_to_SEXP(cholmod_submatrix(chx, INTEGER(i), rsize,
345                                                  INTEGER(j), csize,                                                  INTEGER(j), csize,
346                                                  TRUE, TRUE, &c),                                                  TRUE, TRUE, &c),
347                                1, 0, Rkind, "", R_NilValue);                                1, 0, Rkind, "",
348                                  /* FIXME: drops dimnames */ R_NilValue);
349  }  }

Legend:
Removed from v.1710  
changed lines
  Added in v.1736

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