misc: add more tests and docs for extraction of date components (#155)

* misc: add more tests for extraction of date components, document those functions * fix
etiennebacher · Nov 21, 2024 · 517afc7 · 517afc7
1 parent 0cb9fea
commit 517afc7
Show file tree

Hide file tree

Showing 4 changed files with 73 additions and 82 deletions.
diff --git a/R/funs-date.R b/R/funs-date.R
@@ -133,8 +133,7 @@ pl_make_datetime_lubridate <- function(
     hour = 0,
     min = 0,
     sec = 0,
-    tz = "UTC"
-) {
+    tz = "UTC") {
   pl$datetime(
     year = year,
     month = month,
@@ -153,8 +152,7 @@ pl_ISOdatetime <- function(
     hour = 0,
     min = 0,
     sec = 0,
-    tz = ""
-) {
+    tz = "") {
   if (tz == "") {
     tz <- Sys.timezone()
   }
@@ -180,56 +178,10 @@ pl_ISOdatetime <- function(
 
 # OLD IMPLEMENTATIONS
 
-pl_hours_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$hours()
-}
-
-pl_microsecond_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$microsecond()
-}
-
-pl_microseconds_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$microseconds()
-}
-
-pl_millisecond_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$millisecond()
-}
-
-pl_milliseconds_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$milliseconds()
-}
-
-pl_minutes_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$minutes()
-}
-
-
-pl_nanosecond_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$nanosecond()
-}
-
-pl_nanoseconds_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$nanoseconds()
-}
-
-pl_seconds_lubridate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$seconds()
-}
-
-pl_strftime <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$strftime()
-}
+# pl_strftime <- function(x, ...) {
+#   check_empty_dots(...)
+#   x$dt$strftime()
+# }
 
 pl_strptime <- function(string, format, tz = "", strict = TRUE, ...) {
   check_empty_dots(...)
@@ -241,20 +193,20 @@ pl_strptime <- function(string, format, tz = "", strict = TRUE, ...) {
   string$str$strptime(dtype = dtype, format = format, strict = strict)
 }
 
-pl_timestamp <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$timestamp()
-}
+# pl_timestamp <- function(x, ...) {
+#   check_empty_dots(...)
+#   x$dt$timestamp()
+# }
 
-pl_truncate <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$truncate()
-}
+# pl_truncate <- function(x, ...) {
+#   check_empty_dots(...)
+#   x$dt$truncate()
+# }
 
-pl_tz_localize <- function(x, ...) {
-  check_empty_dots(...)
-  x$dt$tz_localize()
-}
+# pl_tz_localize <- function(x, ...) {
+#   check_empty_dots(...)
+#   x$dt$tz_localize()
+# }
 
 
 # TODO: check the day of weekstart (lubridate starts the
