allow value.var in dots even when it is already explicit in formula

Rdatatable · Apr 29, 2024 · a224768 · a224768
1 parent cceb531
commit a224768
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 9 deletions.
diff --git a/R/fcast.R b/R/fcast.R
@@ -34,14 +34,21 @@ check_formula = function(formula, varnames, valnames, value.var.in.LHSdots, valu
   allvars = c(vars, valnames)
   if (any(allvars %chin% varnames[duplicated(varnames)]))
     stopf('data.table to cast must have unique column names')
-  if (value.var.in.LHSdots == value.var.in.RHSdots && isFALSE(value.var.in.LHSdots))
+  if (value.var.in.LHSdots == value.var.in.RHSdots && isFALSE(value.var.in.LHSdots)) {
     deparse_formula(as.list(formula)[-1L], varnames, allvars)
-  else if (value.var.in.LHSdots == value.var.in.RHSdots && isTRUE(value.var.in.LHSdots))
-    deparse_formula(as.list(formula)[-1L], varnames, vars)
-  else if (isTRUE(value.var.in.LHSdots) && isFALSE(value.var.in.RHSdots))
+  }
+  else if (value.var.in.LHSdots == value.var.in.RHSdots && isTRUE(value.var.in.LHSdots)) {
+    vars = setdiff(vars, valnames)
+    split_deparsing(as.list(formula)[-1L], varnames, vars, vars)
+  }
+  else if (isTRUE(value.var.in.LHSdots) && isFALSE(value.var.in.RHSdots)) {
+    vars = setdiff(vars, valnames)
     split_deparsing(as.list(formula)[-1L], varnames, vars, allvars)
-  else
+  }
+  else {
+    vars = setdiff(vars, valnames)
     split_deparsing(as.list(formula)[-1L], varnames, allvars, vars)
+  }
 }
 
 split_deparsing = function(expr, varnames, LHSallvars, RHSallvars) {
@@ -57,7 +64,7 @@ split_deparsing = function(expr, varnames, LHSallvars, RHSallvars) {
     }
     this
   })
-  lvars = lapply(lvars, function(x) if (length(x) && !is.list(x)) list(x) else x)
+  lvars = lapply(lvars, function(x) if (length(x) && !is.list(x)) list(x) else unique(x))
 }
 
 deparse_formula = function(expr, varnames, allvars) {

diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw
@@ -3677,9 +3677,10 @@ test(1100, dt1[dt2,roll=-Inf,rollends=c(FALSE,TRUE)]$ind, INT(NA,NA,1,2,2,2,2,2,
   test(1102.182, dcast(DT, ... ~ index, fun.aggregate = length, value.var.in.LHSdots = NA), error = "Arguments 'value.var.in.LHSdots', 'value.var.in.RHSdots' should be logical TRUE/FALSE")
   test(1102.183, dcast(DT, ... ~ index, fun.aggregate = length, value.var.in.dots = TRUE), data.table(x = 1:2, a = 1:0, b = 0:1, key = "x"))
   test(1102.184, dcast(DT, ... ~ index, fun.aggregate = length, value.var = "index", value.var.in.dots = TRUE), data.table(index = c("a","b"), x = 1:2, a = 1:0, b = 0:1, key = c("index", "x")))
-  test(1102.185, names(dcast(DT2, ... ~ ..., value.var = "y", value.var.in.LHSdots = TRUE)), c("index", "x", "y", "a_1", "b_2"))
-  test(1102.186, dim(DT3_dcasted), c(7L,11L))
-  test(1102.187, names(DT3_dcasted), c("year", "continent", "1986_Europe_Germany", "1986_Europe_Sweden", "1987_Asia_India", "1987_Europe_France", "1988_Asia_India", "1988_Asia_Japan", "1989_Asia_Japan", "1990_Asia_China", "1991_Asia_China"))
+  test(1102.185, dcast(DT, ... + index ~ index, fun.aggregate = length, value.var = "index", value.var.in.dots = TRUE), data.table(index = c("a","b"), x = 1:2, a = 1:0, b = 0:1, key = c("index", "x")))
+  test(1102.186, names(dcast(DT2, ... ~ ..., value.var = "y", value.var.in.LHSdots = TRUE)), c("index", "x", "y", "a_1", "b_2"))
+  test(1102.187, dim(DT3_dcasted), c(7L,11L))
+  test(1102.188, names(DT3_dcasted), c("year", "continent", "1986_Europe_Germany", "1986_Europe_Sweden", "1987_Asia_India", "1987_Europe_France", "1988_Asia_India", "1988_Asia_Japan", "1989_Asia_Japan", "1990_Asia_China", "1991_Asia_China"))
 
 
   # bug git #693 - dcast error message improvement: