faster numeric and POSIXct methods for IDate and ITime

Rdatatable · Oct 13, 2015 · 39d8c41 · 39d8c41
1 parent cc14b73
commit 39d8c41
Show file tree

Hide file tree

Showing 3 changed files with 53 additions and 1 deletion.
diff --git a/NAMESPACE b/NAMESPACE
@@ -102,8 +102,12 @@ S3method(as.data.frame, ITime)
 S3method(as.Date, IDate)
 S3method(as.IDate, Date)
 S3method(as.IDate, default)
+S3method(as.IDate, POSIXct)
+S3method(as.IDate, numeric)
 S3method(as.ITime, character)
 S3method(as.ITime, default)
+S3method(as.ITime, POSIXct)
+S3method(as.ITime, numeric)
 S3method(as.ITime, POSIXlt)
 S3method(as.ITime, times)
 S3method(as.list, IDate)

diff --git a/R/IDateTime.R b/R/IDateTime.R
@@ -8,9 +8,17 @@ as.IDate <- function(x, ...) UseMethod("as.IDate")
 as.IDate.default <-
     function(x, ...) as.IDate(as.Date(x, ...))
 
+as.IDate.POSIXct <- function(x, ...) {
+    if(attr(x, "tzone") %in% c("UTC", "GMT")) as.IDate(unclass(x), ...) else as.IDate(as.Date(x, ...))
+}
+
+as.IDate.numeric <- function(x, ...) {
+    structure(as.integer(x) %/% 86400L, class=c("IDate","Date"))
+}
+
 as.IDate.Date <- function(x, ...) {
     structure(as.integer(x), class=c("IDate","Date"))
-}    
+}
 
 as.IDate.IDate <- function(x, ...) x
 
@@ -56,6 +64,14 @@ as.ITime.default <- function(x, ...) {
     as.ITime(as.POSIXlt(x, ...))
 }
 
+as.ITime.POSIXct <- function(x, ...) {
+    if(attr(x, "tzone") %in% c("UTC", "GMT")) as.ITime(unclass(x), ...) else as.ITime(as.POSIXlt(x, ...))
+}
+
+as.ITime.numeric <- function(x, ...) {
+    structure(as.integer(x) %% 86400L, class = "ITime")
+}
+
 as.ITime.character <- function(x, format, ...) {
     x <- unclass(x)
     if (!missing(format)) 

diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw
@@ -80,6 +80,8 @@ if (!.devtesting) {
     `%+%.default` = data.table:::`%+%.default`
     .shallow = data.table:::.shallow
     getdots = data.table:::getdots
+    as.ITime.default = data.table:::as.ITime.default
+    as.IDate.default = data.table:::as.IDate.default
 }
 
 # test for covering tables.R 100%, we need to run tables() before creating any data.tables to return null data.table
@@ -7067,6 +7069,36 @@ Y = data.table(A=2:4, B=5:7)
 test(1575.1, X[Y, on=c(A="a")], error="not found in x")
 test(1575.2, X[Y, on=c(a="a")], error="not found in i")
 
+# #1392 IDate ITime new methods for faster conversion
+# conversion in-out match for UTC
+same = list(l = as.POSIXlt("2015-10-12 13:19:35", tz = "UTC"))
+same$p = as.POSIXct(same$l)
+same$d = as.Date(same$p)
+same$n = as.numeric(same$p)
+same$i = as.integer(same$p)
+ld = lapply(same, as.IDate)
+test(1576.1, uniqueN(ld)==1L)
+lt = lapply(same[-3L], as.ITime) # exclude date
+test(1576.2, uniqueN(lt)==1L)
+# some random 1e6 timestamps old defaults vs new methods UTC
+intpx = function(x) as.integer(as.POSIXct(x, origin = "1970-01-01", tz = "UTC"))
+set.seed(1)
+i = sample(seq(intpx("2014-10-12"), intpx("2015-10-12")), 1e6, TRUE)
+p = as.POSIXct(i, origin = "1970-01-01", tz = "UTC")
+test(1576.3, identical(as.ITime.default(p), as.ITime(p)))
+test(1576.4, identical(as.IDate.default(p), as.IDate(p)))
+# test for non-UTC
+p = as.POSIXct(i, origin = "1970-01-01", tz = "Asia/Hong_Kong")
+test(1576.5, identical(as.ITime.default(p), as.ITime(p)))
+test(1576.6, identical(as.IDate.default(p), as.IDate(p)))
+p = as.POSIXct(i, origin = "1970-01-01", tz = "America/New_York")
+test(1576.7, identical(as.ITime.default(p), as.ITime(p)))
+test(1576.8, identical(as.IDate.default(p), as.IDate(p)))
+p = as.POSIXct(i, origin = "1970-01-01")
+test(1576.9, identical(as.ITime.default(p), as.ITime(p)))
+test(1576.10, identical(as.IDate.default(p), as.IDate(p)))
+
+
 ##########################