benchmark update und internal fixes

schochastics · Feb 26, 2024 · 4b0008e · 4b0008e
1 parent 7492ccb
commit 4b0008e
Show file tree

Hide file tree

Showing 11 changed files with 1,000,035 additions and 19 deletions.
diff --git a/R/chronos.R b/R/chronos.R
@@ -25,16 +25,12 @@ chronos.factor <- function(x, formats = NULL, tz = "", out_format = "datetime")
 
 #' @export
 chronos.integer <- function(x, formats = NULL, tz = "", out_format = "datetime") {
-    res <- parse_epoch(x)
-    res[is.na(res)] <- NA_character_
-    .return_parsed(res, tz = tz, format = out_format)
+    parse_epoch(x, tz = tz)
 }
 
 #' @export
 chronos.numeric <- function(x, formats = NULL, tz = "", out_format = "datetime") {
-    res <- parse_epoch(x)
-    res[is.na(res)] <- NA_character_
-    .return_parsed(res, tz = tz, format = out_format)
+    parse_epoch(x, tz = tz)
 }
 
 #' @export
@@ -53,15 +49,26 @@ chronos.character <- function(x, formats = NULL, tz = "", out_format = "datetime
         .return_parsed(res, tz = tz, format = out_format)
     }
 
-    tmp <- parse_date(x[idx], formats)
+    if (out_format == "date") {
+        tmp <- parse_date(x[idx], formats)
+        res[idx] <- tmp
+        idx <- is.na(res)
+        if (!any(idx)) {
+            .return_parsed(res, tz = tz, format = out_format)
+        }
+    }
+    tmp <- parse_epoch(x[idx])
     res[idx] <- tmp
     idx <- is.na(res)
     if (!any(idx)) {
         .return_parsed(res, tz = tz, format = out_format)
     }
 
-    tmp <- parse_epoch(x[idx])
-    res[idx] <- tmp
+    if (out_format != "date") {
+        tmp <- parse_date(x[idx], formats)
+        tmp <- paste(tmp, "00:00:00")
+        res[idx] <- tmp
+    }
     res[is.na(res)] <- NA_character_
     .return_parsed(res, tz = tz, format = out_format)
 }
@@ -102,39 +109,40 @@ parse_date <- function(x, formats = NULL, out_date = "%Y-%m-%d") {
 #' Parse datetime from epoch
 #' @inheritParams chronos
 #' @param out_datetime character defining the datetime format of the parsed strings
+#' @param tz timezone of output datetime. If "", uses local timezone
 #' @return character vector of parsed dates.
 #' @export
-parse_epoch <- function(x, out_datetime = "%Y-%m-%d %H:%M:%S") {
+parse_epoch <- function(x, tz = "", out_datetime = "%Y-%m-%d %H:%M:%S") {
     UseMethod("parse_epoch")
 }
 
 #' @export
-parse_epoch.character <- function(x, out_datetime = "%Y-%m-%d %H:%M:%S") {
+parse_epoch.character <- function(x, tz = "", out_datetime = "%Y-%m-%d %H:%M:%S") {
     res <- parse_epoch_rs(x, out_datetime)
     res[res == "not found"] <- NA_character_
     res
 }
 
 #' @export
-parse_epoch.integer <- function(x, out_datetime = "%Y-%m-%d %H:%M:%S") {
+parse_epoch.integer <- function(x, tz = "", out_datetime = "%Y-%m-%d %H:%M:%S") {
     # res <- parse_epoch_i64_rs(x, out_datetime)
     # res[res == "not found"] <- NA_character_
     # res
     # strftime(as.POSIXct(x), format = out_datetime)
-    as.POSIXct(x)
+    as.POSIXct(x, tz = tz)
 }
 
 #' @export
-parse_epoch.numeric <- function(x, out_datetime = "%Y-%m-%d %H:%M:%S") {
+parse_epoch.numeric <- function(x, tz = "", out_datetime = "%Y-%m-%d %H:%M:%S") {
     # x <- as.integer(x)
     # res <- parse_epoch_i64_rs(x, out_datetime)
     # res[res == "not found"] <- NA_character_
     # res
     # strftime(as.POSIXct(x), format = out_datetime)
-    as.POSIXct(x)
+    as.POSIXct(x, tz = tz)
 }
 
 #' @export
-parse_epoch.default <- function(x, out_datetime = "%Y-%m-%d %H:%M:%S") {
+parse_epoch.default <- function(x, tz = "", out_datetime = "%Y-%m-%d %H:%M:%S") {
     stop(paste0(class(x), " not supported for parse_epoch"), call. = FALSE)
 }
diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/data-raw/bench_date.R b/data-raw/bench_date.R
@@ -143,7 +143,7 @@ formats_datetime <- unique(c(
     "%Y.%m.%d %H:%M", "epoch", "%B %d, %Y %H:%M", "%d %B %Y %I:%M%p",
     "%A, %d %B %Y %H:%M", "%Y%m%d%H%M", "%d-%m-%Y %H:%M", "%d/%m/%Y %I:%M %p", "%m/%d/%Y %I:%M %p",
     "%Y-%m-%d %H:%M:%S", "%Y/%m/%d %H:%M:%S", "%d %b %Y %H:%M:%S", "%A, %d %B %Y %I:%M %p",
-    "%d/%m/%Y %I:%M %p"
+    "%d/%m/%Y %I:%M %p", "%I:%M %p %B %d, %Y"
 ))
 
 formats_date <- unique(c(
@@ -153,7 +153,7 @@ formats_date <- unique(c(
     "%e-%b-%Y", "%Y-%B-%d", "%Y-%B-%e", "%Y%B%d", "%Y%B%e", "%B/%d/%Y",
     "%B/%e/%Y", "%B-%d-%Y", "%B-%e-%Y", "%d/%m/%Y", "%d %B %Y", "%Y-%m-%d", "%Y/%m/%d", "%B %d, %Y",
     "%Y.%m.%d", "%A, %d %B %Y", "%I:%M %p %B %d, %Y", "%d-%b-%Y",
-    "%m/%d/%Y"
+    "%m/%d/%Y", "%d-%b-%Y"
 ))
 formats_lst <- list(datetime = formats_datetime, date = formats_date)
 usethis::use_data(formats_lst, internal = TRUE, overwrite = TRUE)

diff --git a/data-raw/benchmark.md b/data-raw/benchmark.md
@@ -74,6 +74,10 @@ epoch times.
 
 ## Runtime
 
+The package [fasttime](https://github.com/s-u/fasttime) can be used
+together with chronos to convert larger sets of datetimes by letting
+chronos return a character vector which is then parsed by `fastPOSIXct`.
+
 ``` r
 fast_chronos <- function(x, out_format = "datetime") {
     res <- chronos(x, out_format = "character")

diff --git a/data-raw/benchmark.qmd b/data-raw/benchmark.qmd
@@ -51,6 +51,7 @@ When epoch times are encoded as characters (which happens when all data is put t
 
 ## Runtime
 
+The package [fasttime](https://github.com/s-u/fasttime) can be used together with chronos to convert larger sets of datetimes by letting chronos return a character vector which is then parsed by `fastPOSIXct`.
 ```{r}
 #| label: fast_chronos