diff --git a/R/fcast.R b/R/fcast.R index 78e063767..a35095ae0 100644 --- 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 index e7d677c84..62eca23c8 100644 --- 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: