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 1366, Sat Aug 12 17:31:39 2006 UTC revision 1375, Tue Aug 15 18:21:49 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 61  Line 78 
78          diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));          diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));
79      }      }
80      return chm_triplet_to_SEXP(chxt, 1, uploT, diag,      return chm_triplet_to_SEXP(chxt, 1, uploT, diag,
81                                 duplicate(GET_SLOT(x, Matrix_DimNamesSym)));                                 GET_SLOT(x, Matrix_DimNamesSym));
82  }  }
83    
84  SEXP Csparse_transpose(SEXP x)  /* this use to be called  sCMatrix_to_gCMatrix(..)   [in ./dsCMatrix.c ]: */
85    SEXP Csparse_symmetric_to_general(SEXP x)
86    {
87        cholmod_sparse *chx = as_cholmod_sparse(x), *chgx;
88    
89        if (!(chx->stype))
90            error(_("Nonsymmetric matrix in Csparse_symmeteric_to_general"));
91        chgx = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);
92        /* xtype: pattern, "real", complex or .. */
93        Free(chx);
94        return chm_sparse_to_SEXP(chgx, 1, 0, "",
95                                  GET_SLOT(x, Matrix_DimNamesSym));
96    }
97    
98    SEXP Csparse_transpose(SEXP x, SEXP tri)
99  {  {
100      cholmod_sparse *chx = as_cholmod_sparse(x);      cholmod_sparse *chx = as_cholmod_sparse(x);
101      cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);      cholmod_sparse *chxt = cholmod_transpose(chx, (int) chx->xtype, &c);
102      SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;      SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;
103        int uploT = 0; char *diag = "";
104    
105      Free(chx);      Free(chx);
106      tmp = VECTOR_ELT(dn, 0);    /* swap the dimnames */      tmp = VECTOR_ELT(dn, 0);    /* swap the dimnames */
107      SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1));      SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1));
108      SET_VECTOR_ELT(dn, 1, tmp);      SET_VECTOR_ELT(dn, 1, tmp);
109      UNPROTECT(1);      UNPROTECT(1);
110      return chm_sparse_to_SEXP(chxt, 1, 0, "", dn);      if (asLogical(tri)) {       /* triangular sparse matrices */
111            uploT = (strcmp(CHAR(asChar(GET_SLOT(x, Matrix_uploSym))), "U")) ?
112                1 : -1;             /* switch upper and lower for transpose */
113            diag = CHAR(asChar(GET_SLOT(x, Matrix_diagSym)));
114        }
115        return chm_sparse_to_SEXP(chxt, 1, uploT, diag, dn);
116  }  }
117    
118  SEXP Csparse_Csparse_prod(SEXP a, SEXP b)  SEXP Csparse_Csparse_prod(SEXP a, SEXP b)

Legend:
Removed from v.1366  
changed lines
  Added in v.1375

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