ARROW-14810 [R] Implement bindings for lubridate's date_decimal() and decimal_date()

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})

r/NEWS.md

@@ -22,10 +22,11 @@
 * `read_csv_arrow()`'s readr-style type `T` is now mapped to `timestamp(unit = "ns")` instead of `timestamp(unit = "s")`.
 * `lubridate`:
  * component extraction functions: `tz()` (timezone), `semester()` (semester), `dst()` (daylight savings time indicator), `date()` (extract date), `epiyear()` (epiyear), improvements to `month()`, which now works with integer inputs.
- * `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
+ * Added `decimal_date()` and `date_decimal()`
 * date-time functionality:
- * `difftime` and `as.difftime()` 
- * `as.Date()` to convert to date
+ * Added `difftime` and `as.difftime()` 
+ * Added `as.Date()` to convert to date
 
 # arrow 7.0.0
 

r/R/dplyr-funcs-datetime.R

@@ -270,6 +270,20 @@ register_bindings_duration <- function() {
  time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp(timezone = "UTC")))
  }
 
+ # if time1 or time2 are timestamps they cannot be expressed in "s" /seconds
+ # otherwise they cannot be added subtracted with durations
+ # TODO delete the casting to "us" once
+ # https://issues.apache.org/jira/browse/ARROW-16060 is solved
+ if (inherits(time1, "Expression") &&
+ time1$type_id() %in% Type[c("TIMESTAMP")] && time1$type()$unit() != 2L) {
+ time1 <- build_expr("cast", time1, options = cast_options(to_type = timestamp("us")))
+ }
+
+ if (inherits(time2, "Expression") &&
+ time2$type_id() %in% Type[c("TIMESTAMP")] && time2$type()$unit() != 2L) {
+ time2 <- build_expr("cast", time2, options = cast_options(to_type = timestamp("us")))
+ }
+
  # we need to go build the subtract expression instead of `time1 - time2` to
  # prevent complaints when we try to subtract an R object from an Expression
  subtract_output <- build_expr("-", time1, time2)
@@ -309,6 +323,34 @@ register_bindings_duration <- function() {
 
  build_expr("cast", x, options = cast_options(to_type = duration(unit = "s")))
  })
+ register_binding("decimal_date", function(date) {
+ y <- build_expr("year", date)
+ start <- call_binding("make_datetime", year = y, tz = "UTC")
+ sofar <- call_binding("difftime", date, start, units = "secs")
+ total <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", date),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+ y + sofar$cast(int64()) / total
+ })
+ register_binding("date_decimal", function(decimal, tz = "UTC") {
+ y <- build_expr("floor", decimal)
+
+ start <- call_binding("make_datetime", year = y, tz = tz)
+ seconds <- call_binding(
+ "if_else",
+ build_expr("is_leap_year", start),
+ Expression$scalar(31622400L), # number of seconds in a leap year (366 days)
+ Expression$scalar(31536000L) # number of seconds in a regular year (365 days)
+ )
+
+ fraction <- decimal - y
+ delta <- build_expr("floor", seconds * fraction)
+ delta <- delta$cast(int64())
+ start + delta$cast(duration("s"))
+ })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1107,7 +1107,7 @@ test_that("difftime works correctly", {
  .input %>%
  mutate(
  secs2 = difftime(
- as.POSIXct("2022-03-07", tz = "Europe/Bucharest"),
+ as.POSIXct("2022-03-07", tz = "Pacific/Marquesas"),
  time1,
  units = "secs"
  )
@@ -1186,3 +1186,32 @@ test_that("as.difftime()", {
  collect()
  )
 })
+
+test_that("`decimal_date()` and `date_decimal()`", {
+ test_df <- tibble(
+ a = c(2007.38998954347, 1970.77732069883, 2020.96061799722,
+ 2009.43465948477, 1975.71251467871, NA),
+ b = as.POSIXct(
+ c("2007-05-23 08:18:30", "1970-10-11 17:19:45", "2020-12-17 14:04:06",
+ "2009-06-08 15:37:01", "1975-09-18 01:37:42", NA)
+ ),
+ c = as.Date(
+ c("2007-05-23", "1970-10-11", "2020-12-17", "2009-06-08", "1975-09-18", NA)
+ )
+ )
+
+ compare_dplyr_binding(
+ .input %>%
+ mutate(
+ decimal_date_from_POSIXct = decimal_date(b),
+ decimal_date_from_r_POSIXct_obj = decimal_date(as.POSIXct("2022-03-25 15:37:01")),
+ decimal_date_from_r_date_obj = decimal_date(ymd("2022-03-25")),
+ decimal_date_from_date = decimal_date(c),
+ date_from_decimal = date_decimal(a),
+ date_from_decimal_r_obj = date_decimal(2022.178)
+ ) %>%
+ collect(),
+ test_df,
+ ignore_attr = "tzone"
+ )
+})