droplevels works on 0-row tables (#7131)

* droplevels works on 0-row tables

* another test: don't interfere with non-factor columns

Author: MichaelChirico

NEWS.md

@@ -82,6 +82,8 @@
 
 19. Spurious warnings from internal code in `cube()`, `rollup()`, and `groupingsets()` are no longer surfaced to the caller, [#6964](https://github.com/Rdatatable/data.table/issues/6964). Thanks @ferenci-tamas for the report and @venom1204 for the fix.
  
+20. `droplevels()` works on 0-row data.tables, [#7043](https://github.com/Rdatatable/data.table/issues/7043). The result will have factor columns `factor(character())`, consistent with the data.frame method. Thanks @advieser for the report and @MichaelChirico for the fix.
+
 ### NOTES
 
 1. Continued work to remove non-API C functions, [#6180](https://github.com/Rdatatable/data.table/issues/6180). Thanks Ivan Krylov for the PRs and for writing a clear and concise guide about the R API: https://aitap.codeberg.page/R-api/.

R/fdroplevels.R

@@ -1,6 +1,7 @@
 # 647 fast droplevels.data.table method
 fdroplevels = function(x, exclude = if (anyNA(levels(x))) NULL else NA, ...) {
   stopifnot(inherits(x, "factor"))
+  if (!length(x)) return(structure(integer(), class='factor', levels=character())) # skip factor() overhead
   lev = which(tabulate(x, nlevels(x)) & (!match(levels(x), exclude, 0L)))
   ans = match(as.integer(x), lev)
   setattr(ans, 'levels', levels(x)[lev])
@@ -15,7 +16,6 @@ droplevels.data.table = function(x, except=NULL, exclude, ...){
 }
 
 setdroplevels = function(x, except=NULL, exclude=NULL) {
-  if (!nrow(x)) return(invisible(x))
   ix = vapply_1b(x, is.factor)
   if (!is.null(except)) {
     stopifnot(is.numeric(except), except >= 1L, except <= length(x))

inst/tests/tests.Rraw

@@ -21358,3 +21358,10 @@ test(2327.1, cube(DT, .(min(value)), "var"),
 test(2327.2, cube(DT, .(as.numeric(base::min(value, na.rm=TRUE))), "var"),
      data.table(var = c("a", "b", "c", "d", NA), V1 = c(1.0, 2.0, 3.0, Inf, 1.0)),
      warning="no non-missing arguments to min")
+
+# droplevels should still work on a 0-row table, #7043
+DT = data.table(f=factor(character(), levels='a'))
+test(2328.1, levels(droplevels(DT)$f), character())
+DT[, i := integer()]
+DT[, f2 := factor()]
+test(2328.2, droplevels(DT), data.table(f=factor(), i=integer(), f2=factor()))