faster numeric and POSIXct methods for IDate and ITime

NAMESPACE

@@ -122,8 +122,11 @@ S3method(as.Date, IDate)
 S3method(as.IDate, Date)
 S3method(as.IDate, POSIXct)
 S3method(as.IDate, default)
+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)

R/IDateTime.R

@@ -8,6 +8,14 @@ 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"))
 }
@@ -97,7 +105,15 @@ as.ITime.default <- function(x, ...) {
     as.ITime(as.POSIXlt(x, ...))
 }
 
-as.ITime.character <- function (x, format, ...) {
+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)) return(as.ITime(strptime(x, format = format, ...)))
     # else allow for mixed formats, such as test 1189 where seconds are caught despite varying format

inst/tests/tests.Rraw

@@ -77,6 +77,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
     binary = data.table:::binary
 
     # Also, for functions that are masked by other packages, we need to map the data.table one. Or else,
@@ -10682,6 +10684,35 @@ tt[2, B:=gsub("\n","\r",B)]  # base R changes the \r to a \n, so restore that
 test(1778.4, tt, DT)
 unlink(f)
 
+# #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(1776.1, uniqueN(ld)==1L)
+lt = lapply(same[-3L], as.ITime) # exclude date
+test(1776.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(1776.3, identical(as.ITime.default(p), as.ITime(p)))
+test(1776.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(1776.5, identical(as.ITime.default(p), as.ITime(p)))
+test(1776.6, identical(as.IDate.default(p), as.IDate(p)))
+p = as.POSIXct(i, origin = "1970-01-01", tz = "America/New_York")
+test(1776.7, identical(as.ITime.default(p), as.ITime(p)))
+test(1776.8, identical(as.IDate.default(p), as.IDate(p)))
+p = as.POSIXct(i, origin = "1970-01-01")
+test(1776.9, identical(as.ITime.default(p), as.ITime(p)))
+test(1776.11, identical(as.IDate.default(p), as.IDate(p)))
+
 
 ##########################