(v1.2.0.9016) fix in rsi_calc()

R/aa_helper_functions.R

@@ -202,33 +202,33 @@ import_fn <- function(name, pkg) {
 }
 
 stop_if <- function(expr, ..., call = TRUE) {
-  msg <- paste0(c(...), collapse = "")
-  if (!isFALSE(call)) {
-    if (isTRUE(call)) {
-      call <- as.character(sys.call(-1)[1])
-    } else {
-      # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi()
-      call <- as.character(sys.call(call)[1])
-    }
-    msg <- paste0("in ", call, "(): ", msg)
-  }
   if (isTRUE(expr)) {
+    msg <- paste0(c(...), collapse = "")
+    if (!isFALSE(call)) {
+      if (isTRUE(call)) {
+        call <- as.character(sys.call(-1)[1])
+      } else {
+        # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi()
+        call <- as.character(sys.call(call)[1])
+      }
+      msg <- paste0("in ", call, "(): ", msg)
+    }
     stop(msg, call. = FALSE)
   }
 }
 
 stop_ifnot <- function(expr, ..., call = TRUE) {
-  msg <- paste0(c(...), collapse = "")
-  if (!isFALSE(call)) {
-    if (isTRUE(call)) {
-      call <- as.character(sys.call(-1)[1])
-    } else {
-      # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi()
-      call <- as.character(sys.call(call)[1])
-    }
-    msg <- paste0("in ", call, "(): ", msg)
-  }
   if (!isTRUE(expr)) {
+    msg <- paste0(c(...), collapse = "")
+    if (!isFALSE(call)) {
+      if (isTRUE(call)) {
+        call <- as.character(sys.call(-1)[1])
+      } else {
+        # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi()
+        call <- as.character(sys.call(call)[1])
+      }
+      msg <- paste0("in ", call, "(): ", msg)
+    }
     stop(msg, call. = FALSE)
   }
 }

R/ab.R

@@ -209,7 +209,7 @@ as.ab <- function(x, ...) {
       # correct for digital reading text (OCR)
       x_spelling <- gsub("[NRD]", "[NRD]", x_spelling)
     }
-    
+
     # try if name starts with it
     found <- antibiotics[which(antibiotics$name %like% paste0("^", x_spelling)), ]$ab
     if (length(found) > 0) {

R/ab_from_text.R

@@ -58,12 +58,17 @@ ab_from_text <- function(text, collapse = NULL, translate_ab = "name", ...) {
   }
   
   text_split <- unlist(strsplit(text, "[ ;.,:/\\|-]"))
-  result <- as.ab(unique(c(text_split[grep(to_regex(abbr), text_split)],
-                           text_split[grep(to_regex(names), text_split)],
-                           # regular expression must not be too long, so split synonyms in two:
-                           text_split[grep(to_regex(synonyms[c(1:0.5 * length(synonyms))]), text_split)],
-                           text_split[grep(to_regex(synonyms[c(0.5 * length(synonyms):length(synonyms))]), text_split)])),
-                  ...)
+  result <- suppressWarnings(
+    as.ab(unique(c(text_split[grep(to_regex(abbr), text_split)],
+                   text_split[grep(to_regex(names), text_split)],
+                   # regular expression must not be too long, so split synonyms in two:
+                   text_split[grep(to_regex(synonyms[c(1:0.5 * length(synonyms))]), text_split)],
+                   text_split[grep(to_regex(synonyms[c(0.5 * length(synonyms):length(synonyms))]), text_split)])),
+          ...))
+  result <- result[!is.na(result)]
+  if (length(result) == 0) {
+    result <- as.ab(NA)
+  }
   translate_ab <- get_translate_ab(translate_ab)
   if (!isFALSE(translate_ab)) {
     result <- ab_property(result, property = translate_ab)

R/mic.R

@@ -130,7 +130,8 @@ as.mic <- function(x, na.rm = FALSE) {
 }
 
 all_valid_mics <- function(x) {
-  x_mic <- suppressWarnings(as.mic(x[!is.na(x)]))
+  x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
+                    error = function(e) NA)
   !any(is.na(x_mic)) & !all(is.na(x))
 }
 

R/rsi.R

@@ -166,10 +166,10 @@ as.rsi.default <- function(x, ...) {
       }
     }
     
-    x <- x %>% unlist()
+    x <- as.character(unlist(x))
     x.bak <- x
     
-    na_before <- x[is.na(x) | x == ""] %>% length()
+    na_before <- length(x[is.na(x) | x == ""])
     # remove all spaces
     x <- gsub(" +", "", x)
     # remove all MIC-like values: numbers, operators and periods
@@ -188,7 +188,7 @@ as.rsi.default <- function(x, ...) {
     x <- gsub("^I+$", "I", x)
     x <- gsub("^R+$", "R", x)
     x[!x %in% c("S", "I", "R")] <- NA
-    na_after <- x[is.na(x) | x == ""] %>% length()
+    na_after <- length(x[is.na(x) | x == ""])
     
     if (!isFALSE(list(...)$warn)) { # so as.rsi(..., warn = FALSE) will never throw a warning
       if (na_before != na_after) {

R/rsi_calc.R

@@ -48,18 +48,23 @@ rsi_calc <- function(...,
           "Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.", call = -2)
   ndots <- length(dots)
   
-  if ("data.frame" %in% class(dots_df)) {
+  if (is.data.frame(dots_df)) {
     # data.frame passed with other columns, like: example_isolates %>% proportion_S(AMC, GEN)
     dots <- as.character(dots)
-    dots <- dots[dots != "."]
+    # remove first element, it's the data.frame
+    if (length(dots) == 1) {
+      dots <- character(0)
+    } else {
+      dots <- dots[2:length(dots)]
+    }
     if (length(dots) == 0 | all(dots == "df")) {
       # for complete data.frames, like example_isolates %>% select(AMC, GEN) %>% proportion_S()
       # and the old rsi function, which has "df" as name of the first parameter
       x <- dots_df
-    } else if (length(dots) == 1 | all(!dots %in% colnames(dots_df))) {
-      x <- dots_df
     } else {
-      x <- dots_df[, dots[dots %in% colnames(dots_df)], drop = FALSE]
+      dots_not_exist <- dots[!dots %in% colnames(dots_df)]
+      stop_if(length(dots_not_exist) > 0, "column(s) not found: ", paste0("'", dots_not_exist, "'", collapse = ", "), call = -2)
+      x <- dots_df[, dots, drop = FALSE]
     }
   } else if (ndots == 1) {
     # only 1 variable passed (can also be data.frame), like: proportion_S(example_isolates$AMC) and example_isolates$AMC %>% proportion_S()