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 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 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 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() */
