Merge pull request #15 from olivroy/perf

Improve performance somewhat

DESCRIPTION

@@ -22,11 +22,10 @@ BugReports: https://github.com/rstudio/bigD/issues
 Encoding: UTF-8
 RoxygenNote: 7.3.2
 Depends:
-    R (>= 3.3.0)
+    R (>= 3.6.0)
 Suggests:
-    covr,
     testthat (>= 3.0.0),
-    tibble (>= 3.2.1)
+    vctrs (>= 0.5.0)
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true

R/dt_formatters.R

@@ -117,10 +117,10 @@ get_locale_territory <- function(locale) {
   default_locale_name <-
     default_locales[default_locales$base_locale == gsub("_", "-", locale, fixed = TRUE), ][["default_locale"]]
 
-  if (length(default_locale_name) < 1) {
+  if (length(default_locale_name) == 0L) {
 
     default_locale_name <-
-      default_locales[grepl(paste0("^", locale), default_locales$base_locale), ][["default_locale"]][1]
+      default_locales[startsWith(default_locales$base_locale, locale), ][["default_locale"]][1]
   }
 
   territory <- gsub(".*([A-Z]{2}|001|419|150).*", "\\1", default_locale_name)

R/fdt_locales.R

@@ -10,12 +10,12 @@
 #' @examples
 #' # Let's get all the `ar` locales that exist
 #' # in the vector produced by `fdt_locales_vec()`
-#' fdt_locales_vec()[grep("^ar", fdt_locales_vec())]
+#' grep("^ar", fdt_locales_vec(), value = TRUE)
 #'
 #' # Let's get all the locales that pertain to the
 #' # `CH` territory in the vector produced by
 #' # `fdt_locales_vec()`
-#' fdt_locales_vec()[grep("CH", fdt_locales_vec())]
+#' grep("CH", fdt_locales_vec(), value = TRUE)
 #'
 #' @export
 fdt_locales_vec <- function() {

R/utils-date_time_parse.R

@@ -44,14 +44,14 @@ is_time_present <- function(input) {
 
 is_tz_present <- function(input) {
 
-  any(
-    c(
-      grepl(get_tz_pattern_z(), input),
-      grepl(get_tz_pattern_hh(), input),
-      grepl(get_tz_pattern_hh_mm(), input),
-      grepl(get_tz_pattern_hhmm(), input)
-    )
+  regex <- paste(
+    get_tz_pattern_z(),
+    get_tz_pattern_hh(),
+    get_tz_pattern_hh_mm(),
+    get_tz_pattern_hhmm(),
+    sep = "|"
   )
+  any(grepl(regex, input))
 }
 
 is_long_tzid_present <- function(input) {
@@ -232,10 +232,6 @@ which_tz_pattern <- function(input) {
     return("z")
   }
 
-  if (grepl(get_tz_pattern_hh(), input)) {
-    tz_pattern <- "hh"
-  }
-
   if (grepl(get_tz_pattern_hh_mm(), input)) {
     return("hh_mm")
   }
@@ -244,8 +240,8 @@ which_tz_pattern <- function(input) {
     return("hhmm")
   }
 
-  if (exists("tz_pattern")) {
-    return(tz_pattern)
+  if (grepl(get_tz_pattern_hh(), input)) {
+    return("hh")
   }
 
   NA
@@ -336,7 +332,7 @@ get_tz_short_specific <- function(long_tzid, input_dt) {
 
   tzdb_idx <- rle(!(tzdb_entries_tzid$date_start < input_date))$lengths[1]
 
-  tz_short_specific <- tzdb_entries_tzid[tzdb_idx, ]$abbrev
+  tz_short_specific <- tzdb_entries_tzid[tzdb_idx, "abbrev"]
 
   # TODO: add check to ensure that the `abbrev` value is a valid
   # short specific non-location time zone
@@ -379,7 +375,7 @@ get_tz_long_specific <- function(long_tzid, input_dt, locale) {
   # Get the row of the `tz_metazone_names` table based on the supplied locale
   tz_metazone_names_row <- tz_metazone_names[tz_metazone_names$locale == locale, ]
 
-  if (nrow(tz_metazone_names_row) < 1) {
+  if (nrow(tz_metazone_names_row) == 0) {
     return(NA_character_)
   }
 
@@ -432,13 +428,8 @@ get_tz_non_location <- function(
     type
 ) {
 
-  if (!(short_long %in% c("long", "short"))) {
-    stop("The `short_long` keyword should either be 'long' or 'short'.")
-  }
-
-  if (!(type %in% c("generic", "standard", "daylight"))) {
-    stop("The `short_long` keyword should either be 'long' or 'short'.")
-  }
+  short_long <- match.arg(short_long, c("long", "short"))
+  type <- match.arg(type, c("generic", "standard", "daylight"))
 
   # If the supplied `long_tzid` value is NA, return NA
   if (is.na(long_tzid)) {
@@ -512,7 +503,7 @@ long_tz_id_to_metazone_long_id <- function(long_tzid) {
     tz_metazone_users[tz_metazone_users$canonical_tz_name == long_tzid, ]
 
   # Return NA if number of rows in `tz_metazone_users_rows` is zero
-  if (nrow(tz_metazone_users_rows) < 1) {
+  if (nrow(tz_metazone_users_rows) == 0) {
     return(NA_character_)
   }
 

R/zzz.R

@@ -5,16 +5,3 @@ utils::globalVariables(
     "zone_name"
   )
 )
-
-# R 3.5 and earlier have a bug on Windows where if x is latin1 or unknown and
-# replacement is UTF-8, the UTF-8 bytes are inserted into the result but the
-# result is not marked as UTF-8.
-# Example: gsub("a", "\u00B1", "a", fixed = TRUE)
-utf8_aware_sub <- NULL
-
-.onLoad <- function(libname, pkgname, ...) {
-
-  utf8_aware_sub <<- identical("UTF-8", Encoding(sub(".", "\u00B1", ".", fixed = TRUE)))
-
-  invisible(NULL)
-}