P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 05:26:13 +01:00
Code Releases Activity

(v1.4.0.9015) bugfix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-11-10 16:35:56 +01:00
parent dd5a0319ef
commit 15c732703d
35 changed files with 224 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.4.0.9014 Version: 1.4.0.9015
Date: 2020-11-09 Date: 2020-11-10
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person(role = c("aut", "cre"), person(role = c("aut", "cre"),

6
NEWS.md
View File

@ -1,5 +1,5 @@
# AMR 1.4.0.9014 # AMR 1.4.0.9015
## <small>Last updated: 9 November 2020</small> ## <small>Last updated: 10 November 2020</small>
### New ### New
* Functions `is_gram_negative()` and `is_gram_positive()` as wrappers around `mo_gramstain()`. They always return `TRUE` or `FALSE` (except when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria. If you have the `dplyr` package installed, they can even determine the column with microorganisms themselves inside `dplyr` functions: * Functions `is_gram_negative()` and `is_gram_positive()` as wrappers around `mo_gramstain()`. They always return `TRUE` or `FALSE` (except when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria. If you have the `dplyr` package installed, they can even determine the column with microorganisms themselves inside `dplyr` functions:
@ -18,7 +18,7 @@
* Fix for using parameter `reference_df` in `as.mo()` and `mo_*()` functions that contain old microbial codes (from previous package versions) * Fix for using parameter `reference_df` in `as.mo()` and `mo_*()` functions that contain old microbial codes (from previous package versions)
### Other ### Other
* All messages thrown by this package now have correct line breaks * All messages and warnings thrown by this package now break sentences on whole words
* More extensive unit tests * More extensive unit tests
# AMR 1.4.0 # AMR 1.4.0

55
R/aa_helper_functions.R
View File

@ -267,13 +267,19 @@ import_fn <- function(name, pkg, error_on_fail = TRUE) {
}) })
} }
# this alternative to the message() function: # this alternative wrapper to the message(), warning() and stop() functions:
# - wraps text to never break lines within words # - wraps text to never break lines within words
# - ignores formatted text while wrapping # - ignores formatted text while wrapping
# - adds indentation dependent on the type of message (like NOTE) # - adds indentation dependent on the type of message (like NOTE)
# - add additional formatting functions like blue or bold text # - can add additional formatting functions like blue or bold text
message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = TRUE) { word_wrap <- function(...,
add_fn = list(),
as_note = FALSE,
width = 0.95 * getOption("width"),
extra_indent = 0) {
msg <- paste0(c(...), collapse = "") msg <- paste0(c(...), collapse = "")
# replace new lines to add them again later
msg <- gsub("\n", "*|*", msg, fixed = TRUE)
if (isTRUE(as_note)) { if (isTRUE(as_note)) {
msg <- paste0("NOTE: ", gsub("note:? ?", "", msg, ignore.case = TRUE)) msg <- paste0("NOTE: ", gsub("note:? ?", "", msg, ignore.case = TRUE))
@ -284,10 +290,12 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = T
# where are the spaces now? # where are the spaces now?
msg_stripped_wrapped <- paste0(strwrap(msg_stripped, msg_stripped_wrapped <- paste0(strwrap(msg_stripped,
simplify = TRUE, simplify = TRUE,
width = 0.95 * getOption("width")), width = width),
collapse = "\n")
msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
collapse = "\n") collapse = "\n")
msg_stripped_spaces <- which(unlist(strsplit(msg_stripped, "")) == " ") msg_stripped_spaces <- which(unlist(strsplit(msg_stripped, "")) == " ")
msg_stripped_wrapped_spaces <- which(unlist(strsplit(msg_stripped_wrapped, "")) == " ") msg_stripped_wrapped_spaces <- which(unlist(strsplit(msg_stripped_wrapped, "")) != "\n")
# so these are the indices of spaces that need to be replaced # so these are the indices of spaces that need to be replaced
replace_spaces <- which(!msg_stripped_spaces %in% msg_stripped_wrapped_spaces) replace_spaces <- which(!msg_stripped_spaces %in% msg_stripped_wrapped_spaces)
# put it together # put it together
@ -297,13 +305,14 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = T
msg <- gsub("\n ", "\n", msg, fixed = TRUE) msg <- gsub("\n ", "\n", msg, fixed = TRUE)
if (msg_stripped %like% "^NOTE: ") { if (msg_stripped %like% "^NOTE: ") {
indentation <- 6 indentation <- 6 + extra_indent
} else if (msg_stripped %like% "^=> ") { } else if (msg_stripped %like% "^=> ") {
indentation <- 3 indentation <- 3 + extra_indent
} else { } else {
indentation <- 0 indentation <- 0 + extra_indent
} }
msg <- gsub("\n", paste0("\n", strrep(" ", indentation)), msg, fixed = TRUE) msg <- gsub("\n", paste0("\n", strrep(" ", indentation)), msg, fixed = TRUE)
msg <- gsub("*|*", paste0("*|*", strrep(" ", indentation)), msg, fixed = TRUE)
if (length(add_fn) > 0) { if (length(add_fn) > 0) {
if (!is.list(add_fn)) { if (!is.list(add_fn)) {
@ -313,14 +322,38 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = T
msg <- add_fn[[i]](msg) msg <- add_fn[[i]](msg)
} }
} }
message(msg, appendLF = appendLF)
# place back spaces
msg <- gsub("*|*", "\n", msg, fixed = TRUE)
msg
}
message_ <- function(...,
appendLF = TRUE,
add_fn = list(font_blue),
as_note = TRUE) {
message(word_wrap(...,
add_fn = add_fn,
as_note = as_note),
appendLF = appendLF)
}
warning_ <- function(...,
add_fn = list(),
immediate = FALSE,
call = TRUE) {
warning(word_wrap(...,
add_fn = add_fn,
as_note = FALSE),
immediate. = immediate,
call. = call)
} }
# this alternative to the stop() function: # this alternative to the stop() function:
# - adds the function name where the error was thrown # - adds the function name where the error was thrown
# - wraps text to never break lines within words # - wraps text to never break lines within words
stop_ <- function(..., call = TRUE) { stop_ <- function(..., call = TRUE) {
msg <- paste0(c(...), collapse = "") msg <- word_wrap(..., add_fn = list(), as_note = FALSE)
if (!isFALSE(call)) { if (!isFALSE(call)) {
if (isTRUE(call)) { if (isTRUE(call)) {
call <- as.character(sys.call(-1)[1]) call <- as.character(sys.call(-1)[1])
@ -374,7 +407,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
class_integrity_check <- function(value, type, check_vector) { class_integrity_check <- function(value, type, check_vector) {
if (!all(value[!is.na(value)] %in% check_vector)) { if (!all(value[!is.na(value)] %in% check_vector)) {
warning(paste0("invalid ", type, ", NA generated"), call. = FALSE) warning_(paste0("invalid ", type, ", NA generated"), call = FALSE)
value[!value %in% check_vector] <- NA value[!value %in% check_vector] <- NA
} }
value value

16
R/ab.R
View File

@ -434,17 +434,17 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
x_unknown_ATCs <- x_unknown[x_unknown %like% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"] x_unknown_ATCs <- x_unknown[x_unknown %like% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"]
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
if (length(x_unknown_ATCs) > 0) { if (length(x_unknown_ATCs) > 0) {
warning("These ATC codes are not (yet) in the antibiotics data set: ", warning_("These ATC codes are not (yet) in the antibiotics data set: ",
paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "), paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "),
".", ".",
call. = FALSE) call = FALSE)
} }
if (length(x_unknown) > 0) { if (length(x_unknown) > 0) {
warning("These values could not be coerced to a valid antimicrobial ID: ", warning_("These values could not be coerced to a valid antimicrobial ID: ",
paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "), paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "),
".", ".",
call. = FALSE) call = FALSE)
} }
x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %pm>% x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %pm>%

4
R/ab_property.R
View File

@ -225,12 +225,12 @@ ab_url <- function(x, open = FALSE, ...) {
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(ab_atc(ab))] NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(ab_atc(ab))]
if (length(NAs) > 0) { if (length(NAs) > 0) {
warning("No ATC code available for ", paste0(NAs, collapse = ", "), ".") warning_("No ATC code available for ", paste0(NAs, collapse = ", "), ".")
} }
if (open == TRUE) { if (open == TRUE) {
if (length(u) > 1 & !is.na(u[1L])) { if (length(u) > 1 & !is.na(u[1L])) {
warning("only the first URL will be opened, as `browseURL()` only suports one string.") warning_("Only the first URL will be opened, as `browseURL()` only suports one string.")
} }
if (!is.na(u[1L])) { if (!is.na(u[1L])) {
utils::browseURL(u[1L]) utils::browseURL(u[1L])

6
R/age.R
View File

@ -83,10 +83,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
if (any(ages < 0, na.rm = TRUE)) { if (any(ages < 0, na.rm = TRUE)) {
ages[ages < 0] <- NA ages[ages < 0] <- NA
warning("NAs introduced for ages below 0.") warning_("NAs introduced for ages below 0.", call = TRUE)
} }
if (any(ages > 120, na.rm = TRUE)) { if (any(ages > 120, na.rm = TRUE)) {
warning("Some ages are above 120.") warning_("Some ages are above 120.", call = TRUE)
} }
if (isTRUE(na.rm)) { if (isTRUE(na.rm)) {
@ -154,7 +154,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
if (any(x < 0, na.rm = TRUE)) { if (any(x < 0, na.rm = TRUE)) {
x[x < 0] <- NA x[x < 0] <- NA
warning("NAs introduced for ages below 0.") warning_("NAs introduced for ages below 0.", call = TRUE)
} }
if (is.character(split_at)) { if (is.character(split_at)) {
split_at <- split_at[1L] split_at <- split_at[1L]

2
R/atc_online.R
View File

@ -161,7 +161,7 @@ atc_online_property <- function(atc_code,
colnames(tbl) <- gsub("^atc.*", "atc", tolower(colnames(tbl))) colnames(tbl) <- gsub("^atc.*", "atc", tolower(colnames(tbl)))
if (length(tbl) == 0) { if (length(tbl) == 0) {
warning("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call. = FALSE) warning_("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call = FALSE)
returnvalue[i] <- NA returnvalue[i] <- NA
next next
} }

4
R/count.R
View File

@ -134,7 +134,7 @@ count_R <- function(..., only_all_tested = FALSE) {
#' @rdname count #' @rdname count
#' @export #' @export
count_IR <- function(..., only_all_tested = FALSE) { count_IR <- function(..., only_all_tested = FALSE) {
warning("Using 'count_IR' is discouraged; use 'count_resistant()' instead to not consider \"I\" being resistant.", call. = FALSE) warning_("Using 'count_IR' is discouraged; use 'count_resistant()' instead to not consider \"I\" being resistant.", call = FALSE)
rsi_calc(..., rsi_calc(...,
ab_result = c("I", "R"), ab_result = c("I", "R"),
only_all_tested = only_all_tested, only_all_tested = only_all_tested,
@ -162,7 +162,7 @@ count_SI <- function(..., only_all_tested = FALSE) {
#' @rdname count #' @rdname count
#' @export #' @export
count_S <- function(..., only_all_tested = FALSE) { count_S <- function(..., only_all_tested = FALSE) {
warning("Using 'count_S' is discouraged; use 'count_susceptible()' instead to also consider \"I\" being susceptible.", call. = FALSE) warning_("Using 'count_S' is discouraged; use 'count_susceptible()' instead to also consider \"I\" being susceptible.", call = FALSE)
rsi_calc(..., rsi_calc(...,
ab_result = "S", ab_result = "S",
only_all_tested = only_all_tested, only_all_tested = only_all_tested,

8
R/disk.R
View File

@ -101,10 +101,10 @@ as.disk <- function(x, na.rm = FALSE) {
unique() %pm>% unique() %pm>%
sort() sort()
list_missing <- paste0('"', list_missing, '"', collapse = ", ") list_missing <- paste0('"', list_missing, '"', collapse = ", ")
warning(na_after - na_before, " results truncated (", warning_(na_after - na_before, " results truncated (",
round(((na_after - na_before) / length(x)) * 100), round(((na_after - na_before) / length(x)) * 100),
"%) that were invalid disk zones: ", "%) that were invalid disk zones: ",
list_missing, call. = FALSE) list_missing, call = FALSE)
} }
} }
structure(as.integer(x), structure(as.integer(x),

61
R/eucast_rules.R
View File

@ -564,10 +564,12 @@ eucast_rules <- function(x,
x <- as.data.frame(x, stringsAsFactors = FALSE) # no tibbles, data.tables, etc. x <- as.data.frame(x, stringsAsFactors = FALSE) # no tibbles, data.tables, etc.
rownames(x) <- NULL # will later be restored with old_attributes rownames(x) <- NULL # will later be restored with old_attributes
# create unique row IDs - combination of the MO and all ABx columns (so they will only run once per unique combination) # create unique row IDs - combination of the MO and all ABx columns (so they will only run once per unique combination)
x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]))), function(x) { x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]),
x[is.na(x)] <- "." stringsAsFactors = FALSE)),
paste0(x, collapse = "") function(x) {
}) x[is.na(x)] <- "."
paste0(x, collapse = "")
})
# save original table, with the new .rowid column # save original table, with the new .rowid column
x.bak <- x x.bak <- x
@ -676,7 +678,12 @@ eucast_rules <- function(x,
} else { } else {
if (info == TRUE) { if (info == TRUE) {
cat(font_red("\nSkipping inheritance rules defined by this package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R.\nUse eucast_rules(..., rules = \"all\") to also apply those rules.\n")) message_("\n\nSkipping inheritance rules defined by this package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R.",
as_note = FALSE,
add_fn = font_red)
message_("Use eucast_rules(..., rules = \"all\") to also apply those rules.",
as_note = FALSE,
add_fn = font_red)
} }
} }
@ -763,7 +770,9 @@ eucast_rules <- function(x,
# Print rule ------------------------------------------------------------- # Print rule -------------------------------------------------------------
if (rule_current != rule_previous) { if (rule_current != rule_previous) {
# is new rule within group, print its name # is new rule within group, print its name
cat(markup_italics_where_needed(rule_current)) cat(markup_italics_where_needed(word_wrap(rule_current,
width = getOption("width") - 30,
extra_indent = 4)))
warned <- FALSE warned <- FALSE
} }
} }
@ -903,12 +912,12 @@ eucast_rules <- function(x,
} }
cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n")) cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n"))
cat(paste0("The rules ", paste0(wouldve, "affected "), cat(word_wrap(paste0("The rules ", paste0(wouldve, "affected "),
font_bold(formatnr(pm_n_distinct(verbose_info$row)), font_bold(formatnr(pm_n_distinct(verbose_info$row)),
"out of", formatnr(nrow(x.bak)), "out of", formatnr(nrow(x.bak)),
"rows"), "rows"),
", making a total of ", ", making a total of ",
font_bold(formatnr(nrow(verbose_info)), "edits\n"))) font_bold(formatnr(nrow(verbose_info)), "edits\n"))))
total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow() total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow()
total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow() total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow()
@ -960,21 +969,21 @@ eucast_rules <- function(x,
cat(paste0(font_grey(strrep("-", 0.95 * options()$width)), "\n")) cat(paste0(font_grey(strrep("-", 0.95 * options()$width)), "\n"))
if (verbose == FALSE & total_n_added + total_n_changed > 0) { if (verbose == FALSE & total_n_added + total_n_changed > 0) {
cat(paste("\nUse", font_bold("eucast_rules(..., verbose = TRUE)"), "(on your original data) to get a data.frame with all specified edits instead.\n\n")) cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a data.frame with all specified edits instead."), "\n\n", sep = "")
} else if (verbose == TRUE) { } else if (verbose == TRUE) {
cat(paste0("\nUsed 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a data.frame with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data.\n\n")) cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a data.frame with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "")
} }
} }
if (length(warn_lacking_rsi_class) > 0) { if (length(warn_lacking_rsi_class) > 0) {
warn_lacking_rsi_class <- unique(warn_lacking_rsi_class) warn_lacking_rsi_class <- unique(warn_lacking_rsi_class)
warning("Not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\n", warning_("Not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\n",
" ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n", " ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
" ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1, " ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
warn_lacking_rsi_class, warn_lacking_rsi_class,
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])), paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])),
")", ")",
call. = FALSE) call = FALSE)
} }
# Return data set --------------------------------------------------------- # Return data set ---------------------------------------------------------
@ -1034,16 +1043,16 @@ edit_rsi <- function(x,
warning = function(w) { warning = function(w) {
if (w$message %like% "invalid factor level") { if (w$message %like% "invalid factor level") {
xyz <- sapply(cols, function(col) { xyz <- sapply(cols, function(col) {
new_edits[, col] <- factor(x = as.character(pm_pull(new_edits, col)), levels = c(to, levels(pm_pull(new_edits, col)))) new_edits[, col] <<- factor(x = as.character(pm_pull(new_edits, col)),
# x[, col] <<- factor(x = as.character(pm_pull(x, col)), levels = c(to, levels(pm_pull(x, col)))) levels = unique(c(to, levels(pm_pull(new_edits, col)))))
invisible() invisible()
}) })
new_edits[rows, cols] <- to suppressWarnings(new_edits[rows, cols] <<- to)
warning('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level.\nA better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call. = FALSE) warning_('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE)
txt_warning() txt_warning()
warned <- FALSE warned <- FALSE
} else { } else {
warning(w$message, call. = FALSE) warning_(w$message, call = FALSE)
txt_warning() txt_warning()
cat("\n") # txt_warning() does not append a "\n" on itself cat("\n") # txt_warning() does not append a "\n" on itself
} }

24
R/guess_ab_col.R
View File

@ -167,8 +167,9 @@ get_column_abx <- function(x,
if (length(dots) > 0) { if (length(dots) > 0) {
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE)) newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
if (any(is.na(newnames))) { if (any(is.na(newnames))) {
warning("Invalid antibiotic reference(s): ", toString(names(dots)[is.na(newnames)]), warning_("Invalid antibiotic reference(s): ", toString(names(dots)[is.na(newnames)]),
call. = FALSE, immediate. = TRUE) call = FALSE,
immediate = TRUE)
} }
# turn all NULLs to NAs # turn all NULLs to NAs
dots <- unlist(lapply(dots, function(x) if (is.null(x)) NA else x)) dots <- unlist(lapply(dots, function(x) if (is.null(x)) NA else x))
@ -205,11 +206,12 @@ get_column_abx <- function(x,
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").") "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")
} }
if (info == TRUE & names(x[i]) %in% names(duplicates)) { if (info == TRUE & names(x[i]) %in% names(duplicates)) {
warning(font_red(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i], warning_(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
"), although it was matched for multiple antibiotics or columns.")), "), although it was matched for multiple antibiotics or columns."),
call. = FALSE, add_fn = font_red,
immediate. = verbose) call = FALSE,
immediate = verbose)
} }
} }
@ -245,8 +247,8 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
} else { } else {
any_txt <- c("", "are") any_txt <- c("", "are")
} }
warning(paste0("Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ", warning_(paste0("Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
paste(missing, collapse = ", ")), paste(missing, collapse = ", ")),
immediate. = TRUE, immediate = TRUE,
call. = FALSE) call = FALSE)
} }

