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 1960, Fri Jul 6 16:54:43 2007 UTC revision 2113, Mon Feb 18 08:27:41 2008 UTC
# Line 57  Line 57 
57      return ScalarLogical(1);      return ScalarLogical(1);
58  }  }
59    
60    SEXP Rsparse_validate(SEXP x)
61    {
62        /* NB: we do *NOT* check a potential 'x' slot here, at all */
63        SEXP pslot = GET_SLOT(x, Matrix_pSym),
64            jslot = GET_SLOT(x, Matrix_jSym);
65        Rboolean sorted, strictly;
66        int i, k,
67            *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
68            nrow = dims[0],
69            ncol = dims[1],
70            *xp = INTEGER(pslot),
71            *xj = INTEGER(jslot);
72    
73        if (length(pslot) != dims[0] + 1)
74            return mkString(_("slot p must have length = nrow(.) + 1"));
75        if (xp[0] != 0)
76            return mkString(_("first element of slot p must be zero"));
77        if (length(jslot) < xp[nrow]) /* allow larger slots from over-allocation!*/
78            return
79                mkString(_("last element of slot p must match length of slots j and x"));
80        for (i = 0; i < length(jslot); i++) {
81            if (xj[i] < 0 || xj[i] >= ncol)
82                return mkString(_("all column indices must be between 0 and ncol-1"));
83        }
84        sorted = TRUE; strictly = TRUE;
85        for (i = 0; i < nrow; i++) {
86            if (xp[i] > xp[i+1])
87                return mkString(_("slot p must be non-decreasing"));
88            if(sorted)
89                for (k = xp[i] + 1; k < xp[i + 1]; k++) {
90                    if (xj[k] < xj[k - 1])
91                        sorted = FALSE;
92                    else if (xj[k] == xj[k - 1])
93                        strictly = FALSE;
94                }
95        }
96        if (!sorted)
97            /* cannot easily use cholmod_sort(.) ... -> "error out" :*/
98            return mkString(_("slot j is not increasing inside a column"));
99        else if(!strictly) /* sorted, but not strictly */
100            return mkString(_("slot j is not *strictly* increasing inside a column"));
101    
102        return ScalarLogical(1);
103    }
104    
105    
106  /* Called from ../R/Csparse.R : */  /* Called from ../R/Csparse.R : */
107  /* Can only return [dln]geMatrix (no symm/triang);  /* Can only return [dln]geMatrix (no symm/triang);
108   * FIXME: replace by non-CHOLMOD code ! */   * FIXME: replace by non-CHOLMOD code ! */
# Line 124  Line 170 
170  SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)  SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)
171  {  {
172      CHM_SP chx = AS_CHM_SP(x), chgx;      CHM_SP chx = AS_CHM_SP(x), chgx;
173      int uploT = (*CHAR(asChar(uplo)) == 'U') ? 1 : -1;      int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;
174      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;      int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
175      R_CheckStack();      R_CheckStack();
176    
# Line 339  Line 385 
385                                1, 0, Rkind, "",                                1, 0, Rkind, "",
386                                /* FIXME: drops dimnames */ R_NilValue);                                /* FIXME: drops dimnames */ R_NilValue);
387  }  }
388    
389    SEXP Csparse_MatrixMarket(SEXP x, SEXP fname)
390    {
391        FILE *f = fopen(CHAR(asChar(fname)), "w");
392    
393        if (!f)
394            error(_("failure to open file \"%s\" for writing"),
395                  CHAR(asChar(fname)));
396        if (!cholmod_write_sparse(f, AS_CHM_SP(x), (CHM_SP)NULL,
397                                  (char*) NULL, &c))
398            error(_("cholmod_write_sparse returned error code"));
399        fclose(f);
400        return R_NilValue;
401    }

Legend:
Removed from v.1960  
changed lines
  Added in v.2113

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