Fast data.table to matrix conversion in C [Depends: #4196]

R/IDateTime.R

@@ -198,22 +198,7 @@ as.ITime.times = function(x, ms = 'truncate', ...) {
 }
 
 as.character.ITime = format.ITime = function(x, ...) {
-  # adapted from chron's format.times
-  # Fix for #811. Thanks to @StefanFritsch for the code snippet
-  neg = x < 0L
-  x  = abs(unclass(x))
-  hh = x %/% 3600L
-  mm = (x - hh * 3600L) %/% 60L
-  # #2171 -- trunc gives numeric but %02d requires integer;
-  #   as.integer is also faster (but doesn't handle integer overflow)
-  #   http://stackoverflow.com/questions/43894077
-  ss = as.integer(x - hh * 3600L - 60L * mm)
-  res = sprintf('%02d:%02d:%02d', hh, mm, ss)
-  # Fix for #1354, so that "NA" input is handled correctly.
-  if (is.na(any(neg))) res[is.na(x)] = NA
-  neg = which(neg)
-  if (length(neg)) res[neg] = paste0("-", res[neg])
-  res
+  .Call("CasCharacterITime", x)
 }
 
 as.data.frame.ITime = function(x, ...) {

R/data.table.R

@@ -1870,10 +1870,9 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) {
       stop("length(rownames)==0 but should be a single column name or number, or NULL")
     } else {
       if (isTRUE(rownames)) {
-        if (length(key(x))>1L) {
+        if (length(key(x))>1L)
           warning("rownames is TRUE but key has multiple columns ",
                   brackify(key(x)), "; taking first column x[,1] as rownames")
-        }
         rownames = if (length(key(x))==1L) chmatch(key(x),names(x)) else 1L
       }
       else if (is.logical(rownames) || is.na(rownames)) {
@@ -1883,7 +1882,6 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) {
       else if (is.character(rownames)) {
         w = chmatch(rownames, names(x))
         if (is.na(w)) stop("'", rownames, "' is not a column of x")
-        rownames = w
       }
       else { # rownames is a column number already
         rownames = as.integer(rownames)
@@ -1892,73 +1890,23 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) {
                " which is outside the column number range [1,ncol=", ncol(x), "].")
       }
     }
-  } else if (!is.null(rownames.value)) {
-    if (length(rownames.value)!=nrow(x))
-      stop("length(rownames.value)==", length(rownames.value),
-           " but should be nrow(x)==", nrow(x))
   }
-  if (!is.null(rownames)) {
-    # extract that column and drop it.
-    rownames.value = x[[rownames]]
-    dm = dim(x) - 0:1
-    cn = names(x)[-rownames]
-    X = x[, .SD, .SDcols = cn]
-  } else {
-    dm = dim(x)
-    cn = names(x)
-    X = x
-  }
-  if (any(dm == 0L))
-    return(array(NA, dim = dm, dimnames = list(rownames.value, cn)))
-  p = dm[2L]
-  n = dm[1L]
-  collabs = as.list(cn)
+
+  # Create shallow copy - where each element of the list X is simply a pointer to
+  # the same column in the data.table x. This means that we do not modify the 
+  # input data.table when dropping rows or coercing columns. See tests #2139.XXX
+  X = x
   class(X) = NULL
