Performance improvements for dim.data.table and alloc.col, closes #1433

R/data.table.R

@@ -72,10 +72,9 @@ replace_dot <- function(e) {
     e
 }
 
-dim.data.table <- function(x) {
-    if (length(x)) c(length(x[[1L]]), length(x))
-    else c(0L,0L)
-    # TO DO: consider placing "dim" as an attibute updated on inserts. Saves this 'if'.
+dim.data.table <- function(x) 
+{
+    .Call(Cdim, x)
 }
 
 .global <- new.env()  # thanks to: http://stackoverflow.com/a/12605694/403310
@@ -2138,12 +2137,7 @@ alloc.col <- function(DT, n=getOption("datatable.alloccol"), verbose=getOption("
     name = substitute(DT)
     if (identical(name,quote(`*tmp*`))) stop("alloc.col attempting to modify `*tmp*`")
     ans = .Call(Calloccolwrapper,DT,as.integer(eval(n)),verbose)
-    for (i in seq_along(ans)) {
-        # clear the same excluded by copyMostAttrib(). Primarily for data.table and as.data.table, but added here centrally (see #4890).
-        setattr(ans[[i]],"names",NULL)
-        setattr(ans[[i]],"dim",NULL)
-        setattr(ans[[i]],"dimnames",NULL)
-    }
+
     if (is.name(name)) {
         name = as.character(name)
         assign(name,ans,parent.frame(),inherits=TRUE)

README.md

@@ -87,6 +87,8 @@
 
   5. `test.data.table` gets new argument `silent`, if set to TRUE then it will not raise exception but returns TRUE/FALSE based on the test results.
 
+  6. `dim.data.table` is now implemented in C. Thanks to Andrey Riabushenko.
+
 ### Changes in v1.9.6  (on CRAN 19 Sep 2015)
 
 #### NEW FEATURES

src/assign.c

@@ -223,7 +223,19 @@ SEXP alloccol(SEXP dt, R_len_t n, Rboolean verbose)
 SEXP alloccolwrapper(SEXP dt, SEXP newncol, SEXP verbose) {
     if (!isInteger(newncol) || length(newncol)!=1) error("n must be integer length 1. Has datatable.alloccol somehow become unset?");
     if (!isLogical(verbose) || length(verbose)!=1) error("verbose must be TRUE or FALSE"); 
-    return(alloccol(dt, INTEGER(newncol)[0], LOGICAL(verbose)[0]));
+
+    SEXP ans = PROTECT(alloccol(dt, INTEGER(newncol)[0], LOGICAL(verbose)[0]));
+
+    for(R_len_t i = 0; i < LENGTH(ans); i++) {
+        // clear the same excluded by copyMostAttrib(). Primarily for data.table and as.data.table, but added here centrally (see #4890).
+
+	setAttrib(VECTOR_ELT(ans, i), R_NamesSymbol, R_NilValue);
+	setAttrib(VECTOR_ELT(ans, i), R_DimSymbol, R_NilValue);
+	setAttrib(VECTOR_ELT(ans, i), R_DimNamesSymbol, R_NilValue);
+    }
+
+    UNPROTECT(1);
+    return ans;
 }
 
 SEXP shallowwrapper(SEXP dt, SEXP cols) {

src/init.c

@@ -66,6 +66,7 @@ SEXP ghead();
 SEXP glast();
 SEXP gfirst();
 SEXP gnthvalue();
+SEXP dim();
 
 // .Externals
 SEXP fastmean();
@@ -134,6 +135,7 @@ R_CallMethodDef callMethods[] = {
 {"Cglast", (DL_FUNC) &glast, -1},
 {"Cgfirst", (DL_FUNC) &gfirst, -1},
 {"Cgnthvalue", (DL_FUNC) &gnthvalue, -1},
+{"Cdim", (DL_FUNC) &dim, -1},
 {NULL, NULL, 0}
 };
 

src/wrappers.c

@@ -96,3 +96,26 @@ SEXP copyNamedInList(SEXP x)
 	return R_NilValue;
 }
 
+
+
+SEXP dim(SEXP x)
+{
+    // fast implementation of dim.data.table
+
+    if (TYPEOF(x) != VECSXP) {
+	error("dim.data.table expects a data.table as input (which is a list), but seems to be of type %s", 
+	    type2char(TYPEOF(x)));
+    }
+
+    SEXP ans = allocVector(INTSXP, 2);
+    if(length(x) == 0) {
+	INTEGER(ans)[0] = 0;
+	INTEGER(ans)[1] = 0;
+    }
+    else {
+	INTEGER(ans)[0] = length(VECTOR_ELT(x, 0));
+	INTEGER(ans)[1] = length(x);
+    }
+
+    return ans;
+}