10
R/join_microorganisms.R
View File

@ -83,7 +83,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
) )
} }
if (NROW(join) > NROW(x)) { if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.") warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
} }
class(join) <- x_class class(join) <- x_class
join join
@ -114,7 +114,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
) )
} }
if (NROW(join) > NROW(x)) { if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.") warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
} }
class(join) <- x_class class(join) <- x_class
join join
@ -145,7 +145,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
) )
} }
if (NROW(join) > NROW(x)) { if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.") warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
} }
class(join) <- x_class class(join) <- x_class
join join
@ -176,7 +176,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
) )
} }
if (NROW(join) > NROW(x)) { if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.") warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
} }
class(join) <- x_class class(join) <- x_class
join join
@ -280,7 +280,7 @@ check_groups_before_join <- function(x, fn) {
x <- pm_ungroup(x) x <- pm_ungroup(x)
attr(x, "groups") <- NULL attr(x, "groups") <- NULL
class(x) <- class(x)[!class(x) %like% "group"] class(x) <- class(x)[!class(x) %like% "group"]
warning("Groups are dropped, since the ", fn, "() function relies on merge() from base R if dplyr is not installed.", call. = FALSE) warning_("Groups are dropped, since the ", fn, "() function relies on merge() from base R.", call = FALSE)
} }
x x
} }