-  non.numeric = non.atomic = FALSE
-  all.logical = TRUE
-  for (j in seq_len(p)) {
-    if (is.ff(X[[j]])) X[[j]] = X[[j]][]   # nocov to bring the ff into memory, since we need to create a matrix in memory
-    xj = X[[j]]
-    if (length(dj <- dim(xj)) == 2L && dj[2L] > 1L) {
-      if (inherits(xj, "data.table"))
-        xj = X[[j]] = as.matrix(X[[j]])
-      dnj = dimnames(xj)[[2L]]
-      collabs[[j]] = paste(collabs[[j]], if (length(dnj) >
-        0L)
-        dnj
-      else seq_len(dj[2L]), sep = ".")
-    }
-    if (!is.logical(xj))
-      all.logical = FALSE
-    if (length(levels(xj)) > 0L || !(is.numeric(xj) || is.complex(xj) || is.logical(xj)) ||
-        (!is.null(cl <- attr(xj, "class", exact=TRUE)) && any(cl %chin%
-        c("Date", "POSIXct", "POSIXlt"))))
-      non.numeric = TRUE
-    if (!is.atomic(xj))
-      non.atomic = TRUE
-  }
-  if (non.atomic) {
-    for (j in seq_len(p)) {
-      xj = X[[j]]
-      if (is.recursive(xj)) { }
-      else X[[j]] = as.list(as.vector(xj))
-    }
-  }
-  else if (all.logical) { }
-  else if (non.numeric) {
-    for (j in seq_len(p)) {
-      if (is.character(X[[j]])) next
-      xj = X[[j]]
-      miss = is.na(xj)
-      xj = if (length(levels(xj))) as.vector(xj) else format(xj)
-      is.na(xj) = miss
-      X[[j]] = xj
-    }
-  }
-  X = unlist(X, recursive = FALSE, use.names = FALSE)
-  dim(X) <- c(n, length(X)/n)
-  dimnames(X) <- list(rownames.value, unlist(collabs, use.names = FALSE))
-  X
+
+  # Extract and drop the rownames column, if used
+  if (!is.null(rownames)) {
+    rownames.value = X[[rownames]]
+    X[[rownames]] = NULL
+  }
+
+  # Remaining type and class coercion is handled in Casmatrix
+  ans = .Call(Casmatrix, X, rownames.value)
+  ans
 }
 
 # bug #2375. fixed. same as head.data.frame and tail.data.frame to deal with negative indices

inst/tests/tests.Rraw

@@ -12544,7 +12544,7 @@ mat4 <- matrix(c("a", 1, 5), nrow=1, dimnames=list(c("x"), c("id", "X", "Y")))
 test(1899.14, as.matrix(DT[1,], 1), mat[1,,drop=FALSE])
 test(1899.15, as.matrix(DT[1,], "id"), mat[1,,drop=FALSE])
 test(1899.16, as.matrix(DT[1,], rownames.value="x"), mat4)
-test(1899.17, as.matrix(DT[1,], rownames.value=c("x", "y")), error="length(rownames.value)==2 but should be nrow(x)==1")
+test(1899.17, as.matrix(DT[1,], rownames.value=c("x", "y")), error="Extracted rownames column or provided rownames.values do not match the number of rows in the matrix")
 test(1899.18, as.matrix(DT, rownames=TRUE, rownames.value=1:nrow(DT)), error="rownames and rownames.value cannot both be used at the same time")
 
 # index argument for fread, #2633
