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 1369, Mon Aug 14 18:54:04 2006 UTC revision 1419, Tue Aug 22 22:49:17 2006 UTC
# Line 38  Line 38 
38      return chm_dense_to_SEXP(chxd, 1);      return chm_dense_to_SEXP(chxd, 1);
39  }  }
40    
41    SEXP Csparse_to_logical(SEXP x, SEXP tri)
42    {
43        cholmod_sparse *chxs = as_cholmod_sparse(x);
44        cholmod_sparse
45            *chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);
46        int uploT = 0; char *diag = "";
47    
48        Free(chxs);
49        if (asLogical(tri)) {       /* triangular sparse matrices */
50            uploT = (strcmp(CHAR(asChar(GET_SLOT(x, Matrix_uploSym))), "U")) ?
51                -1 : 1;
52            diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));
53        }
54        return chm_sparse_to_SEXP(chxcp, 1, uploT, diag,
55                                    GET_SLOT(x, Matrix_DimNamesSym));
56    }
57    
58  SEXP Csparse_to_matrix(SEXP x)  SEXP Csparse_to_matrix(SEXP x)
59  {  {
60      cholmod_sparse *chxs = as_cholmod_sparse(x);      cholmod_sparse *chxs = as_cholmod_sparse(x);
# Line 56  Line 73 
73    
74      Free(chxs);      Free(chxs);
75      if (asLogical(tri)) {       /* triangular sparse matrices */      if (asLogical(tri)) {       /* triangular sparse matrices */
76          uploT = (strcmp(CHAR(asChar(GET_SLOT(x, Matrix_uploSym))), "U")) ?          uploT = (*uplo_P(x) == 'U') ? -1 : 1;
77              -1 : 1;          diag = diag_P(x);
         diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));  
78      }      }
79      return chm_triplet_to_SEXP(chxt, 1, uploT, diag,      return chm_triplet_to_SEXP(chxt, 1, uploT, diag,
80                                 duplicate(GET_SLOT(x, Matrix_DimNamesSym)));                                 GET_SLOT(x, Matrix_DimNamesSym));
81    }
82    
83    /* this use to be called  sCMatrix_to_gCMatrix(..)   [in ./dsCMatrix.c ]: */
84    SEXP Csparse_symmetric_to_general(SEXP x)
85    {
86        cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;
87    
88        if (!(chx->stype))
89            error(_("Nonsymmetric matrix in Csparse_symmeteric_to_general"));
90        chgx = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);
91        /* xtype: pattern, "real", complex or .. */
92        Free(chx);
93        return chm_sparse_to_SEXP(chgx, 1, 0, "",
94                                  GET_SLOT(x, Matrix_DimNamesSym));
95  }  }
96    
97  SEXP Csparse_transpose(SEXP x, SEXP tri)  SEXP Csparse_transpose(SEXP x, SEXP tri)
# Line 77  Line 107 
107      SET_VECTOR_ELT(dn, 1, tmp);      SET_VECTOR_ELT(dn, 1, tmp);
108      UNPROTECT(1);      UNPROTECT(1);
109      if (asLogical(tri)) {       /* triangular sparse matrices */      if (asLogical(tri)) {       /* triangular sparse matrices */
110          uploT = (strcmp(CHAR(asChar(GET_SLOT(x, Matrix_uploSym))), "U")) ?          uploT = (*uplo_P(x) == 'U') ? -1 : 1;
111              1 : -1;             /* switch upper and lower for transpose */          diag = diag_P(x);
         diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));  
112      }      }
113      return chm_sparse_to_SEXP(chxt, 1, uploT, diag, dn);      return chm_sparse_to_SEXP(chxt, 1, uploT, diag, dn);
114  }  }

Legend:
Removed from v.1369  
changed lines
  Added in v.1419

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