fixes2

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 1.8.2.9107
+Version: 1.8.2.9108
 Date: 2023-02-06
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.8.2.9107
+# AMR 1.8.2.9108
 
 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
 

R/aaa_helper_functions.R

@@ -1424,30 +1424,6 @@ case_when <- function(...) {
   out
 }
 
-# adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
-where <- function(fn) {
-  if (!is.function(fn)) {
-    stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
-  }
-  df <- pm_select_env$.data
-  cols <- pm_select_env$get_colnames()
-  if (is.null(df)) {
-    df <- get_current_data("where", call = FALSE)
-    cols <- colnames(df)
-  }
-  preds <- unlist(lapply(
-    df,
-    function(x, fn) {
-      do.call("fn", list(x))
-    },
-    fn
-  ))
-  if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
-  data_cols <- cols
-  cols <- data_cols[preds]
-  which(data_cols %in% cols)
-}
-
 
 # dplyr implementations ----
 
@@ -1478,6 +1454,7 @@ if (pkg_is_available("dplyr", also_load = FALSE)) {
   ungroup <- import_fn("ungroup", "dplyr", error_on_fail = FALSE)
   mutate <- import_fn("mutate", "dplyr", error_on_fail = FALSE)
   bind_rows <- import_fn("bind_rows", "dplyr", error_on_fail = FALSE)
+  where <- import_fn("where", "dplyr", error_on_fail = FALSE)
 } else {
   `%>%` <- `%pm>%`
   anti_join <- pm_anti_join
@@ -1523,6 +1500,29 @@ if (pkg_is_available("dplyr", also_load = FALSE)) {
     mat <- do.call(rbind, mat_list)
     as.data.frame(mat, stringsAsFactors = FALSE)
   }
+  where <- function(fn) {
+    # adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
+    if (!is.function(fn)) {
+      stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
+    }
+    df <- pm_select_env$.data
+    cols <- pm_select_env$get_colnames()
+    if (is.null(df)) {
+      df <- get_current_data("where", call = FALSE)
+      cols <- colnames(df)
+    }
+    preds <- unlist(lapply(
+      df,
+      function(x, fn) {
+        do.call("fn", list(x))
+      },
+      fn
+    ))
+    if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
+    data_cols <- cols
+    cols <- data_cols[preds]
+    which(data_cols %in% cols)
+  }
   
 }
 

R/ab_property.R

@@ -362,13 +362,13 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
   }
 
   if (is.data.frame(data)) {
-    if (tryCatch(length(list(...)) > 0, error = function(e) TRUE)) {
-      out <- tryCatch(suppressWarnings(unlist(list(...))), error = function(e) NULL)
-      if (!is.null(out)) {
-        df <- data[, out, drop = FALSE]
-      } else {
-        df <- select(data, ...)
-      }
+    if (tryCatch(length(c(...)) > 1, error = function(e) TRUE)) {
+      df <- tryCatch(suppressWarnings(select(data, ...)),
+                     error = function(e) {
+                       data[, c(...), drop = FALSE]
+                     })
+    } else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) {
+      df <- data[, c(...), drop = FALSE]
     } else {
       df <- data
     }

inst/tinytest/test-zzz.R

@@ -73,7 +73,8 @@ import_functions <- c(
   "semi_join" = "dplyr",
   "showQuestion" = "rstudioapi",
   "summarise" = "dplyr",
-  "ungroup" = "dplyr"
+  "ungroup" = "dplyr",
+  "where" = "dplyr"
 )
 
 # functions that are called directly with ::