@@ -13687,7 +13687,7 @@ test(1967.526, x[keyby=a],      x,       warning=c("Ignoring keyby= because j= i
 test(1967.53, as.matrix(x, rownames = 2:3),
      error = 'length(rownames)==2 but')
 test(1967.54, as.matrix(x[0L]),
-     structure(logical(0), .Dim = c(0L, 2L), .Dimnames = list(NULL, c("a", "b"))))
+     structure(integer(0), .Dim = c(0L, 2L), .Dimnames = list(NULL, c("a", "b"))))
 
 test(1967.55, subset(x, 5L), error = "'subset' must evaluate to logical")
 
@@ -15789,7 +15789,7 @@ DT = data.table(a=1, b=2)
 test(2074.06, DT[ , c(.SD[1], .SD[1, .SD[1]]), by=a], data.table(a=1, b=2, b=2))
 ## as.matrix.data.table when a column has columns (only possible when constructed incorrectly)
 DT = structure(list(a=1:5, d=data.table(b=6:10, c=11:15), m=matrix(16:25, ncol=2L)), class = c('data.table', 'data.frame'))
-test(2074.07, as.matrix(DT), matrix(1:25, ncol=5L, dimnames=list(NULL, c('a', 'd.b', 'd.c', 'm.1', 'm.2'))))
+test(2074.07, as.matrix(DT), matrix(1:25, ncol=5L, dimnames=list(NULL, c('a', 'd.b', 'd.c', 'm.V1', 'm.V2'))))
 ## can induce !cedta() from base::rownames to get this error
 test(2074.08, rownames(structure(list(1:5), class='data.table')), error="Has it been created manually")
 ## default dimnames.data.table
@@ -16770,6 +16770,145 @@ test(2132.2, fifelse(TRUE, 1, s2),       error = "S4 class objects (except nanot
 test(2132.3, fcase(TRUE, s1, FALSE, s2), error = "S4 class objects (except nanotime) are not supported. Please see https://github.com/Rdatatable/data.table/issues/4131.")
 rm(s1, s2, class2132)
 
+## Check for appropriate errors when giving rownames to as.matrix.data.table that are mutli-column (only possible when constructed incorrectly) or list
+DT = structure(list(a=list(1,2:3,4:6,letters[1:5],list(1, "a")), d=data.table(b=6:10, c=11:15), m=matrix(16:25, ncol=2L)), class = c('data.table', 'data.frame'))
+test(2133.1, as.matrix(DT, rownames="d"), error="Extracted rownames column or provided rownames.values are multi-column type")
+test(2133.2, as.matrix(DT, rownames=2), error='Extracted rownames column or provided rownames.values are multi-column type')
+mat = matrix(6:25, nrow=5, dimnames=list(DT[["a"]], c("d.b", "d.c", "m.V1", "m.V2")))
+test(2133.3, as.matrix(DT, rownames="a"), mat, warning="Extracted rownames column or provided rownames.values are a list column")
+test(2133.4, as.matrix(DT, rownames=1), mat, warning='Extracted rownames column or provided rownames.values are a list column')
+
+## Check C-implementations of basic matrix types not covered by previous tests
+lmat = matrix(c(TRUE, FALSE, NA, FALSE), ncol=2, dimnames=list(NULL, c("A", "B")))
+ldt = as.data.table(lmat)
+test(2134.1, as.matrix(ldt), lmat)
+cmat = matrix(complex(real=1:4, imaginary=0:3), ncol=2, dimnames=list(NULL, c("A", "B")))
+cdt = as.data.table(cmat)
+test(2134.2, as.matrix(cdt), cmat)
+
+## Test bit64 conversion in as.matrix
+if (test_bit64) {
+  # integer64 with logical, raw, or integer should be coerced to integer64
+  i64_mat <- matrix(as.integer64(c(1,0,NA,1:6)), nrow=3, ncol=3, dimnames=list(NULL, LETTERS[1:3]))
+  DT = data.table(A=c(TRUE, FALSE, NA), B=1:3, C=as.integer64(4:6))
+  test(2135.1, as.matrix(DT), i64_mat) # should be integer64 aware, but class not added
+
+  # integer64 with raw, numeric and/or complex should be coerced to character - 
+  # large integers (>32 bits) cannot be converted to numeric or complex
+  mat = matrix(c("0", "1", "0.1", "0.2", "1+0i", "2+1i", "02", "03"), ncol=4, dimnames=list(NULL, LETTERS[1:4]))
+  DT = data.table(A=as.integer64(0:1), B=c(0.1, 0.2), C=complex(real=1:2, imaginary=0:1), D=as.raw(2:3))
+  test(2135.2, as.matrix(DT), mat)
+
+  # But not if any non-atomic columns
+  DT = data.table(A=as.integer64(0:1), B=c('asd', 'qwe'), C=list(2:3, "A"))
+  mat = matrix(list(as.integer64(0), as.integer64(1), 'asd', 'qwe', 2:3, "A"),
+                ncol=3, dimnames=list(NULL, c("A", "B", "C")))
+  test(2135.3, as.matrix(DT), mat)
+}
+
+## Test other class and type conversion in as.matrix
+mat = matrix(letters[1:4], ncol=2, dimnames=list(NULL, c("A", "B")))
+DT = data.table(A=as.factor(c("a", "b")), B=as.factor(c("c", "d")))
+test(2136.1, as.matrix(DT), mat)
+
+mat = matrix(as.raw(1:4), ncol=2, dimnames=list(NULL, c("A", "B")))
+DT = data.table(A=as.raw(1:2), B=as.raw(3:4))
+test(2136.2, as.matrix(DT), mat)
+
+mat = matrix(paste0("2019-01-0", 1:4), ncol=2, dimnames=list(NULL, c("A", "B")))
+DT = data.table(A=as.IDate(paste0("2019-01-0", 1:2)), B=as.IDate(paste0("2019-01-0", 3:4)))
+test(2136.3, as.matrix(DT), mat)
+
+mat = matrix(c(1, 2, 0.1, 0.2, TRUE, FALSE), ncol=3, dimnames=list(NULL, c("A", "B", "C")))
+DT = data.table(A=1:2, B=c(0.1, 0.2), C=c(TRUE, FALSE))
+test(2136.4, as.matrix(DT), mat)
+
+mat = matrix(c(1, 2, 0.1, 0.2, TRUE, FALSE, complex(1:2, 1:2)), ncol=4, dimnames=list(NULL, LETTERS[1:4]))
+DT = data.table(A=1:2, B=c(0.1, 0.2), C=c(TRUE, FALSE), D=complex(1:2, 1:2))
+test(2136.5, as.matrix(DT), mat)
+
+mat = matrix(c("TRUE", "FALSE", "00", "01"), ncol=2, dimnames=list(NULL, c("A", "B")))
+DT = data.table(A=c(TRUE,FALSE), B=as.raw(0:1))
+test(2136.6, as.matrix(DT), mat)
+
+mat = matrix(logical(0), nrow=26, ncol=0, dimnames=list(LETTERS, NULL))
+DT = data.table(A=LETTERS)
+test(2136.7, as.matrix(DT, rownames="A"), mat) # nrow and rownames should be preserved
+
+## Tests for complex column types not captured by standard tests. These are things that would usually only
+## be possible through incorrect construction of data.tables, e.g. NULL columns, environments, expressions, etc.
+DT = structure(list(A=NULL, B=1:2, C=NULL, D=3:4, E=NULL), class=c("data.table", "data.frame"))
+mat = matrix(1:4, ncol=2, dimnames=list(NULL, c("B", "D"))) 
+test(2137.1, as.matrix(DT), mat)
+
+DT = structure(list(B=1:2, C=NULL, D=3:4, E=NULL), class=c("data.table", "data.frame"))
+test(2137.2, as.matrix(DT), mat)
+
+DT = structure(list(C=NULL, E=NULL), class=c("data.table", "data.frame"))
+mat = array(NA, dim = list(0, 0))
+test(2137.3, as.matrix(DT), mat)
+
+DT = structure(list(A=NULL, B=logical(0), C=NULL, D=character(0)), class=c("data.table", "data.frame"))
+mat = matrix(character(0), nrow=0, ncol=2, dimnames = list(NULL, c("B", "D")))
+test(2137.4, as.matrix(DT), mat)
+
+DT = structure(list(A=1:6, B=1:2), class=c("data.table", "data.frame"))  # DT[,B]  is c(1,2)
+DT2 = data.table(A=1:6, B=1:2)                                           # DT2[,B] is c(1,2,1,2,1,2)
+test(2137.5, as.matrix(DT), as.matrix(DT2))
+
+DT = structure(list(A=function(){}, B=list(1), C=expression(1+1)), class=c("data.table", "data.frame")) 
+mat = matrix(c(A=list(function(){}), B=list(1), C=list(expression(1+1))), ncol=3, dimnames=list(NULL, c("A","B","C")))
+test(2137.6, as.matrix(DT), mat) 
+
+DT = data.table(A=function(){}, B=list(1))
+mat = matrix(c(A=function(){}, B=list(1)), ncol=2, dimnames=list(NULL, c("A","B")))
+test(2137.7, as.matrix(DT), mat)
+
+DT = data.table(A=expression(as.character(system.time())), B=quote(1+1))
+mat = matrix(list(expression(as.character(system.time())), expression(as.character(system.time())),
+                  expression(as.character(system.time())), quote(1+1), quote(1+1), quote(1+1)), 
+                  nrow=3, ncol=2, dimnames=list(NULL, c("A","B")))
+test(2137.8, as.matrix(DT), mat) # non-atomic wrapped in list #4196
+
+# Test rownames to character conversions
+DT = data.table(A=as.IDate(1:3), B=factor(c("A", "B", "A"), levels=c("B", "A")))
+mat1 = matrix(c("A", "B", "A"), nrow=3, ncol=1, dimnames=list(as.character(as.IDate(1:3)), "B"))
+mat2 = matrix(as.character(as.IDate(1:3)), nrow=3, ncol=1, dimnames=list(c("A", "B", "A"), "A"))
+test(2138.1, as.matrix(DT, rownames="A"), mat1)
+test(2138.2, as.matrix(DT, rownames="B"), mat2)
+
+if (test_bit64) {
+  # Integer64 as row names
+  DT = data.table(A=as.integer64(0:1), B=c('asd', 'qwe'), C=list(2:3, "A"))
+  mat = matrix(list('asd', 'qwe', 2:3, "A"), ncol=2, dimnames=list(c("0", "1"), c("B", "C")))
+  test(2138.3, as.matrix(DT, rownames="A"), mat)
+}
+
+# Check input data.table is not modified by reference in as.matrix
+dt = data.table(rn=letters[1:3], A=1:3, B=4:6)
+dt2 = copy(dt)
+mat = as.matrix(dt, rownames="rn")
+test(2139.1, dt, dt2) # rn column taken as rownames should still be in dt
+
+dt = data.table(rn=letters[1:3], A=1:3, B=4:6)
+dt2 = copy(dt)
+mat = as.matrix(dt)
+test(2139.2, dt, dt2) # column type coercion should not modify input dt
+
+dt = structure(list(A=NULL, B=1:2, C=NULL, D=3:4, E=NULL), class=c("data.table", "data.frame"))
+dt2 = structure(list(A=NULL, B=1:2, C=NULL, D=3:4, E=NULL), class=c("data.table", "data.frame"))
+mat = as.matrix(dt)
+test(2139.3, dt, dt2) # null columns should not be dropped after as.matrix
+
+dt = structure(list(A=1:6, B=1:2), class=c("data.table", "data.frame"))  # DT[,B]  is c(1,2)
+dt2 = structure(list(A=1:6, B=1:2), class=c("data.table", "data.frame"))  # DT[,B]  is c(1,2)
+mat = as.matrix(dt)
+test(2139.4, dt, dt2) # recycling of dt$B to length dt$A in as.matrix should not modify input dt$B.
+
+dt = structure(list(a=list(1,2:3,4:6,letters[1:5],list(1, "a")), d=data.table(b=6:10, c=11:15), m=matrix(16:25, ncol=2L)), class = c('data.table', 'data.frame'))
+dt2 = structure(list(a=list(1,2:3,4:6,letters[1:5],list(1, "a")), d=data.table(b=6:10, c=11:15), m=matrix(16:25, ncol=2L)), class = c('data.table', 'data.frame'))
+mat = as.matrix(dt)
+test(2139.5, dt, dt2) # flattening data.table and matrix columns should not modify input dt
 
 ########################
 #  Add new tests here  #