16
R/key_antibiotics.R
View File

@ -188,11 +188,11 @@ key_antibiotics <- function(x,
} }
if (!all(col.list %in% colnames(x))) { if (!all(col.list %in% colnames(x))) {
if (warnings == TRUE) { if (warnings == TRUE) {
warning("Some columns do not exist and will be ignored: ", warning_("Some columns do not exist and will be ignored: ",
col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(), col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(),
".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.", ".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
immediate. = TRUE, immediate = TRUE,
call. = FALSE) call = FALSE)
} }
} }
col.list col.list
@ -227,7 +227,7 @@ key_antibiotics <- function(x,
gram_positive <- gram_positive[!is.null(gram_positive)] gram_positive <- gram_positive[!is.null(gram_positive)]
gram_positive <- gram_positive[!is.na(gram_positive)] gram_positive <- gram_positive[!is.na(gram_positive)]
if (length(gram_positive) < 12) { if (length(gram_positive) < 12) {
warning("only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call. = FALSE) warning_("Only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call = FALSE)
} }
gram_negative <- c(universal, gram_negative <- c(universal,
@ -236,7 +236,7 @@ key_antibiotics <- function(x,
gram_negative <- gram_negative[!is.null(gram_negative)] gram_negative <- gram_negative[!is.null(gram_negative)]
gram_negative <- gram_negative[!is.na(gram_negative)] gram_negative <- gram_negative[!is.na(gram_negative)]
if (length(gram_negative) < 12) { if (length(gram_negative) < 12) {
warning("only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call. = FALSE) warning_("Only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call = FALSE)
} }
x <- as.data.frame(x, stringsAsFactors = FALSE) x <- as.data.frame(x, stringsAsFactors = FALSE)
@ -264,7 +264,7 @@ key_antibiotics <- function(x,
key_abs <- toupper(gsub("[^SIR]", ".", gsub("(NA|NULL)", ".", x$key_ab))) key_abs <- toupper(gsub("[^SIR]", ".", gsub("(NA|NULL)", ".", x$key_ab)))
if (pm_n_distinct(key_abs) == 1) { if (pm_n_distinct(key_abs) == 1) {
warning("No distinct key antibiotics determined.", call. = FALSE) warning_("No distinct key antibiotics determined.", call = FALSE)
} }
key_abs key_abs

4
R/mdro.R
View File

@ -132,7 +132,7 @@ mdro <- function(x,
} }
if (!is.null(list(...)$country)) { if (!is.null(list(...)$country)) {
warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE) warning_("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call = FALSE)
guideline <- list(...)$country guideline <- list(...)$country
} }
@ -1205,7 +1205,7 @@ mdro <- function(x,
# Results ---- # Results ----
if (guideline$code == "cmi2012") { if (guideline$code == "cmi2012") {
if (any(x$MDRO == -1, na.rm = TRUE)) { if (any(x$MDRO == -1, na.rm = TRUE)) {
warning("NA introduced for isolates where the available percentage of antimicrobial classes was below ", warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
percentage(pct_required_classes), " (set with `pct_required_classes`)") percentage(pct_required_classes), " (set with `pct_required_classes`)")
# set these -1s to NA # set these -1s to NA
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_ x[which(x$MDRO == -1), "MDRO"] <- NA_integer_

8
R/mic.R
View File

@ -125,10 +125,10 @@ as.mic <- function(x, na.rm = FALSE) {
unique() %pm>% unique() %pm>%
sort() sort()
list_missing <- paste0('"', list_missing, '"', collapse = ", ") list_missing <- paste0('"', list_missing, '"', collapse = ", ")
warning(na_after - na_before, " results truncated (", warning_(na_after - na_before, " results truncated (",
round(((na_after - na_before) / length(x)) * 100), round(((na_after - na_before) / length(x)) * 100),
"%) that were invalid MICs: ", "%) that were invalid MICs: ",
list_missing, call. = FALSE) list_missing, call = FALSE)
} }
structure(.Data = factor(x, levels = lvls, ordered = TRUE), structure(.Data = factor(x, levels = lvls, ordered = TRUE),

41
R/mo.R
View File

@ -173,7 +173,7 @@ as.mo <- function(x,
& isFALSE(Becker) & isFALSE(Becker)
& isFALSE(Lancefield), error = function(e) FALSE)) { & isFALSE(Lancefield), error = function(e) FALSE)) {
# don't look into valid MO codes, just return them # don't look into valid MO codes, just return them
# is.mo() won't work - codes might change between package versions # is.mo() won't work - MO codes might change between package versions
return(to_class_mo(x)) return(to_class_mo(x))
} }
@ -1393,9 +1393,10 @@ exec_as.mo <- function(x,
"You can also use your own reference data, e.g.:\n", "You can also use your own reference data, e.g.:\n",
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n', ' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n',
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n') ' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n')
warning(font_red(paste0("\n", msg)), warning_(paste0("\n", msg),
call. = FALSE, add_fn = font_red,
immediate. = TRUE) # thus will always be shown, even if >= warnings call = FALSE,
immediate = TRUE) # thus will always be shown, even if >= warnings
} }
# handling uncertainties ---- # handling uncertainties ----
if (NROW(uncertainties) > 0 & initial_search == TRUE) { if (NROW(uncertainties) > 0 & initial_search == TRUE) {
@ -1420,13 +1421,13 @@ exec_as.mo <- function(x,
post_Becker <- character(0) # 2020-10-20 currently all are mentioned in above papers post_Becker <- character(0) # 2020-10-20 currently all are mentioned in above papers
if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) { if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) {
warning("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ", warning_("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ",
font_italic(paste("S.", font_italic(paste("S.",
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))), sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
collapse = ", ")), collapse = ", ")),
".", ".",
call. = FALSE, call = FALSE,
immediate. = TRUE) immediate = TRUE)
} }
# 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/zzz.R # 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/zzz.R
@ -1903,13 +1904,14 @@ replace_old_mo_codes <- function(x, property) {
mo_new <- microorganisms.translation$mo_new[matched] mo_new <- microorganisms.translation$mo_new[matched]
# assign on places where a match was found # assign on places where a match was found
x[which(!is.na(matched))] <- mo_new[which(!is.na(matched))] x[which(!is.na(matched))] <- mo_new[which(!is.na(matched))]
n_matched <- length(matched[!is.na(matched)])
if (property != "mo") { if (property != "mo") {
message_(font_blue("NOTE: The input contained old microbial codes (from previous package versions). Please update your MO codes with as.mo().")) message_(font_blue("NOTE: The input contained old microbial codes (from previous package versions). Please update your MO codes with as.mo()."))
} else { } else {
if (length(matched) == 1) { if (n_matched == 1) {
message_(font_blue("NOTE: 1 old microbial code (from previous package versions) was updated to a current used code.")) message_(font_blue("NOTE: 1 old microbial code (from previous package versions) was updated to a current used MO code."))
} else { } else {
message_(font_blue("NOTE:", length(matched), "old microbial codes (from previous package versions) were updated to current used codes.")) message_(font_blue("NOTE:", n_matched, "old microbial codes (from previous package versions) were updated to current used MO codes."))
} }
} }
} }
@ -1940,13 +1942,14 @@ repair_reference_df <- function(reference_df) {
} else { } else {
reference_df <- reference_df %pm>% pm_select(1, "mo") reference_df <- reference_df %pm>% pm_select(1, "mo")
} }
# some microbial codes might be old
reference_df[, 2] <- as.mo(reference_df[, 2, drop = TRUE])
# remove factors, just keep characters # remove factors, just keep characters
suppressWarnings(
reference_df[] <- lapply(reference_df, as.character)
)
colnames(reference_df)[1] <- "x" colnames(reference_df)[1] <- "x"
reference_df[, "x"] <- as.character(reference_df[, "x", drop = TRUE])
reference_df[, "mo"] <- as.character(reference_df[, "mo", drop = TRUE])
# some microbial codes might be old
reference_df[, "mo"] <- as.mo(reference_df[, "mo", drop = TRUE])
reference_df reference_df
} }

