Preserve names in as.IDate() and as.ITime()

NEWS.md

@@ -62,6 +62,8 @@
 
 13. `rbindlist()` (and therefore the `rbind()` method for `data.table`s) no longer raises an error upon encountering more than approximately 50000 columns in a list entry, [#7793](https://github.com/Rdatatable/data.table/issues/7793). The bug was introduced in `data.table` version 1.18.2.1. Thanks to @rickhelmus for the report and @aitap for the fix.
 
+14. `as.IDate()` and `as.ITime()` now preserve names, matching base `as.Date()` behavior, [#7252](https://github.com/Rdatatable/data.table/issues/7252). Thanks @DavisVaughan for the report and @venom1204 for the PR.
+
 ### Notes
 
 1. {data.table} now depends on R 3.5.0 (2018).

R/IDateTime.R

@@ -5,6 +5,11 @@
 
 as.IDate = function(x, ...) UseMethod("as.IDate")
 
+copy_names = function(ans, nm) {
+  if (!is.null(nm)) setattr(ans, "names", nm)
+  ans
+}
+
 as.IDate.default = function(x, ..., tz = attr(x, "tzone", exact=TRUE)) {
   if (is.null(tz)) tz = "UTC"
   if (is.character(x)) {
@@ -16,31 +21,35 @@ as.IDate.default = function(x, ..., tz = attr(x, "tzone", exact=TRUE)) {
 
 as.IDate.numeric = function(x, origin = "1970-01-01", ...) {
   if (origin=="1970-01-01") {
-    # standard epoch
+    nm = names(x)
     x = as.integer(x)
     class(x) = c("IDate", "Date")
     # We used to use structure() here because class(x)<- copied several times in R before v3.1.0
     # Since R 3.1.0 improved class()<- and data.table's oldest oldest supported R is now >3.1.0, we can use class<- again
     # structure() contains a match() and replace for specials, which we don't need.
     # class()<- ensures at least 1 shallow copy as appropriate is returned.
-    x
+    copy_names(x, nm)
   } else {
-    # only call expensive as.IDate.character if we have to
-    as.IDate(origin, ...) + as.integer(x)
+    as.IDate(origin, ...) + copy_names(as.integer(x), names(x))
   }
 }
 
 as.IDate.Date = function(x, ...) {
-  x = as.integer(x)                 # if already integer, x will be left unchanged as the original input
-  class(x) = c("IDate", "Date")     # class()<- will copy if as.integer() did not create, and may not if it did we hope
-  x                                 # always return a new object
+  nm = names(x)
+  x = as.integer(x)
+  class(x) = c("IDate", "Date")
+  copy_names(x, nm)
 }
 
 as.IDate.POSIXct = function(x, tz = attr(x, "tzone", exact=TRUE), ...) {
-  if (is_utc(tz))
-    (setattr(as.integer(as.numeric(x) %/% 86400L), "class", c("IDate", "Date")))  # %/% returns new object so can use setattr() on it; wrap with () to return visibly
-  else
+  if (is_utc(tz)) {
+    ans = as.integer(as.numeric(x) %/% 86400L)
+    setattr(ans, "class", c("IDate", "Date"))
+    copy_names(ans, names(x))
+  } else {
+
     as.IDate(as.Date(x, tz =  tz %||% '', ...))
+  }
 }
 
 as.IDate.IDate = function(x, ...) x
@@ -106,7 +115,11 @@ chooseOpsMethod.IDate = function(x, y, mx, my, cl, reverse) inherits(y, "Date")
   }
   if (inherits(e1, "Date") && inherits(e2, "Date"))
     stopf("binary + is not defined for \"IDate\" objects")
-  (setattr(as.integer(unclass(e1) + unclass(e2)), "class", c("IDate", "Date")))  # () wrap to return visibly
+  res = unclass(e1) + unclass(e2)
+  nm = names(res)
+  ans = as.integer(res)
+  setattr(ans, "class", c("IDate", "Date"))  # () wrap to return visibly
+  copy_names(ans, nm)
 }
 
 `-.IDate` = function(e1, e2) {
@@ -126,14 +139,16 @@ chooseOpsMethod.IDate = function(x, y, mx, my, cl, reverse) inherits(y, "Date")
     return(base::`-.Date`(as.Date(e1), e2))
     # can't call base::.Date directly (last line of base::`-.Date`) as tried in PR#3168 because ?.Date states "Internal objects in the base package most of which are only user-visible because of the special nature of the base namespace."
   }
-  ans = as.integer(unclass(e1) - unclass(e2))
+  res = unclass(e1) - unclass(e2)
+  nm = names(res)
+  ans = as.integer(res)
   if (inherits(e2, "Date")) {
     setattr(ans, "class", "difftime")
     setattr(ans, "units", "days")
   } else {
     setattr(ans, "class", c("IDate", "Date"))
   }
-  ans
+  copy_names(ans, nm)
 }
 
 
@@ -155,13 +170,19 @@ as.ITime.POSIXct = function(x, tz = attr(x, "tzone", exact=TRUE), ...) {
 }
 
 as.ITime.numeric = function(x, ms = 'truncate', ...) {
+  nm = names(x)
   secs = clip_msec(x, ms) %% 86400L # the %% here ensures a local copy is obtained; the truncate as.integer() may not copy
-  (setattr(secs, "class", "ITime"))
+  setattr(secs, "class", "ITime")
+  copy_names(secs, nm)
 }
 
 as.ITime.character = function(x, format, ...) {
+  nm = names(x)
   x = unclass(x)
-  if (!missing(format)) return(as.ITime(strptime(x, format = format, ...), ...))
+  if (!missing(format)) {
+    ans = as.ITime(strptime(x, format = format, ...), ...)
+    return(copy_names(ans, nm))
+  }
   # else allow for mixed formats, such as test 1189 where seconds are caught despite varying format
   y = strptime(x, format = "%H:%M:%OS", ...)
   w = which(is.na(y))
@@ -181,18 +202,24 @@ as.ITime.character = function(x, format, ...) {
       w = w[!nna]
     }
   }
-  as.ITime(y, ...)
+  ans = as.ITime(y, ...)
+  copy_names(ans, nm)
 }
 
 as.ITime.POSIXlt = function(x, ms = 'truncate', ...) {
+  nm = names(x)
   secs = clip_msec(x$sec, ms)
-  (setattr(with(x, secs + min * 60L + hour * 3600L), "class", "ITime"))  # () wrap to return visibly
+  ans = with(x, secs + min * 60L + hour * 3600L)
+  setattr(ans, "class", "ITime")
+  copy_names(ans, nm)
 }
 
 as.ITime.times = function(x, ms = 'truncate', ...) {
+  nm = names(x)
   secs = 86400L * (unclass(x) %% 1L)
   secs = clip_msec(secs, ms)
-  (setattr(secs, "class", "ITime"))  # the first line that creates sec will create a local copy so we can use setattr() to avoid potential copy of class()<-
+  setattr(secs, "class", "ITime")  # the first line that creates sec will create a local copy so we can use setattr() to avoid potential copy of class()<-
+  copy_names(secs, nm)
 }
 
 as.character.ITime = format.ITime = function(x, ...) {

inst/tests/tests.Rraw

@@ -21831,3 +21831,16 @@ test(2378.92, .Call(CresizeVector, x, 2:3), error = "must be length 1 non-NA non
 test(2378.93, .Call(CresizeVector, x, -2L), error = "must be length 1 non-NA non-negative integer value")
 test(2378.94, .Call(CresizeVector, x, NA_integer_), error = "must be length 1 non-NA non-negative integer value")
 test(2378.95, .Call(CresizeVector, NULL, 2L), error = "must be a vector")
+
+# #7252 as.IDate()/as.ITime preserve names and are compliant with as.Date()
+test(2379.01, as.IDate(c(a = "2019-01-01")), as.IDate(as.Date(c(a = "2019-01-01"))))
+test(2379.02, c(a = as.IDate("2019-01-01")), structure(as.IDate("2019-01-01"), names="a"))
+test(2379.03, as.ITime(c(a = "12:00:00")), structure(as.ITime("12:00:00"), names="a"))
+test(2379.04, as.IDate(structure(as.POSIXct("2019-01-01 12:00:00", tz="UTC"), names = "a")), as.IDate(as.Date(structure(as.POSIXct("2019-01-01 12:00:00", tz="UTC"), names = "a"))))
+test(2379.05, as.ITime(structure(3600, names = "a")), structure(as.ITime(3600), names="a"))
+test(2379.06, as.IDate(c(a = 18000)), as.IDate(as.Date(c(a = 18000), origin="1970-01-01")))
+test(2379.07, as.IDate(c(a = 1), origin = "2020-01-01"), as.IDate(as.Date(c(a = 1), origin = "2020-01-01")))
+test(2379.08, as.ITime(c(a = "12-00-00"), format = "%H-%M-%S"), structure(as.ITime("12:00:00"), names="a"))
+test(2379.09, as.IDate(as.POSIXct(c(a = "2019-01-01"), tz="America/New_York")), as.IDate(as.Date(as.POSIXct(c(a = "2019-01-01"), tz="America/New_York"))))
+test(2379.10, as.IDate(c(a = 1), origin = c(b = "2020-01-01")), as.IDate(as.Date(c(a = 1), origin = c(b = "2020-01-01"))))
+test(2379.11, as.IDate(c(a = 20.5), origin="2020-01-01"), structure(as.IDate("2020-01-21"), names="a"))