SEXP rowMads(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP constant, SEXP naRm, SEXP hasNA, SEXP byRow) {
int narm, hasna, byrow;
SEXP ans;
R_xlen_t nrow, ncol;
double scale;
/* Argument 'x' and 'dim': */
assertArgMatrix(x, dim, (R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'constant': */
if (!isNumeric(constant))
error("Argument 'constant' must be a numeric scale.");
scale = asReal(constant);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
void *crows = validateIndices(rows, nrow, 0, &nrows, &rowsType);
void *ccols = validateIndices(cols, ncol, 0, &ncols, &colsType);
/* Argument 'byRow': */
byrow = asLogical(byRow);
if (!byrow) {
SWAP(R_xlen_t, nrow, ncol);
SWAP(void*, crows, ccols);
SWAP(R_xlen_t, nrows, ncols);
SWAP(int, rowsType, colsType);
}
/* R allocate a double vector of length 'nrow'
Note that 'nrow' means 'ncol' if byrow=FALSE. */
PROTECT(ans = allocVector(REALSXP, nrows));
/* Double matrices are more common to use. */
if (isReal(x)) {
rowMads_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, scale, narm, hasna, byrow, REAL(ans));
} else if (isInteger(x)) {
rowMads_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, scale, narm, hasna, byrow, REAL(ans));
}
UNPROTECT(1);
return(ans);
} /* rowMads() */
SEXP rowCounts(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP value, SEXP what, SEXP naRm, SEXP hasNA) {
SEXP ans;
int narm, hasna, what2;
R_xlen_t nrow, ncol;
/* Argument 'x' & 'dim': */
assertArgMatrix(x, dim, (R_TYPE_LGL | R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'value': */
if (length(value) != 1)
error("Argument 'value' must be a single value.");
if (!isNumeric(value))
error("Argument 'value' must be a numeric value.");
/* Argument 'what': */
what2 = asInteger(what);
if (what2 < 0 || what2 > 2)
error("INTERNAL ERROR: Unknown value of 'what' for rowCounts: %d", what2);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
void *crows = validateIndices(rows, nrow, 0, &nrows, &rowsType);
void *ccols = validateIndices(cols, ncol, 0, &ncols, &colsType);
/* R allocate a double vector of length 'nrow' */
PROTECT(ans = allocVector(INTSXP, nrows));
/* Double matrices are more common to use. */
if (isReal(x)) {
rowCounts_Real[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, asReal(value), what2, narm, hasna, INTEGER(ans));
} else if (isInteger(x)) {
rowCounts_Integer[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, asInteger(value), what2, narm, hasna, INTEGER(ans));
} else if (isLogical(x)) {
rowCounts_Logical[rowsType][colsType](LOGICAL(x), nrow, ncol, crows, nrows, ccols, ncols, asLogical(value), what2, narm, hasna, INTEGER(ans));
}
UNPROTECT(1);
return(ans);
} // rowCounts()
SEXP meanOver(SEXP x, SEXP idxs, SEXP naRm, SEXP refine) {
SEXP ans;
R_xlen_t nx;
int narm, refine2;
double avg = NA_REAL;
/* Argument 'x': */
assertArgVector(x, (R_TYPE_INT | R_TYPE_REAL), "x");
nx = xlength(x);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'refine': */
refine2 = asLogicalNoNA(refine, "refine");
/* Argument 'idxs': */
R_xlen_t nidxs;
int idxsType;
void *cidxs = validateIndices(idxs, nx, 1, &nidxs, &idxsType);
/* Double matrices are more common to use. */
if (isReal(x)) {
avg = meanOver_Real[idxsType](REAL(x), nx, cidxs, nidxs, narm, refine2);
} else if (isInteger(x)) {
avg = meanOver_Integer[idxsType](INTEGER(x), nx, cidxs, nidxs, narm, refine2);
}
/* Return results */
PROTECT(ans = allocVector(REALSXP, 1));
REAL(ans)[0] = avg;
UNPROTECT(1);
return(ans);
} // meanOver()
SEXP count(SEXP x, SEXP idxs, SEXP value, SEXP what, SEXP naRm, SEXP hasNA) {
SEXP ans;
int narm, hasna, what2;
R_xlen_t nx;
/* Argument 'x' and 'dim': */
assertArgVector(x, (R_TYPE_LGL | R_TYPE_INT | R_TYPE_REAL), "x");
nx = xlength(x);
/* Argument 'value': */
if (length(value) != 1)
error("Argument 'value' must be a single value.");
if (!isNumeric(value))
error("Argument 'value' must be a numeric value.");
/* Argument 'what': */
what2 = asInteger(what);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'idxs': */
R_xlen_t nrows, ncols = 1;
int rowsType, colsType = SUBSETTED_ALL;
void *crows = validateIndices(idxs, nx, 1, &nrows, &rowsType);
void *ccols = NULL;
/* R allocate a integer scalar */
PROTECT(ans = allocVector(INTSXP, 1));
if (isReal(x)) {
colCounts_Real[rowsType][colsType](REAL(x), nx, 1, crows, nrows, ccols, ncols, asReal(value), what2, narm, hasna, INTEGER(ans));
} else if (isInteger(x)) {
colCounts_Integer[rowsType][colsType](INTEGER(x), nx, 1, crows, nrows, ccols, ncols, asInteger(value), what2, narm, hasna, INTEGER(ans));
} else if (isLogical(x)) {
colCounts_Logical[rowsType][colsType](LOGICAL(x), nx, 1, crows, nrows, ccols, ncols, asLogical(value), what2, narm, hasna, INTEGER(ans));
}
UNPROTECT(1);
return(ans);
} // count()
SEXP weightedMedian(SEXP x, SEXP w, SEXP idxs, SEXP naRm, SEXP interpolate, SEXP ties) {
SEXP ans;
int narm, interpolate2, ties2;
double mu = NA_REAL;
R_xlen_t nx, nw;
/* Argument 'x': */
assertArgVector(x, (R_TYPE_INT | R_TYPE_REAL), "x");
nx = xlength(x);
/* Argument 'x': */
assertArgVector(w, (R_TYPE_REAL), "w");
nw = xlength(w);
if (nx != nw) {
error("Argument 'x' and 'w' are of different lengths: %d != %d", nx, nw);
}
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'interpolate': */
interpolate2 = asLogicalNoNA(interpolate, "interpolate");
/* Argument 'idxs': */
R_xlen_t nidxs;
int idxsType;
void *cidxs = validateIndices(idxs, nx, 1, &nidxs, &idxsType);
/* Argument 'ties': */
ties2 = asInteger(ties);
/* Double matrices are more common to use. */
if (isReal(x)) {
mu = weightedMedian_Real[idxsType](REAL(x), nx, REAL(w), cidxs, nidxs, narm, interpolate2, ties2);
} else if (isInteger(x)) {
mu = weightedMedian_Integer[idxsType](INTEGER(x), nx, REAL(w), cidxs, nidxs, narm, interpolate2, ties2);
}
/* Return results */
PROTECT(ans = allocVector(REALSXP, 1));
REAL(ans)[0] = mu;
UNPROTECT(1);
return(ans);
} // weightedMedian()
SEXP diff2(SEXP x, SEXP idxs, SEXP lag, SEXP differences) {
SEXP ans = NILSXP;
R_xlen_t nx, nans, lagg, diff;
/* Argument 'x': */
assertArgVector(x, (R_TYPE_INT | R_TYPE_REAL), "x");
nx = xlength(x);
/* Argument 'lag': */
lagg = asInteger(lag);
if (lagg < 1) {
error("Argument 'lag' must be a positive integer.");
}
/* Argument 'differences': */
diff = asInteger(differences);
if (diff < 1) {
error("Argument 'differences' must be a positive integer.");
}
/* Argument 'idxs': */
R_xlen_t nidxs;
int idxsType;
void *cidxs = validateIndices(idxs, nx, 1, &nidxs, &idxsType);
/* Length of result vector */
nans = (R_xlen_t)((double)nidxs - ((double)diff*(double)lagg));
if (nans < 0) nans = 0;
/* Dispatch to low-level C function */
if (isReal(x)) {
PROTECT(ans = allocVector(REALSXP, nans));
diff2_dbl[idxsType](REAL(x), nx, cidxs, nidxs, lagg, diff, REAL(ans), nans);
UNPROTECT(1);
} else if (isInteger(x)) {
PROTECT(ans = allocVector(INTSXP, nans));
diff2_int[idxsType](INTEGER(x), nx, cidxs, nidxs, lagg, diff, INTEGER(ans), nans);
UNPROTECT(1);
} else {
error("Argument 'x' must be numeric.");
}
return ans;
} // diff2()
SEXP x_OP_y(SEXP x, SEXP y, SEXP dim, SEXP operator, SEXP xrows, SEXP xcols, SEXP yidxs, SEXP commute, SEXP naRm, SEXP hasNA, SEXP byRow) {
SEXP ans = NILSXP;
int narm, hasna, byrow, commute2;
int op;
R_xlen_t nrow, ncol, ny;
/* Argument 'x' and 'dim': */
assertArgMatrix(x, dim, (R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'y': */
assertArgVector(y, (R_TYPE_INT | R_TYPE_REAL), "y");
ny = xlength(y);
/* Argument 'byRow': */
byrow = asLogicalNoNA(byRow, "byrow");
/* Argument 'commute2': */
commute2 = asLogicalNoNA(commute, "commute");
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'xrows', 'xcols' and 'yidxs': */
R_xlen_t nxrows, nxcols, nyidxs;
int xrowsType, xcolsType, yidxsType;
void *cxrows = validateIndices(xrows, nrow, 0, &nxrows, &xrowsType);
void *cxcols = validateIndices(xcols, ncol, 0, &nxcols, &xcolsType);
void *cyidxs = validateIndices(yidxs, ny, 1, &nyidxs, &yidxsType);
/* Argument 'operator': */
op = asInteger(operator);
if (op == 1) {
/* Addition */
if (isReal(x) || isReal(y)) {
PROTECT(ans = allocMatrix(REALSXP, nxrows, nxcols));
if (isReal(x) && isReal(y)) {
x_OP_y_Add_Real_Real[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isReal(x) && isInteger(y)) {
x_OP_y_Add_Real_Integer[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isInteger(x) && isReal(y)) {
x_OP_y_Add_Integer_Real[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
}
UNPROTECT(1);
} else {
PROTECT(ans = allocMatrix(INTSXP, nxrows, nxcols));
x_OP_y_Add_Integer_Integer[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, INTEGER(ans), xlength(ans));
UNPROTECT(1);
}
} if (op == 2) {
/* Subtraction */
if (isReal(x) || isReal(y)) {
PROTECT(ans = allocMatrix(REALSXP, nxrows, nxcols));
if (isReal(x) && isReal(y)) {
x_OP_y_Sub_Real_Real[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isReal(x) && isInteger(y)) {
x_OP_y_Sub_Real_Integer[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isInteger(x) && isReal(y)) {
x_OP_y_Sub_Integer_Real[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
}
UNPROTECT(1);
} else {
PROTECT(ans = allocMatrix(INTSXP, nxrows, nxcols));
x_OP_y_Sub_Integer_Integer[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, INTEGER(ans), xlength(ans));
UNPROTECT(1);
}
} else if (op == 3) {
/* Multiplication */
if (isReal(x) || isReal(y)) {
PROTECT(ans = allocMatrix(REALSXP, nxrows, nxcols));
if (isReal(x) && isReal(y)) {
x_OP_y_Mul_Real_Real[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isReal(x) && isInteger(y)) {
x_OP_y_Mul_Real_Integer[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isInteger(x) && isReal(y)) {
x_OP_y_Mul_Integer_Real[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
}
UNPROTECT(1);
} else {
PROTECT(ans = allocMatrix(INTSXP, nxrows, nxcols));
x_OP_y_Mul_Integer_Integer[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, INTEGER(ans), xlength(ans));
UNPROTECT(1);
}
} else if (op == 4) {
/* Division */
PROTECT(ans = allocMatrix(REALSXP, nxrows, nxcols));
if (isReal(x) && isReal(y)) {
x_OP_y_Div_Real_Real[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isReal(x) && isInteger(y)) {
x_OP_y_Div_Real_Integer[xrowsType][xcolsType][yidxsType](
REAL(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isInteger(x) && isReal(y)) {
x_OP_y_Div_Integer_Real[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, REAL(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
} else if (isInteger(x) && isInteger(y)) {
x_OP_y_Div_Integer_Integer[xrowsType][xcolsType][yidxsType](
INTEGER(x), nrow, ncol, INTEGER(y), ny, cxrows, nxrows, cxcols, nxcols, cyidxs, nyidxs, byrow, commute2, narm, hasna, REAL(ans), xlength(ans));
}
UNPROTECT(1);
}
return(ans);
} /* x_OP_y() */
/* Peter Langfelder's modifications:
* byrow: 0 => rank columns, !0 => rank rows
* tiesMethod: 1: maximum, 2: average, 3:minimum
* The returned rank is a REAL matrix to accomodate average ranks
*/
SEXP rowRanksWithTies(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP tiesMethod, SEXP byRow) {
int tiesmethod, byrow;
SEXP ans = NILSXP;
R_xlen_t nrow, ncol;
/* Argument 'x' and 'dim': */
assertArgMatrix(x, dim, (R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'tiesMethod': */
tiesmethod = asInteger(tiesMethod);
if (tiesmethod < 1 || tiesmethod > 3) {
error("Argument 'tiesMethod' is out of range [1,3]: %d", tiesmethod);
}
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
void *crows = validateIndices(rows, nrow, 0, &nrows, &rowsType);
void *ccols = validateIndices(cols, ncol, 0, &ncols, &colsType);
/* Argument 'byRow': */
byrow = asLogical(byRow);
/* Double matrices are more common to use. */
if (isReal(x)) {
if (byrow) {
switch (tiesmethod) {
case 1:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
rowRanksWithTies_Max_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
case 2:
PROTECT(ans = allocMatrix(REALSXP, nrows, ncols));
rowRanksWithTies_Average_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, REAL(ans));
UNPROTECT(1);
break;
case 3:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
rowRanksWithTies_Min_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
} /* switch */
} else {
switch (tiesmethod) {
case 1:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
colRanksWithTies_Max_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
case 2:
PROTECT(ans = allocMatrix(REALSXP, nrows, ncols));
colRanksWithTies_Average_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, REAL(ans));
UNPROTECT(1);
break;
case 3:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
colRanksWithTies_Min_dbl[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
} /* switch */
}
} else if (isInteger(x)) {
if (byrow) {
switch (tiesmethod) {
case 1:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
rowRanksWithTies_Max_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
case 2:
PROTECT(ans = allocMatrix(REALSXP, nrows, ncols));
rowRanksWithTies_Average_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, REAL(ans));
UNPROTECT(1);
break;
case 3:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
rowRanksWithTies_Min_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
} /* switch */
} else {
switch (tiesmethod) {
case 1:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
colRanksWithTies_Max_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
case 2:
PROTECT(ans = allocMatrix(REALSXP, nrows, ncols));
colRanksWithTies_Average_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, REAL(ans));
UNPROTECT(1);
break;
case 3:
PROTECT(ans = allocMatrix(INTSXP, nrows, ncols));
colRanksWithTies_Min_int[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, INTEGER(ans));
UNPROTECT(1);
break;
} /* switch */
}
}
return(ans);
} // rowRanksWithTies()
SEXP colRanges(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP what, SEXP naRm, SEXP hasNA) {
SEXP ans = NILSXP, ans2 = NILSXP;
int *mins, *maxs;
double *mins2, *maxs2;
int *is_counted, all_counted = 0;
int what2, narm, hasna;
R_xlen_t nrow, ncol, jj;
/* Argument 'x' and 'dim': */
assertArgMatrix(x, dim, (R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'what': */
if (length(what) != 1)
error("Argument 'what' must be a single number.");
if (!isNumeric(what))
error("Argument 'what' must be a numeric number.");
what2 = asInteger(what);
if (what2 < 0 || what2 > 2)
error("Invalid value of 'what': %d", what2);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
void *crows = validateIndices(rows, nrow, 0, &nrows, &rowsType);
void *ccols = validateIndices(cols, ncol, 0, &ncols, &colsType);
is_counted = (int *) R_alloc(ncols, sizeof(int));
if (isReal(x)) {
if (what2 == 2) {
PROTECT(ans = allocMatrix(REALSXP, ncols, 2));
} else {
PROTECT(ans = allocVector(REALSXP, ncols));
}
colRanges_Real[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, what2, narm, hasna, REAL(ans), is_counted);
UNPROTECT(1);
} else if (isInteger(x)) {
if (what2 == 2) {
PROTECT(ans = allocMatrix(INTSXP, ncols, 2));
} else {
PROTECT(ans = allocVector(INTSXP, ncols));
}
colRanges_Integer[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, what2, narm, hasna, INTEGER(ans), is_counted);
/* Any entries with zero non-missing values? */
all_counted = 1;
for (jj=0; jj < ncols; jj++) {
if (!is_counted[jj]) {
all_counted = 0;
break;
}
}
if (!all_counted) {
/* Handle zero non-missing values */
/* Instead of return INTSXP, we must return REALSXP (to hold -Inf, and Inf) */
if (what2 == 0) {
PROTECT(ans2 = allocVector(REALSXP, ncols));
mins = INTEGER(ans);
mins2 = REAL(ans2);
for (jj=0; jj < ncols; jj++) {
if (is_counted[jj]) {
mins2[jj] = (double)mins[jj];
} else {
mins2[jj] = R_PosInf;
}
}
UNPROTECT(1); /* ans2 */
} else if (what2 == 1) {
PROTECT(ans2 = allocVector(REALSXP, ncols));
maxs = INTEGER(ans);
maxs2 = REAL(ans2);
for (jj=0; jj < ncols; jj++) {
if (is_counted[jj]) {
maxs2[jj] = (double)maxs[jj];
} else {
maxs2[jj] = R_NegInf;
}
}
UNPROTECT(1); /* ans2 */
} else if (what2 == 2) {
PROTECT(ans2 = allocMatrix(REALSXP, ncols, 2));
mins = INTEGER(ans);
maxs = &INTEGER(ans)[ncols];
mins2 = REAL(ans2);
maxs2 = &REAL(ans2)[ncols];
for (jj=0; jj < ncols; jj++) {
if (is_counted[jj]) {
mins2[jj] = (double)mins[jj];
maxs2[jj] = (double)maxs[jj];
} else {
mins2[jj] = R_PosInf;
maxs2[jj] = R_NegInf;
}
}
UNPROTECT(1); /* ans2 */
}
ans = ans2;
}
UNPROTECT(1); /* ans */
}
return(ans);
} // colRanges()