Added gforce_dynamic attrib returned by gfirstlast and gshift to gforce at C level which now reps grpcols instead of R level

Author: mattdowle

NEWS.md

@@ -622,6 +622,8 @@
 
 53. `as.data.frame(DT, row.names=)` no longer silently ignores `row.names`, [#5319](https://github.com/Rdatatable/data.table/issues/5319). Thanks to @dereckdemezquita for the fix and PR, and @ben-schwen for guidance.
 
+54. An empty result in one column by group would be correctly filled with `NA` with warning: `Item <n> of j's result for group <n> is zero length. This will be filled with <n> NAs to match the longest column in this result. Later groups may have a similar problem but only the first is reported to save filling the warning buffer.` However, this was not true for type `list` where the fill value was `NULL`. Empty list results are now filled with `NA`.
+
 ## NOTES
 
 1. New feature 29 in v1.12.4 (Oct 2019) introduced zero-copy coercion. Our thinking is that requiring you to get the type right in the case of `0` (type double) vs `0L` (type integer) is too inconvenient for you the user. So such coercions happen in `data.table` automatically without warning. Thanks to zero-copy coercion there is no speed penalty, even when calling `set()` many times in a loop, so there's no speed penalty to warn you about either. However, we believe that assigning a character value such as `"2"` into an integer column is more likely to be a user mistake that you would like to be warned about. The type difference (character vs integer) may be the only clue that you have selected the wrong column, or typed the wrong variable to be assigned to that column. For this reason we view character to numeric-like coercion differently and will warn about it. If it is correct, then the warning is intended to nudge you to wrap the RHS with `as.<type>()` so that it is clear to readers of your code that a coercion from character to that type is intended. For example :

R/data.table.R

@@ -1863,43 +1863,8 @@ replace_dot_alias = function(e) {
     assign(".N", len__, thisEnv) # For #334
     #fix for #1683
     if (use.I) assign(".I", seq_len(nrow(x)), thisEnv)
-    ans = gforce(thisEnv, jsub, o__, f__, len__, irows) # irows needed for #971.
-    gi = if (length(o__)) o__[f__] else f__
-    g = lapply(grpcols, function(i) groups[[i]][gi])
-
-    # returns all rows instead of one per group
-    nrow_funs = c("gshift")
-    .is_nrows = function(q) {
-      if (!is.call(q)) return(FALSE)
-      if (q[[1L]] == "list") {
-        any(vapply(q, .is_nrows, FALSE))
-      } else {
-        q[[1L]] %chin% nrow_funs
-      }
-    }
-
-    # ghead/gtail/gfirst/glast(n) support for n>1 #5060 #523 #5168
-    qn = 0L
-    if (!is.symbol(jsub)) {
-      headTail_arg = function(q) {
-        if (length(q)<3L || !(q1=q[[1L]]) %chin% c("ghead", "gtail", "gfirst", "glast")) return(0L)
-        q = match.call(get(q1), q)
-        qn = q[["n"]] # not q$n because partial argument matching matches to na.rm when n isn't present
-        if (length(qn)==1L && is.numeric(qn) && qn!=1L) qn else 0L
-      }
-      if (jsub[[1L]] == "list"){
-        qn = max(sapply(jsub, headTail_arg))
-      } else if (length(jsub)>=3L) {
-        qn = headTail_arg(jsub)
-      }
-    }
-    if (qn > 0L) {
-      grplens = pmin.int(qn, len__)
-      g = lapply(g, rep.int, times=grplens)
-    } else if (.is_nrows(jsub)) {
-      g = lapply(g, rep.int, times=len__)
-    }
-    ans = c(g, ans)
+    ans = gforce(thisEnv, jsub, o__, f__, len__, irows,  # irows needed for #971
+                 .Call(CsubsetVector, groups, grpcols))  # just a list() subset to make C level neater; doesn't copy column contents
   } else {
     ans = .Call(Cdogroups, x, xcols, groups, grpcols, jiscols, xjiscols, grporder, o__, f__, len__, jsub, SDenv, cols, newnames, !missing(on), verbose)
   }
@@ -1922,9 +1887,9 @@ replace_dot_alias = function(e) {
   # TO DO: setkey could mark the key whether it is unique or not.
   if (!is.null(lhs)) {
     if (GForce) { # GForce should work with := #1414
-      vlen = length(ans[[1L]])
+      vlen = length(ans[[1L]])   # TODO: this might be ngrp when na.rm=TRUE and one group has 2 and another 0, so needs enhancing here (by passing all-1 back from gans?)
       # replicate vals if GForce returns 1 value per group
-      jvals = if (vlen==length(len__)) lapply(tail(ans, -length(g)), rep, times=len__) else tail(ans, -length(g))  # see comment in #4245 for why rep instead of rep.int
+      jvals = if (vlen==length(len__)) lapply(tail(ans, -length(grpcols)), rep, times=len__) else tail(ans, -length(grpcols))  # see comment in #4245 for why rep instead of rep.int
       jrows = vecseq(f__,len__,NULL)
       if (length(o__)) jrows = o__[jrows]
       if (length(irows)) jrows = irows[jrows]
@@ -3039,7 +3004,7 @@ gshift = function(x, n=1L, fill=NA, type=c("lag", "lead", "shift", "cyclic")) {
   stopifnot(is.numeric(n))
   .Call(Cgshift, x, as.integer(n), fill, type)
 }
-gforce = function(env, jsub, o, f, l, rows) .Call(Cgforce, env, jsub, o, f, l, rows)
+gforce = function(env, jsub, o, f, l, rows, grpcols) .Call(Cgforce, env, jsub, o, f, l, rows, grpcols)
 
 .prepareFastSubset = function(isub, x, enclos, notjoin, verbose = FALSE){
   ## helper that decides, whether a fast binary search can be performed, if i is a call

R/last.R

@@ -51,7 +51,7 @@ last = function(x, n=1L, na.rm=FALSE, ...) {
     # else na.rm==TRUE; select the first/last non-NA within each column
     ans = lapply(x, .narmVector, n=n, first=first)
     l = vapply_1i(ans, length)
-    m = min(n, nrow(x))
+    m = max(l)
     for (i in which(l<m)) {  # pad with NA
       ans[[i]] = if (first) c(ans[[i]], rep(NA, m-l[i]))
                  else       c(rep(NA, m-l[i]), ans[[i]])
@@ -73,7 +73,7 @@ last = function(x, n=1L, na.rm=FALSE, ...) {
 
 .narmVector = function(x, n, first) {
   nna = which_(is.na(x) | (is.list(x) & vapply_1b(x,is.null)), bool=FALSE)   # TODO: again, n and first/last could be passed to C here
-  if (!length(nna)) if (is.list(x)) list(NA) else x[NA_integer_]
+  if (!length(nna)) x[0L]
   else if (n==1L)   x[nna[if (first) 1L else length(nna)]]
   else              x[(if (first) utils::head else utils::tail)(nna, n)]  # TODO: avoid dispatch here and do ourselves since just a vector
 }

inst/tests/tests.Rraw

@@ -18801,11 +18801,11 @@ DT = data.table( grp = INT(1,1,     2,2,2,               3,          4,4),
 # all the results instead may reveal mistakes and be good but then might be inflexible to adding more cases.
 FNNA = function(x) {  # First Not NA
   nna = which(if (is.list(x)) !is.na(x) & !sapply(x,is.null) else !is.na(x))
-  if (length(nna)) x[nna[1L]]          else if (is.list(x)) list(NA) else x[NA_integer_]
+  if (length(nna)) x[nna[1L]]          else x[0L]
 }
 LNNA = function(x) {  # Last Not NA
   nna = which(if (is.list(x)) !is.na(x) & !sapply(x,is.null) else !is.na(x))
-  if (length(nna)) x[nna[length(nna)]] else if (is.list(x)) list(NA) else x[NA_integer_]
+  if (length(nna)) x[nna[length(nna)]] else x[0L]
 }
 test_no = 2238.0
 for (col in setdiff(names(DT), "grp")) {
@@ -18871,11 +18871,12 @@ test(2239.51, DT[, .(last(A,na.rm=TRUE), first(B, na.rm=TRUE), last(C)), by=grp,
               data.table(grp=1:4, V1=c(1L, 2L, NA, 3L), V2=c(1,pi,3,pi), V3=c(NA,NA,"c",NA)),
               output="GForce optimized.*glast.*gfirst.*glast")
 test(2239.61, DT[, last(D,na.rm=TRUE,n=2)], c(3i,4i))
-test(2239.62, DT[, last(B,na.rm=TRUE,n=2), by=grp, verbose=TRUE], data.table(grp=INT(1,1,2,2,3,4,4), V1=c(NA,1,pi,3,3,NA,pi)), output="GForce.*glast")
+test(2239.62, DT[, last(B,na.rm=TRUE,n=2), by=grp, verbose=TRUE], data.table(grp=INT(1,2,2,3,4), V1=c(1,pi,3,3,pi)), output="GForce.*glast")
 test(2239.63, DT[, first(D,na.rm=TRUE,n=2)], c(1i,2i))
-test(2239.64, DT[, first(B,na.rm=TRUE,n=2), by=grp, verbose=TRUE], data.table(grp=INT(1,1,2,2,3,4,4), V1=c(1,NA,pi,3,3,pi,NA)), output="GForce.*gfirst")
+test(2239.64, DT[, first(B,na.rm=TRUE,n=2), by=grp, verbose=TRUE], data.table(grp=INT(1,2,2,3,4), V1=c(1,pi,3,3,pi)), output="GForce.*gfirst")
+test(2239.65, DT[, last(D,na.rm=TRUE,n=1), by=grp, verbose=TRUE], data.table(grp=INT(1,2,4), V1=c(1i,3i,4i)), output="GForce.*glast")
 test(2239.71, DT[, last(.SD, na.rm=TRUE, n=2), by=grp, verbose=TRUE],
-              ans<-data.table(grp=INT(1,1,2,2,3,4,4), A=INT(NA,1,NA,2,NA,3,3), B=c(NA,1,pi,3,3,NA,pi), C=c(NA,"a",NA,"b","c",NA,"d"), D=c(NA,1i,2i,3i,NA,NA,4i), E=list(NA,NA,NA,c("a","b"),list(1:2),NA,3:4)),
+              ans<-data.table(grp=INT(1,2,2,3,4,4), A=INT(1,NA,2,NA,3,3), B=c(1,pi,3,3,NA,pi), C=c("a",NA,"b","c",NA,"d"), D=c(1i,2i,3i,NA,NA,4i), E=list(NA,NA,c("a","b"),list(1:2),NA,3:4)),
               output="GForce.*glast")
 old = options(datatable.optimize=0)
 test(2239.72, DT[, last(.SD, na.rm=TRUE, n=2), by=grp, verbose=TRUE], ans, output="GForce FALSE")
@@ -18884,7 +18885,7 @@ test(2239.73, DT[, last(.SD, na.rm="row", n=2), by=grp, verbose=TRUE],
               data.table(grp=INT(1,1,2,2,3,4,4), A=c(NA,NA,NA,2L,NA,NA,3L), B=c(NA,NA,NA,3,NA,NA,pi), C=c(NA,NA,NA,"b",NA,NA,"d"), D=c(NA,NA,NA,3i,NA,NA,4i), E=list(NA,NA,NA,c("a","b"),NA,NA,3:4)),
               output="GForce FALSE")
 test(2239.74, DT[, first(.SD, na.rm=TRUE, n=2), by=grp, verbose=TRUE],
-              ans<-data.table(grp=INT(1,1,2,2,3,4,4), A=INT(1,NA,2,NA,NA,3,3), B=c(1,NA,pi,3,3,pi,NA), C=c("a",NA,"b",NA,"c","d",NA), D=c(1i,NA,2i,3i,NA,4i,NA), E=list(NA,NA,c("a","b"),NA,list(1:2),3:4,NA)),
+              ans<-data.table(grp=INT(1,2,2,3,4,4), A=INT(1,2,NA,NA,3,3), B=c(1,pi,3,3,pi,NA), C=c("a","b",NA,"c","d",NA), D=c(1i,2i,3i,NA,4i,NA), E=list(NA,c("a","b"),NA,list(1:2),3:4,NA)),
               output="GForce.*gfirst")
 old = options(datatable.optimize=0)
 test(2239.75, DT[, first(.SD, na.rm=TRUE, n=2), by=grp, verbose=TRUE], ans, output="GForce FALSE")

src/data.table.h

@@ -80,6 +80,7 @@ extern SEXP char_POSIXct;
 extern SEXP char_POSIXt;
 extern SEXP char_UTC;
 extern SEXP char_nanotime;
+extern SEXP char_lens;
 extern SEXP char_indices;
 extern SEXP char_allLen1;
 extern SEXP char_allGrp1;
@@ -94,8 +95,7 @@ extern SEXP sym_index;
 extern SEXP sym_BY;
 extern SEXP sym_starts, char_starts;
 extern SEXP sym_maxgrpn;
-extern SEXP sym_lens, char_lens;
-extern SEXP sym_first;
+extern SEXP sym_gforce_dynamic;
 extern SEXP sym_colClassesAs;
 extern SEXP sym_verbose;
 extern SEXP SelfRefSymbol;

src/dogroups.c

@@ -409,7 +409,7 @@ SEXP dogroups(SEXP dt, SEXP dtcols, SEXP groups, SEXP grpcols, SEXP jiscols, SEX
           warning(_("Item %d of j's result for group %d is zero length. This will be filled with %d NAs to match the longest column in this result. Later groups may have a similar problem but only the first is reported to save filling the warning buffer."), j+1, i+1, maxn);
           NullWarnDone = TRUE;
         }
-        writeNA(target, thisansloc, maxn, false);
+        writeNA(target, thisansloc, maxn, true);
       } else {
         // thislen>0
         if (TYPEOF(source) != TYPEOF(target))