diff --git a/DESCRIPTION b/DESCRIPTION index 964942bd..0c120676 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.6.0.9007 -Date: 2021-04-20 +Version: 1.6.0.9008 +Date: 2021-04-23 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 18ad201d..c8a9ade3 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -142,6 +142,8 @@ S3method(unique,mo) S3method(unique,rsi) export("%like%") export("%like_case%") +export("%unlike%") +export("%unlike_case%") export(ab_atc) export(ab_atc_group1) export(ab_atc_group2) diff --git a/NEWS.md b/NEWS.md index f73246ac..66557e7a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.6.0.9007 -## Last updated: 20 April 2021 +# AMR 1.6.0.9008 +## Last updated: 23 April 2021 ### New * Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()` @@ -13,9 +13,19 @@ * Fix for minor translation errors * Printing of microbial codes in a `data.frame` or `tibble` now gives a warning if the data contains old microbial codes (from a previous AMR package version) * `first_isolate()` can now take a vector of values for `col_keyantibiotics` and can have an episode length of `Inf` -* `like()` (and `%like%`) now checks if `pattern` is a *valid* regular expression +* Extended the `like()` functions: + * Now checks if `pattern` is a *valid* regular expression + * Added `%unlike%` and `%unlike_case%` (as negations of the existing `%like%` and `%like_case%`). This greatly improves readability: + ```r + if (!grepl("EUCAST", guideline)) ... + # same: + if (guideline %unlike% "EUCAST") ... + ``` + * Altered the RStudio addin, so it now iterates over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%` if you keep pressing your keyboard shortcut * Fixed an installation error on R-3.0 * Added `info` argument to `as.mo()` to turn on/off the progress bar +* Fixed a bug that `col_mo` for some functions (esp. `eucast_rules()` and `mdro()`) could not be column names of the `microorganisms` data set as it would throw an error + # AMR 1.6.0 diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index f261159b..b59b36fd 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -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 class) cospi <- function(...) 1 sinpi <- function(...) 1 tanpi <- function(...) 1 diff --git a/R/ab.R b/R/ab.R index 1f3d454a..82c81235 100755 --- a/R/ab.R +++ b/R/ab.R @@ -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 } diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 71fb800f..1b909701 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -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, diff --git a/R/filter_ab_class.R b/R/filter_ab_class.R index bfe39d38..ea5f3603 100644 --- a/R/filter_ab_class.R +++ b/R/filter_ab_class.R @@ -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 = ", ") diff --git a/R/first_isolate.R b/R/first_isolate.R index 5c106549..7cd2d500 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -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 diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index 4b570bd8..015e47bf 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -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 diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R index a390ffe0..89bb7a30 100755 --- a/R/key_antibiotics.R +++ b/R/key_antibiotics.R @@ -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) diff --git a/R/like.R b/R/like.R index d70a13f1..21651513 100755 --- a/R/like.R +++ b/R/like.R @@ -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) +} diff --git a/R/mdro.R b/R/mdro.R index 76f95bdb..729d2e1c 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -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"), diff --git a/R/mic.R b/R/mic.R index cca503bf..3dff87fb 100755 --- a/R/mic.R +++ b/R/mic.R @@ -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) diff --git a/R/mo.R b/R/mo.R index b36fb5ef..cf6c1272 100755 --- a/R/mo.R +++ b/R/mo.R @@ -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) diff --git a/R/plot.R b/R/plot.R index 43533edd..75940a66 100644 --- a/R/plot.R +++ b/R/plot.R @@ -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 { diff --git a/R/rsi.R b/R/rsi.R index b22ff8fa..f291ee23 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -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") diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index 3c9f865e..c5d908ac 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/read_EUCAST.R b/data-raw/read_EUCAST.R index d0a414dd..e2631349 100644 --- a/data-raw/read_EUCAST.R +++ b/data-raw/read_EUCAST.R @@ -136,8 +136,8 @@ read_EUCAST <- function(sheet, file, guideline_name) { disk_R = ifelse(has_zone_diameters, G, NA_character_)) %>% filter(!is.na(drug), !(is.na(MIC_S) & is.na(MIC_R) & is.na(disk_S) & is.na(disk_R)), - !MIC_S %like% "(MIC|S ≤|note)", - !MIC_S %like% "^[-]", + MIC_S %unlike% "(MIC|S ≤|note)", + MIC_S %unlike% "^[-]", drug != MIC_S,) %>% mutate(administration = case_when(drug %like% "[( ]oral" ~ "oral", drug %like% "[( ]iv" ~ "iv", diff --git a/data-raw/reproduction_of_antibiotics.R b/data-raw/reproduction_of_antibiotics.R index 1e4f00c1..3931ddb9 100644 --- a/data-raw/reproduction_of_antibiotics.R +++ b/data-raw/reproduction_of_antibiotics.R @@ -114,8 +114,8 @@ abx_atc2 <- ab_old %>% filter(!atc %in% abx_atc1$atc, is.na(ears_net), !is.na(atc_group1), - !atc_group1 %like% ("virus|vaccin|viral|immun"), - !official %like% "(combinations| with )") %>% + atc_group1 %unlike% ("virus|vaccin|viral|immun"), + official %unlike% "(combinations| with )") %>% mutate(ab = NA_character_) %>% as.data.frame(stringsAsFactors = FALSE) %>% select(ab, atc, name = official) diff --git a/data-raw/reproduction_of_microorganisms.R b/data-raw/reproduction_of_microorganisms.R index 977fce7f..73eec453 100644 --- a/data-raw/reproduction_of_microorganisms.R +++ b/data-raw/reproduction_of_microorganisms.R @@ -382,7 +382,7 @@ MOs <- MOs %>% # what characters are in the fullnames? table(sort(unlist(strsplit(x = paste(MOs$fullname, collapse = ""), split = "")))) -MOs %>% filter(!fullname %like% "^[a-z ]+$") %>% arrange(fullname) %>% View() +MOs %>% filter(fullname %unlike% "^[a-z ]+$") %>% arrange(fullname) %>% View() table(MOs$kingdom, MOs$rank) table(AMR::microorganisms$kingdom, AMR::microorganisms$rank) diff --git a/data-raw/reproduction_of_poorman.R b/data-raw/reproduction_of_poorman.R index 13d49b3e..978bd795 100644 --- a/data-raw/reproduction_of_poorman.R +++ b/data-raw/reproduction_of_poorman.R @@ -9,9 +9,9 @@ files <- xml2::read_html(paste0("https://github.com/nathaneastwood/poorman/tree/ # get full URLs of all raw R files files <- sort(paste0("https://raw.githubusercontent.com", gsub("blob/", "", files[files %like% "/R/.*.R$"]))) # remove files with only pkg specific code -files <- files[!files %like% "(zzz|init)[.]R$"] +files <- files[files %unlike% "(zzz|init)[.]R$"] # also, there's a lot of functions we don't use -files <- files[!files %like% "(slice|glimpse|recode|replace_na|coalesce)[.]R$"] +files <- files[files %unlike% "(slice|glimpse|recode|replace_na|coalesce)[.]R$"] # add our prepend file, containing info about the source of the data intro <- readLines("data-raw/poorman_prepend.R") diff --git a/docs/404.html b/docs/404.html index 162642f5..417534c7 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index db6fcf6c..8ab704f1 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 diff --git a/docs/articles/index.html b/docs/articles/index.html index 182bff7d..36000237 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 diff --git a/docs/authors.html b/docs/authors.html index 2faf7b0d..a765239d 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 diff --git a/docs/index.html b/docs/index.html index d57ebb31..ea587c7e 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 diff --git a/docs/news/index.html b/docs/news/index.html index 802e366c..7333015f 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.6.0.9007 Unreleased +
+

