P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 02:03:04 +02:00
Code Releases Activity

(v1.6.0.9008) unlike, bugfix for col_mo naming

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-04-23 09:59:36 +02:00
parent c6289c3fc3
commit 70b803dbb6
33 changed files with 269 additions and 137 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
R/aa_helper_functions.R
View File

@ -71,7 +71,49 @@ addin_insert_in <- function() {
# No export, no Rd
addin_insert_like <- function() {
import_fn("insertText", "rstudioapi")(" %like% ")
# we want Shift + Ctrl/Cmd + L to iterate over %like%, %unlike%, %like_case%, and %unlike_case%
getActiveDocumentContext <- import_fn("getActiveDocumentContext", "rstudioapi")
insertText <- import_fn("insertText", "rstudioapi")
modifyRange <- import_fn("modifyRange", "rstudioapi")
document_range <- import_fn("document_range", "rstudioapi")
document_position <- import_fn("document_position", "rstudioapi")
context <- getActiveDocumentContext()
current_row <- context$selection[[1]]$range$end[1]
current_col <- context$selection[[1]]$range$end[2]
current_row_txt <- context$contents[current_row]
if (is.null(current_row) || current_row_txt %unlike% "%(un)?like") {
insertText(" %like% ")
return(invisible())
}
pos_preceded_by <- function(txt) {
if (tryCatch(substr(current_row_txt, current_col - nchar(trimws(txt, which = "right")), current_col) == trimws(txt, which = "right"),
error = function(e) FALSE)) {
return(TRUE)
}
tryCatch(substr(current_row_txt, current_col - nchar(txt), current_col) %like% paste0("^", txt),
error = function(e) FALSE)
}
replace_pos <- function(old, with) {
modifyRange(document_range(document_position(current_row, current_col - nchar(old)),
document_position(current_row, current_col)),
text = with,
id = context$id)
}
if (pos_preceded_by(" %like% ")) {
replace_pos(" %like% ", with = " %unlike% ")
} else if (pos_preceded_by(" %unlike% ")) {
replace_pos(" %unlike% ", with = " %like_case% ")
} else if (pos_preceded_by(" %like_case% ")) {
replace_pos(" %like_case% ", with = " %unlike_case% ")
} else if (pos_preceded_by(" %unlike_case% ")) {
replace_pos(" %unlike_case% ", with = " %like% ")
} else {
insertText(" %like% ")
}
}
check_dataset_integrity <- function() {
@ -234,8 +276,8 @@ stop_ifnot_installed <- function(package) {
vapply(FUN.VALUE = character(1), package, function(pkg)
tryCatch(get(".packageName", envir = asNamespace(pkg)),
error = function(e) {
if (package == "rstudioapi") {
stop("This function only works in RStudio.", call. = FALSE)
if (pkg == "rstudioapi") {
stop("This function only works in RStudio when using R >= 3.2.", call. = FALSE)
} else if (pkg != "base") {
stop("This requires the '", pkg, "' package.",
"\nTry to install it with: install.packages(\"", pkg, "\")",
@ -652,7 +694,7 @@ get_current_data <- function(arg_name, call) {
return(out)
}
}
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2) {
# R-3.0 and R-3.1 do not have an `x` element in the call stack, rendering this function useless
if (is.na(arg_name)) {
@ -660,6 +702,7 @@ get_current_data <- function(arg_name, call) {
warning_("this function can only be used in R >= 3.2", call = call)
return(data.frame())
} else {
# mimic a default R error, e.g. for example_isolates[which(mo_name() %like% "^ent"), ]
stop_("argument `", arg_name, "` is missing with no default", call = call)
}
}
@ -669,12 +712,17 @@ get_current_data <- function(arg_name, call) {
frms <- lapply(sys.frames(), function(el) {
if (not_set == TRUE && ".Generic" %in% names(el)) {
if (tryCatch(".data" %in% names(el) && is.data.frame(el$`.data`), error = function(e) FALSE)) {
# dplyr? - an element `.data` will be in the system call stack
# will be used in dplyr::select() (but not in dplyr::filter(), dplyr::mutate() or dplyr::summarise())
# - - - -
# dplyr
# - - - -
# an element `.data` will be in the system call stack when using dplyr::select()
# [but not when using dplyr::filter(), dplyr::mutate() or dplyr::summarise()]
not_set <<- FALSE
el$`.data`
} else if (tryCatch(any(c("x", "xx") %in% names(el)), error = function(e) FALSE)) {
# otherwise try base R:
# - - - -
# base R
# - - - -
# an element `x` will be in this environment for only cols, e.g. `example_isolates[, carbapenems()]`
# an element `xx` will be in this environment for rows + cols, e.g. `example_isolates[c(1:3), carbapenems()]`
if (tryCatch(is.data.frame(el$xx), error = function(e) FALSE)) {
@ -694,6 +742,7 @@ 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(vars_df)
@ -1157,6 +1206,7 @@ lengths <- function(x, use.names = TRUE) {
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.1) {
# R-3.0 does not contain these functions, set them here to prevent installation failure
# (required for extension of the <mic> class)
cospi <- function(...) 1
sinpi <- function(...) 1
tanpi <- function(...) 1

2
R/ab.R
View File

@ -389,7 +389,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# first 5 except for cephalosporins, then first 7 (those cephalosporins all start quite the same!)
found <- suppressWarnings(as.ab(substr(x[i], 1, 5), initial_search = FALSE))
if (!is.na(found) && !ab_group(found, initial_search = FALSE) %like% "cephalosporins") {
if (!is.na(found) && ab_group(found, initial_search = FALSE) %unlike% "cephalosporins") {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}

32
R/eucast_rules.R
View File

@ -190,7 +190,7 @@ eucast_rules <- function(x,
}
x_deparsed <- deparse(substitute(x))
if (length(x_deparsed) > 1 || !all(x_deparsed %like% "[a-z]+")) {
if (length(x_deparsed) > 1 || any(x_deparsed %unlike% "[a-z]+")) {
x_deparsed <- "your_data"
}
@ -225,8 +225,6 @@ eucast_rules <- function(x,
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
stop_if(is.null(col_mo), "`col_mo` must be set")
} else {
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
decimal.mark <- getOption("OutDec")
@ -420,8 +418,11 @@ eucast_rules <- function(x,
pm_distinct(`.rowid`, .keep_all = TRUE) %pm>%
as.data.frame(stringsAsFactors = FALSE)
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
x <- x %pm>%
left_join_microorganisms(by = col_mo, suffix = c("_oldcols", ""))
# rename col_mo to prevent interference with joined columns
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
col_mo <- ".col_mo"
# join to microorganisms data set
x <- left_join_microorganisms(x, by = col_mo, suffix = c("_oldcols", ""))
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
x$genus_species <- paste(x$genus, x$species)
if (info == TRUE & NROW(x) > 10000) {
@ -480,7 +481,6 @@ eucast_rules <- function(x,
extra_indent = 6))
}
run_changes <- edit_rsi(x = x,
col_mo = col_mo,
to = "R",
rule = c(rule_current, "Other rules", "",
paste0("Non-EUCAST: AMR package v", utils::packageDescription("AMR")$Version)),
@ -515,7 +515,6 @@ eucast_rules <- function(x,
extra_indent = 6))
}
run_changes <- edit_rsi(x = x,
col_mo = col_mo,
to = "S",
rule = c(rule_current, "Other rules", "",
paste0("Non-EUCAST: AMR package v", utils::packageDescription("AMR")$Version)),
@ -569,19 +568,19 @@ eucast_rules <- function(x,
# filter on user-set guideline versions ----
if (any(c("all", "breakpoints") %in% rules)) {
eucast_rules_df <- subset(eucast_rules_df,
!reference.rule_group %like% "breakpoint" |
reference.rule_group %unlike% "breakpoint" |
(reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints))
}
if (any(c("all", "expert") %in% rules)) {
eucast_rules_df <- subset(eucast_rules_df,
!reference.rule_group %like% "expert" |
reference.rule_group %unlike% "expert" |
(reference.rule_group %like% "expert" & reference.version == version_expertrules))
}
# filter out AmpC de-repressed cephalosporin-resistant mutants ----
# cefotaxime, ceftriaxone, ceftazidime
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
eucast_rules_df <- subset(eucast_rules_df,
!reference.rule %like% "ampc")
reference.rule %unlike% "ampc")
} else {
if (isTRUE(ampc_cephalosporin_resistance)) {
ampc_cephalosporin_resistance <- "R"
@ -627,7 +626,7 @@ eucast_rules <- function(x,
if (info == TRUE) {
# Print EUCAST intro ------------------------------------------------------
if (!rule_group_current %like% "other" & eucast_notification_shown == FALSE) {
if (rule_group_current %unlike% "other" & eucast_notification_shown == FALSE) {
cat(
paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n",
word_wrap("Rules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)")), "\n",
@ -750,7 +749,6 @@ eucast_rules <- function(x,
# Apply rule on data ------------------------------------------------------
# this will return the unique number of changes
run_changes <- edit_rsi(x = x,
col_mo = col_mo,
to = target_value,
rule = c(rule_text, rule_group_current, rule_current,
ifelse(rule_group_current %like% "breakpoint",
@ -803,7 +801,6 @@ eucast_rules <- function(x,
warned <- FALSE
}
run_changes <- edit_rsi(x = x,
col_mo = col_mo,
to = target_value,
rule = c(rule_text,
"Custom EUCAST rules",
@ -949,13 +946,12 @@ eucast_rules <- function(x,
}
# helper function for editing the table ----
edit_rsi <- function(x,
col_mo,
to,
rule,
edit_rsi <- function(x,
to,
rule,
rows,
cols,
last_verbose_info,
last_verbose_info,
original_data,
warned,
info,

2
R/filter_ab_class.R
View File

@ -425,7 +425,7 @@ find_ab_group <- function(ab_class) {
find_ab_names <- function(ab_group, n = 3) {
ab_group <- gsub("[^a-zA-Z0-9]", ".*", ab_group)
drugs <- antibiotics[which(antibiotics$group %like% ab_group & !antibiotics$ab %like% "[0-9]$"), ]$name
drugs <- antibiotics[which(antibiotics$group %like% ab_group & antibiotics$ab %unlike% "[0-9]$"), ]$name
paste0(sort(ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
tolower = TRUE, language = NULL)),
collapse = ", ")

4
R/first_isolate.R
View File

@ -497,10 +497,10 @@ first_isolate <- function(x = NULL,
n_found <- sum(x$newvar_first_isolate, na.rm = TRUE)
p_found_total <- percentage(n_found / nrow(x[which(!is.na(x$newvar_mo)), , drop = FALSE]), digits = 1)
p_found_scope <- percentage(n_found / scope.size, digits = 1)
if (!p_found_total %like% "[.]") {
if (p_found_total %unlike% "[.]") {
p_found_total <- gsub("%", ".0%", p_found_total, fixed = TRUE)
}
if (!p_found_scope %like% "[.]") {
if (p_found_scope %unlike% "[.]") {
p_found_scope <- gsub("%", ".0%", p_found_scope, fixed = TRUE)
}
# mark up number of found

2
R/join_microorganisms.R
View File

@ -279,7 +279,7 @@ check_groups_before_join <- function(x, fn) {
if (is.data.frame(x) && !is.null(attributes(x)$groups)) {
x <- pm_ungroup(x)
attr(x, "groups") <- NULL
class(x) <- class(x)[!class(x) %like% "group"]
class(x) <- class(x)[class(x) %unlike% "group"]
warning_("Groups are dropped, since the ", fn, "() function relies on merge() from base R.", call = FALSE)
}
x

4
R/key_antibiotics.R
View File

@ -136,7 +136,7 @@ key_antibiotics <- function(x = NULL,
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x))
meet_criteria(universal_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
@ -173,8 +173,6 @@ key_antibiotics <- function(x = NULL,
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
} else {
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
if (is.null(col_mo)) {
warning_("No column found for `col_mo`, ignoring antimicrobial agents set for Gram-negative and Gram-positive bacteria", call = FALSE)

29
R/like.R
View File

@ -35,13 +35,13 @@
#' @rdname like
#' @export
#' @details
#' These [like()] and `%like%` functions:
#' * Are case-insensitive (use `%like_case%` for case-sensitive matching)
#' These [like()] and `%like%`/`%unlike%` functions:
#' * Are case-insensitive (use `%like_case%`/`%unlike_case%` for case-sensitive matching)
#' * Support multiple patterns
#' * Check if `pattern` is a valid regular expression and sets `fixed = TRUE` if not, to greatly improve speed (vectorised over `pattern`)
#' * Always use compatibility with Perl unless `fixed = TRUE`, to greatly improve speed
#'
#' Using RStudio? The text `%like%` can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
#' Using RStudio? The `%like%`/`%unlike%` functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like `Shift+Ctrl+L` or `Shift+Cmd+L` (see menu `Tools` > `Modify Keyboard Shortcuts...`). If you keep pressing your shortcut, the inserted text will be iterated over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%`.
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R), although altered as explained in *Details*.
#' @seealso [grepl()]
#' @inheritSection AMR Read more on Our Website!
@ -58,18 +58,25 @@
#' b <- c( "case", "diff", "yet")
#' a %like% b
#' #> TRUE TRUE TRUE
#' a %unlike% b
#' #> FALSE FALSE FALSE
#'
#' a[1] %like% b
#' #> TRUE FALSE FALSE
#' a %like% b[1]
#' #> TRUE FALSE FALSE
#'
#' # get isolates whose name start with 'Ent' or 'ent'
#' example_isolates[which(mo_name(example_isolates$mo) %like% "^ent"), ]
#' \donttest{
#' # faster way, only works in R 3.2 and later:
#' example_isolates[which(mo_name() %like% "^ent"), ]
#'
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo_name() %like% "^ent")
#' }
#' }
like <- function(x, pattern, ignore.case = TRUE) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
@ -122,6 +129,14 @@ like <- function(x, pattern, ignore.case = TRUE) {
like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%unlike%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
!like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%like_case%" <- function(x, pattern) {
@ -129,3 +144,11 @@ like <- function(x, pattern, ignore.case = TRUE) {
meet_criteria(pattern, allow_NA = FALSE)
like(x, pattern, ignore.case = FALSE)
}
#' @rdname like
#' @export
"%unlike_case%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
!like(x, pattern, ignore.case = FALSE)
}

26
R/mdro.R
View File

@ -311,7 +311,6 @@ mdro <- function(x = NULL,
col_mo <- "mo"
}
stop_if(is.null(col_mo), "`col_mo` must be set")
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
if (guideline$code == "cmi2012") {
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
@ -761,7 +760,11 @@ mdro <- function(x = NULL,
row_filter <- x[which(row_filter), "row_number", drop = TRUE]
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
x[rows, "reason"] <<- paste0(any_all, " of the required antibiotics ", ifelse(any_all == "any", "is", "are"), " R")
x[rows, "reason"] <<- paste0(any_all,
" of the required antibiotics ",
ifelse(any_all == "any", "is", "are"),
" R",
ifelse(!isTRUE(combine_SI), " or I", ""))
}
}
trans_tbl2 <- function(txt, rows, lst) {
@ -814,6 +817,9 @@ mdro <- function(x = NULL,
}
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
# rename col_mo to prevent interference with joined columns
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
col_mo <- ".col_mo"
# join to microorganisms data set
x <- left_join_microorganisms(x, by = col_mo)
x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_)
@ -1027,7 +1033,10 @@ mdro <- function(x = NULL,
# PDR (=4): all agents are R
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
if (verbose == TRUE) {
x[which(x$MDRO == 4), "reason"] <- paste("all antibiotics in all", x$classes_in_guideline[which(x$MDRO == 4)], "classes were tested R or I")
x[which(x$MDRO == 4), "reason"] <- paste("all antibiotics in all",
x$classes_in_guideline[which(x$MDRO == 4)],
"classes were tested R",
ifelse(!isTRUE(combine_SI), " or I", ""))
}
# not enough classes available
@ -1390,7 +1399,12 @@ mdro <- function(x = NULL,
# some more info on negative results
if (verbose == TRUE) {
if (guideline$code == "cmi2012") {
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))],
" of ",
x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))],
" available classes contain R",
ifelse(!isTRUE(combine_SI), " or I", ""),
" (3 required for MDR)")
} else {
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
}
@ -1431,8 +1445,10 @@ mdro <- function(x = NULL,
}
if (verbose == TRUE) {
colnames(x)[colnames(x) == col_mo] <- "microorganism"
x$microorganism <- mo_name(x$microorganism, language = NULL)
x[, c("row_number",
col_mo,
"microorganism",
"MDRO",
"reason",
"columns_nonsusceptible"),

2
R/mic.R
View File

@ -133,7 +133,7 @@ as.mic <- function(x, na.rm = FALSE) {
# keep only one zero before dot
x <- gsub("0+[.]", "0.", x, perl = TRUE)
# starting 00 is probably 0.0 if there's no dot yet
x[!x %like% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
x[x %unlike% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
# remove last zeroes
x <- gsub("([.].?)0+$", "\\1", x, perl = TRUE)
x <- gsub("(.*[.])0+$", "\\10", x, perl = TRUE)

12
R/mo.R
View File

@ -708,7 +708,7 @@ exec_as.mo <- function(x,
# check for very small input, but ignore the O antigens of E. coli
if (nchar(gsub("[^a-zA-Z]", "", x_trimmed[i])) < 3
& !toupper(x_backup_without_spp[i]) %like_case% "O?(26|103|104|104|111|121|145|157)") {
& toupper(x_backup_without_spp[i]) %unlike_case% "O?(26|103|104|104|111|121|145|157)") {
# fewer than 3 chars and not looked for species, add as failure
x[i] <- lookup(mo == "UNKNOWN")
if (initial_search == TRUE) {
@ -860,7 +860,7 @@ exec_as.mo <- function(x,
x[i] <- lookup(genus == "Salmonella", uncertainty = -1)
next
} else if (x_backup[i] %like_case% "[sS]almonella [A-Z][a-z]+ ?.*" &
!x_backup[i] %like% "t[iy](ph|f)[iy]") {
x_backup[i] %unlike% "t[iy](ph|f)[iy]") {
# Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica
# except for S. typhi, S. paratyphi, S. typhimurium
x[i] <- lookup(fullname == "Salmonella enterica", uncertainty = -1)
@ -916,7 +916,7 @@ exec_as.mo <- function(x,
# FIRST TRY FULLNAMES AND CODES ----
# if only genus is available, return only genus
if (all(!c(x[i], b.x_trimmed) %like_case% " ")) {
if (all(c(x[i], b.x_trimmed) %unlike_case% " ")) {
found <- lookup(fullname_lower %in% c(h.x_species, i.x_trimmed_species),
haystack = data_to_check)
if (!is.na(found)) {
@ -1123,8 +1123,8 @@ exec_as.mo <- function(x,
if (isTRUE(debug)) {
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (3) look for genus only, part of name\n"))
}
if (nchar(g.x_backup_without_spp) > 4 & !b.x_trimmed %like_case% " ") {
if (!b.x_trimmed %like_case% "^[A-Z][a-z]+") {
if (nchar(g.x_backup_without_spp) > 4 & b.x_trimmed %unlike_case% " ") {
if (b.x_trimmed %unlike_case% "^[A-Z][a-z]+") {
if (isTRUE(debug)) {
message("Running '", paste(b.x_trimmed, "species"), "'")
}
@ -1268,7 +1268,7 @@ exec_as.mo <- function(x,
stringsAsFactors = FALSE)
return(found)
}
if (b.x_trimmed %like_case% "(fungus|fungi)" & !b.x_trimmed %like_case% "fungiphrya") {
if (b.x_trimmed %like_case% "(fungus|fungi)" & b.x_trimmed %unlike_case% "fungiphrya") {
found <- "F_FUNGUS"
found_result <- found
found <- lookup(mo == found)

2
R/plot.R
View File

@ -688,7 +688,7 @@ plot_prepare_table <- function(x, expand) {
}
plot_name_of_I <- function(guideline) {
if (!guideline %like% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) {
if (guideline %unlike% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) {
# interpretation since 2019
"Incr. exposure"
} else {

6
R/rsi.R
View File

@ -265,7 +265,7 @@ as.rsi.default <- function(x, ...) {
} else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R"))) {
if (!any(x %like% "(R|S|I)", na.rm = TRUE)) {
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
# check if they are actually MICs or disks
if (all_valid_mics(x)) {
warning_("The input seems to be MIC values. Transform them with `as.mic()` before running `as.rsi()` to interpret them.")
@ -683,7 +683,7 @@ get_guideline <- function(guideline, reference_data) {
if (guideline_param %in% c("CLSI", "EUCAST")) {
guideline_param <- rev(sort(subset(reference_data, guideline %like% guideline_param)$guideline))[1L]
}
if (!guideline_param %like% " ") {
if (guideline_param %unlike% " ") {
# like 'EUCAST2020', should be 'EUCAST 2020'
guideline_param <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param, ignore.case = TRUE)
}
@ -776,7 +776,7 @@ exec_as.rsi <- function(method,
any_is_intrinsic_resistant <- any_is_intrinsic_resistant | is_intrinsic_r
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
if (!guideline_coerced %like% "EUCAST") {
if (guideline_coerced %unlike% "EUCAST") {
if (message_not_thrown_before("as.rsi2")) {
warning_("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call = FALSE)
remember_thrown_message("as.rsi2")