@@ -264,8 +216,7 @@ pl_wday_lubridate <- function(
     label = FALSE,
     abbr = TRUE,
     week_start = getOption("lubridate.week.start", 7),
-    ...
-) {
+    ...) {
   check_empty_dots(...)
   env <- env_from_dots(...)
   if (week_start != 7) {

diff --git a/tests/testthat/test-funs-date-lazy.R b/tests/testthat/test-funs-date-lazy.R
@@ -3,26 +3,43 @@
 Sys.setenv('TIDYPOLARS_TEST' = TRUE)
 
 patrick::with_parameters_test_that(
-  "extracting date components works", {
+  "extracting date components works",
+  {
     for_all(
       tests = 20,
-      date = date_(),
-      property = function(date) {
+      date = date_(any_na = TRUE),
+      datetime = posixct_(any_na = TRUE),
+      property = function(date, datetime) {
+        # date -----------------------------------
         test_df <- data.frame(x1 = date)
         test <- pl$LazyFrame(x1 = date)
 
-        pl_code <- paste0("mutate(test, foo = ", fun, "(date)) |> pull(foo)")
-        tv_code <- paste0("mutate(test_df, foo = ", fun, "(date)) |> pull(foo)")
+        pl_code <- paste0("mutate(test, foo = ", fun, "(x1)) |> pull(foo)")
+        tv_code <- paste0("mutate(test_df, foo = ", fun, "(x1)) |> pull(foo)")
 
         expect_equal_lazy(
           eval(parse(text = pl_code)),
-          eval(parse(text = tv_code)),
+          eval(parse(text = tv_code))
         )
+
+        # datetime -----------------------------------
+        # TODO: this should be removed eventually
+        if (!fun %in% c("yday", "mday")) {
+          test_df <- data.frame(x1 = datetime)
+          test <- pl$LazyFrame(x1 = datetime)
+
+          pl_code <- paste0("mutate(test, foo = ", fun, "(x1)) |> pull(foo)")
+          tv_code <- paste0("mutate(test_df, foo = ", fun, "(x1)) |> pull(foo)")
+
+          expect_equal_lazy(
+            eval(parse(text = pl_code)),
+            eval(parse(text = tv_code))
+          )
+        }
       }
     )
   },
   fun = c("year", "month", "day", "quarter", "mday", "yday")
 )
 
-
 Sys.setenv('TIDYPOLARS_TEST' = FALSE)
diff --git a/tests/testthat/test-funs-date.R b/tests/testthat/test-funs-date.R
@@ -1,22 +1,39 @@
 patrick::with_parameters_test_that(
-  "extracting date components works", {
+  "extracting date components works",
+  {
     for_all(
       tests = 20,
-      date = date_(),
-      property = function(date) {
+      date = date_(any_na = TRUE),
+      datetime = posixct_(any_na = TRUE),
+      property = function(date, datetime) {
+        # date -----------------------------------
         test_df <- data.frame(x1 = date)
         test <- pl$DataFrame(x1 = date)
 
-        pl_code <- paste0("mutate(test, foo = ", fun, "(date)) |> pull(foo)")
-        tv_code <- paste0("mutate(test_df, foo = ", fun, "(date)) |> pull(foo)")
+        pl_code <- paste0("mutate(test, foo = ", fun, "(x1)) |> pull(foo)")
+        tv_code <- paste0("mutate(test_df, foo = ", fun, "(x1)) |> pull(foo)")
 
         expect_equal(
           eval(parse(text = pl_code)),
-          eval(parse(text = tv_code)),
+          eval(parse(text = tv_code))
         )
+
+        # datetime -----------------------------------
+        # TODO: this should be removed eventually
+        if (!fun %in% c("yday", "mday")) {
+          test_df <- data.frame(x1 = datetime)
+          test <- pl$DataFrame(x1 = datetime)
+
+          pl_code <- paste0("mutate(test, foo = ", fun, "(x1)) |> pull(foo)")
+          tv_code <- paste0("mutate(test_df, foo = ", fun, "(x1)) |> pull(foo)")
+
+          expect_equal(
+            eval(parse(text = pl_code)),
+            eval(parse(text = tv_code))
+          )
+        }
       }
     )
   },
   fun = c("year", "month", "day", "quarter", "mday", "yday")
 )
-
diff --git a/vignettes/r-and-polars-expressions.Rmd b/vignettes/r-and-polars-expressions.Rmd
@@ -254,6 +254,7 @@ out <- tribble(
   "`dplyr`", "`nth`",
   "`dplyr`", "`n_distinct`",
   "`dplyr`", "`row_number`",
+  "`lubridate`", "`day`",
   "`lubridate`", "`ddays`",
   "`lubridate`", "`dhours`",
   "`lubridate`", "`dmilliseconds`",
@@ -262,7 +263,12 @@ out <- tribble(
   "`lubridate`", "`dweeks`",
   "`lubridate`", "`make_date`",
   "`lubridate`", "`make_datetime`",
+  "`lubridate`", "`mday`",
+  "`lubridate`", "`month`",
+  "`lubridate`", "`quarter`",
   "`lubridate`", "`wday`",
+  "`lubridate`", "`yday`",
+  "`lubridate`", "`year`",
   "`stats`", "`median`",
   "`stats`", "`lag`",
   "`stats`", "`sd`",