+AMR 1.6.0.9008 Unreleased

-
+

-Last updated: 20 April 2021 +Last updated: 23 April 2021

@@ -270,10 +270,23 @@
  • first_isolate() can now take a vector of values for col_keyantibiotics and can have an episode length of Inf
  • +
  • Extended the like() functions: +
      +
    • Now checks if pattern is a valid regular expression

    • -like() (and %like%) now checks if pattern is a valid regular expression
    • +

      Added %unlike% and %unlike_case% (as negations of the existing %like% and %like_case%). This greatly improves readability:

      +
      +
      +if (!grepl("EUCAST", guideline)) ...
      +# same:
      +if (guideline %unlike% "EUCAST") ...
      + +
    • Altered the RStudio addin, so it now iterates over %like% -> %unlike% -> %like_case% -> %unlike_case% if you keep pressing your keyboard shortcut

    • +
    +
  • Fixed an installation error on R-3.0
  • Added info argument to as.mo() to turn on/off the progress bar
  • +
  • Fixed a bug that col_mo for some functions (esp. eucast_rules() and mdro()) could not be column names of the microorganisms data set as it would throw an error
  • @@ -307,7 +320,7 @@
  • Functions oxazolidinones() (an antibiotic selector function) and filter_oxazolidinones() (an antibiotic filter function) to select/filter on e.g. linezolid and tedizolid

    -
    +
     
     library(dplyr)
     x <- example_isolates %>% select(date, hospital_id, oxazolidinones())
    @@ -320,7 +333,7 @@
     
  • ggplot() generics for classes <mic> and <disk>

  • Function mo_is_yeast(), which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:

    -
    +
     
     mo_kingdom(c("Aspergillus", "Candida"))
     #> [1] "Fungi" "Fungi"
    @@ -332,7 +345,7 @@
     example_isolates[which(mo_is_yeast()), ]   # base R
     example_isolates %>% filter(mo_is_yeast()) # dplyr

    The mo_type() function has also been updated to reflect this change:

    -
    +
     
     mo_type(c("Aspergillus", "Candida"))
     # [1] "Fungi"  "Yeasts"
    @@ -342,7 +355,7 @@
     
  • Added Pretomanid (PMD, J04AK08) to the antibiotics data set

  • MIC values (see as.mic()) can now be used in any mathematical processing, such as usage inside functions min(), max(), range(), and with binary operators (+, -, etc.). This allows for easy distribution analysis and fast filtering on MIC values:

    -
    +
     
     x <- random_mic(10)
     x
    @@ -426,7 +439,7 @@
     
    -
    +
     
     # to select first isolates that are Gram-negative 
     # and view results of cephalosporins and aminoglycosides:
    @@ -492,7 +505,7 @@
     
  • For antibiotic selection functions (such as cephalosporins(), aminoglycosides()) to select columns based on a certain antibiotic group, the dependency on the tidyselect package was removed, meaning that they can now also be used without the need to have this package installed and now also work in base R function calls (they rely on R 3.2 or later):

    -
    +
     
     # above example in base R:
     example_isolates[which(first_isolate() & mo_is_gram_negative()),
    @@ -543,7 +556,7 @@
     
  • Data set intrinsic_resistant. This data set contains all bug-drug combinations where the ‘bug’ is intrinsic resistant to the ‘drug’ according to the latest EUCAST insights. It contains just two columns: microorganism and antibiotic.

    Curious about which enterococci are actually intrinsic resistant to vancomycin?

    -
    +
     
     library(AMR)
     library(dplyr)
    @@ -566,7 +579,7 @@
     
    • Support for using dplyr’s across() to interpret MIC values or disk zone diameters, which also automatically determines the column with microorganism names or codes.

      -
      +
       
       # until dplyr 1.0.0
       your_data %>% mutate_if(is.mic, as.rsi)
      @@ -584,7 +597,7 @@
       
    • Added intelligent data cleaning to as.disk(), so numbers can also be extracted from text and decimal numbers will always be rounded up:

      -
      +
       
       as.disk(c("disk zone: 23.4 mm", 23.4))
       #> Class <disk>
      @@ -645,7 +658,7 @@
       
    • Function ab_from_text() to retrieve antimicrobial drug names, doses and forms of administration from clinical texts in e.g. health care records, which also corrects for misspelling since it uses as.ab() internally

    • Tidyverse selection helpers for antibiotic classes, that help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. They can be used in any function that allows selection helpers, like dplyr::select() and tidyr::pivot_longer():

      -
      +
       
       library(dplyr)
       
      @@ -834,7 +847,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
       
    • Fixed important floating point error for some MIC comparisons in EUCAST 2020 guideline

    • Interpretation from MIC values (and disk zones) to R/SI can now be used with mutate_at() of the dplyr package:

      -
      +
       
       yourdata %>% 
         mutate_at(vars(antibiotic1:antibiotic25), as.rsi, mo = "E. coli")
      @@ -863,7 +876,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
       
      • Support for LOINC codes in the antibiotics data set. Use ab_loinc() to retrieve LOINC codes, or use a LOINC code for input in any ab_* function:

        -
        +
         
         ab_loinc("ampicillin")
         #> [1] "21066-6" "3355-5"  "33562-0" "33919-2" "43883-8" "43884-6" "87604-5"
        @@ -874,7 +887,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
         
      • Support for SNOMED CT codes in the microorganisms data set. Use mo_snomed() to retrieve SNOMED codes, or use a SNOMED code for input in any mo_* function:

        -
        +
         
         mo_snomed("S. aureus")
         #> [1] 115329001   3092008 113961008
        @@ -939,11 +952,11 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
         
        • If you were dependent on the old Enterobacteriaceae family e.g. by using in your code:

          -
          +
           
           if (mo_family(somebugs) == "Enterobacteriaceae") ...

          then please adjust this to:

          -
          +
           
           if (mo_order(somebugs) == "Enterobacterales") ...
        • @@ -957,7 +970,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
          • Functions susceptibility() and resistance() as aliases of proportion_SI() and proportion_R(), respectively. These functions were added to make it more clear that “I” should be considered susceptible and not resistant.

            -
            +
             
             library(dplyr)
             example_isolates %>%
            @@ -986,7 +999,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
             
          • More intelligent way of coping with some consonants like “l” and “r”

          • Added a score (a certainty percentage) to mo_uncertainties(), that is calculated using the Levenshtein distance:

            -
            +
             
             as.mo(c("Stafylococcus aureus",
                     "staphylokok aureuz"))
            @@ -1045,14 +1058,14 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
             
            • Determination of first isolates now excludes all ‘unknown’ microorganisms at default, i.e. microbial code "UNKNOWN". They can be included with the new argument include_unknown:

              -
              +
               
               first_isolate(..., include_unknown = TRUE)

              For WHONET users, this means that all records/isolates with organism code "con" (contamination) will be excluded at default, since as.mo("con") = "UNKNOWN". The function always shows a note with the number of ‘unknown’ microorganisms that were included or excluded.

            • For code consistency, classes ab and mo will now be preserved in any subsetting or assignment. For the sake of data integrity, this means that invalid assignments will now result in NA:

              -
              +
               
               # how it works in base R:
               x <- factor("A")
              @@ -1077,7 +1090,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
               
              • Function bug_drug_combinations() to quickly get a data.frame with the results of all bug-drug combinations in a data set. The column containing microorganism codes is guessed automatically and its input is transformed with mo_shortname() at default:

                -
                +
                 
                 x <- bug_drug_combinations(example_isolates)
                 #> NOTE: Using column `mo` as input for `col_mo`.
                @@ -1100,13 +1113,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 #> 4 Gram-negative AMX 227  0 405   632
                 #> NOTE: Use 'format()' on this result to get a publicable/printable format.

                You can format this to a printable format, ready for reporting or exporting to e.g. Excel with the base R format() function:

                -
                +
                 
                 format(x, combine_IR = FALSE)
              • Additional way to calculate co-resistance, i.e. when using multiple antimicrobials as input for portion_* functions or count_* functions. This can be used to determine the empiric susceptibility of a combination therapy. A new argument only_all_tested (which defaults to FALSE) replaces the old also_single_tested and can be used to select one of the two methods to count isolates and calculate portions. The difference can be seen in this example table (which is also on the portion and count help pages), where the %SI is being determined:

                -
                +
                 
                 # --------------------------------------------------------------------
                 #                     only_all_tested = FALSE  only_all_tested = TRUE
                @@ -1128,7 +1141,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • tibble printing support for classes rsi, mic, disk, ab mo. When using tibbles containing antimicrobial columns, values S will print in green, values I will print in yellow and values R will print in red. Microbial IDs (class mo) will emphasise on the genus and species, not on the kingdom.

                -
                +
                 
                 # (run this on your own console, as this page does not support colour printing)
                 library(dplyr)
                @@ -1211,7 +1224,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
                • Function rsi_df() to transform a data.frame to a data set containing only the microbial interpretation (S, I, R), the antibiotic, the percentage of S/I/R and the number of available isolates. This is a convenient combination of the existing functions count_df() and portion_df() to immediately show resistance percentages and number of available isolates:

                  -
                  +
                   
                   septic_patients %>%
                     select(AMX, CIP) %>%
                  @@ -1238,7 +1251,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                   
                • UPEC (Uropathogenic E. coli)

                All these lead to the microbial ID of E. coli:

                -
                +
                 
                 as.mo("UPEC")
                 # B_ESCHR_COL
                @@ -1343,7 +1356,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • when all values are unique it now shows a message instead of a warning

              • support for boxplots:

                -
                +
                 
                 septic_patients %>% 
                   freq(age) %>% 
                @@ -1438,7 +1451,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • New filters for antimicrobial classes. Use these functions to filter isolates on results in one of more antibiotics from a specific class:

                -
                +
                 
                 filter_aminoglycosides()
                 filter_carbapenems()
                @@ -1452,7 +1465,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 filter_macrolides()
                 filter_tetracyclines()

                The antibiotics data set will be searched, after which the input data will be checked for column names with a value in any abbreviations, codes or official names found in the antibiotics data set. For example:

                -
                +
                 
                 septic_patients %>% filter_glycopeptides(result = "R")
                 # Filtering on glycopeptide antibacterials: any of `vanc` or `teic` is R
                @@ -1461,7 +1474,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • All ab_* functions are deprecated and replaced by atc_* functions:

                -
                +
                 
                 ab_property -> atc_property()
                 ab_name -> atc_name()
                @@ -1482,7 +1495,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • New function age_groups() to split ages into custom or predefined groups (like children or elderly). This allows for easier demographic AMR data analysis per age group.

              • New function ggplot_rsi_predict() as well as the base R plot() function can now be used for resistance prediction calculated with resistance_predict():

                -
                +
                 
                 x <- resistance_predict(septic_patients, col_ab = "amox")
                 plot(x)
                @@ -1490,13 +1503,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
              • Functions filter_first_isolate() and filter_first_weighted_isolate() to shorten and fasten filtering on data sets with antimicrobial results, e.g.:

                -
                +
                 
                 septic_patients %>% filter_first_isolate(...)
                 # or
                 filter_first_isolate(septic_patients, ...)

                is equal to:

                -
                +
                 
                 septic_patients %>%
                   mutate(only_firsts = first_isolate(septic_patients, ...)) %>%
                @@ -1529,7 +1542,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                 
                • Now handles incorrect spelling, like i instead of y and f instead of ph:

                  -
                  +
                   
                   # mo_fullname() uses as.mo() internally
                   
                  @@ -1541,7 +1554,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                   
                • Uncertainty of the algorithm is now divided into four levels, 0 to 3, where the default allow_uncertain = TRUE is equal to uncertainty level 2. Run ?as.mo for more info about these levels.

                  -
                  +
                   
                   # equal:
                   as.mo(..., allow_uncertain = TRUE)
                  @@ -1556,7 +1569,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                   
                • All microbial IDs that found are now saved to a local file ~/.Rhistory_mo. Use the new function clean_mo_history() to delete this file, which resets the algorithms.

                • Incoercible results will now be considered ‘unknown’, MO code UNKNOWN. On foreign systems, properties of these will be translated to all languages already previously supported: German, Dutch, French, Italian, Spanish and Portuguese:

                  -
                  +
                   
                   mo_genus("qwerty", language = "es")
                   # Warning: 
                  @@ -1606,7 +1619,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                   
                  • Support for tidyverse quasiquotation! Now you can create frequency tables of function outcomes:

                    -
                    +
                     
                     # Determine genus of microorganisms (mo) in `septic_patients` data set:
                     # OLD WAY
                    @@ -1690,7 +1703,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                  • Fewer than 3 characters as input for as.mo will return NA

                  • Function as.mo (and all mo_* wrappers) now supports genus abbreviations with “species” attached

                    -
                    +
                     
                     as.mo("E. species")        # B_ESCHR
                     mo_fullname("E. spp.")     # "Escherichia species"
                    @@ -1707,7 +1720,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                    • Support for grouping variables, test with:

                      -
                      +
                       
                       septic_patients %>% 
                         group_by(hospital_id) %>% 
                      @@ -1715,7 +1728,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                       
                    • Support for (un)selecting columns:

                      -
                      +
                       
                       septic_patients %>% 
                         freq(hospital_id) %>% 
                      @@ -1795,7 +1808,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                       

                    They also come with support for German, Dutch, French, Italian, Spanish and Portuguese:

                    -
                    +
                     
                     mo_gramstain("E. coli")
                     # [1] "Gram negative"
                    @@ -1806,7 +1819,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     mo_fullname("S. group A", language = "pt") # Portuguese
                     # [1] "Streptococcus grupo A"

                    Furthermore, former taxonomic names will give a note about the current taxonomic name:

                    -
                    +
                     
                     mo_gramstain("Esc blattae")
                     # Note: 'Escherichia blattae' (Burgess et al., 1973) was renamed 'Shimwellia blattae' (Priest and Barker, 2010)
                    @@ -1821,7 +1834,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                  • Function is.rsi.eligible to check for columns that have valid antimicrobial results, but do not have the rsi class yet. Transform the columns of your raw data with: data %>% mutate_if(is.rsi.eligible, as.rsi)

                  • Functions as.mo and is.mo as replacements for as.bactid and is.bactid (since the microoganisms data set not only contains bacteria). These last two functions are deprecated and will be removed in a future release. The as.mo function determines microbial IDs using intelligent rules:

                    -
                    +
                     
                     as.mo("E. coli")
                     # [1] B_ESCHR_COL
                    @@ -1830,7 +1843,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     as.mo("S group A")
                     # [1] B_STRPTC_GRA

                    And with great speed too - on a quite regular Linux server from 2007 it takes us less than 0.02 seconds to transform 25,000 items:

                    -
                    +
                     
                     thousands_of_E_colis <- rep("E. coli", 25000)
                     microbenchmark::microbenchmark(as.mo(thousands_of_E_colis), unit = "s")
                    @@ -1864,7 +1877,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                  • Added three antimicrobial agents to the antibiotics data set: Terbinafine (D01BA02), Rifaximin (A07AA11) and Isoconazole (D01AC05)

                  • Added 163 trade names to the antibiotics data set, it now contains 298 different trade names in total, e.g.:

                    -
                    +
                     
                     ab_official("Bactroban")
                     # [1] "Mupirocin"
                    @@ -1881,7 +1894,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                  • Added arguments minimum and as_percent to portion_df

                  • Support for quasiquotation in the functions series count_* and portions_*, and n_rsi. This allows to check for more than 2 vectors or columns.

                    -
                    +
                     
                     septic_patients %>% select(amox, cipr) %>% count_IR()
                     # which is the same as:
                    @@ -1901,12 +1914,12 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                     
                  • Added longest en shortest character length in the frequency table (freq) header of class character

                  • Support for types (classes) list and matrix for freq

                    -
                    +
                     
                     my_matrix = with(septic_patients, matrix(c(age, gender), ncol = 2))
                     freq(my_matrix)

                    For lists, subsetting is possible:

                    -
                    +
                     
                     my_list = list(age = septic_patients$age, gender = septic_patients$gender)
                     my_list %>% freq(age)
                    diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
                    index 0ac57443..4d38cacb 100644
                    --- a/docs/pkgdown.yml
                    +++ b/docs/pkgdown.yml
                    @@ -12,7 +12,7 @@ articles:
                       datasets: datasets.html
                       resistance_predict: resistance_predict.html
                       welcome_to_AMR: welcome_to_AMR.html
                    -last_built: 2021-04-20T08:46Z
                    +last_built: 2021-04-23T07:52Z
                     urls:
                       reference: https://msberends.github.io/AMR//reference
                       article: https://msberends.github.io/AMR//articles
                    diff --git a/docs/reference/index.html b/docs/reference/index.html
                    index b4fd26c9..bc624c91 100644
                    --- a/docs/reference/index.html
                    +++ b/docs/reference/index.html
                    @@ -81,7 +81,7 @@
                           
                           
                             AMR (for R)
                    -        1.6.0.9007
                    +        1.6.0.9008
                           
                         
                    @@ -599,7 +599,7 @@ -

                    like() `%like%` `%like_case%`

                    +

                    like() `%like%` `%unlike%` `%like_case%` `%unlike_case%`

                    Vectorised Pattern Matching with Keyboard Shortcut

                    diff --git a/docs/reference/like.html b/docs/reference/like.html index 31a1d6e4..f978776c 100644 --- a/docs/reference/like.html +++ b/docs/reference/like.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9008
                    @@ -246,7 +246,11 @@ x %like% pattern -x %like_case% pattern
                    +x %unlike% pattern + +x %like_case% pattern + +x %unlike_case% pattern
                  • Arguments

                    @@ -273,14 +277,14 @@

                    A logical vector

                    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%.

                      Stable Lifecycle

                      @@ -310,18 +314,25 @@ The lifecycle of this function is stableb <- 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") } +# } diff --git a/inst/rstudio/addins.dcf b/inst/rstudio/addins.dcf index d43c060a..4ad06262 100644 --- a/inst/rstudio/addins.dcf +++ b/inst/rstudio/addins.dcf @@ -2,6 +2,6 @@ Name: Insert %in% Binding: addin_insert_in Interactive: false -Name: Insert %like% +Name: Insert %like% or %unlike% Binding: addin_insert_like Interactive: false diff --git a/man/like.Rd b/man/like.Rd index 217275b5..09b0d940 100755 --- a/man/like.Rd +++ b/man/like.Rd @@ -3,7 +3,9 @@ \name{like} \alias{like} \alias{\%like\%} +\alias{\%unlike\%} \alias{\%like_case\%} +\alias{\%unlike_case\%} \title{Vectorised Pattern Matching with Keyboard Shortcut} \source{ Idea from the \href{https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R}{\code{like} function from the \code{data.table} package}, although altered as explained in \emph{Details}. @@ -13,7 +15,11 @@ like(x, pattern, ignore.case = TRUE) x \%like\% pattern +x \%unlike\% pattern + x \%like_case\% pattern + +x \%unlike_case\% pattern } \arguments{ \item{x}{a character vector where matches are sought, or an object which can be coerced by \code{\link[=as.character]{as.character()}} to a character vector.} @@ -29,15 +35,15 @@ A \link{logical} vector Convenient wrapper around \code{\link[=grepl]{grepl()}} to match a pattern: \code{x \%like\% pattern}. It always returns a \code{\link{logical}} vector and is always case-insensitive (use \code{x \%like_case\% pattern} for case-sensitive matching). Also, \code{pattern} can be as long as \code{x} to compare items of each index in both vectors, or they both can have the same length to iterate over all cases. } \details{ -These \code{\link[=like]{like()}} and \verb{\%like\%} functions: +These \code{\link[=like]{like()}} and \verb{\%like\%}/\verb{\%unlike\%} functions: \itemize{ -\item Are case-insensitive (use \verb{\%like_case\%} for case-sensitive matching) +\item Are case-insensitive (use \verb{\%like_case\%}/\verb{\%unlike_case\%} for case-sensitive matching) \item Support multiple patterns \item Check if \code{pattern} is a valid regular expression and sets \code{fixed = TRUE} if not, to greatly improve speed (vectorised over \code{pattern}) \item Always use compatibility with Perl unless \code{fixed = TRUE}, to greatly improve speed } -Using RStudio? The text \verb{\%like\%} can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like \code{Ctrl+Shift+L} or \code{Cmd+Shift+L} (see \code{Tools} > \verb{Modify Keyboard Shortcuts...}). +Using RStudio? The \verb{\%like\%}/\verb{\%unlike\%} functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like \code{Shift+Ctrl+L} or \code{Shift+Cmd+L} (see menu \code{Tools} > \verb{Modify Keyboard Shortcuts...}). If you keep pressing your shortcut, the inserted text will be iterated over \verb{\%like\%} -> \verb{\%unlike\%} -> \verb{\%like_case\%} -> \verb{\%unlike_case\%}. } \section{Stable Lifecycle}{ @@ -65,12 +71,18 @@ a <- c("Test case", "Something different", "Yet another thing") 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")) { @@ -78,6 +90,7 @@ if (require("dplyr")) { filter(mo_name() \%like\% "^ent") } } +} \seealso{ \code{\link[=grepl]{grepl()}} }