diff --git a/NEWS.md b/NEWS.md index acbbeca35..17d2398d0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -66,6 +66,8 @@ 14. Subtracting an `IDate` from a `Date` is fast again by avoiding unnecessary conversion to `POSIXlt`/`POSIXct`, [#7825](https://github.com/Rdatatable/data.table/issues/7825). Thanks @gilesheywood for the report and @ben-schwen for the fix. +15. `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). diff --git a/R/IDateTime.R b/R/IDateTime.R index 931a51824..82b9e5380 100644 --- a/R/IDateTime.R +++ b/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)) { @@ -17,30 +22,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, ...) { + nm = names(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 + 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) # %/% returns a new object, so setattr() is safe + 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 @@ -112,7 +122,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")) + copy_names(ans, nm) } `-.IDate` = function(e1, e2) { @@ -139,14 +153,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) } @@ -168,13 +184,18 @@ 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)) { + return(copy_names(as.ITime(strptime(x, format = format, ...), ...), 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)) @@ -194,18 +215,23 @@ as.ITime.character = function(x, format, ...) { w = w[!nna] } } - as.ITime(y, ...) + copy_names(as.ITime(y, ...), 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, ...) { diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 4e3ea6d80..d15de1bc6 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -20964,11 +20964,11 @@ dt = data.table(a = NA_integer_, b = NaN) test(2329.3, print(dt, col.names = "none"), output = "1: NA NaN$") # Row name extraction from multiple vectors, #7136 -x <- 1:3 -y <- setNames(4:6, c("A", "B", "C")) +x <- 1:3 +y <- setNames(4:6, c("A", "B", "C")) test(2330.1, as.data.table(list(x, y), keep.rownames=TRUE), data.table(rn=c("A", "B", "C"), V1=1:3, V2=4:6)) test(2330.2, as.data.table(list(x, y), keep.rownames="custom"), data.table(custom=c("A", "B", "C"), V1=1:3, V2=4:6)) -test(2330.3, as.data.table(list(y, x), keep.rownames=TRUE), data.table(rn=c("A", "B", "C"), V1=4:6, V2=1:3)) +test(2330.3, as.data.table(list(y, x), keep.rownames=TRUE), data.table(rn=c("A", "B", "C"), V1=4:6, V2=1:3)) # Behavior under data.frame() test(2330.4, as.data.table(data.frame(x, y), keep.rownames=TRUE), data.table(rn=c("A", "B", "C"), x=1:3, y=4:6)) @@ -21272,7 +21272,7 @@ test(2341.22, fread('a,b # inline header comment\r\n1,2\r\n', comment.char = ' test(2341.230, fread('a b # trailing cmnt ', comment.char = '#', strip.white = FALSE, sep = ","), data.table(a="b ")) -test(2341.231, fread('a # trailing header cmnt +test(2341.231, fread('a # trailing header cmnt b ', comment.char = '#', strip.white = FALSE, sep = ","), data.table(`a `="b")) test(2341.232, fread('a @@ -21606,7 +21606,7 @@ xenv$N = list(a=1:5) xenv$DF = data.frame(a = 1:2) xenv$DF$b = data.table(c = 3:4, d = 5:6) test(2366.1, - tables(env=xenv, depth=1L, index=TRUE)[, .(NAME, NROW, NCOL, INDICES, KEY)], + tables(env=xenv, depth=1L, index=TRUE)[, .(NAME, NROW, NCOL, INDICES, KEY)], data.table( NAME = c("DF$b", "DT", "L[[1]]", "L[[2]]", "M$b"), NROW = c(2L, 1L, 3L, 4L, 3L), @@ -21832,3 +21832,21 @@ 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")) +d = c(a="2020-01-02") +a = c(a=1L) +test(2379.12, as.IDate(d) + 1L, as.IDate(as.Date(d) + 1L)) +test(2379.13, as.IDate("2020-01-01") + a, as.IDate(as.Date("2020-01-01") + a)) +test(2379.14, as.IDate(d) - 1L, as.IDate(as.Date(d) - 1L))