The R Project SVN R-packages

Rev

Rev 4418 | Rev 4500 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4418 Rev 4456
Line 5... Line 5...
5 
SEXP Csparse_validate(SEXP x)
 5 
SEXP Csparse_validate(SEXP x)
6 
{
 6 
{
7 
    /* NB: we do *NOT* check a potential 'x' slot here, at all */
 7 
    /* NB: we do *NOT* check a potential 'x' slot here, at all */
8 
    SEXP pslot = GET_SLOT(x, Matrix_pSym),
 8 
    SEXP pslot = GET_SLOT(x, Matrix_pSym),
9 
	islot = GET_SLOT(x, Matrix_iSym);
 9 
	islot = GET_SLOT(x, Matrix_iSym);
- 
 
 10 
    Rboolean sorted, strictly;
10 
    int j, k, sorted,
 11 
    int j, k,
11 
	*dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
 12 
	*dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
12 
	nrow = dims[0],
 13 
	nrow = dims[0],
13 
	ncol = dims[1],
 14 
	ncol = dims[1],
14 
	*xp = INTEGER(pslot),
 15 
	*xp = INTEGER(pslot),
15 
	*xi = INTEGER(islot);
 16 
	*xi = INTEGER(islot);
16 
 
 17 
 
17 
    if (length(pslot) != dims[1] + 1)
 18 
    if (length(pslot) != dims[1] + 1)
18 
	return mkString(_("slot p must have length = ncol(.) + 1"));
 19 
	return mkString(_("slot p must have length = ncol(.) + 1"));
19 
    if (xp[0] != 0)
 20 
    if (xp[0] != 0)
20 
	return mkString(_("first element of slot p must be zero"));
 21 
	return mkString(_("first element of slot p must be zero"));
21 
    if (length(islot) != xp[ncol])
 22 
    if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/
22 
	return
 23 
	return
23 
	    mkString(_("last element of slot p must match length of slots i and x"));
 24 
	    mkString(_("last element of slot p must match length of slots i and x"));
24 
    for (j = 0; j < length(islot); j++) {
 25 
    for (j = 0; j < length(islot); j++) {
25 
	if (xi[j] < 0 || xi[j] >= nrow)
 26 
	if (xi[j] < 0 || xi[j] >= nrow)
26 
	    return mkString(_("all row indices must be between 0 and nrow-1"));
 27 
	    return mkString(_("all row indices must be between 0 and nrow-1"));
27 
    }
 28 
    }
28 
    sorted = TRUE;
 29 
    sorted = TRUE; strictly = TRUE;
29 
    for (j = 0; j < ncol; j++) {
 30 
    for (j = 0; j < ncol; j++) {
30 
	if (xp[j] > xp[j+1])
 31 
	if (xp[j] > xp[j+1])
31 
	    return mkString(_("slot p must be non-decreasing"));
 32 
	    return mkString(_("slot p must be non-decreasing"));
- 
 
 33 
	if(sorted)
32 
	for (k = xp[j] + 1; k < xp[j + 1]; k++)
 34 
	    for (k = xp[j] + 1; k < xp[j + 1]; k++) {
33 
	    if (xi[k] < xi[k - 1]) sorted = FALSE;
 35 
		if (xi[k] < xi[k - 1])
- 
 
 36 
		    sorted = FALSE;
- 
 
 37 
		else if (xi[k] == xi[k - 1])
- 
 
 38 
		    strictly = FALSE;
- 
 
 39 
	    }
34 
    }
 40 
    }
35 
    if (!sorted) {
 41 
    if (!sorted) {
36 
	cholmod_sparse *chx = as_cholmod_sparse(x);
 42 
	cholmod_sparse *chx = as_cholmod_sparse(x);
37 
	cholmod_sort(chx, &c);
 43 
	cholmod_sort(chx, &c);
38 
	Free(chx);
 44 
	Free(chx);
- 
 
 45 
	/* Now re-check that row indices are *strictly* increasing
- 
 
 46 
	 * (and not just increasing) within each column : */
- 
 
 47 
	for (j = 0; j < ncol; j++) {
- 
 
 48 
	    for (k = xp[j] + 1; k < xp[j + 1]; k++)
- 
 
 49 
		if (xi[k] == xi[k - 1])
- 
 
 50 
		    return mkString(_("slot i is not *strictly* increasing inside a column (even after cholmod_sort)"));
- 
 
 51 
	}
- 
 
 52 
 
- 
 
 53 
    } else if(!strictly) {  /* sorted, but not strictly */
- 
 
 54 
	return mkString(_("slot i is not *strictly* increasing inside a column"));
39 
    }
 55 
    }
40 
    return ScalarLogical(1);
 56 
    return ScalarLogical(1);
41 
}
 57 
}
42 
 
 58 
 
43 
/* Called from ../R/Csparse.R : */
 59 
/* Called from ../R/Csparse.R : */