fmelt: create the string var once per measure group instead of once per row

.ci/atime/tests.R

@@ -459,5 +459,23 @@ test.list <- atime::atime_test_list(
     seconds.limit = 1,
     expr = data.table:::`[.data.table`(dt, , base::max(V1, na.rm = TRUE), by = id)),
 
+  # https://github.com/Rdatatable/data.table/pull/7917 creates the variable string once per measure group instead of once per row.
+  "melt(list measure.vars, variable.factor=FALSE) improved in #7917" = atime::atime_test(
+    setup = {
+      DT = data.table(id = seq_len(N), a_1 = 1, a_2 = 2, b_1 = 3, b_2 = 4)
+    },
+    Slow = "df59dd637403e65d7fa90d48bb0dfec2764d6744", # Parent of the first commit (https://github.com/Rdatatable/data.table/commit/7c73bf0d4f760066feb7256896375727656e398d) in the PR (https://github.com/Rdatatable/data.table/pull/7917/commits) that improves efficiency
+    Fast = "7c73bf0d4f760066feb7256896375727656e398d", # Commit in the PR (https://github.com/Rdatatable/data.table/pull/7917/commits) that creates the variable string once per measure group TODO after merging PR7917, change to its merge commit
+    expr = data.table:::melt(DT, measure.vars = list(c("a_1", "a_2"), c("b_1", "b_2")), variable.factor = FALSE)),
+
+  # https://github.com/Rdatatable/data.table/pull/7917 hoists INTEGER()/STRING_ELT() out of the row loop when filling variable_table columns.
+  "melt(measure()) improved in #7917" = atime::atime_test(
+    setup = {
+      DT = data.table(id = seq_len(N), a_1 = 1, a_2 = 2, b_1 = 3, b_2 = 4)
+    },
+    Slow = "df59dd637403e65d7fa90d48bb0dfec2764d6744", # Parent of the first commit (https://github.com/Rdatatable/data.table/commit/7c73bf0d4f760066feb7256896375727656e398d) in the PR (https://github.com/Rdatatable/data.table/pull/7917/commits) that improves efficiency
+    Fast = "45c63fa0410c441cbc3764d3fa19b47344d0e418", # Commit in the PR (https://github.com/Rdatatable/data.table/pull/7917/commits) that hoists REAL()/INTEGER()/STRING_ELT() out of the row loop TODO after merging PR7917, change to its merge commit
+    expr = data.table:::melt(DT, measure.vars = measure(letter, number = as.integer))),
+
   tests=extra.test.list)
 # nolint end: undesirable_operator_linter.

NEWS.md

@@ -48,6 +48,8 @@
 
 13. `nafill()` and `setnafill()` gain a `limit` argument to restrict the maximum number of consecutive `NA` values filled, [#7677](https://github.com/Rdatatable/data.table/issues/7677). Thanks to @jaynewton for the suggestion and @venom1204 and @ben-schwen for the PR.
 
+14. `melt()` is faster on large inputs when `measure.vars` is a list with `variable.factor=FALSE` (e.g. 3x) or uses `measure()` (e.g. 2x). Thanks @m-muecke for the PR.
+
 ### 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.

src/fmelt.c

@@ -611,7 +611,8 @@ SEXP getvarcols(SEXP DT, SEXP dtnames, Rboolean varfactor, Rboolean verbose, str
           const int thislen = data->narm ? length(VECTOR_ELT(data->not_NA_indices, j)) : data->nrow;
           char buff[20];
           snprintf(buff, sizeof(buff), "%d", level++); // # notranslate
-          for (int k=0; k<thislen; ++k) SET_STRING_ELT(target, ansloc++, mkChar(buff));
+          SEXP str = mkChar(buff);
+          for (int k=0; k<thislen; ++k) SET_STRING_ELT(target, ansloc++, str);
         }
       }
     } else {// varfactor==TRUE
@@ -662,24 +663,29 @@ SEXP getvarcols(SEXP DT, SEXP dtnames, Rboolean varfactor, Rboolean verbose, str
       for (int j=0, ansloc=0; j<data->lmax; ++j) {
         const int thislen = data->narm ? length(VECTOR_ELT(data->not_NA_indices, j)) : data->nrow;
         switch (TYPEOF(target)) {
-        case STRSXP :
+        case STRSXP : {
+          const SEXP val = STRING_ELT(out_col, j);
           for (int k=0; k<thislen; ++k)
-            SET_STRING_ELT(target, ansloc++, STRING_ELT(out_col, j));
-          break;
-        case REALSXP :
+            SET_STRING_ELT(target, ansloc++, val);
+        } break;
+        case REALSXP : {
+          double *td = REAL(target);
+          const double val = REAL_RO(out_col)[j];
           for (int k=0; k<thislen; ++k)
-            REAL(target)[ansloc++] = REAL(out_col)[j];
-          break;
+            td[ansloc++] = val;
+        } break;
         case INTSXP :
-        case LGLSXP :
+        case LGLSXP : {
+          int *td = INTEGER(target);
+          const int val = INTEGER_RO(out_col)[j];
           for (int k=0; k<thislen; ++k)
-            INTEGER(target)[ansloc++] = INTEGER(out_col)[j];
+            td[ansloc++] = val;
           if (isFactor(out_col)) {
             // Do we need a copy here?
             setAttrib(target, R_LevelsSymbol, getAttrib(out_col, R_LevelsSymbol));
             setAttrib(target, R_ClassSymbol, ScalarString(char_factor));
           }
-          break;
+        } break;
         default :
           error(_("variable_table does not support column type '%s' for column '%s'."), type2char(TYPEOF(out_col)), CHAR(STRING_ELT(getAttrib(data->variable_table, R_NamesSymbol), out_col_i)));
         }