From a228f6b98774ccd48e8f558e2255278d757b304e Mon Sep 17 00:00:00 2001 From: jangorecki Date: Wed, 20 Nov 2019 11:41:06 +0530 Subject: [PATCH 1/4] fix first-last xts dispatch #4053 --- NEWS.md | 2 + R/last.R | 95 +++++++++++++++++++++++++++------------ inst/tests/tests.Rraw | 101 ++++++++++++++++++++++++++++++++++++++---- 3 files changed, 161 insertions(+), 37 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0b346019b0..476b2b2baf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,8 @@ ## BUG FIXES +1. Dispatch of `first` and `last` functions now properly works for `xts` objects, [#4053](https://github.com/Rdatatable/data.table/issues/4053). Thanks to @ethanbsmith for reporting. + ## NOTES 1. Links in the manual were creating warnings when installing HTML, [#4000](https://github.com/Rdatatable/data.table/issues/4000). Thanks to Morgan Jacob. diff --git a/R/last.R b/R/last.R index 052f8e8277..18560232f7 100644 --- a/R/last.R +++ b/R/last.R @@ -1,41 +1,80 @@ - # data.table defined last(x) with no arguments, just for last. If you need the last 10 then use tail(x,10). -# This last is implemented this way for compatibility with xts::last which is S3 generic taking 'n' and 'keep' arguments -# We'd like last() on vectors to be fast, so that's a direct x[NROW(x)] as it was in data.table, otherwise use xts's. -# If xts is loaded higher than data.table, xts::last will work but slower. +# for xts class objects it will dispatch to xts::last +# reworked to avoid loading xts namespace (#3857) then again to fix dispatching of xts class (#4053) last = function(x, n=1L, ...) { - if (nargs()==1L) { - if (is.vector(x) || is.atomic(x)) { - if (!length(x)) x else x[[length(x)]] - } else if (is.data.frame(x)) { - x[NROW(x),] + verbose = isTRUE(getOption("datatable.verbose", FALSE)) + if (!inherits(x, "xts")) { + if (nargs()>1L) { + if ("package:xts" %chin% search()) { + if (verbose) + cat("last: using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n") + xts::last(x, n=n, ...) + } else { + if (verbose) + cat("last: using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n") + utils::tail(x, n=n, ...) + } + } else { + dx = dim(x) + if (is.null(dx)) { + if (verbose) + cat("last: using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))\n") + lx = length(x) + if (!lx) x else x[[lx]] + } else if (is.data.frame(x)) { + if (verbose) + cat("last: using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)\n") + x[dx[1L], , drop=FALSE] + } else { + if (verbose) + cat("last: using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)\n") + utils::tail(x, n=n, ...) + } } - } else if ("package:xts" %chin% search()) { - if (!requireNamespace("xts", quietly=TRUE)) - stop("internal error, package:xts is on search path but could not be loaded via requireNamespace") # nocov - if (isTRUE(getOption("datatable.verbose", FALSE))) - cat("last: using xts::last\n") - xts::last(x, n=n, ...) # UseMethod("last") doesn't find xts's methods, not sure what I did wrong. } else { - tail(x, n=n, ...) # nocov + if (!requireNamespace("xts", quietly=TRUE)) + stop("'xts' class passed to data.table::last function but 'xts' is not available, you should have 'xts' installed already") + if (verbose) + cat("last: using xts::last: is.xts(x)\n") + xts::last(x, n=n, ...) } } -# first(), similar to last(), not sure why this wasn't exported in the first place... first = function(x, n=1L, ...) { - if (nargs()==1L) { - if (is.vector(x) || is.atomic(x)) { - if (!length(x)) x else x[[1L]] - } else if (is.data.frame(x)) { - if (!NROW(x)) x else x[1L,] + verbose = isTRUE(getOption("datatable.verbose", FALSE)) + if (!inherits(x, "xts")) { + if (nargs()>1L) { + if ("package:xts" %chin% search()) { + if (verbose) + cat("first: using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n") + xts::first(x, n=n, ...) + } else { + if (verbose) + cat("first: using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n") + utils::head(x, n=n, ...) + } + } else { + dx = dim(x) + if (is.null(dx)) { + if (verbose) + cat("first: using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))\n") + lx = length(x) + if (!lx) x else x[[1L]] + } else if (is.data.frame(x)) { + if (verbose) + cat("first: using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)\n") + if (!dx[1L]) x else x[1L, , drop=FALSE] + } else { + if (verbose) + cat("first: using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)\n") + utils::head(x, n=n, ...) + } } - } else if ("package:xts" %chin% search()) { + } else { if (!requireNamespace("xts", quietly=TRUE)) - stop("internal error, package:xts is on search path but could not be loaded via requireNamespace") # nocov - if (isTRUE(getOption("datatable.verbose", FALSE))) - cat("first: using xts::first\n") + stop("'xts' class passed to data.table::first function but 'xts' is not available, you should have 'xts' installed already") + if (verbose) + cat("first: using xts::first: is.xts(x)\n") xts::first(x, n=n, ...) - } else { - head(x, n=n, ...) # nocov } } diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 157e68e8e7..c1527b7546 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -16163,23 +16163,106 @@ test(2107.3, names(DT), c('A','b','c')) setnames(DT, -(1:2), toupper) test(2107.4, names(DT), c('A','b','C')) -# first and last should no longer load xts namespace, #3857 +# first and last should no longer load xts namespace, #3857, below commented test for interactive validation when xts present but not loaded or attached +#stopifnot("xts"%in%installed.packages(), !"xts"%in%loadedNamespaces()); library(data.table); x=as.POSIXct("2019-01-01"); last(x); stopifnot(!"xts" %in% loadedNamespaces()) x = as.POSIXct("2019-09-09")+0:1 old = options(datatable.verbose=TRUE) -test(2108.01, last(x), x[length(x)], notOutput="xts") -test(2108.02, first(x), x[1L], notOutput="xts") +test(2108.01, last(x), x[length(x)], output="!is.xts(x)") +test(2108.02, first(x), x[1L], output="!is.xts(x)") if (test_xts) { xt = xts(1:2, x) - test(2108.03, last(xt, 2L), xt, output="last: using xts::last") - test(2108.04, first(xt, 2L), xt, output="first: using xts::first") + test(2108.03, last(xt, 2L), xt, output="using xts::last: is.xts(x)") + test(2108.04, first(xt, 2L), xt, output="using xts::first: is.xts(x)") xt = xts(matrix(1:4, 2L, 2L), x) - test(2108.05, last(xt, 2L), xt, output="last: using xts::last") - test(2108.06, first(xt, 2L), xt, output="first: using xts::first") + test(2108.05, last(xt, 2L), xt, output="using xts::last: is.xts(x)") + test(2108.06, first(xt, 2L), xt, output="using xts::first: is.xts(x)") } # first on empty df now match head(df, n=1L), #3858 df = data.frame(a=integer(), b=integer()) -test(2108.11, first(df), df, notOutput="xts") -test(2108.12, tail(df), df, notOutput="xts") +test(2108.11, first(df), df, output="!is.xts(x)") +test(2108.12, last(df), df, output="!is.xts(x)") +options(old) +# xts last-first dispatch fix #4053 +x = 1:3 +y = as.POSIXct(x, origin="1970-01-01") +df = data.frame(a=1:2, b=3:2) +dt = as.data.table(df) +mx = matrix(1:9, 3, 3) +ar = array(1:27, c(3,3,3)) +xt = structure( + c(142.25, 141.229996, 141.330002, 142.860001, 142.050003, 141.399994, + 140.570007, 140.610001, 140.380005, 141.369995, 141.669998, 140.539993, + 94807600, 69620600, 76645300, 108.999954, 109.231255, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167782400, 1167868800, 1167955200), tzone = "UTC", tclass = "Date"), + .Dim = c(3L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) +) +old = options(datatable.verbose=TRUE) +if (test_xts) { + test(2108.21, last(x, n=2L), 2:3, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.22, last(y, n=2L), y[2:3], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.23, last(x, n=1L), 3L, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.24, last(y, n=1L), y[3L], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + xt_last = structure( + c(141.330002, 141.399994, 140.380005, 140.539993, 76645300, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(1167955200, tzone = "UTC", tclass = "Date"), + .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + xt_last2 = structure( + c(141.229996, 141.330002, 142.050003, 141.399994, 140.610001, 140.380005, + 141.669998, 140.539993, 69620600, 76645300, 109.231255, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167868800, 1167955200), tzone = "UTC", tclass = "Date"), + .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + test(2108.25, last(xt), xt_last, output="using xts::last: is.xts(x)") + test(2108.26, last(xt, n=2L), xt_last2, output="using xts::last: is.xts(x)") + test(2108.31, head(x, n=2L), 1:2, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.32, head(y, n=2L), y[1:2], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.33, head(x, n=1L), 1L, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.34, head(y, n=1L), y[1L], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + xt_first = structure( + c(142.25, 142.860001, 140.570007, 141.369995, 94807600, 108.999954), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(1167782400, tzone = "UTC", tclass = "Date"), + .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + xt_first2 = structure( + c(142.25, 141.229996, 142.860001, 142.050003, 140.570007, 140.610001, 141.369995, 141.669998, 94807600, 69620600, 108.999954, 109.231255), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167782400, 1167868800), tzone = "UTC", tclass = "Date"), + .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + test(2108.35, first(xt), xt_first, output="using xts::first: is.xts(x)") + test(2108.36, first(xt, n=2L), xt_first2, output="using xts::first: is.xts(x)") +} else { + test(2108.21, last(x, n=2L), 2:3, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.22, last(y, n=2L), y[2:3], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.23, last(x, n=1L), 3L, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.24, last(y, n=1L), y[3L], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.25, last(xt), error="you should have 'xts' installed already") + test(2108.26, last(xt, n=2L), error="you should have 'xts' installed already") + test(2108.31, first(x, n=2L), 1:2, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.32, first(y, n=2L), y[1:2], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.33, first(x, n=1L), 1L, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.34, first(y, n=1L), y[1L], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(2108.35, first(xt), error="you should have 'xts' installed already") + test(2108.36, first(xt, n=2L), error="you should have 'xts' installed already") +} +test(2108.41, last(x), 3L, output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(2108.42, last(y), y[3L], output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(2108.51, first(x), 1L, output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(2108.52, first(y), y[1L], output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(2108.61, last(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(2108.62, last(dt), data.table(a=2L, b=2L), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(2108.71, first(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(2108.72, first(dt), data.table(a=2L, b=2L), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +# matrix/array utils::tail behavior is likely to in future R, Michael is more in the topic +test(2108.81, last(mx), structure(c(3L, 6L, 9L), .Dim = c(1L, 3L), .Dimnames = list("[3,]", NULL)), output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +test(2108.82, last(ar), 27L, output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +test(2108.91, first(mx), structure(c(1L, 4L, 7L), .Dim = c(1L, 3L)), output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +test(2108.92, first(ar), 1L, output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") options(old) # error in autonaming by={...}, #3156 From 5a77efecd1f22c4e53d26e1b44ffeda11d02aa0a Mon Sep 17 00:00:00 2001 From: jangorecki Date: Wed, 20 Nov 2019 11:47:47 +0530 Subject: [PATCH 2/4] fix bad replace --- inst/tests/tests.Rraw | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index c1527b7546..f33b8ec034 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -16218,10 +16218,10 @@ if (test_xts) { ) test(2108.25, last(xt), xt_last, output="using xts::last: is.xts(x)") test(2108.26, last(xt, n=2L), xt_last2, output="using xts::last: is.xts(x)") - test(2108.31, head(x, n=2L), 1:2, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.32, head(y, n=2L), y[1:2], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.33, head(x, n=1L), 1L, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.34, head(y, n=1L), y[1L], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.31, first(x, n=2L), 1:2, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.32, first(y, n=2L), y[1:2], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.33, first(x, n=1L), 1L, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(2108.34, first(y, n=1L), y[1L], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") xt_first = structure( c(142.25, 142.860001, 140.570007, 141.369995, 94807600, 108.999954), class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", From f0013771b4894897712350b2874666a61ef8120d Mon Sep 17 00:00:00 2001 From: jangorecki Date: Thu, 21 Nov 2019 09:04:23 +0530 Subject: [PATCH 3/4] fix first tests --- inst/tests/tests.Rraw | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index f33b8ec034..7e34be3420 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -16256,9 +16256,9 @@ test(2108.51, first(x), 1L, output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is. test(2108.52, first(y), y[1L], output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") test(2108.61, last(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") test(2108.62, last(dt), data.table(a=2L, b=2L), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -test(2108.71, first(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -test(2108.72, first(dt), data.table(a=2L, b=2L), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -# matrix/array utils::tail behavior is likely to in future R, Michael is more in the topic +test(2108.71, first(df), structure(list(a=1L, b=3L), row.names=1L, class="data.frame"), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(2108.72, first(dt), data.table(a=1L, b=3L), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +# matrix/array utils::tail behavior is likely to change in future R, Michael is more in the topic test(2108.81, last(mx), structure(c(3L, 6L, 9L), .Dim = c(1L, 3L), .Dimnames = list("[3,]", NULL)), output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") test(2108.82, last(ar), 27L, output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") test(2108.91, first(mx), structure(c(1L, 4L, 7L), .Dim = c(1L, 3L)), output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") From 5ce604c862aa3854a0c14d67b5a7cd35020a0c41 Mon Sep 17 00:00:00 2001 From: jangorecki Date: Thu, 21 Nov 2019 10:15:00 +0530 Subject: [PATCH 4/4] coverage --- R/last.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/last.R b/R/last.R index 18560232f7..8b26b92850 100644 --- a/R/last.R +++ b/R/last.R @@ -10,9 +10,11 @@ last = function(x, n=1L, ...) { cat("last: using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n") xts::last(x, n=n, ...) } else { + # nocov start if (verbose) cat("last: using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n") utils::tail(x, n=n, ...) + # nocov end } } else { dx = dim(x) @@ -33,7 +35,7 @@ last = function(x, n=1L, ...) { } } else { if (!requireNamespace("xts", quietly=TRUE)) - stop("'xts' class passed to data.table::last function but 'xts' is not available, you should have 'xts' installed already") + stop("'xts' class passed to data.table::last function but 'xts' is not available, you should have 'xts' installed already") # nocov if (verbose) cat("last: using xts::last: is.xts(x)\n") xts::last(x, n=n, ...) @@ -49,9 +51,11 @@ first = function(x, n=1L, ...) { cat("first: using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n") xts::first(x, n=n, ...) } else { + # nocov start if (verbose) cat("first: using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n") utils::head(x, n=n, ...) + # nocov end } } else { dx = dim(x) @@ -72,7 +76,7 @@ first = function(x, n=1L, ...) { } } else { if (!requireNamespace("xts", quietly=TRUE)) - stop("'xts' class passed to data.table::first function but 'xts' is not available, you should have 'xts' installed already") + stop("'xts' class passed to data.table::first function but 'xts' is not available, you should have 'xts' installed already") # nocov if (verbose) cat("first: using xts::first: is.xts(x)\n") xts::first(x, n=n, ...)