(v1.0.1.9006) added generic CLSI rules

R/ab.R

@@ -253,7 +253,7 @@ as.ab <- function(x, ...) {
         next
       }
     }
-    
+
     if (!isFALSE(list(...)$initial_search)) {
       # transform back from other languages and try again
       x_translated <- paste(lapply(strsplit(x[i], "[^a-zA-Z0-9 ]"),
@@ -294,6 +294,15 @@ as.ab <- function(x, ...) {
       }
     }
     
+    # try by removing all trailing capitals
+    if (x[i] %like_case% "[a-z]+[A-Z]+$") {
+      found <- suppressWarnings(as.ab(gsub("[A-Z]+$", "", x[i])))
+      if (length(found) > 0 & !is.na(found)) {
+        x_new[i] <- found[1L]
+        next
+      }
+    }
+    
     # not found
     x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
   }

R/like.R

@@ -21,7 +21,7 @@
 
 #' Pattern Matching
 #'
-#' Convenient wrapper around [base::grep()] to match a pattern: `a %like% b`. It always returns a [`logical`] vector and is always case-insensitive (use `a %like_case% b` for case-sensitive matching). Also, `pattern` (*b*) can be as long as `x` (*a*) to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
+#' Convenient wrapper around [grep()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
 #' @inheritSection lifecycle Stable lifecycle
 #' @param x a character vector where matches are sought, or an object which can be coerced by [as.character()] to a character vector.
 #' @param pattern a character string containing a regular expression (or [`character`] string for `fixed = TRUE`) to be matched in the given character vector. Coerced by [as.character()] to a character string if possible.  If a [`character`] vector of length 2 or more is supplied, the first element is used with a warning.
@@ -30,7 +30,9 @@
 #' @name like
 #' @rdname like
 #' @export
-#' @details Using RStudio? This function can also be inserted from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
+#' @details When running a regular expression fails, these functions try again with `base::grepl(..., perl = TRUE)`.
+#' 
+#' Using RStudio? This function can also be inserted from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
 #' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R), but made it case insensitive at default and let it support multiple patterns. Also, if the regex fails the first time, it tries again with `perl = TRUE`.
 #' @seealso [base::grep()]
 #' @inheritSection AMR Read more on our website!
@@ -52,7 +54,7 @@
 #' # get frequencies of bacteria whose name start with 'Ent' or 'ent'
 #' library(dplyr)
 #' example_isolates %>%
-#'   filter(mo_name(mo) %like% '^ent') %>%
+#'   filter(mo_name(mo) %like% "^ent") %>%
 #'   freq(mo_genus(mo))
 like <- function(x, pattern, ignore.case = TRUE) {
   if (length(pattern) > 1) {
@@ -89,7 +91,7 @@ like <- function(x, pattern, ignore.case = TRUE) {
              error = function(e) ifelse(grepl("Invalid regexp", e$message),
                                         # try with perl = TRUE:
                                         return(base::grepl(pattern = pattern, x = x,
-                                                                 ignore.case = ignore.case, perl = TRUE)),
+                                                           ignore.case = ignore.case, perl = TRUE)),
                                         # stop otherwise
                                         stop(e$message)))
   }

R/mic.R

@@ -294,6 +294,6 @@ pillar_shaft.mic <- function(x, ...) {
 #' @noRd
 c.mic <- function(x, ...) {
   y <- NextMethod()
-  attributes(y) <- attributes(i)
+  attributes(y) <- attributes(x)
   y
 }

R/mo.R

@@ -1745,9 +1745,13 @@ pillar_shaft.mo <- function(x, ...) {
   # markup NA and UNKNOWN
   out[is.na(x)] <- pillar::style_na("  NA")
   out[x == "UNKNOWN"] <- pillar::style_na("  UNKNOWN")
-  
+
   # make it always fit exactly
-  pillar::new_pillar_shaft_simple(out, align = "left", width = max(nchar(x)))
+  pillar::new_pillar_shaft_simple(out,
+                                  align = "left", 
+                                  width = max(nchar(x)) + ifelse(length(x[x %in% c(NA, "UNKNOWN")]) > 0, 
+                                                                 2,
+                                                                 0))
 }
 
 #' @exportMethod summary.mo
@@ -1961,7 +1965,7 @@ load_mo_failures_uncertainties_renamed <- function(metadata) {
 levenshtein_fraction <- function(input, output) {
   levenshtein <- double(length = length(input))
   for (i in seq_len(length(input))) {
-    # determine levenshtein distance, but maximise to nchar of output
+    # determine Levenshtein distance, but maximise to nchar of output
     levenshtein[i] <- base::min(base::as.double(adist(input[i], output[i], ignore.case = TRUE)),
                                 base::nchar(output[i]))
   }
@@ -1975,8 +1979,10 @@ trimws2 <- function(x) {
 
 parse_encoding <- function(x) {
   tryCatch({
+    x <- unname(unlist(x))
     parsed <- iconv(x, to = "UTF-8")
     parsed[is.na(parsed) & !is.na(x)] <- iconv(x[is.na(parsed) & !is.na(x)], from = "Latin1", to = "ASCII//TRANSLIT")
-    gsub('"', "", parsed, fixed = TRUE)
-  }, error = function(e) stop(e$message, call. = FALSE))
+    parsed <- gsub('"', "", parsed, fixed = TRUE)
+  }, error = function(e) stop(e$message, call. = FALSE)) # this will also be thrown when running `as.mo(no_existing_object)`
+  parsed
 }