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 2223, Fri Jul 18 23:04:48 2008 UTC revision 2279, Fri Oct 3 09:15:54 2008 UTC
# Line 3  Line 3 
3  #include "Tsparse.h"  #include "Tsparse.h"
4  #include "chm_common.h"  #include "chm_common.h"
5    
6    /** "Cheap" C version of  Csparse_validate() - *not* sorting : */
7    Rboolean isValid_Csparse(SEXP x)
8    {
9        /* NB: we do *NOT* check a potential 'x' slot here, at all */
10        SEXP pslot = GET_SLOT(x, Matrix_pSym),
11            islot = GET_SLOT(x, Matrix_iSym);
12        int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), j,
13            nrow = dims[0],
14            ncol = dims[1],
15            *xp = INTEGER(pslot),
16            *xi = INTEGER(islot);
17    
18        if (length(pslot) != dims[1] + 1)
19            return FALSE;
20        if (xp[0] != 0)
21            return FALSE;
22        if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/
23            return FALSE;
24        for (j = 0; j < xp[ncol]; j++) {
25            if (xi[j] < 0 || xi[j] >= nrow)
26                return FALSE;
27        }
28        for (j = 0; j < ncol; j++) {
29            if (xp[j] > xp[j + 1])
30                return FALSE;
31        }
32        return TRUE;
33    }
34    
35  SEXP Csparse_validate(SEXP x)  SEXP Csparse_validate(SEXP x)
36  {  {
37      /* NB: we do *NOT* check a potential 'x' slot here, at all */      /* NB: we do *NOT* check a potential 'x' slot here, at all */
# Line 23  Line 52 
52      if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/      if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/
53          return          return
54              mkString(_("last element of slot p must match length of slots i and x"));              mkString(_("last element of slot p must match length of slots i and x"));
55      for (j = 0; j < length(islot); j++) {      for (j = 0; j < xp[ncol]; j++) {
56          if (xi[j] < 0 || xi[j] >= nrow)          if (xi[j] < 0 || xi[j] >= nrow)
57              return mkString(_("all row indices must be between 0 and nrow-1"));              return mkString(_("all row indices must be between 0 and nrow-1"));
58      }      }
# Line 31  Line 60 
60      for (j = 0; j < ncol; j++) {      for (j = 0; j < ncol; j++) {
61          if (xp[j] > xp[j+1])          if (xp[j] > xp[j+1])
62              return mkString(_("slot p must be non-decreasing"));              return mkString(_("slot p must be non-decreasing"));
63          if(sorted)          if(sorted) /* only act if >= 2 entries in column j : */
64              for (k = xp[j] + 1; k < xp[j + 1]; k++) {              for (k = xp[j] + 1; k < xp[j + 1]; k++) {
65                  if (xi[k] < xi[k - 1])                  if (xi[k] < xi[k - 1])
66                      sorted = FALSE;                      sorted = FALSE;
# Line 40  Line 69 
69              }              }
70      }      }
71      if (!sorted) {      if (!sorted) {
72          CHM_SP chx = AS_CHM_SP__(x);          CHM_SP chx = (CHM_SP) alloca(sizeof(cholmod_sparse));
73          R_CheckStack();          R_CheckStack();
74            as_cholmod_sparse(chx, x, FALSE, TRUE); /* includes cholmod_sort() ! */
75            /* as chx = AS_CHM_SP__(x)  but  ^^^^  sorting x in_place (no copying)*/
76    
         cholmod_sort(chx, &c);  
77          /* Now re-check that row indices are *strictly* increasing          /* Now re-check that row indices are *strictly* increasing
78           * (and not just increasing) within each column : */           * (and not just increasing) within each column : */
79          for (j = 0; j < ncol; j++) {          for (j = 0; j < ncol; j++) {

Legend:
Removed from v.2223  
changed lines
  Added in v.2279

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