Added skip_absent arguement to colnamesInt()

R/wrappers.R

@@ -8,7 +8,7 @@ setcoalesce = function(...) .Call(Ccoalesce, list(...), TRUE)
 fifelse = function(test, yes, no, na=NA) .Call(CfifelseR, test, yes, no, na)
 fcase   = function(..., default=NA) .Call(CfcaseR, default, parent.frame(), as.list(substitute(list(...)))[-1L])
 
-colnamesInt = function(x, cols, check_dups=FALSE) .Call(CcolnamesInt, x, cols, check_dups)
+colnamesInt = function(x, cols, check_dups=FALSE, skip_absent=FALSE) .Call(CcolnamesInt, x, cols, check_dups, skip_absent)
 
 testMsg = function(status=0L, nx=2L, nk=2L) .Call(CtestMsgR, as.integer(status)[1L], as.integer(nx)[1L], as.integer(nk)[1L])
 

inst/tests/nafill.Rraw

@@ -149,8 +149,19 @@ test(4.20, colnamesInt(dt, integer()), integer())
 test(4.21, colnamesInt(dt, NULL), seq_along(dt))
 test(4.22, colnamesInt("asd", 1), error="must be data.table compatible")
 test(4.23, colnamesInt(dt, 1, check_dups="a"), error="check_dups")
+test(4.24, colnamesInt(dt, c("a", "e"), skip_absent=TRUE), c(1L,0L))
+test(4.25, colnamesInt(dt, c(1L, 4L), skip_absent=TRUE), c(1L,0L))
+test(4.26, colnamesInt(dt, c(1, 4), skip_absent=TRUE), c(1L,0L))
+test(4.27, colnamesInt(dt, c("a", NA), skip_absent=TRUE), c(1L,0L))
+test(4.28, colnamesInt(dt, c(1L, 0L), skip_absent=TRUE), error="received non-existing column*.*0")
+test(4.29, colnamesInt(dt, c(1, -5), skip_absent=TRUE), error="received non-existing column*.*-5")
+test(4.30, colnamesInt(dt, c(1, 4), skip_absent=NULL), error="skip_absent must be TRUE or FALSE")
+test(4.31, colnamesInt(dt, c(1L, 1000L), skip_absent=TRUE), c(1L,0L))
+cols=c(1L,100L)
+test(4.32, colnamesInt(dt, cols, skip_absent=TRUE), c(1L, 0L))
+test(4.33, cols, c(1L, 100L)) # ensure input was not overwritten with output 0
 names(dt) <- NULL
-test(4.24, colnamesInt(dt, "a"), error="has no names")
+test(4.34, colnamesInt(dt, "a"), error="has no names")
 
 # verbose
 dt = data.table(a=c(1L, 2L, NA_integer_), b=c(1, 2, NA_real_))

src/data.table.h

@@ -238,7 +238,7 @@ bool isRealReallyInt(SEXP x);
 SEXP isRealReallyIntR(SEXP x);
 SEXP isReallyReal(SEXP x);
 bool allNA(SEXP x, bool errorForBadType);
-SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups);
+SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups, SEXP skip_absent);
 bool INHERITS(SEXP x, SEXP char_);
 SEXP copyAsPlain(SEXP x);
 void copySharedColumns(SEXP x);

src/nafill.c

@@ -114,7 +114,7 @@ SEXP nafillR(SEXP obj, SEXP type, SEXP fill, SEXP nan_is_na_arg, SEXP inplace, S
     obj = PROTECT(allocVector(VECSXP, 1)); protecti++; // wrap into list
     SET_VECTOR_ELT(obj, 0, obj1);
   }
-  SEXP ricols = PROTECT(colnamesInt(obj, cols, ScalarLogical(TRUE))); protecti++; // nafill cols=NULL which turns into seq_along(obj)
+  SEXP ricols = PROTECT(colnamesInt(obj, cols, /* check_dups= */ ScalarLogical(TRUE), /* skip_absent= */ ScalarLogical(FALSE))); protecti++; // nafill cols=NULL which turns into seq_along(obj)
   x = PROTECT(allocVector(VECSXP, length(ricols))); protecti++;
   int *icols = INTEGER(ricols);
   for (int i=0; i<length(ricols); i++) {

src/utils.c

@@ -97,16 +97,20 @@ SEXP allNAR(SEXP x) {
  * adds validation for:
  *   correct range [1,ncol], and if type real checks whole integer
  *   existing columns for character
- *   optionally check for no duplicates
+ *   optionally (check_dups) check for no duplicates
+ *   optionally (skip_absent) skip (return 0) for numbers outside the range or not naming extant columns
  */
-SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups) {
+SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups, SEXP skip_absent) {
   if (!isNewList(x))
     error(_("'x' argument must be data.table compatible"));
   if (!IS_TRUE_OR_FALSE(check_dups))
     error(_("%s must be TRUE or FALSE"), "check_dups");
+  if (!IS_TRUE_OR_FALSE(skip_absent))
+    error(_("%s must be TRUE or FALSE"), "skip_absent");
   int protecti = 0;
   R_len_t nx = length(x);
   R_len_t nc = length(cols);
+  bool bskip_absent = LOGICAL(skip_absent)[0];
   SEXP ricols = R_NilValue;
   if (isNull(cols)) { // seq_along(x)
     ricols = PROTECT(allocVector(INTSXP, nx)); protecti++;
@@ -116,26 +120,33 @@ SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups) {
     ricols = PROTECT(allocVector(INTSXP, 0)); protecti++;
   } else if (isInteger(cols) || isReal(cols)) {
     if (isInteger(cols)) {
-      ricols = cols;
+      if (bskip_absent) { // we might overwrite values, so make a copy
+        ricols = PROTECT(duplicate(cols)); protecti++;
+      } else
+        ricols = cols;
     } else if (isReal(cols)) {
       if (!isRealReallyInt(cols))
         error(_("argument specifying columns is type 'double' and one or more items in it are not whole integers"));
       ricols = PROTECT(coerceVector(cols, INTSXP)); protecti++;
     }
     int *icols = INTEGER(ricols);
-    for (int i=0; i<nc; i++) {
-      if ((icols[i]>nx) || (icols[i]<1))
+    for (int i=0; i<nc; ++i) {
+      if ((!bskip_absent && icols[i]>nx) || (icols[i]<1))
         error(_("argument specifying columns received non-existing column(s): cols[%d]=%d"), i+1, icols[i]); // handles NAs also
+      else if(bskip_absent && icols[i]>nx)
+        icols[i] = 0L;
     }
   } else if (isString(cols)) {
     SEXP xnames = PROTECT(getAttrib(x, R_NamesSymbol)); protecti++;
     if (isNull(xnames))
       error(_("'x' argument data.table has no names"));
     ricols = PROTECT(chmatch(cols, xnames, 0)); protecti++;
     int *icols = INTEGER(ricols);
-    for (int i=0; i<nc; i++) {
-      if (icols[i]==0)
-        error(_("argument specifying columns received non-existing column(s): cols[%d]='%s'"), i+1, CHAR(STRING_ELT(cols, i))); // handles NAs also
+    if (!bskip_absent){
+      for (int i=0; i<nc; ++i) {
+        if (icols[i]==0)
+          error(_("argument specifying columns received non-existing column(s): cols[%d]='%s'"), i+1, CHAR(STRING_ELT(cols, i))); // handles NAs also
+      }
     }
   } else {
     error(_("argument specifying columns must be character or numeric"));