Matrix  $Rev: 3071 $ at $LastChangedDate: 2015-03-26 15:35:47 +0100 (Thu, 26 Mar 2015) $
t_Csparse_validate.c
Go to the documentation of this file.
1 /* Included from ./Csparse.c
2  * ----------
3  */
4 #ifdef _t_Csparse_sort
5 
6 # define CSPARSE_VAL_RES_TYPE static int
7 # define CSPARSE_VAL_FN_NAME Csparse_sort_2
8 # define CSPARSE_VAL_RETURN_TRUE return 1
9 # define CSPARSE_VAL_RETURN_STRING(STR) return 0
10 
11 # undef _t_Csparse_sort
12 
13 #elif defined (_t_Csparse_validate)
14 
15 # define CSPARSE_VAL_RES_TYPE SEXP
16 # define CSPARSE_VAL_FN_NAME Csparse_validate_
17 # define CSPARSE_VAL_RETURN_TRUE return ScalarLogical(1)
18 # define CSPARSE_VAL_RETURN_STRING(STR) return mkString(_(STR))
19 
20 # undef _t_Csparse_validate
21 
22 #else
23 # error "no valid _t_Csparse_* option"
24 #endif
25 
26 
27 CSPARSE_VAL_RES_TYPE CSPARSE_VAL_FN_NAME(SEXP x, Rboolean maybe_modify)
28 {
29  /* NB: we do *NOT* check a potential 'x' slot here, at all */
30  SEXP pslot = GET_SLOT(x, Matrix_pSym),
31  islot = GET_SLOT(x, Matrix_iSym);
32  Rboolean sorted, strictly;
33  int j, k,
34  *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
35  nrow = dims[0],
36  ncol = dims[1],
37  *xp = INTEGER(pslot),
38  *xi = INTEGER(islot);
39 
40  if (length(pslot) != dims[1] + 1)
41  CSPARSE_VAL_RETURN_STRING("slot p must have length = ncol(.) + 1");
42  if (xp[0] != 0)
43  CSPARSE_VAL_RETURN_STRING("first element of slot p must be zero");
44  if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/
45  CSPARSE_VAL_RETURN_STRING("last element of slot p must match length of slots i and x");
46  for (j = 0; j < xp[ncol]; j++) {
47  if (xi[j] < 0 || xi[j] >= nrow)
48  CSPARSE_VAL_RETURN_STRING("all row indices must be between 0 and nrow-1");
49  }
50  sorted = TRUE; strictly = TRUE;
51  for (j = 0; j < ncol; j++) {
52  if (xp[j] > xp[j + 1])
53  CSPARSE_VAL_RETURN_STRING("slot p must be non-decreasing");
54  if(sorted) /* only act if >= 2 entries in column j : */
55  for (k = xp[j] + 1; k < xp[j + 1]; k++) {
56  if (xi[k] < xi[k - 1])
57  sorted = FALSE;
58  else if (xi[k] == xi[k - 1])
59  strictly = FALSE;
60  }
61  }
62  if (!sorted) {
63  if(maybe_modify) {
64  CHM_SP chx = (CHM_SP) alloca(sizeof(cholmod_sparse));
65  R_CheckStack();
66  as_cholmod_sparse(chx, x, FALSE, TRUE);/*-> cholmod_l_sort() ! */
67  /* as chx = AS_CHM_SP__(x) but ^^^^ sorting x in_place !!! */
68 
69  /* Now re-check that row indices are *strictly* increasing
70  * (and not just increasing) within each column : */
71  for (j = 0; j < ncol; j++) {
72  for (k = xp[j] + 1; k < xp[j + 1]; k++)
73  if (xi[k] == xi[k - 1])
74  CSPARSE_VAL_RETURN_STRING("slot i is not *strictly* increasing inside a column (even after cholmod_l_sort)");
75  }
76  } else { /* no modifying sorting : */
77  CSPARSE_VAL_RETURN_STRING("row indices are not sorted within columns");
78  }
79  } else if(!strictly) { /* sorted, but not strictly */
80  CSPARSE_VAL_RETURN_STRING("slot i is not *strictly* increasing inside a column");
81  }
82  CSPARSE_VAL_RETURN_TRUE;
83 }
84 
85 #undef CSPARSE_VAL_RES_TYPE
86 #undef CSPARSE_VAL_FN_NAME
87 #undef CSPARSE_VAL_RETURN_TRUE
88 #undef CSPARSE_VAL_RETURN_STRING
SEXP Matrix_DimSym
Definition: Syms.h:2
cholmod_sparse * CHM_SP
Definition: chm_common.h:25
CHM_SP as_cholmod_sparse(CHM_SP ans, SEXP x, Rboolean check_Udiag, Rboolean sort_in_place)
Populate ans with the pointers from x and modify its scalar elements accordingly. ...
Definition: chm_common.c:245
SEXP Matrix_iSym
Definition: Syms.h:2
SEXP Matrix_pSym
Definition: Syms.h:2
CSPARSE_VAL_RES_TYPE CSPARSE_VAL_FN_NAME(SEXP x, Rboolean maybe_modify)