From d8ded02734236c3cd08a8697d1fa641eb96e919f Mon Sep 17 00:00:00 2001 From: Sergio Oller Date: Thu, 2 Mar 2017 00:57:16 +0100 Subject: [PATCH] Add difftime support to Collecter.h We want to support difftime in bind_rows and combine. We are already supporting mutate and I'm preparing a PR to make mutate use Collecter.h as well. --- NEWS.md | 2 + inst/include/dplyr/Collecter.h | 104 ++++++++++++++++++++++++++++++++- tests/testthat/test-binds.R | 8 +++ tests/testthat/test-combine.R | 20 +++++++ 4 files changed, 133 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 99a3d3923d..c9d615891d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -350,6 +350,8 @@ * `combine()` and `bind_rows()` with character and factor types now always warn about the coercion to character (#2317, @zeehio) +* `combine()` and `bind_rows()` accept `difftime` objects. + # dplyr 0.5.0 ## Breaking changes diff --git a/inst/include/dplyr/Collecter.h b/inst/include/dplyr/Collecter.h index ae74a35294..8d7e98d440 100644 --- a/inst/include/dplyr/Collecter.h +++ b/inst/include/dplyr/Collecter.h @@ -25,12 +25,13 @@ namespace dplyr { static bool is_class_known(SEXP x) { /* C++11 (need initializer lists) static std::set known_classes { - "POSIXct", "factor", "Date", "AsIs", "integer64", "table" + "difftime", "POSIXct", "factor", "Date", "AsIs", "integer64", "table" }; */ /* Begin C++98 workaround */ static std::set known_classes; if (known_classes.empty()) { + known_classes.insert("difftime"); known_classes.insert("POSIXct"); known_classes.insert("factor"); known_classes.insert("Date"); @@ -364,6 +365,103 @@ namespace dplyr { }; + class DifftimeCollecter : public Collecter_Impl { + public: + typedef Collecter_Impl Parent; + + DifftimeCollecter(int n, SEXP units_) : + Parent(n), units(units_) {} + + void collect(const SlicingIndex& index, SEXP v) { + if (Rf_inherits(v, "difftime")) { + collect_difftime(index, v); + } else if (all_logical_na(v, TYPEOF(v))) { + Parent::collect(index, v); + } + } + + inline SEXP get() { + set_class(Parent::data, "difftime"); + if (!units.isNULL()) { + Parent::data.attr("units") = units; + } + return Parent::data; + } + + inline bool compatible(SEXP x) { + return Rf_inherits(x, "difftime") || all_logical_na(x, TYPEOF(x)); + } + + inline bool can_promote(SEXP x) const { + return false; + } + + std::string describe() const { + return "difftime"; + } + + private: + RObject units; + + void collect_difftime(const SlicingIndex& index, SEXP v) { + RObject v_units(Rf_getAttrib(v, Rf_install("units"))); + if (v_units.isNULL()) { + // assume seconds + v_units = wrap("secs"); + } + if (units.isNULL()) { + // if current unit is NULL, grab the new one + units = v_units; + // then collect the data: + Parent::collect(index, v); + } else { + // We already units, is the new vector with the same units? + if (STRING_ELT(units, 0) == STRING_ELT(v_units,0)) { + Parent::collect(index, v); + } else { + // If units are different convert the existing data and the new vector + // to seconds (following the convention on + // r-source/src/library/base/R/datetime.R) + double factor_data = time_conversion_factor(units); + if (factor_data != 1.0) { + for (int i=0; i(v_units); + if (v_units_c == "secs") { + factor = 1; + } else if (v_units_c == "mins") { + factor = 60; + } else if (v_units_c == "hours") { + factor = 60*60; + } else if (v_units_c == "days") { + factor = 60*60*24; + } else if (v_units_c == "weeks") { + factor = 60*60*24*7; + } else { + stop("Cannot convert %s to seconds", v_units_c.c_str()); + } + return factor; + } + + }; + + class FactorCollecter : public Collecter { public: typedef dplyr_hash_map LevelsMap; @@ -461,6 +559,8 @@ namespace dplyr { case INTSXP: if (Rf_inherits(model, "POSIXct")) return new POSIXctCollecter(n, Rf_getAttrib(model, Rf_install("tzone"))); + if (Rf_inherits(model, "difftime")) + return new DifftimeCollecter(n, Rf_getAttrib(model, Rf_install("units"))); if (Rf_inherits(model, "factor")) return new FactorCollecter(n, model); if (Rf_inherits(model, "Date")) @@ -469,6 +569,8 @@ namespace dplyr { case REALSXP: if (Rf_inherits(model, "POSIXct")) return new POSIXctCollecter(n, Rf_getAttrib(model, Rf_install("tzone"))); + if (Rf_inherits(model, "difftime")) + return new DifftimeCollecter(n, Rf_getAttrib(model, Rf_install("units"))); if (Rf_inherits(model, "Date")) return new TypedCollecter(n, get_date_classes()); if (Rf_inherits(model, "integer64")) diff --git a/tests/testthat/test-binds.R b/tests/testthat/test-binds.R index 815caaecff..5e98455476 100644 --- a/tests/testthat/test-binds.R +++ b/tests/testthat/test-binds.R @@ -457,3 +457,11 @@ test_that("bind_rows rejects data frame columns (#2015)", { fixed = TRUE ) }) + +test_that("bind_rows accepts difftime objects", { + df1 <- data.frame(x = as.difftime(1, units = "hours")) + df2 <- data.frame(x = as.difftime(1, units = "mins")) + res <- bind_rows(df1, df2) + expect_equal(res$x, + c(df1$x, df2$x)) +}) diff --git a/tests/testthat/test-combine.R b/tests/testthat/test-combine.R index 216ce26ef7..3d64465385 100644 --- a/tests/testthat/test-combine.R +++ b/tests/testthat/test-combine.R @@ -167,5 +167,25 @@ test_that("combine works with integer64 (#1092)", { ) }) +test_that("combine works with difftime", { + expect_equal( + combine(as.difftime(1, units = "mins"), as.difftime(1, units = "hours")), + as.difftime(c(60, 3600), units = "secs") + ) + expect_equal( + combine(as.difftime(1, units = "secs"), as.difftime(1, units = "secs")), + as.difftime(c(1, 1), units = "secs") + ) + expect_equal( + combine(as.difftime(1, units = "days"), as.difftime(1, units = "secs")), + as.difftime(c(24*60*60, 1), units = "secs") + ) + expect_equal( + combine(as.difftime(2, units = "weeks"), as.difftime(1, units = "secs")), + as.difftime(c(2*7*24*60*60, 1), units = "secs") + ) + +}) + # Uses helper-combine.R combine_coercion_types()