Bug - speed up get_chi()

R/get_anon_chi.R

@@ -18,9 +18,9 @@
 #' chi_cohort %>% get_anon_chi()
 #' chi_cohort %>% get_anon_chi(chi_var = "upi_number")
 #' }
 get_anon_chi <- function(chi_cohort, chi_var = "chi", drop = TRUE, check = TRUE) {
   if (check) {
     # Optional code, if the user has phsmethods installed check the CHIs with it.
     if (rlang::is_installed("phsmethods")) {
       checked_chi <- phsmethods::chi_check(
         dplyr::pull(chi_cohort, {{ chi_var }})
@@ -39,11 +39,11 @@
         ))
       } else if (n_invalid > 0) {
         cli::cli_alert_warning(
           "{n_invalid} CHI number{?s} {?is/are} invalid according to {.fn phsmethods::chi_check}."
         )
         print(
           tibble::tibble(
             {{ chi_var }} := dplyr::pull(chi_cohort, {{ chi_var }})[which_invalid],
             reason = checked_chi[which_invalid]
           )
         )
@@ -54,7 +54,9 @@
   lookup <- tibble::tibble(
     chi = unique(chi_cohort[[chi_var]])
   ) %>%
-    dplyr::mutate(anon_chi = convert_chi_to_anon_chi(.data$chi))
+    dplyr::mutate(chi = dplyr::if_else(is.na(.data$chi), "", .data$chi),
+                  anon_chi = purrr::map_chr(.data$chi, openssl::base64_encode),
+                  anon_chi = dplyr::if_else(.data$anon_chi == "", NA_character_, .data$anon_chi))
 
   chi_cohort <- chi_cohort %>%
     dplyr::left_join(

R/get_chi.R

@@ -19,8 +19,9 @@ get_chi <- function(data, anon_chi_var = "anon_chi", drop = TRUE) {
   lookup <- tibble::tibble(
     anon_chi = unique(data[[anon_chi_var]])
   ) %>%
-    dplyr::mutate(chi = convert_anon_chi_to_chi(.data$anon_chi))
-
+    dplyr::mutate(anon_chi = dplyr::if_else(is.na(.data$anon_chi), "", .data$anon_chi),
+                  chi = unname(convert_anon_chi_to_chi(.data$anon_chi)),
+                  chi = dplyr::if_else(.data$chi == "", NA_character_, .data$chi))
   data <- data %>%
     dplyr::left_join(
       lookup,
@@ -36,17 +37,10 @@ get_chi <- function(data, anon_chi_var = "anon_chi", drop = TRUE) {
   return(data)
 }
 
-convert_anon_chi_to_chi <- function(anon_chi) {
-  chi <- purrr::map_chr(
-    anon_chi,
-    ~ dplyr::case_match(.x,
-      NA_character_ ~ NA_character_,
-      "" ~ "",
-      .default = openssl::base64_decode(.x) %>%
-        substr(2, 2) %>%
-        paste0(collapse = "")
-    )
-  )
+  convert_anon_chi_to_chi <- Vectorize(function(anon_chi) {
+    chi <- openssl::base64_decode(anon_chi) %>%
+      substr(2, 2) %>%
+      paste0(collapse = "")
 
   return(chi)
-}
+})