SCM

SCM Repository

[matrix] Diff of /pkg/src/Csparse.c
ViewVC logotype

Diff of /pkg/src/Csparse.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1598, Fri Sep 29 09:39:34 2006 UTC revision 1618, Fri Oct 6 15:44:01 2006 UTC
# Line 105  Line 105 
105                                GET_SLOT(x, Matrix_DimNamesSym));                                GET_SLOT(x, Matrix_DimNamesSym));
106  }  }
107    
108  #ifdef _not_yet_FIXME_  SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)
 /* MM: This would seem useful; e.g. lsC* can hardly be coerced to ! */  
 SEXP Csparse_general_to_symmetric(SEXP x,  
                                   int stype)/*-1 : "L", +1 : "U" */  
109  {  {
110      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;      cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;
111        int uploT = (*CHAR(asChar(uplo)) == 'U') ? -1 : 1;
112      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;      int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;
113    
114      chgx = cholmod_copy(chx, /* stype: */ stype, chx->xtype, &c);      chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c);
115      /* xtype: pattern, "real", complex or .. */      /* xtype: pattern, "real", complex or .. */
116      Free(chx);      Free(chx);
117      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",      return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",
118                                GET_SLOT(x, Matrix_DimNamesSym));                                GET_SLOT(x, Matrix_DimNamesSym));
119  }  }
120    
 #endif  
   
121  SEXP Csparse_transpose(SEXP x, SEXP tri)  SEXP Csparse_transpose(SEXP x, SEXP tri)
122  {  {
123      cholmod_sparse *chx = as_cholmod_sparse(x);      cholmod_sparse *chx = as_cholmod_sparse(x);
# Line 200  Line 196 
196          chxt = cholmod_transpose(chx, chx->xtype, &c);          chxt = cholmod_transpose(chx, chx->xtype, &c);
197      chcp = cholmod_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);      chcp = cholmod_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);
198      if(!chcp)      if(!chcp)
199          error("Csparse_crossprod(): error return from cholmod_aat()");          error(_("Csparse_crossprod(): error return from cholmod_aat()"));
200      cholmod_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c);      cholmod_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c);
201      chcp->stype = 1;      chcp->stype = 1;
202      if (trip) {      if (trip) {
# Line 219  Line 215 
215      return chm_sparse_to_SEXP(chcp, 1, 0, 0, "", dn);      return chm_sparse_to_SEXP(chcp, 1, 0, 0, "", dn);
216  }  }
217    
218    SEXP Csparse_drop(SEXP x, SEXP tol)
219    {
220        cholmod_sparse *chx = as_cholmod_sparse(x),
221            *ans = cholmod_copy(chx, chx->stype, chx->xtype, &c);
222        double dtol = asReal(tol);
223        int Rkind = (chx->xtype == CHOLMOD_REAL) ? Real_kind(x) : 0;
224    
225        if(!cholmod_drop(dtol, ans, &c))
226            error(_("cholmod_drop() failed"));
227        Free(chx);
228        /* FIXME: currently drops dimnames */
229        return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);
230    }
231    
232    
233  SEXP Csparse_horzcat(SEXP x, SEXP y)  SEXP Csparse_horzcat(SEXP x, SEXP y)
234  {  {
235      cholmod_sparse *chx = as_cholmod_sparse(x),      cholmod_sparse *chx = as_cholmod_sparse(x),

Legend:
Removed from v.1598  
changed lines
  Added in v.1618

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