feat(7614): added redirection of data.frame at dcast and melt to dcast.data.table and melt.data.table

NEWS.md

@@ -26,6 +26,8 @@
       - Type conversion support in GForce expressions (e.g., `sum(as.numeric(x))` will use GForce, saving the need to coerce `x` in a setup step) [#2934](https://github.com/Rdatatable/data.table/issues/2934)
       - Arithmetic operation support in GForce (e.g., `max(x) - min(x)` will use GForce on both `max(x)` and `min(x)`, saving the need to do the subtraction in a follow-up step) [#3815](https://github.com/Rdatatable/data.table/issues/3815)
 
+4. Added support for dcast/melt of data.frames, Thanks @MichaelChirico for the suggestion and @manmita for the PR. [#7614](https://github.com/Rdatatable/data.table/issues/7614)
+
 ### BUG FIXES
 
 1. `fread()` with `skip=0` and `(header=TRUE|FALSE)` no longer skips the first row when it has fewer fields than subsequent rows, [#7463](https://github.com/Rdatatable/data.table/issues/7463). Thanks @emayerhofer for the report and @ben-schwen for the fix.

R/fcast.R

@@ -12,6 +12,12 @@ dcast = function(
   data, formula, fun.aggregate = NULL, ..., margins = NULL,
   subset = NULL, fill = NULL, value.var = guess(data)
 ) {
+  if (!is.data.table(data) && is.data.frame(data))
+    return(
+      dcast.data.table(data, formula, fun.aggregate = fun.aggregate, ...,
+      margins = margins, subset = subset, fill = fill,
+      value.var = value.var)
+    )
   UseMethod("dcast", data)
 }
 
@@ -119,7 +125,6 @@ aggregate_funs = function(funs, vals, sep="_", ...) {
 }
 
 dcast.data.table = function(data, formula, fun.aggregate = NULL, sep = "_", ..., margins = NULL, subset = NULL, fill = NULL, drop = TRUE, value.var = guess(data), verbose = getOption("datatable.verbose"), value.var.in.dots = FALSE, value.var.in.LHSdots = value.var.in.dots, value.var.in.RHSdots = value.var.in.dots) {
-  if (!is.data.table(data)) stopf("'%s' must be a data.table", "data")
   drop = as.logical(rep_len(drop, 2L))
   if (anyNA(drop)) stopf("'drop' must be logical vector with no missing entries")
   if (!isTRUEorFALSE(value.var.in.dots))

R/fmelt.R

@@ -4,6 +4,8 @@
 #   redirection as well
 
 melt = function(data, ..., na.rm = FALSE, value.name = "value") {
+  if (!is.data.table(data) && is.data.frame(data))
+    return(melt.data.table(data, ..., na.rm = na.rm, value.name = value.name))
   UseMethod("melt", data)
 }
 
@@ -176,7 +178,6 @@ measurev = function(fun.list, sep="_", pattern, cols, multiple.keyword="value.na
 melt.data.table = function(data, id.vars, measure.vars, variable.name = "variable",
        value.name = "value", ..., na.rm = FALSE, variable.factor = TRUE, value.factor = FALSE,
        verbose = getOption("datatable.verbose")) {
-  if (!is.data.table(data)) stopf("'%s' must be a data.table", "data")
   for(type.vars in c("id.vars","measure.vars")){
     sub.lang <- substitute({
       if (missing(VAR)) VAR=NULL

inst/tests/tests.Rraw

@@ -13043,8 +13043,8 @@ test(1953.2, melt(DT, id.vars = 'id', measure.vars = patterns(a = 'a', b = 'b',
 test(1953.3, melt(DT, id.vars = 'id', measure.vars = patterns(1L)),
              error = 'Input patterns must be of type character')
 setDF(DT)
-test(1953.4, melt.data.table(DT, id.vars = 'id', measure.vars = 'a'),
-             error = "must be a data.table")
+expected = data.table(id = rep(DT$id, 2), variable = factor(rep(c("a1", "a2"), each = 3)), value = c(DT$a1, DT$a2))
+test(1953.4, melt.data.table(DT, id.vars = "id", measure.vars = c("a1", "a2")), expected)
 
 # appearance order of two low-cardinality columns that were squashed in pr#3124
 DT = data.table(A=INT(1,3,2,3,2), B=1:5)  # respect groups in 1st column (3's and 2's)
@@ -13390,7 +13390,8 @@ setnames(DT, 'V')
 test(1962.084, guess(DT), 'V',
      message = 'Using.*value column.*override')
 setDF(DT)
-test(1962.085, dcast.data.table(DT), error = 'must be a data.table')
+test(1962.085, guess(DT), 'V',
+     message = 'Using.*value column.*override')
 setDT(DT)
 test(1962.086, dcast(DT, a ~ a, drop = NA),
      error = "'drop' must be logical vector with no missing entries")
@@ -21509,3 +21510,13 @@ setdroplevels(x)
 setdroplevels(y)
 test(2364.2, levels(x$a), levels(y$a))
 rm(x, y)
+
+# test for data.frame reshape for melt
+df_melt = data.frame(a = 1:2, b = 3:4)
+dt_melt = data.table(a = 1:2, b = 3:4)
+test(2365.1, melt(df_melt, id.vars=1:2), melt(dt_melt, id.vars=1:2))
+
+# test for data.frame reshape for dcast
+df_dcast = data.frame(a = c("x", "y"), b = 1:2, v = 3:4)
+dt_dcast = data.table(a = c("x", "y"), b = 1:2, v = 3:4)
+test(2365.2, dcast(df_dcast, a ~ b, value.var = "v"), dcast(dt_dcast, a ~ b, value.var = "v"))