[cbindlist/mergelist] copyCols

src/data.table.h

@@ -300,6 +300,7 @@ SEXP notchin(SEXP x, SEXP table);
 
 // mergelist.c
 SEXP cbindlist(SEXP x, SEXP copyArg);
+SEXP copyCols(SEXP x, SEXP cols);
 
 // functions called from R level .Call/.External and registered in init.c
 // these now live here to pass -Wstrict-prototypes, #5477

src/init.c

@@ -151,6 +151,7 @@ R_CallMethodDef callMethods[] = {
 {"Cnotchin", (DL_FUNC)&notchin, -1},
 {"Ccbindlist", (DL_FUNC) &cbindlist, -1},
 {"CperhapsDataTableR", (DL_FUNC) &perhapsDataTableR, -1},
+{"CcopyCols", (DL_FUNC) &copyCols, -1},
 {"Cwarn_matrix_column_r", (DL_FUNC)&warn_matrix_column_r, -1},
 {NULL, NULL, 0}
 };

src/mergelist.c

@@ -1,5 +1,22 @@
 #include "data.table.h"
 
+// set(x, NULL, cols, copy(unclass(x)[cols])) ## but keeps the index
+SEXP copyCols(SEXP x, SEXP cols) {
+  // used in R/mergelist.R
+  if (!isDataTable(x))
+    internal_error(__func__, "'x' must be a data.table"); // # nocov
+  if (!isInteger(cols))
+    internal_error(__func__, "'cols' must be integer"); // # nocov
+  int nx = length(x), ncols = LENGTH(cols), *colsp = INTEGER(cols);
+  if (!nx || !ncols)
+    return R_NilValue;
+  for (int i=0; i<ncols; ++i) {
+    int thiscol = colsp[i]-1;
+    SET_VECTOR_ELT(x, thiscol, duplicate(VECTOR_ELT(x, thiscol)));
+  }
+  return R_NilValue;
+}
+
 void mergeIndexAttrib(SEXP to, SEXP from) {
   if (!isInteger(to) || LENGTH(to)!=0)
     internal_error(__func__, "'to' must be integer() already"); // # nocov