2
R/mo_property.R
View File

@ -529,7 +529,7 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
if (open == TRUE) { if (open == TRUE) {
if (length(u) > 1) { if (length(u) > 1) {
warning("only the first URL will be opened, as `browseURL()` only suports one string.") warning_("Only the first URL will be opened, as `browseURL()` only suports one string.")
} }
utils::browseURL(u[1L]) utils::browseURL(u[1L])
} }

28
R/mo_source.R
View File

@ -239,7 +239,7 @@ get_mo_source <- function() {
mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) { mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
check_dataset_integrity() check_dataset_integrity()
if (deparse(substitute(x)) == "get_mo_source()") { if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
return(TRUE) return(TRUE)
} }
if (identical(x, get_mo_source())) { if (identical(x, get_mo_source())) {
@ -247,21 +247,21 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error
} }
if (is.null(x)) { if (is.null(x)) {
if (stop_on_error == TRUE) { if (stop_on_error == TRUE) {
stop(refer_to_name, " cannot be NULL", call. = FALSE) stop_(refer_to_name, " cannot be NULL", call = FALSE)
} else { } else {
return(FALSE) return(FALSE)
} }
} }
if (!is.data.frame(x)) { if (!is.data.frame(x)) {
if (stop_on_error == TRUE) { if (stop_on_error == TRUE) {
stop(refer_to_name, " must be a data.frame", call. = FALSE) stop_(refer_to_name, " must be a data.frame", call = FALSE)
} else { } else {
return(FALSE) return(FALSE)
} }
} }
if (!"mo" %in% colnames(x)) { if (!"mo" %in% colnames(x)) {
if (stop_on_error == TRUE) { if (stop_on_error == TRUE) {
stop(refer_to_name, " must contain a column 'mo'", call. = FALSE) stop_(refer_to_name, " must contain a column 'mo'", call = FALSE)
} else { } else {
return(FALSE) return(FALSE)
} }
@ -274,13 +274,27 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error
} else { } else {
plural <- "" plural <- ""
} }
stop("Value", plural, " ", paste0("'", invalid[, 1, drop = TRUE], "'", collapse = ", "), stop_("Value", plural, " ", paste0("'", invalid[, 1, drop = TRUE], "'", collapse = ", "),
" found in ", tolower(refer_to_name), " found in ", tolower(refer_to_name),
", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "), ", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "),
call. = FALSE) call = FALSE)
} else { } else {
return(FALSE) return(FALSE)
} }
} }
TRUE if (colnames(x)[1] != "mo" & nrow(x) > length(unique(x[, 1, drop = TRUE]))) {
if (stop_on_error == TRUE) {
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[1], "'", call = FALSE)
} else {
return(FALSE)
}
}
if (colnames(x)[2] != "mo" & nrow(x) > length(unique(x[, 2, drop = TRUE]))) {
if (stop_on_error == TRUE) {
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[2], "'", call = FALSE)
} else {
return(FALSE)
}
}
return(TRUE)
} }

