mirror of https://github.com/msberends/AMR.git
(v1.4.0.9015) bugfix
This commit is contained in:
parent
dd5a0319ef
commit
15c732703d
|
|
@ -1,6 +1,6 @@
|
|||
Package: AMR
|
||||
Version: 1.4.0.9014
|
||||
Date: 2020-11-09
|
||||
Version: 1.4.0.9015
|
||||
Date: 2020-11-10
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
person(role = c("aut", "cre"),
|
||||
|
|
|
|||
6
NEWS.md
6
NEWS.md
|
|
@ -1,5 +1,5 @@
|
|||
# AMR 1.4.0.9014
|
||||
## <small>Last updated: 9 November 2020</small>
|
||||
# AMR 1.4.0.9015
|
||||
## <small>Last updated: 10 November 2020</small>
|
||||
|
||||
### 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:
|
||||
|
|
@ -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)
|
||||
|
||||
### 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
|
||||
|
||||
# AMR 1.4.0
|
||||
|
|
|
|||
|
|
@ -267,27 +267,35 @@ 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
|
||||
# - ignores formatted text while wrapping
|
||||
# - adds indentation dependent on the type of message (like NOTE)
|
||||
# - add additional formatting functions like blue or bold text
|
||||
message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = TRUE) {
|
||||
# - can add additional formatting functions like blue or bold text
|
||||
word_wrap <- function(...,
|
||||
add_fn = list(),
|
||||
as_note = FALSE,
|
||||
width = 0.95 * getOption("width"),
|
||||
extra_indent = 0) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
# replace new lines to add them again later
|
||||
msg <- gsub("\n", "*|*", msg, fixed = TRUE)
|
||||
|
||||
if (isTRUE(as_note)) {
|
||||
msg <- paste0("NOTE: ", gsub("note:? ?", "", msg, ignore.case = TRUE))
|
||||
}
|
||||
|
||||
|
||||
# we need to correct for already applied style, that adds text like "\033[31m\"
|
||||
msg_stripped <- font_stripstyle(msg)
|
||||
# where are the spaces now?
|
||||
msg_stripped_wrapped <- paste0(strwrap(msg_stripped,
|
||||
simplify = TRUE,
|
||||
width = 0.95 * getOption("width")),
|
||||
width = width),
|
||||
collapse = "\n")
|
||||
msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
|
||||
collapse = "\n")
|
||||
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
|
||||
replace_spaces <- which(!msg_stripped_spaces %in% msg_stripped_wrapped_spaces)
|
||||
# put it together
|
||||
|
|
@ -295,15 +303,16 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = T
|
|||
msg[replace_spaces] <- paste0(msg[replace_spaces], "\n")
|
||||
msg <- paste0(msg, collapse = " ")
|
||||
msg <- gsub("\n ", "\n", msg, fixed = TRUE)
|
||||
|
||||
|
||||
if (msg_stripped %like% "^NOTE: ") {
|
||||
indentation <- 6
|
||||
indentation <- 6 + extra_indent
|
||||
} else if (msg_stripped %like% "^=> ") {
|
||||
indentation <- 3
|
||||
indentation <- 3 + extra_indent
|
||||
} else {
|
||||
indentation <- 0
|
||||
indentation <- 0 + extra_indent
|
||||
}
|
||||
msg <- gsub("\n", paste0("\n", strrep(" ", indentation)), msg, fixed = TRUE)
|
||||
msg <- gsub("*|*", paste0("*|*", strrep(" ", indentation)), msg, fixed = TRUE)
|
||||
|
||||
if (length(add_fn) > 0) {
|
||||
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)
|
||||
}
|
||||
}
|
||||
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:
|
||||
# - adds the function name where the error was thrown
|
||||
# - wraps text to never break lines within words
|
||||
stop_ <- function(..., call = TRUE) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
msg <- word_wrap(..., add_fn = list(), as_note = FALSE)
|
||||
if (!isFALSE(call)) {
|
||||
if (isTRUE(call)) {
|
||||
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) {
|
||||
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
|
||||
|
|
|
|||
16
R/ab.R
16
R/ab.R
|
|
@ -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 <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||
if (length(x_unknown_ATCs) > 0) {
|
||||
warning("These ATC codes are not (yet) in the antibiotics data set: ",
|
||||
paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
call. = FALSE)
|
||||
warning_("These ATC codes are not (yet) in the antibiotics data set: ",
|
||||
paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
if (length(x_unknown) > 0) {
|
||||
warning("These values could not be coerced to a valid antimicrobial ID: ",
|
||||
paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
call. = FALSE)
|
||||
warning_("These values could not be coerced to a valid antimicrobial ID: ",
|
||||
paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %pm>%
|
||||
|
|
|
|||
|
|
@ -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))]
|
||||
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 (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])) {
|
||||
utils::browseURL(u[1L])
|
||||
|
|
|
|||
6
R/age.R
6
R/age.R
|
|
@ -83,10 +83,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
|||
|
||||
if (any(ages < 0, na.rm = TRUE)) {
|
||||
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)) {
|
||||
warning("Some ages are above 120.")
|
||||
warning_("Some ages are above 120.", call = TRUE)
|
||||
}
|
||||
|
||||
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)) {
|
||||
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)) {
|
||||
split_at <- split_at[1L]
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ atc_online_property <- function(atc_code,
|
|||
colnames(tbl) <- gsub("^atc.*", "atc", tolower(colnames(tbl)))
|
||||
|
||||
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
|
||||
next
|
||||
}
|
||||
|
|
|
|||
|
|
@ -134,7 +134,7 @@ count_R <- function(..., only_all_tested = FALSE) {
|
|||
#' @rdname count
|
||||
#' @export
|
||||
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(...,
|
||||
ab_result = c("I", "R"),
|
||||
only_all_tested = only_all_tested,
|
||||
|
|
@ -162,7 +162,7 @@ count_SI <- function(..., only_all_tested = FALSE) {
|
|||
#' @rdname count
|
||||
#' @export
|
||||
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(...,
|
||||
ab_result = "S",
|
||||
only_all_tested = only_all_tested,
|
||||
|
|
|
|||
8
R/disk.R
8
R/disk.R
|
|
@ -101,10 +101,10 @@ as.disk <- function(x, na.rm = FALSE) {
|
|||
unique() %pm>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
warning(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
list_missing, call. = FALSE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
list_missing, call = FALSE)
|
||||
}
|
||||
}
|
||||
structure(as.integer(x),
|
||||
|
|
|
|||
|
|
@ -564,10 +564,12 @@ eucast_rules <- function(x,
|
|||
x <- as.data.frame(x, stringsAsFactors = FALSE) # no tibbles, data.tables, etc.
|
||||
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)
|
||||
x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]))), function(x) {
|
||||
x[is.na(x)] <- "."
|
||||
paste0(x, collapse = "")
|
||||
})
|
||||
x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]),
|
||||
stringsAsFactors = FALSE)),
|
||||
function(x) {
|
||||
x[is.na(x)] <- "."
|
||||
paste0(x, collapse = "")
|
||||
})
|
||||
|
||||
# save original table, with the new .rowid column
|
||||
x.bak <- x
|
||||
|
|
@ -676,7 +678,12 @@ eucast_rules <- function(x,
|
|||
|
||||
} else {
|
||||
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 -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
# 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
|
||||
}
|
||||
}
|
||||
|
|
@ -903,12 +912,12 @@ eucast_rules <- function(x,
|
|||
}
|
||||
|
||||
cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n"))
|
||||
cat(paste0("The rules ", paste0(wouldve, "affected "),
|
||||
font_bold(formatnr(pm_n_distinct(verbose_info$row)),
|
||||
"out of", formatnr(nrow(x.bak)),
|
||||
"rows"),
|
||||
", making a total of ",
|
||||
font_bold(formatnr(nrow(verbose_info)), "edits\n")))
|
||||
cat(word_wrap(paste0("The rules ", paste0(wouldve, "affected "),
|
||||
font_bold(formatnr(pm_n_distinct(verbose_info$row)),
|
||||
"out of", formatnr(nrow(x.bak)),
|
||||
"rows"),
|
||||
", making a total of ",
|
||||
font_bold(formatnr(nrow(verbose_info)), "edits\n"))))
|
||||
|
||||
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()
|
||||
|
|
@ -960,21 +969,21 @@ eucast_rules <- function(x,
|
|||
cat(paste0(font_grey(strrep("-", 0.95 * options()$width)), "\n"))
|
||||
|
||||
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) {
|
||||
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) {
|
||||
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",
|
||||
" ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||
" ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
|
||||
warn_lacking_rsi_class,
|
||||
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])),
|
||||
")",
|
||||
call. = FALSE)
|
||||
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, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
|
||||
warn_lacking_rsi_class,
|
||||
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])),
|
||||
")",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
# Return data set ---------------------------------------------------------
|
||||
|
|
@ -1034,16 +1043,16 @@ edit_rsi <- function(x,
|
|||
warning = function(w) {
|
||||
if (w$message %like% "invalid factor level") {
|
||||
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))))
|
||||
# x[, col] <<- factor(x = as.character(pm_pull(x, col)), levels = c(to, levels(pm_pull(x, col))))
|
||||
new_edits[, col] <<- factor(x = as.character(pm_pull(new_edits, col)),
|
||||
levels = unique(c(to, levels(pm_pull(new_edits, col)))))
|
||||
invisible()
|
||||
})
|
||||
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)
|
||||
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. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE)
|
||||
txt_warning()
|
||||
warned <- FALSE
|
||||
} else {
|
||||
warning(w$message, call. = FALSE)
|
||||
warning_(w$message, call = FALSE)
|
||||
txt_warning()
|
||||
cat("\n") # txt_warning() does not append a "\n" on itself
|
||||
}
|
||||
|
|
|
|||
|
|
@ -167,8 +167,9 @@ get_column_abx <- function(x,
|
|||
if (length(dots) > 0) {
|
||||
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
|
||||
if (any(is.na(newnames))) {
|
||||
warning("Invalid antibiotic reference(s): ", toString(names(dots)[is.na(newnames)]),
|
||||
call. = FALSE, immediate. = TRUE)
|
||||
warning_("Invalid antibiotic reference(s): ", toString(names(dots)[is.na(newnames)]),
|
||||
call = FALSE,
|
||||
immediate = TRUE)
|
||||
}
|
||||
# turn all NULLs to NAs
|
||||
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), ").")
|
||||
}
|
||||
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],
|
||||
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
|
||||
"), although it was matched for multiple antibiotics or columns.")),
|
||||
call. = FALSE,
|
||||
immediate. = verbose)
|
||||
warning_(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
|
||||
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
|
||||
"), although it was matched for multiple antibiotics or columns."),
|
||||
add_fn = font_red,
|
||||
call = FALSE,
|
||||
immediate = verbose)
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -245,8 +247,8 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
|
|||
} else {
|
||||
any_txt <- c("", "are")
|
||||
}
|
||||
warning(paste0("Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||
paste(missing, collapse = ", ")),
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
warning_(paste0("Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||
paste(missing, collapse = ", ")),
|
||||
immediate = TRUE,
|
||||
call = FALSE)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
|||
)
|
||||
}
|
||||
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
|
||||
join
|
||||
|
|
@ -114,7 +114,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
|||
)
|
||||
}
|
||||
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
|
||||
join
|
||||
|
|
@ -145,7 +145,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
|||
)
|
||||
}
|
||||
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
|
||||
join
|
||||
|
|
@ -176,7 +176,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
|||
)
|
||||
}
|
||||
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
|
||||
join
|
||||
|
|
@ -280,7 +280,7 @@ check_groups_before_join <- function(x, fn) {
|
|||
x <- pm_ungroup(x)
|
||||
attr(x, "groups") <- NULL
|
||||
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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -188,11 +188,11 @@ key_antibiotics <- function(x,
|
|||
}
|
||||
if (!all(col.list %in% colnames(x))) {
|
||||
if (warnings == TRUE) {
|
||||
warning("Some columns do not exist and will be ignored: ",
|
||||
col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(),
|
||||
".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
warning_("Some columns do not exist and will be ignored: ",
|
||||
col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(),
|
||||
".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
|
||||
immediate = TRUE,
|
||||
call = FALSE)
|
||||
}
|
||||
}
|
||||
col.list
|
||||
|
|
@ -227,7 +227,7 @@ key_antibiotics <- function(x,
|
|||
gram_positive <- gram_positive[!is.null(gram_positive)]
|
||||
gram_positive <- gram_positive[!is.na(gram_positive)]
|
||||
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,
|
||||
|
|
@ -236,7 +236,7 @@ key_antibiotics <- function(x,
|
|||
gram_negative <- gram_negative[!is.null(gram_negative)]
|
||||
gram_negative <- gram_negative[!is.na(gram_negative)]
|
||||
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)
|
||||
|
|
@ -264,7 +264,7 @@ key_antibiotics <- function(x,
|
|||
key_abs <- toupper(gsub("[^SIR]", ".", gsub("(NA|NULL)", ".", x$key_ab)))
|
||||
|
||||
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
|
||||
|
|
|
|||
4
R/mdro.R
4
R/mdro.R
|
|
@ -132,7 +132,7 @@ mdro <- function(x,
|
|||
}
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
|
|
@ -1205,7 +1205,7 @@ mdro <- function(x,
|
|||
# Results ----
|
||||
if (guideline$code == "cmi2012") {
|
||||
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`)")
|
||||
# set these -1s to NA
|
||||
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_
|
||||
|
|
|
|||
8
R/mic.R
8
R/mic.R
|
|
@ -125,10 +125,10 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||
unique() %pm>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
warning(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
list_missing, call. = FALSE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
list_missing, call = FALSE)
|
||||
}
|
||||
|
||||
structure(.Data = factor(x, levels = lvls, ordered = TRUE),
|
||||
|
|
|
|||
41
R/mo.R
41
R/mo.R
|
|
@ -173,7 +173,7 @@ as.mo <- function(x,
|
|||
& isFALSE(Becker)
|
||||
& isFALSE(Lancefield), error = function(e) FALSE)) {
|
||||
# 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))
|
||||
}
|
||||
|
||||
|
|
@ -1393,9 +1393,10 @@ exec_as.mo <- function(x,
|
|||
"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',
|
||||
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n')
|
||||
warning(font_red(paste0("\n", msg)),
|
||||
call. = FALSE,
|
||||
immediate. = TRUE) # thus will always be shown, even if >= warnings
|
||||
warning_(paste0("\n", msg),
|
||||
add_fn = font_red,
|
||||
call = FALSE,
|
||||
immediate = TRUE) # thus will always be shown, even if >= warnings
|
||||
}
|
||||
# handling uncertainties ----
|
||||
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
|
||||
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: ",
|
||||
font_italic(paste("S.",
|
||||
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
|
||||
collapse = ", ")),
|
||||
".",
|
||||
call. = FALSE,
|
||||
immediate. = TRUE)
|
||||
warning_("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ",
|
||||
font_italic(paste("S.",
|
||||
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
|
||||
collapse = ", ")),
|
||||
".",
|
||||
call = FALSE,
|
||||
immediate = TRUE)
|
||||
}
|
||||
|
||||
# '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]
|
||||
# assign on places where a match was found
|
||||
x[which(!is.na(matched))] <- mo_new[which(!is.na(matched))]
|
||||
n_matched <- length(matched[!is.na(matched)])
|
||||
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()."))
|
||||
} else {
|
||||
if (length(matched) == 1) {
|
||||
message_(font_blue("NOTE: 1 old microbial code (from previous package versions) was updated to a current used code."))
|
||||
if (n_matched == 1) {
|
||||
message_(font_blue("NOTE: 1 old microbial code (from previous package versions) was updated to a current used MO code."))
|
||||
} 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 {
|
||||
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
|
||||
suppressWarnings(
|
||||
reference_df[] <- lapply(reference_df, as.character)
|
||||
)
|
||||
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
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -529,7 +529,7 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
|
|||
|
||||
if (open == TRUE) {
|
||||
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])
|
||||
}
|
||||
|
|
|
|||
|
|
@ -239,7 +239,7 @@ get_mo_source <- function() {
|
|||
mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
|
||||
check_dataset_integrity()
|
||||
|
||||
if (deparse(substitute(x)) == "get_mo_source()") {
|
||||
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
|
||||
return(TRUE)
|
||||
}
|
||||
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 (stop_on_error == TRUE) {
|
||||
stop(refer_to_name, " cannot be NULL", call. = FALSE)
|
||||
stop_(refer_to_name, " cannot be NULL", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (!is.data.frame(x)) {
|
||||
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 {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (!"mo" %in% colnames(x)) {
|
||||
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 {
|
||||
return(FALSE)
|
||||
}
|
||||
|
|
@ -274,13 +274,27 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error
|
|||
} else {
|
||||
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),
|
||||
", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "),
|
||||
call. = FALSE)
|
||||
call = FALSE)
|
||||
} else {
|
||||
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
2
R/pca.R
|
|
@ -98,7 +98,7 @@ pca <- function(x,
|
|||
|
||||
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -148,7 +148,7 @@ resistance_predict <- function(x,
|
|||
x <- dots[which(dots.names == "tbl")]
|
||||
}
|
||||
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
16
R/rsi.R
|
|
@ -237,9 +237,9 @@ as.rsi.default <- function(x, ...) {
|
|||
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
|
||||
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)) {
|
||||
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>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
warning(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid antimicrobial interpretations: ",
|
||||
list_missing, call. = FALSE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid antimicrobial interpretations: ",
|
||||
list_missing, call = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -675,14 +675,14 @@ exec_as.rsi <- function(method,
|
|||
|
||||
if (all(trans$uti == TRUE, na.rm = TRUE) & all(uti == 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
|
||||
}
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
if (isTRUE(add_intrinsic_resistance)) {
|
||||
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 {
|
||||
get_record <- subset(intrinsic_resistant,
|
||||
microorganism == mo_name(mo[i], language = NULL) & antibiotic == ab_name(ab, language = NULL))
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@ rsi_calc <- function(...,
|
|||
}
|
||||
|
||||
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)
|
||||
}
|
||||
|
||||
|
|
@ -143,8 +143,8 @@ rsi_calc <- function(...,
|
|||
}
|
||||
|
||||
if (print_warning == TRUE) {
|
||||
warning("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)",
|
||||
call. = FALSE)
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
if (only_count == TRUE) {
|
||||
|
|
@ -155,7 +155,7 @@ rsi_calc <- function(...,
|
|||
if (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_
|
||||
} else {
|
||||
fraction <- numerator / denominator
|
||||
|
|
|
|||
|
|
@ -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
|
||||
any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
|
||||
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)
|
||||
})
|
||||
if (NROW(df_trans) == 0 | !any_form_in_patterns) {
|
||||
|
|
|
|||
11
R/zzz.R
11
R/zzz.R
|
|
@ -77,10 +77,13 @@
|
|||
if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(getOption("AMR_silentstart", FALSE)))) {
|
||||
return()
|
||||
}
|
||||
packageStartupMessage("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:",
|
||||
"\nhttps://msberends.github.io/AMR/survey.html",
|
||||
"\n[ prevent his notice with suppressPackageStartupMessages(library(AMR)) or use options(AMR_silentstart = TRUE) ]")
|
||||
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: ",
|
||||
font_blue("https://msberends.github.io/AMR/survey.html\n"),
|
||||
"[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")) {
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</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">
|
||||
</h1></div>
|
||||
<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>
|
||||
</blockquote>
|
||||
<div id="what-is-amr-for-r" class="section level3">
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
@ -236,13 +236,13 @@
|
|||
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
|
||||
</div>
|
||||
|
||||
<div id="amr-1409014" class="section level1">
|
||||
<h1 class="page-header" data-toc-text="1.4.0.9014">
|
||||
<a href="#amr-1409014" class="anchor"></a>AMR 1.4.0.9014<small> Unreleased </small>
|
||||
<div id="amr-1409015" class="section level1">
|
||||
<h1 class="page-header" data-toc-text="1.4.0.9015">
|
||||
<a href="#amr-1409015" class="anchor"></a>AMR 1.4.0.9015<small> Unreleased </small>
|
||||
</h1>
|
||||
<div id="last-updated-9-november-2020" class="section level2">
|
||||
<div id="last-updated-10-november-2020" class="section level2">
|
||||
<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>
|
||||
<div id="new" class="section level3">
|
||||
<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>
|
||||
<div class="sourceCode" id="cb1"><pre class="downlit">
|
||||
<span class="va">example_isolates</span> <span class="op">%>%</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">#> NOTE: Using column `mo` as input for 'x'</span></pre></div>
|
||||
</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">
|
||||
<a href="#other" class="anchor"></a>Other</h3>
|
||||
<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>
|
||||
</ul>
|
||||
</div>
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ articles:
|
|||
datasets: datasets.html
|
||||
resistance_predict: resistance_predict.html
|
||||
welcome_to_AMR: welcome_to_AMR.html
|
||||
last_built: 2020-11-09T14:18Z
|
||||
last_built: 2020-11-10T15:32Z
|
||||
urls:
|
||||
reference: https://msberends.github.io/AMR//reference
|
||||
article: https://msberends.github.io/AMR//articles
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
1
index.md
1
index.md
|
|
@ -1,6 +1,5 @@
|
|||
# `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!**
|
||||
> 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>
|
||||
|
|
|
|||
|
|
@ -90,12 +90,12 @@ test_that("EUCAST rules work", {
|
|||
"R")
|
||||
|
||||
# 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,
|
||||
AZM = as.rsi("R"),
|
||||
CLR = as.rsi("R"),
|
||||
CLR = factor("R"),
|
||||
stringsAsFactors = FALSE),
|
||||
version_expertrules = 3.1)$CLR
|
||||
version_expertrules = 3.1)$CLR)
|
||||
b <- example_isolates$ERY
|
||||
expect_identical(a[!is.na(b)],
|
||||
b[!is.na(b)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue