(v1.6.0.9064) prepare new release

R/aa_helper_functions.R

@@ -716,6 +716,11 @@ meet_criteria <- function(object,
 }
 
 get_current_data <- function(arg_name, call) {
+  # check if retrieved before, then get it from package environment
+  if (identical(unique_call_id(entire_session = FALSE), pkg_env$get_current_data.call)) {
+    return(pkg_env$get_current_data.out)
+  }
+  
   # try dplyr::cur_data_all() first to support dplyr groups
   # only useful for e.g. dplyr::filter(), dplyr::mutate() and dplyr::summarise()
   # not useful (throws error) with e.g. dplyr::select() - but that will be caught later in this function
@@ -723,7 +728,10 @@ get_current_data <- function(arg_name, call) {
   if (!is.null(cur_data_all)) {
     out <- tryCatch(cur_data_all(), error = function(e) NULL)
     if (is.data.frame(out)) {
-      return(structure(out, type = "dplyr_cur_data_all"))
+      out <- structure(out, type = "dplyr_cur_data_all")
+      pkg_env$get_current_data.call <- unique_call_id(entire_session = FALSE)
+      pkg_env$get_current_data.out <- out
+      return(out)
     }
   }
 
@@ -779,7 +787,10 @@ get_current_data <- function(arg_name, call) {
   # lookup the matched frame and return its value: a data.frame
   vars_df <- tryCatch(frms[[which(!vapply(FUN.VALUE = logical(1), frms, is.null))]], error = function(e) NULL)
   if (is.data.frame(vars_df)) {
-    return(structure(vars_df, type = source))
+    out <- structure(vars_df, type = source)
+    pkg_env$get_current_data.call <- unique_call_id(entire_session = FALSE)
+    pkg_env$get_current_data.out <- out
+    return(out)
   }
   
   # nothing worked, so:

R/ab_class_selectors.R

@@ -228,16 +228,9 @@ ab_selector <- function(ab_class,
     return(NULL)
   }
   
+  # to improve speed, get_current_data() and get_column_abx() only run once when e.g. in a select or group call
   vars_df <- get_current_data(arg_name = NA, call = -3)
-
-  # improve speed here so it will only run once when e.g. in one select call
-  if (!identical(pkg_env$ab_selector, unique_call_id())) {
-    ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
-    pkg_env$ab_selector <- unique_call_id()
-    pkg_env$ab_selector_cols <- ab_in_data
-  } else {
-    ab_in_data <- pkg_env$ab_selector_cols
-  }
+  ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
   
   if (length(ab_in_data) == 0) {
     message_("No antimicrobial agents found.")

R/atc_online.R

@@ -64,14 +64,16 @@
 #' @inheritSection AMR Read more on Our Website!
 #' @source <https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
 #' @examples
-#' \dontrun{
-#' # oral DDD (Defined Daily Dose) of amoxicillin
-#' atc_online_property("J01CA04", "DDD", "O")
+#' \donttest{
+#' if (requireNamespace("curl") && requireNamespace("rvest") && requireNamespace("xml2")) { 
+#'   # oral DDD (Defined Daily Dose) of amoxicillin
+#'   atc_online_property("J01CA04", "DDD", "O")
 #' 
-#' # parenteral DDD (Defined Daily Dose) of amoxicillin
-#' atc_online_property("J01CA04", "DDD", "P")
+#'   # parenteral DDD (Defined Daily Dose) of amoxicillin
+#'   atc_online_property("J01CA04", "DDD", "P")
 #'
-#' atc_online_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
+#'   atc_online_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
+#' }
 #' }
 atc_online_property <- function(atc_code,
                                 property,

R/guess_ab_col.R

@@ -104,6 +104,12 @@ get_column_abx <- function(x,
                            only_rsi_columns = FALSE,
                            sort = TRUE,
                            ...) {
+  
+  # check if retrieved before, then get it from package environment
+  if (identical(unique_call_id(entire_session = FALSE), pkg_env$get_column_abx.call)) {
+    return(pkg_env$get_column_abx.out)
+  }
+  
   meet_criteria(x, allow_class = "data.frame")
   meet_criteria(soft_dependencies, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(hard_dependencies, allow_class = "character", allow_NULL = TRUE)
@@ -184,6 +190,8 @@ get_column_abx <- function(x,
     if (info == TRUE) {
       message_("No columns found.")
     }
+    pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE)
+    pkg_env$get_column_abx.out <- x
     return(x)
   }
   
@@ -239,6 +247,9 @@ get_column_abx <- function(x,
                missing_msg)
     }
   }
+  
+  pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE)
+  pkg_env$get_column_abx.out <- x
   x
 }