2
R/pca.R
View File

@ -98,7 +98,7 @@ pca <- function(x,
x <- as.data.frame(new_list, stringsAsFactors = FALSE) x <- as.data.frame(new_list, stringsAsFactors = FALSE)
if (any(sapply(x, function(y) !is.numeric(y)))) { if (any(sapply(x, function(y) !is.numeric(y)))) {
warning("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. Please see Examples in ?pca.") warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. Please see Examples in ?pca.")
} }
# set column names # set column names

2
R/resistance_predict.R
View File

@ -148,7 +148,7 @@ resistance_predict <- function(x,
x <- dots[which(dots.names == "tbl")] x <- dots[which(dots.names == "tbl")]
} }
if ("I_as_R" %in% dots.names) { if ("I_as_R" %in% dots.names) {
warning("`I_as_R is deprecated - use I_as_S instead.", call. = FALSE) warning_("`I_as_R is deprecated - use I_as_S instead.", call = FALSE)
} }
} }

16
R/rsi.R
View File

@ -237,9 +237,9 @@ as.rsi.default <- function(x, ...) {
if (!any(x %like% "(R|S|I)", na.rm = TRUE)) { if (!any(x %like% "(R|S|I)", na.rm = TRUE)) {
# check if they are actually MICs or disks now that the antibiotic name is valid # check if they are actually MICs or disks now that the antibiotic name is valid
if (all_valid_mics(x)) { 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.") warning_("The input seems to be MIC values. Transform them with as.mic() before running as.rsi() to interpret them.")
} else if (all_valid_disks(x)) { } else if (all_valid_disks(x)) {
warning("The input seems to be disk diffusion values. Transform them with as.disk() before running as.rsi() to interpret them.") warning_("The input seems to be disk diffusion values. Transform them with as.disk() before running as.rsi() to interpret them.")
} }
} }
@ -273,10 +273,10 @@ as.rsi.default <- function(x, ...) {
unique() %pm>% unique() %pm>%
sort() sort()
list_missing <- paste0('"', list_missing, '"', collapse = ", ") list_missing <- paste0('"', list_missing, '"', collapse = ", ")
warning(na_after - na_before, " results truncated (", warning_(na_after - na_before, " results truncated (",
round(((na_after - na_before) / length(x)) * 100), round(((na_after - na_before) / length(x)) * 100),
"%) that were invalid antimicrobial interpretations: ", "%) that were invalid antimicrobial interpretations: ",
list_missing, call. = FALSE) list_missing, call = FALSE)
} }
} }
@ -675,14 +675,14 @@ exec_as.rsi <- function(method,
if (all(trans$uti == TRUE, na.rm = TRUE) & all(uti == FALSE)) { if (all(trans$uti == TRUE, na.rm = TRUE) & all(uti == FALSE)) {
message_("WARNING.", add_fn = list(font_red, font_bold), as_note = FALSE) message_("WARNING.", add_fn = list(font_red, font_bold), as_note = FALSE)
warning("Interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI).\n Use parameter 'uti' to set which isolates are from urine. See ?as.rsi.", call. = FALSE) warning_("Interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI).\n Use parameter 'uti' to set which isolates are from urine. See ?as.rsi.", call = FALSE)
warned <- TRUE warned <- TRUE
} }
for (i in seq_len(length(x))) { for (i in seq_len(length(x))) {
if (isTRUE(add_intrinsic_resistance)) { if (isTRUE(add_intrinsic_resistance)) {
if (!guideline_coerced %like% "EUCAST") { if (!guideline_coerced %like% "EUCAST") {
warning("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call. = FALSE) warning_("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call = FALSE)
} else { } else {
get_record <- subset(intrinsic_resistant, get_record <- subset(intrinsic_resistant,
microorganism == mo_name(mo[i], language = NULL) & antibiotic == ab_name(ab, language = NULL)) microorganism == mo_name(mo[i], language = NULL) & antibiotic == ab_name(ab, language = NULL))

8
R/rsi_calc.R
View File

@ -95,7 +95,7 @@ rsi_calc <- function(...,
} }
if (is.null(x)) { if (is.null(x)) {
warning("argument is NULL (check if columns exist): returning NA", call. = FALSE) warning_("argument is NULL (check if columns exist): returning NA", call = FALSE)
return(NA) return(NA)
} }
@ -143,8 +143,8 @@ rsi_calc <- function(...,
} }
if (print_warning == TRUE) { if (print_warning == TRUE) {
warning("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)", warning_("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)",
call. = FALSE) call = FALSE)
} }
if (only_count == TRUE) { if (only_count == TRUE) {
@ -155,7 +155,7 @@ rsi_calc <- function(...,
if (data_vars != "") { if (data_vars != "") {
data_vars <- paste(" for", data_vars) data_vars <- paste(" for", data_vars)
} }
warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` = ", minimum, ").", call. = FALSE) warning_("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` = ", minimum, ").", call = FALSE)
fraction <- NA_real_ fraction <- NA_real_
} else { } else {
fraction <- numerator / denominator fraction <- numerator / denominator

2
R/translate.R
View File

@ -155,7 +155,7 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
# check if text to look for is in one of the patterns # check if text to look for is in one of the patterns
any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")), any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
error = function(e) { error = function(e) {
warning("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call. = FALSE) warning_("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call = FALSE)
return(FALSE) return(FALSE)
}) })
if (NROW(df_trans) == 0 | !any_form_in_patterns) { if (NROW(df_trans) == 0 | !any_form_in_patterns) {

11
R/zzz.R
View File

@ -77,10 +77,13 @@
if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(getOption("AMR_silentstart", FALSE)))) { if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(getOption("AMR_silentstart", FALSE)))) {
return() return()
} }
packageStartupMessage("Thank you for using the AMR package! ", packageStartupMessage(word_wrap("Thank you for using the AMR package! ",
"If you have a minute, please anonymously fill in this short questionnaire to improve the package and its functionalities:", "If you have a minute, please anonymously fill in this short questionnaire to improve the package and its functionalities: ",
"\nhttps://msberends.github.io/AMR/survey.html", font_blue("https://msberends.github.io/AMR/survey.html\n"),
"\n[ prevent his notice with suppressPackageStartupMessages(library(AMR)) or use options(AMR_silentstart = TRUE) ]") "[prevent his notice with ",
font_bold("suppressPackageStartupMessages(library(AMR))"),
" or use ",
font_bold("options(AMR_silentstart = TRUE)"), "]"))
} }
create_species_cons_cops <- function(type = c("CoNS", "CoPS")) { create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a> <a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

4
docs/index.html
View File

@ -43,7 +43,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>
@ -198,7 +198,7 @@
<a href="#amr-for-r-" class="anchor"></a><code>AMR</code> (for R) <img src="./logo.png" align="right" height="120px"> <a href="#amr-for-r-" class="anchor"></a><code>AMR</code> (for R) <img src="./logo.png" align="right" height="120px">
</h1></div> </h1></div>
<blockquote> <blockquote>
<p><em>July 2020</em><br><span class="fa fa-clipboard-list" style="color: #128f76; font-size: 20pt; margin-right: 5px;"></span> <strong>PLEASE TAKE PART IN OUR SURVEY!</strong><br> <p><span class="fa fa-clipboard-list" style="color: #128f76; font-size: 20pt; margin-right: 5px;"></span> <strong>PLEASE TAKE PART IN OUR SURVEY!</strong><br>
Since you are one of our users, we would like to know how you use the package and what it brought you or your organisation. <strong>If you have a minute, please <a href="./survey.html">anonymously fill in this short questionnaire</a></strong>. Your valuable input will help to improve the package and its functionalities. You can answer the open questions in either English, Spanish, French, Dutch, or German. Thank you very much in advance! <br><a class="btn btn-info btn-amr" href="./survey.html">Take me to the 5-min survey!</a></p> Since you are one of our users, we would like to know how you use the package and what it brought you or your organisation. <strong>If you have a minute, please <a href="./survey.html">anonymously fill in this short questionnaire</a></strong>. Your valuable input will help to improve the package and its functionalities. You can answer the open questions in either English, Spanish, French, Dutch, or German. Thank you very much in advance! <br><a class="btn btn-info btn-amr" href="./survey.html">Take me to the 5-min survey!</a></p>
</blockquote> </blockquote>
<div id="what-is-amr-for-r" class="section level3"> <div id="what-is-amr-for-r" class="section level3">

16
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>
@ -236,13 +236,13 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small> <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div> </div>
<div id="amr-1409014" class="section level1"> <div id="amr-1409015" class="section level1">
<h1 class="page-header" data-toc-text="1.4.0.9014"> <h1 class="page-header" data-toc-text="1.4.0.9015">
<a href="#amr-1409014" class="anchor"></a>AMR 1.4.0.9014<small> Unreleased </small> <a href="#amr-1409015" class="anchor"></a>AMR 1.4.0.9015<small> Unreleased </small>
</h1> </h1>
<div id="last-updated-9-november-2020" class="section level2"> <div id="last-updated-10-november-2020" class="section level2">
<h2 class="hasAnchor"> <h2 class="hasAnchor">
<a href="#last-updated-9-november-2020" class="anchor"></a><small>Last updated: 9 November 2020</small> <a href="#last-updated-10-november-2020" class="anchor"></a><small>Last updated: 10 November 2020</small>
</h2> </h2>
<div id="new" class="section level3"> <div id="new" class="section level3">
<h3 class="hasAnchor"> <h3 class="hasAnchor">
@ -252,7 +252,7 @@
<p>Functions <code><a href="../reference/mo_property.html">is_gram_negative()</a></code> and <code><a href="../reference/mo_property.html">is_gram_positive()</a></code> as wrappers around <code><a href="../reference/mo_property.html">mo_gramstain()</a></code>. They always return <code>TRUE</code> or <code>FALSE</code> (except when the input is <code>NA</code> or the MO code is <code>UNKNOWN</code>), thus always return <code>FALSE</code> for species outside the taxonomic kingdom of Bacteria. If you have the <code>dplyr</code> package installed, they can even determine the column with microorganisms themselves inside <code>dplyr</code> functions:</p> <p>Functions <code><a href="../reference/mo_property.html">is_gram_negative()</a></code> and <code><a href="../reference/mo_property.html">is_gram_positive()</a></code> as wrappers around <code><a href="../reference/mo_property.html">mo_gramstain()</a></code>. They always return <code>TRUE</code> or <code>FALSE</code> (except when the input is <code>NA</code> or the MO code is <code>UNKNOWN</code>), thus always return <code>FALSE</code> for species outside the taxonomic kingdom of Bacteria. If you have the <code>dplyr</code> package installed, they can even determine the column with microorganisms themselves inside <code>dplyr</code> functions:</p>
<div class="sourceCode" id="cb1"><pre class="downlit"> <div class="sourceCode" id="cb1"><pre class="downlit">
<span class="va">example_isolates</span> <span class="op">%&gt;%</span> <span class="va">example_isolates</span> <span class="op">%&gt;%</span>
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/filter.html">filter</a></span><span class="op">(</span><span class="fu"><a href="../reference/mo_property.html">is_gram_positive</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span> <span class="fu"><a href="https://rdrr.io/r/stats/filter.html">filter</a></span><span class="op">(</span><span class="fu"><a href="../reference/mo_property.html">is_gram_positive</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span>
<span class="co">#&gt; NOTE: Using column `mo` as input for 'x'</span></pre></div> <span class="co">#&gt; NOTE: Using column `mo` as input for 'x'</span></pre></div>
</li> </li>
<li><p>Functions <code><a href="../reference/like.html">%not_like%</a></code> and <code><a href="../reference/like.html">%not_like_case%</a></code> as wrappers around <code><a href="../reference/like.html">%like%</a></code> and <code><a href="../reference/like.html">%like_case%</a></code>. The RStudio addin to insert the text " %like% " as provided in this package now iterates over all like variants. So if you have defined the keyboard shortcut Ctrl/Cmd + L to this addin, it will first insert <code><a href="../reference/like.html">%like%</a></code> and by pressing it again it will be replaced with <code><a href="../reference/like.html">%not_like%</a></code>, etc.</p></li> <li><p>Functions <code><a href="../reference/like.html">%not_like%</a></code> and <code><a href="../reference/like.html">%not_like_case%</a></code> as wrappers around <code><a href="../reference/like.html">%like%</a></code> and <code><a href="../reference/like.html">%like_case%</a></code>. The RStudio addin to insert the text " %like% " as provided in this package now iterates over all like variants. So if you have defined the keyboard shortcut Ctrl/Cmd + L to this addin, it will first insert <code><a href="../reference/like.html">%like%</a></code> and by pressing it again it will be replaced with <code><a href="../reference/like.html">%not_like%</a></code>, etc.</p></li>
@ -273,7 +273,7 @@
<h3 class="hasAnchor"> <h3 class="hasAnchor">
<a href="#other" class="anchor"></a>Other</h3> <a href="#other" class="anchor"></a>Other</h3>
<ul> <ul>
<li>All messages thrown by this package now have correct line breaks</li> <li>All messages and warnings thrown by this package now break sentences on whole words</li>
<li>More extensive unit tests</li> <li>More extensive unit tests</li>
</ul> </ul>
</div> </div>

2
docs/pkgdown.yml
View File

@ -12,7 +12,7 @@ articles:
datasets: datasets.html datasets: datasets.html
resistance_predict: resistance_predict.html resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html welcome_to_AMR: welcome_to_AMR.html
last_built: 2020-11-09T14:18Z last_built: 2020-11-10T15:32Z
urls: urls:
reference: https://msberends.github.io/AMR//reference reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles article: https://msberends.github.io/AMR//articles

2
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9014</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9015</span>
</span> </span>
</div> </div>

1
index.md
View File

@ -1,6 +1,5 @@
# `AMR` (for R) <img src="./logo.png" align="right" height="120px" /> # `AMR` (for R) <img src="./logo.png" align="right" height="120px" />
> *July 2020*<br>
> <span class="fa fa-clipboard-list" style="color: #128f76; font-size: 20pt; margin-right: 5px;"></span> **PLEASE TAKE PART IN OUR SURVEY!** > <span class="fa fa-clipboard-list" style="color: #128f76; font-size: 20pt; margin-right: 5px;"></span> **PLEASE TAKE PART IN OUR SURVEY!**
> Since you are one of our users, we would like to know how you use the package and what it brought you or your organisation. **If you have a minute, please [anonymously fill in this short questionnaire](./survey.html)**. Your valuable input will help to improve the package and its functionalities. You can answer the open questions in either English, Spanish, French, Dutch, or German. Thank you very much in advance! > Since you are one of our users, we would like to know how you use the package and what it brought you or your organisation. **If you have a minute, please [anonymously fill in this short questionnaire](./survey.html)**. Your valuable input will help to improve the package and its functionalities. You can answer the open questions in either English, Spanish, French, Dutch, or German. Thank you very much in advance!
> <br> > <br>

6
tests/testthat/test-eucast_rules.R
View File

@ -90,12 +90,12 @@ test_that("EUCAST rules work", {
"R") "R")
# Azithromycin and Clarythromycin must be equal to Erythromycin # Azithromycin and Clarythromycin must be equal to Erythromycin
a <- eucast_rules(data.frame(mo = example_isolates$mo, a <- as.rsi(eucast_rules(data.frame(mo = example_isolates$mo,
ERY = example_isolates$ERY, ERY = example_isolates$ERY,
AZM = as.rsi("R"), AZM = as.rsi("R"),
CLR = as.rsi("R"), CLR = factor("R"),
stringsAsFactors = FALSE), stringsAsFactors = FALSE),
version_expertrules = 3.1)$CLR version_expertrules = 3.1)$CLR)
b <- example_isolates$ERY b <- example_isolates$ERY
expect_identical(a[!is.na(b)], expect_identical(a[!is.na(b)],
b[!is.na(b)]) b[!is.na(b)])