add feature

Rdatatable · Dec 6, 2023 · 7ea6e87 · 7ea6e87
1 parent 3e590f8
commit 7ea6e87
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 6 deletions.
diff --git a/R/transpose.R b/R/transpose.R
@@ -1,4 +1,4 @@
-transpose = function(l, fill=NA, ignore.empty=FALSE, keep.names=NULL, make.names=NULL) {
+transpose = function(l, fill=NA, ignore.empty=FALSE, keep.names=NULL, make.names=NULL, return.list=FALSE) {
   if (!is.null(make.names)) {
     stopifnot(length(make.names)==1L)
     if (is.character(make.names)) {
@@ -14,12 +14,14 @@ transpose = function(l, fill=NA, ignore.empty=FALSE, keep.names=NULL, make.names
     colnames = as.character(l[[make.names]])
     l = if (is.data.table(l)) l[,-make.names,with=FALSE] else l[-make.names]
   }
-  ans = .Call(Ctranspose, l, fill, ignore.empty, keep.names)
+  ans = .Call(Ctranspose, l, fill, ignore.empty, keep.names, return.list)
   if (!is.null(make.names)) setattr(ans, "names", c(keep.names, colnames))
   else if (is.data.frame(l))  # including data.table but not plain list
     setattr(ans, "names", c(keep.names, paste0("V", seq_len(length(ans)-length(keep.names)))))
-  if (is.data.table(l)) setDT(ans)
-  else if (is.data.frame(l)) setDF(ans)
+  if (!return.list) {
+    if (is.data.table(l)) setDT(ans)
+    else if (is.data.frame(l)) setDF(ans)
+  }
   ans[]
 }
 

diff --git a/src/data.table.h b/src/data.table.h
@@ -304,7 +304,7 @@ SEXP lookup(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 SEXP overlaps(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 SEXP whichwrapper(SEXP, SEXP);
 SEXP shift(SEXP, SEXP, SEXP, SEXP);
-SEXP transpose(SEXP, SEXP, SEXP, SEXP);
+SEXP transpose(SEXP, SEXP, SEXP, SEXP, SEXP);
 SEXP anyNA(SEXP, SEXP);
 SEXP setlevels(SEXP, SEXP, SEXP);
 SEXP rleid(SEXP, SEXP);

diff --git a/src/transpose.c b/src/transpose.c
@@ -2,7 +2,7 @@
 #include <Rdefines.h>
 #include <time.h>
 
-SEXP transpose(SEXP l, SEXP fill, SEXP ignoreArg, SEXP keepNamesArg) {
+SEXP transpose(SEXP l, SEXP fill, SEXP ignoreArg, SEXP keepNamesArg, SEXP returnListArg) {
 
   int nprotect=0;
   if (!isNewList(l))
@@ -18,6 +18,9 @@ SEXP transpose(SEXP l, SEXP fill, SEXP ignoreArg, SEXP keepNamesArg) {
   if (length(fill) != 1)
     error(_("fill must be a length 1 vector, such as the default NA"));
   R_len_t ln = LENGTH(l);
+  if (!isLogical(returnListArg) || LOGICAL(returnListArg)[0]==NA_LOGICAL)
+    error(_("ignore.empty should be logical TRUE/FALSE."));
+  bool returnList = LOGICAL(returnListArg)[0];
 
   // preprocessing
   int maxlen=0, zerolen=0;
@@ -33,6 +36,7 @@ SEXP transpose(SEXP l, SEXP fill, SEXP ignoreArg, SEXP keepNamesArg) {
     if (isFactor(li)) type=STRSXP;
     if (type>maxtype) maxtype=type;
   }
+  if (returnList) maxtype=VECSXP; // need to keep preprocessing for zerolen
   fill = PROTECT(coerceVector(fill, maxtype)); nprotect++;
 
   SEXP ans = PROTECT(allocVector(VECSXP, maxlen+rn)); nprotect++;
@@ -84,6 +88,12 @@ SEXP transpose(SEXP l, SEXP fill, SEXP ignoreArg, SEXP keepNamesArg) {
         SET_STRING_ELT(ansp[j+rn], k, j<len ? STRING_ELT(li, j) : sfill);
       }
     } break;
+    case VECSXP : {
+      const SEXP vfill = R_NilValue;
+      for (int j=0; j<maxlen; ++j) {
+        SET_VECTOR_ELT(ansp[j+rn], k, j<len ? VECTOR_ELT(li, j) : vfill);
+      }
+    } break;
     default :
       error(_("Unsupported column type '%s'"), type2char(maxtype));
     }