mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 19:26:13 +01:00
(v1.8.0.9002) as.rsi() cleanup, more informative warnings
This commit is contained in:
parent
18e8525d10
commit
3b2b2be5f8
@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 1.8.0.9001
|
Version: 1.8.0.9002
|
||||||
Date: 2022-02-26
|
Date: 2022-03-02
|
||||||
Title: Antimicrobial Resistance Data Analysis
|
Title: Antimicrobial Resistance Data Analysis
|
||||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
|
5
NEWS.md
5
NEWS.md
@ -1,5 +1,5 @@
|
|||||||
# `AMR` 1.8.0.9001
|
# `AMR` 1.8.0.9002
|
||||||
## <small>Last updated: 26 February 2022</small>
|
## <small>Last updated: 2 March 2022</small>
|
||||||
|
|
||||||
All functions in this package are considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months.
|
All functions in this package are considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months.
|
||||||
|
|
||||||
@ -10,6 +10,7 @@ All functions in this package are considered to be stable. Updates to the AMR in
|
|||||||
mo_name("methicillin-resistant S. aureus (MRSA)")
|
mo_name("methicillin-resistant S. aureus (MRSA)")
|
||||||
#> [1] "Staphylococcus aureus"
|
#> [1] "Staphylococcus aureus"
|
||||||
```
|
```
|
||||||
|
* More informative warning messages
|
||||||
|
|
||||||
### Other
|
### Other
|
||||||
* Fix for unit testing on R 3.3
|
* Fix for unit testing on R 3.3
|
||||||
|
@ -206,7 +206,7 @@ check_dataset_integrity <- function() {
|
|||||||
" overwritten by your global environment and prevent", plural[2],
|
" overwritten by your global environment and prevent", plural[2],
|
||||||
" the AMR package from working correctly: ",
|
" the AMR package from working correctly: ",
|
||||||
vector_and(overwritten, quotes = "'"),
|
vector_and(overwritten, quotes = "'"),
|
||||||
".\nPlease rename your object", plural[3], ".", call = FALSE)
|
".\nPlease rename your object", plural[3], ".")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# check if other packages did not overwrite our data sets
|
# check if other packages did not overwrite our data sets
|
||||||
@ -492,7 +492,7 @@ message_ <- function(...,
|
|||||||
warning_ <- function(...,
|
warning_ <- function(...,
|
||||||
add_fn = list(),
|
add_fn = list(),
|
||||||
immediate = FALSE,
|
immediate = FALSE,
|
||||||
call = TRUE) {
|
call = FALSE) {
|
||||||
warning(word_wrap(...,
|
warning(word_wrap(...,
|
||||||
add_fn = add_fn,
|
add_fn = add_fn,
|
||||||
as_note = FALSE),
|
as_note = FALSE),
|
||||||
@ -559,7 +559,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
|
|||||||
|
|
||||||
return_after_integrity_check <- function(value, type, check_vector) {
|
return_after_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"))
|
||||||
value[!value %in% check_vector] <- NA
|
value[!value %in% check_vector] <- NA
|
||||||
}
|
}
|
||||||
value
|
value
|
||||||
|
10
R/ab.R
10
R/ab.R
@ -455,15 +455,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
|||||||
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 & fast_mode == FALSE) {
|
if (length(x_unknown_ATCs) > 0 & fast_mode == FALSE) {
|
||||||
warning_("These ATC codes are not (yet) in the antibiotics data set: ",
|
warning_("in `as.ab()`: these ATC codes are not (yet) in the antibiotics data set: ",
|
||||||
vector_and(x_unknown_ATCs), ".",
|
vector_and(x_unknown_ATCs), ".")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if (length(x_unknown) > 0 & fast_mode == FALSE) {
|
if (length(x_unknown) > 0 & fast_mode == FALSE) {
|
||||||
warning_("These values could not be coerced to a valid antimicrobial ID: ",
|
warning_("in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
|
||||||
vector_and(x_unknown), ".",
|
vector_and(x_unknown), ".")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
x_result <- x_new[match(x_bak_clean, x)]
|
x_result <- x_new[match(x_bak_clean, x)]
|
||||||
|
@ -240,8 +240,8 @@ ab_ddd <- function(x, administration = "oral", ...) {
|
|||||||
units <- list(...)$units
|
units <- list(...)$units
|
||||||
if (!is.null(units) && isTRUE(units)) {
|
if (!is.null(units) && isTRUE(units)) {
|
||||||
if (message_not_thrown_before("ab_ddd", entire_session = TRUE)) {
|
if (message_not_thrown_before("ab_ddd", entire_session = TRUE)) {
|
||||||
warning_("Using `ab_ddd(..., units = TRUE)` is deprecated, use `ab_ddd_units()` to retrieve units instead. ",
|
warning_("in `ab_ddd()`: using `ab_ddd(..., units = TRUE)` is deprecated, use `ab_ddd_units()` to retrieve units instead.",
|
||||||
"This warning will be shown once per session.", call = FALSE)
|
"This warning will be shown once per session.")
|
||||||
}
|
}
|
||||||
ddd_prop <- paste0(ddd_prop, "_units")
|
ddd_prop <- paste0(ddd_prop, "_units")
|
||||||
} else {
|
} else {
|
||||||
@ -250,9 +250,9 @@ ab_ddd <- function(x, administration = "oral", ...) {
|
|||||||
out <- ab_validate(x = x, property = ddd_prop)
|
out <- ab_validate(x = x, property = ddd_prop)
|
||||||
|
|
||||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||||
warning_("DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package. ",
|
warning_("in `ab_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||||
"Please refer to the WHOCC website:\n",
|
"Please refer to the WHOCC website:\n",
|
||||||
"www.whocc.no/ddd/list_of_ddds_combined_products/", call = FALSE)
|
"www.whocc.no/ddd/list_of_ddds_combined_products/")
|
||||||
}
|
}
|
||||||
out
|
out
|
||||||
}
|
}
|
||||||
@ -265,9 +265,9 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
|
|||||||
|
|
||||||
x <- as.ab(x, ...)
|
x <- as.ab(x, ...)
|
||||||
if (any(ab_name(x, language = NULL) %like% "/")) {
|
if (any(ab_name(x, language = NULL) %like% "/")) {
|
||||||
warning_("DDDs of combined products are available for different dose combinations and not (yet) part of the AMR package. ",
|
warning_("in `ab_ddd_units()`: DDDs of combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||||
"Please refer to the WHOCC website:\n",
|
"Please refer to the WHOCC website:\n",
|
||||||
"www.whocc.no/ddd/list_of_ddds_combined_products/", call = FALSE)
|
"www.whocc.no/ddd/list_of_ddds_combined_products/")
|
||||||
}
|
}
|
||||||
|
|
||||||
ddd_prop <- paste0(administration, "_units")
|
ddd_prop <- paste0(administration, "_units")
|
||||||
@ -311,12 +311,12 @@ ab_url <- function(x, open = FALSE, ...) {
|
|||||||
|
|
||||||
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(atcs)]
|
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(atcs)]
|
||||||
if (length(NAs) > 0) {
|
if (length(NAs) > 0) {
|
||||||
warning_("No ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
warning_("in `ab_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||||
}
|
}
|
||||||
|
|
||||||
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_("in `ab_url()`: 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])
|
||||||
@ -385,7 +385,8 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
|||||||
},
|
},
|
||||||
USE.NAMES = FALSE)
|
USE.NAMES = FALSE)
|
||||||
if (any(x %in% c("", NA))) {
|
if (any(x %in% c("", NA))) {
|
||||||
warning_("No ", property, " found for column(s): ", vector_and(vars[x %in% c("", NA)], sort = FALSE), call = FALSE)
|
warning_("in `set_ab_names()`: no ", property, " found for column(s): ",
|
||||||
|
vector_and(vars[x %in% c("", NA)], sort = FALSE))
|
||||||
x[x %in% c("", NA)] <- vars[x %in% c("", NA)]
|
x[x %in% c("", NA)] <- vars[x %in% c("", NA)]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -481,14 +481,13 @@ ab_select_exec <- function(function_name,
|
|||||||
untreatable <- antibiotics[which(antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
|
untreatable <- antibiotics[which(antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
|
||||||
if (any(untreatable %in% names(ab_in_data))) {
|
if (any(untreatable %in% names(ab_in_data))) {
|
||||||
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
|
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
|
||||||
warning_("Some agents in `", function_name, "()` were ignored since they cannot be used for treating patients: ",
|
warning_("in `", function_name, "()`: some agents were ignored since they cannot be used for treating patients: ",
|
||||||
vector_and(ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
|
vector_and(ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
|
||||||
language = NULL,
|
language = NULL,
|
||||||
tolower = TRUE),
|
tolower = TRUE),
|
||||||
quotes = FALSE,
|
quotes = FALSE,
|
||||||
sort = TRUE), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
|
sort = TRUE), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
|
||||||
"This warning will be shown once per session.",
|
"This warning will be shown once per session.")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
ab_in_data <- ab_in_data[!names(ab_in_data) %in% untreatable]
|
ab_in_data <- ab_in_data[!names(ab_in_data) %in% untreatable]
|
||||||
}
|
}
|
||||||
|
6
R/age.R
6
R/age.R
@ -95,10 +95,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[!is.na(ages) & ages < 0] <- NA
|
ages[!is.na(ages) & ages < 0] <- NA
|
||||||
warning_("NAs introduced for ages below 0.", call = TRUE)
|
warning_("in `age()`: NAs introduced for ages below 0.")
|
||||||
}
|
}
|
||||||
if (any(ages > 120, na.rm = TRUE)) {
|
if (any(ages > 120, na.rm = TRUE)) {
|
||||||
warning_("Some ages are above 120.", call = TRUE)
|
warning_("in `age()`: some ages are above 120.")
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(na.rm)) {
|
if (isTRUE(na.rm)) {
|
||||||
@ -171,7 +171,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.", call = TRUE)
|
warning_("in `age_groups()`: NAs introduced for ages below 0.")
|
||||||
}
|
}
|
||||||
if (is.character(split_at)) {
|
if (is.character(split_at)) {
|
||||||
split_at <- split_at[1L]
|
split_at <- split_at[1L]
|
||||||
|
@ -175,7 +175,7 @@ atc_online_property <- function(atc_code,
|
|||||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||||
|
|
||||||
if (length(out) == 0) {
|
if (length(out) == 0) {
|
||||||
warning_("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call = FALSE)
|
warning_("in `atc_online_property()`: ATC not found: ", atc_code[i], ". Please check ", atc_url, ".")
|
||||||
returnvalue[i] <- NA
|
returnvalue[i] <- NA
|
||||||
next
|
next
|
||||||
}
|
}
|
||||||
|
@ -184,7 +184,7 @@ format.bug_drug_combinations <- function(x,
|
|||||||
|
|
||||||
if (inherits(x, "grouped")) {
|
if (inherits(x, "grouped")) {
|
||||||
# bug_drug_combinations() has been run on groups, so de-group here
|
# bug_drug_combinations() has been run on groups, so de-group here
|
||||||
warning_("formatting the output of `bug_drug_combinations()` does not support grouped variables, they are ignored", call = FALSE)
|
warning_("in `format()`: formatting the output of `bug_drug_combinations()` does not support grouped variables, they were ignored")
|
||||||
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
|
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
|
||||||
x <- data.frame(mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
|
x <- data.frame(mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
|
||||||
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
|
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
|
||||||
|
4
R/disk.R
4
R/disk.R
@ -100,10 +100,10 @@ as.disk <- function(x, na.rm = FALSE) {
|
|||||||
unique() %pm>%
|
unique() %pm>%
|
||||||
sort() %pm>%
|
sort() %pm>%
|
||||||
vector_and(quotes = TRUE)
|
vector_and(quotes = TRUE)
|
||||||
warning_(na_after - na_before, " results truncated (",
|
warning_("in `as.disk()`: ", 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)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
set_clean_class(as.integer(x),
|
set_clean_class(as.integer(x),
|
||||||
|
@ -181,8 +181,7 @@ eucast_rules <- function(x,
|
|||||||
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
||||||
|
|
||||||
if ("custom" %in% rules & is.null(custom_rules)) {
|
if ("custom" %in% rules & is.null(custom_rules)) {
|
||||||
warning_("No custom rules were set with the `custom_rules` argument",
|
warning_("in `eucast_rules()`: no custom rules were set with the `custom_rules` argument",
|
||||||
call = FALSE,
|
|
||||||
immediate = TRUE)
|
immediate = TRUE)
|
||||||
rules <- rules[rules != "custom"]
|
rules <- rules[rules != "custom"]
|
||||||
if (length(rules) == 0) {
|
if (length(rules) == 0) {
|
||||||
@ -915,13 +914,12 @@ eucast_rules <- function(x,
|
|||||||
# take order from original data set
|
# take order from original data set
|
||||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[order(colnames(x.bak))]
|
warn_lacking_rsi_class <- warn_lacking_rsi_class[order(colnames(x.bak))]
|
||||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[!is.na(warn_lacking_rsi_class)]
|
warn_lacking_rsi_class <- warn_lacking_rsi_class[!is.na(warn_lacking_rsi_class)]
|
||||||
warning_("Not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\n",
|
warning_("in `eucast_rules()`: not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\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)])), ")\n",
|
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])), ")\n",
|
||||||
" - ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
" - ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||||
" - ", x_deparsed, " %>% mutate(across(where(is.rsi.eligible), as.rsi))",
|
" - ", x_deparsed, " %>% mutate(across(where(is.rsi.eligible), as.rsi))")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Return data set ---------------------------------------------------------
|
# Return data set ---------------------------------------------------------
|
||||||
@ -986,14 +984,14 @@ edit_rsi <- function(x,
|
|||||||
TRUE
|
TRUE
|
||||||
})
|
})
|
||||||
suppressWarnings(new_edits[rows, cols] <<- to)
|
suppressWarnings(new_edits[rows, cols] <<- to)
|
||||||
warning_("Value \"", to, "\" added to the factor levels of column", ifelse(length(cols) == 1, "", "s"),
|
warning_("in `eucast_rules()`: value \"", to, "\" added to the factor levels of column",
|
||||||
|
ifelse(length(cols) == 1, "", "s"),
|
||||||
" ", vector_and(cols, quotes = "`", sort = FALSE),
|
" ", vector_and(cols, quotes = "`", sort = FALSE),
|
||||||
" because this value was not an existing factor level.",
|
" because this value was not an existing factor level.")
|
||||||
call = FALSE)
|
|
||||||
txt_warning()
|
txt_warning()
|
||||||
warned <- FALSE
|
warned <- FALSE
|
||||||
} else {
|
} else {
|
||||||
warning_(w$message, call = FALSE)
|
warning_("in `eucast_rules()`: ", w$message)
|
||||||
txt_warning()
|
txt_warning()
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
@ -267,7 +267,6 @@ get_column_abx <- function(x,
|
|||||||
", as it is already set for ",
|
", as it is already set for ",
|
||||||
names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"),
|
names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"),
|
||||||
add_fn = font_red,
|
add_fn = font_red,
|
||||||
call = FALSE,
|
|
||||||
immediate = verbose)
|
immediate = verbose)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -338,6 +337,5 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
|
|||||||
}
|
}
|
||||||
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: ",
|
||||||
vector_and(missing, quotes = FALSE)),
|
vector_and(missing, quotes = FALSE)),
|
||||||
immediate = TRUE,
|
immediate = TRUE)
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
@ -170,7 +170,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
|
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
|
||||||
warning_("The newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.", call = FALSE)
|
warning_("in `", type, "_join()`: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.")
|
||||||
}
|
}
|
||||||
|
|
||||||
joined
|
joined
|
||||||
|
@ -150,7 +150,7 @@ key_antimicrobials <- function(x = NULL,
|
|||||||
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
|
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
|
||||||
}
|
}
|
||||||
if (is.null(col_mo)) {
|
if (is.null(col_mo)) {
|
||||||
warning_("No column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`", call = FALSE)
|
warning_("in `key_antimicrobials()`: no column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`")
|
||||||
gramstain <- NA_character_
|
gramstain <- NA_character_
|
||||||
kingdom <- NA_character_
|
kingdom <- NA_character_
|
||||||
} else {
|
} else {
|
||||||
@ -172,11 +172,11 @@ key_antimicrobials <- function(x = NULL,
|
|||||||
if (values_new_length < values_old_length &
|
if (values_new_length < values_old_length &
|
||||||
any(filter, na.rm = TRUE) &
|
any(filter, na.rm = TRUE) &
|
||||||
message_not_thrown_before("key_antimicrobials", name)) {
|
message_not_thrown_before("key_antimicrobials", name)) {
|
||||||
warning_(ifelse(values_new_length == 0,
|
warning_("in `key_antimicrobials()`: ",
|
||||||
|
ifelse(values_new_length == 0,
|
||||||
"No columns available ",
|
"No columns available ",
|
||||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")),
|
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")),
|
||||||
"as key antimicrobials for ", name, "s. See ?key_antimicrobials.",
|
"as key antimicrobials for ", name, "s. See ?key_antimicrobials.")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
generate_antimcrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
generate_antimcrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
||||||
@ -217,7 +217,7 @@ key_antimicrobials <- function(x = NULL,
|
|||||||
cols = cols)
|
cols = cols)
|
||||||
|
|
||||||
if (length(unique(key_ab)) == 1) {
|
if (length(unique(key_ab)) == 1) {
|
||||||
warning_("No distinct key antibiotics determined.", call = FALSE)
|
warning_("in `key_antimicrobials()`: no distinct key antibiotics determined.")
|
||||||
}
|
}
|
||||||
|
|
||||||
key_ab
|
key_ab
|
||||||
|
8
R/mdro.R
8
R/mdro.R
@ -240,7 +240,7 @@ mdro <- function(x = NULL,
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (!is.null(list(...)$country)) {
|
if (!is.null(list(...)$country)) {
|
||||||
warning_("Using `country` is deprecated, use `guideline` instead. See ?mdro.", call = FALSE)
|
warning_("in `mdro()`: using `country` is deprecated, use `guideline` instead. See ?mdro")
|
||||||
guideline <- list(...)$country
|
guideline <- list(...)$country
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1550,8 +1550,8 @@ mdro <- function(x = NULL,
|
|||||||
if (guideline$code == "cmi2012") {
|
if (guideline$code == "cmi2012") {
|
||||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||||
if (message_not_thrown_before("mdro", "availability")) {
|
if (message_not_thrown_before("mdro", "availability")) {
|
||||||
warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
warning_("in `mdro()`: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||||
percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
|
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_
|
||||||
@ -1709,7 +1709,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
|||||||
return("error")
|
return("error")
|
||||||
})
|
})
|
||||||
if (identical(qry, "error")) {
|
if (identical(qry, "error")) {
|
||||||
warning_("in custom_mdro_guideline(): rule ", i,
|
warning_("in `custom_mdro_guideline()`: rule ", i,
|
||||||
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
||||||
pkg_env$err_msg,
|
pkg_env$err_msg,
|
||||||
call = FALSE,
|
call = FALSE,
|
||||||
|
4
R/mic.R
4
R/mic.R
@ -175,7 +175,7 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||||||
unique() %pm>%
|
unique() %pm>%
|
||||||
sort() %pm>%
|
sort() %pm>%
|
||||||
vector_and(quotes = TRUE)
|
vector_and(quotes = TRUE)
|
||||||
warning_(na_after - na_before, " results truncated (",
|
warning_("in `as.mic()`: ", 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)
|
||||||
@ -358,7 +358,7 @@ sort.mic <- function(x, decreasing = FALSE, ...) {
|
|||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
hist.mic <- function(x, ...) {
|
hist.mic <- function(x, ...) {
|
||||||
warning_("Use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values", call = FALSE)
|
warning_("in `hist()`: use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values")
|
||||||
hist(log2(x))
|
hist(log2(x))
|
||||||
}
|
}
|
||||||
|
|
||||||
|
47
R/mo.R
47
R/mo.R
@ -1489,9 +1489,8 @@ exec_as.mo <- function(x,
|
|||||||
"You can also use your own reference data with set_mo_source() or directly, e.g.:\n",
|
"You can also use your own reference data with set_mo_source() or directly, e.g.:\n",
|
||||||
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n',
|
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n',
|
||||||
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n')
|
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n')
|
||||||
warning_(paste0("\n", msg),
|
warning_(paste0("\nin `as.mo()`: ", msg),
|
||||||
add_fn = font_red,
|
add_fn = font_red,
|
||||||
call = FALSE,
|
|
||||||
immediate = TRUE) # thus will always be shown, even if >= warnings
|
immediate = TRUE) # thus will always be shown, even if >= warnings
|
||||||
}
|
}
|
||||||
# handling uncertainties ----
|
# handling uncertainties ----
|
||||||
@ -1531,12 +1530,11 @@ exec_as.mo <- function(x,
|
|||||||
# comment below code if all staphylococcal species are categorised as CoNS/CoPS
|
# comment below code if all staphylococcal species are categorised as CoNS/CoPS
|
||||||
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])) {
|
||||||
if (message_not_thrown_before("as.mo", "becker")) {
|
if (message_not_thrown_before("as.mo", "becker")) {
|
||||||
warning_("Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
|
warning_("in `as.mo()`: Becker ", font_italic("et al."), " (2014, 2019, 2020) 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 = ", ")),
|
||||||
". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).",
|
". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).",
|
||||||
call = FALSE,
|
|
||||||
immediate = TRUE)
|
immediate = TRUE)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -1709,8 +1707,7 @@ pillar_shaft.mo <- function(x, ...) {
|
|||||||
col <- "The data"
|
col <- "The data"
|
||||||
}
|
}
|
||||||
warning_(col, " contains old MO codes (from a previous AMR package version). ",
|
warning_(col, " contains old MO codes (from a previous AMR package version). ",
|
||||||
"Please update your MO codes with `as.mo()`.",
|
"Please update your MO codes with `as.mo()`.")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# make it always fit exactly
|
# make it always fit exactly
|
||||||
@ -1784,8 +1781,7 @@ print.mo <- function(x, print.shortnames = FALSE, ...) {
|
|||||||
names(x) <- x_names
|
names(x) <- x_names
|
||||||
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
|
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
|
||||||
warning_("Some MO codes are from a previous AMR package version. ",
|
warning_("Some MO codes are from a previous AMR package version. ",
|
||||||
"Please update these MO codes with `as.mo()`.",
|
"Please update the MO codes with `as.mo()`.")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
print.default(x, quote = FALSE)
|
print.default(x, quote = FALSE)
|
||||||
}
|
}
|
||||||
@ -1814,8 +1810,7 @@ summary.mo <- function(object, ...) {
|
|||||||
as.data.frame.mo <- function(x, ...) {
|
as.data.frame.mo <- function(x, ...) {
|
||||||
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
|
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
|
||||||
warning_("The data contains old MO codes (from a previous AMR package version). ",
|
warning_("The data contains old MO codes (from a previous AMR package version). ",
|
||||||
"Please update your MO codes with `as.mo()`.",
|
"Please update your MO codes with `as.mo()`.")
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
nm <- deparse1(substitute(x))
|
nm <- deparse1(substitute(x))
|
||||||
if (!"nm" %in% names(list(...))) {
|
if (!"nm" %in% names(list(...))) {
|
||||||
@ -2119,24 +2114,22 @@ replace_old_mo_codes <- function(x, property) {
|
|||||||
n_unique <- ""
|
n_unique <- ""
|
||||||
}
|
}
|
||||||
if (property != "mo") {
|
if (property != "mo") {
|
||||||
warning_(paste0("The input contained ", n_matched,
|
warning_("in `mo_", property, "()`: the input contained ", n_matched,
|
||||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||||
" (", n_unique, "from a previous AMR package version). ",
|
" (", n_unique, "from a previous AMR package version). ",
|
||||||
"Please update your MO codes with `as.mo()` to increase speed."),
|
"Please update your MO codes with `as.mo()` to increase speed.")
|
||||||
call = FALSE)
|
|
||||||
} else {
|
} else {
|
||||||
warning_(paste0("The input contained ", n_matched,
|
warning_("in `as.mo()`: the input contained ", n_matched,
|
||||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||||
" (", n_unique, "from a previous AMR package version). ",
|
" (", n_unique, "from a previous AMR package version). ",
|
||||||
n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
|
n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
|
||||||
ifelse(n_solved == 1, " was", " were"),
|
ifelse(n_solved == 1, " was", " were"),
|
||||||
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
||||||
"to ", ifelse(n_solved == 1, "a ", ""),
|
"to ", ifelse(n_solved == 1, "a ", ""),
|
||||||
"currently used MO code", ifelse(n_solved == 1, "", "s"),
|
"currently used MO code", ifelse(n_solved == 1, "", "s"),
|
||||||
ifelse(n_unsolved > 0,
|
ifelse(n_unsolved > 0,
|
||||||
paste0(" and ", n_unsolved, " old MO code", ifelse(n_unsolved == 1, "", "s"), " could not be updated."),
|
paste0(" and ", n_unsolved, " old MO code", ifelse(n_unsolved == 1, "", "s"), " could not be updated."),
|
||||||
".")),
|
"."))
|
||||||
call = FALSE)
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
x
|
x
|
||||||
|
@ -684,7 +684,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
|
|||||||
|
|
||||||
if (isTRUE(open)) {
|
if (isTRUE(open)) {
|
||||||
if (length(u) > 1) {
|
if (length(u) > 1) {
|
||||||
warning_("Only the first URL will be opened, as `browseURL()` only suports one string.")
|
warning_("in `mo_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||||
}
|
}
|
||||||
utils::browseURL(u[1L])
|
utils::browseURL(u[1L])
|
||||||
}
|
}
|
||||||
|
2
R/pca.R
2
R/pca.R
@ -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(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
if (any(vapply(FUN.VALUE = logical(1), 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. See Examples in ?pca.", call = FALSE)
|
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in ?pca.", call = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
# set column names
|
# set column names
|
||||||
|
@ -106,7 +106,7 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
|||||||
if (nrow(df_new) > 0) {
|
if (nrow(df_new) > 0) {
|
||||||
df <- df_new
|
df <- df_new
|
||||||
} else {
|
} else {
|
||||||
warning_("No rows found that match mo '", mo, "', ignoring argument `mo`", call = FALSE)
|
warning_("in `random_", tolower(type), "()`: no rows found that match mo '", mo, "', ignoring argument `mo`")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -117,7 +117,7 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
|||||||
if (nrow(df_new) > 0) {
|
if (nrow(df_new) > 0) {
|
||||||
df <- df_new
|
df <- df_new
|
||||||
} else {
|
} else {
|
||||||
warning_("No rows found that match ab '", ab, "', ignoring argument `ab`", call = FALSE)
|
warning_("in `random_", tolower(type), "()`: no rows found that match ab '", ab, "', ignoring argument `ab`")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -153,7 +153,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_("in `resistance_predict()`: I_as_R is deprecated - use I_as_S instead.")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
343
R/rsi.R
343
R/rsi.R
@ -233,9 +233,9 @@ is.rsi.eligible <- function(x, threshold = 0.05) {
|
|||||||
} else if (!any(c("R", "S", "I") %in% x, na.rm = TRUE) & !all(is.na(x))) {
|
} else if (!any(c("R", "S", "I") %in% x, na.rm = TRUE) & !all(is.na(x))) {
|
||||||
return(FALSE)
|
return(FALSE)
|
||||||
} else {
|
} else {
|
||||||
x <- x[!is.na(x) & !is.null(x) & x != ""]
|
x <- x[!is.na(x) & !is.null(x) & !x %in% c("", "-", "NULL")]
|
||||||
if (length(x) == 0) {
|
if (length(x) == 0) {
|
||||||
# no other values than NA or ""
|
# no other values than empty
|
||||||
cur_col <- get_current_column()
|
cur_col <- get_current_column()
|
||||||
if (!is.null(cur_col)) {
|
if (!is.null(cur_col)) {
|
||||||
ab <- suppressWarnings(as.ab(cur_col, fast_mode = TRUE, info = FALSE))
|
ab <- suppressWarnings(as.ab(cur_col, fast_mode = TRUE, info = FALSE))
|
||||||
@ -257,7 +257,7 @@ is.rsi.eligible <- function(x, threshold = 0.05) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#' @export
|
#' @export
|
||||||
# extra param: warn (never throw warning)
|
# extra param: warn (logical, to never throw a warning)
|
||||||
as.rsi.default <- function(x, ...) {
|
as.rsi.default <- function(x, ...) {
|
||||||
if (is.rsi(x)) {
|
if (is.rsi(x)) {
|
||||||
return(x)
|
return(x)
|
||||||
@ -284,16 +284,17 @@ as.rsi.default <- function(x, ...) {
|
|||||||
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
|
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
|
||||||
# check if they are actually MICs or disks
|
# check if they are actually MICs or disks
|
||||||
if (all_valid_mics(x)) {
|
if (all_valid_mics(x)) {
|
||||||
warning_("The input seems to contain MIC values. You can transform them with `as.mic()` before running `as.rsi()` to interpret them.", call = FALSE)
|
warning_("in `as.rsi()`: the input seems to contain MIC values. You can 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 contain disk diffusion values. You can transform them with `as.disk()` before running `as.rsi()` to interpret them.", call = FALSE)
|
warning_("in `as.rsi()`: the input seems to contain disk diffusion values. You can transform them with `as.disk()` before running `as.rsi()` to interpret them.")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# trim leading and trailing spaces, new lines, etc.
|
# trim leading and trailing spaces, new lines, etc.
|
||||||
x <- trimws2(as.character(unlist(x)))
|
x <- trimws2(as.character(unlist(x)))
|
||||||
|
x[x %in% c(NA, "", "-", "NULL")] <- NA_character_
|
||||||
x.bak <- x
|
x.bak <- x
|
||||||
na_before <- length(x[is.na(x) | x == ""])
|
na_before <- length(x[is.na(x)])
|
||||||
|
|
||||||
# correct for translations
|
# correct for translations
|
||||||
trans_R <- unlist(TRANSLATIONS[which(TRANSLATIONS$pattern == "Resistant"),
|
trans_R <- unlist(TRANSLATIONS[which(TRANSLATIONS$pattern == "Resistant"),
|
||||||
@ -332,19 +333,19 @@ as.rsi.default <- function(x, ...) {
|
|||||||
unique() %pm>%
|
unique() %pm>%
|
||||||
sort() %pm>%
|
sort() %pm>%
|
||||||
vector_and(quotes = TRUE)
|
vector_and(quotes = TRUE)
|
||||||
warning_(na_after - na_before, " results truncated (",
|
warning_("in `as.rsi()`: ", 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)
|
||||||
}
|
}
|
||||||
if (any(toupper(x.bak) == "U") && message_not_thrown_before("as.rsi", "U")) {
|
if (any(toupper(x.bak[!is.na(x.bak)]) == "U") && message_not_thrown_before("as.rsi", "U")) {
|
||||||
warning_("in as.rsi(): 'U' was interpreted as 'S', following some laboratory systems", call = FALSE)
|
warning_("in `as.rsi()`: 'U' was interpreted as 'S', following some laboratory systems")
|
||||||
}
|
}
|
||||||
if (any(toupper(x.bak) == "D") && message_not_thrown_before("as.rsi", "D")) {
|
if (any(toupper(x.bak[!is.na(x.bak)]) == "D") && message_not_thrown_before("as.rsi", "D")) {
|
||||||
warning_("in as.rsi(): 'D' (dose-dependent) was interpreted as 'I', following some laboratory systems", call = FALSE)
|
warning_("in `as.rsi()`: 'D' (dose-dependent) was interpreted as 'I', following some laboratory systems")
|
||||||
}
|
}
|
||||||
if (any(toupper(x.bak) == "H") && message_not_thrown_before("as.rsi", "H")) {
|
if (any(toupper(x.bak[!is.na(x.bak)]) == "H") && message_not_thrown_before("as.rsi", "H")) {
|
||||||
warning_("in as.rsi(): 'H' was interpreted as 'I', following some laboratory systems", call = FALSE)
|
warning_("in `as.rsi()`: 'H' was interpreted as 'I', following some laboratory systems")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -364,89 +365,17 @@ as.rsi.mic <- function(x,
|
|||||||
add_intrinsic_resistance = FALSE,
|
add_intrinsic_resistance = FALSE,
|
||||||
reference_data = AMR::rsi_translation,
|
reference_data = AMR::rsi_translation,
|
||||||
...) {
|
...) {
|
||||||
meet_criteria(x)
|
as_rsi_method(method_short = "mic",
|
||||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
method_long = "MIC values",
|
||||||
meet_criteria(ab, allow_class = c("ab", "character"))
|
x = x,
|
||||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
mo = mo,
|
||||||
meet_criteria(uti, allow_class = "logical", has_length = c(1, length(x)))
|
ab = ab,
|
||||||
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1)
|
guideline = guideline,
|
||||||
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
|
uti = uti,
|
||||||
meet_criteria(reference_data, allow_class = "data.frame")
|
conserve_capped_values = conserve_capped_values,
|
||||||
check_reference_data(reference_data)
|
add_intrinsic_resistance = add_intrinsic_resistance,
|
||||||
|
reference_data = reference_data,
|
||||||
# for dplyr's across()
|
...)
|
||||||
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
|
||||||
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0)), error = function(e) FALSE)) {
|
|
||||||
# try to get current column, which will only be available when in across()
|
|
||||||
ab <- tryCatch(cur_column_dplyr(),
|
|
||||||
error = function(e) ab)
|
|
||||||
}
|
|
||||||
|
|
||||||
# for auto-determining mo
|
|
||||||
mo_var_found <- ""
|
|
||||||
if (is.null(mo)) {
|
|
||||||
tryCatch({
|
|
||||||
df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
|
|
||||||
mo <- NULL
|
|
||||||
try({
|
|
||||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
|
||||||
}, silent = TRUE)
|
|
||||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
|
||||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
|
||||||
mo <- df[, mo, drop = TRUE]
|
|
||||||
}
|
|
||||||
}, error = function(e)
|
|
||||||
stop_('No information was supplied about the microorganisms (missing argument `mo`). See ?as.rsi.\n\n',
|
|
||||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
|
||||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
|
||||||
)
|
|
||||||
}
|
|
||||||
if (length(ab) == 1 && ab %like% "as.mic") {
|
|
||||||
stop_('No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.rsi.', call = FALSE)
|
|
||||||
}
|
|
||||||
|
|
||||||
ab_coerced <- suppressWarnings(as.ab(ab))
|
|
||||||
mo_coerced <- suppressWarnings(as.mo(mo))
|
|
||||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
|
||||||
if (is.na(ab_coerced)) {
|
|
||||||
message_("Returning NAs for unknown drug: '", font_bold(ab),
|
|
||||||
"'. Rename this column to a drug name or code, and check the output with `as.ab()`.",
|
|
||||||
add_fn = font_red,
|
|
||||||
as_note = FALSE)
|
|
||||||
return(as.rsi(rep(NA, length(x))))
|
|
||||||
}
|
|
||||||
if (length(mo_coerced) == 1) {
|
|
||||||
mo_coerced <- rep(mo_coerced, length(x))
|
|
||||||
}
|
|
||||||
if (length(uti) == 1) {
|
|
||||||
uti <- rep(uti, length(x))
|
|
||||||
}
|
|
||||||
|
|
||||||
agent_formatted <- paste0("'", font_bold(ab), "'")
|
|
||||||
agent_name <- ab_name(ab_coerced, tolower = TRUE, language = NULL)
|
|
||||||
if (generalise_antibiotic_name(ab) != generalise_antibiotic_name(agent_name)) {
|
|
||||||
agent_formatted <- paste0(agent_formatted, " (", ab_coerced, ", ", agent_name, ")")
|
|
||||||
}
|
|
||||||
message_("=> Interpreting MIC values of ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
|
||||||
agent_formatted,
|
|
||||||
mo_var_found,
|
|
||||||
" according to ", ifelse(identical(reference_data, AMR::rsi_translation),
|
|
||||||
font_bold(guideline_coerced),
|
|
||||||
"manually defined 'reference_data'"),
|
|
||||||
"... ",
|
|
||||||
appendLF = FALSE,
|
|
||||||
as_note = FALSE)
|
|
||||||
|
|
||||||
result <- exec_as.rsi(method = "mic",
|
|
||||||
x = x,
|
|
||||||
mo = mo_coerced,
|
|
||||||
ab = ab_coerced,
|
|
||||||
guideline = guideline_coerced,
|
|
||||||
uti = uti,
|
|
||||||
conserve_capped_values = conserve_capped_values,
|
|
||||||
add_intrinsic_resistance = add_intrinsic_resistance,
|
|
||||||
reference_data = reference_data) # exec_as.rsi will return message 'OK'
|
|
||||||
result
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname as.rsi
|
#' @rdname as.rsi
|
||||||
@ -459,88 +388,17 @@ as.rsi.disk <- function(x,
|
|||||||
add_intrinsic_resistance = FALSE,
|
add_intrinsic_resistance = FALSE,
|
||||||
reference_data = AMR::rsi_translation,
|
reference_data = AMR::rsi_translation,
|
||||||
...) {
|
...) {
|
||||||
meet_criteria(x)
|
as_rsi_method(method_short = "disk",
|
||||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
method_long = "disk diffusion zones",
|
||||||
meet_criteria(ab, allow_class = c("ab", "character"))
|
x = x,
|
||||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
mo = mo,
|
||||||
meet_criteria(uti, allow_class = "logical", has_length = c(1, length(x)))
|
ab = ab,
|
||||||
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
|
guideline = guideline,
|
||||||
meet_criteria(reference_data, allow_class = "data.frame")
|
uti = uti,
|
||||||
check_reference_data(reference_data)
|
conserve_capped_values = FALSE,
|
||||||
|
add_intrinsic_resistance = add_intrinsic_resistance,
|
||||||
# for dplyr's across()
|
reference_data = reference_data,
|
||||||
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
...)
|
||||||
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0)), error = function(e) FALSE)) {
|
|
||||||
# try to get current column, which will only be available when in across()
|
|
||||||
ab <- tryCatch(cur_column_dplyr(),
|
|
||||||
error = function(e) ab)
|
|
||||||
}
|
|
||||||
|
|
||||||
# for auto-determining mo
|
|
||||||
mo_var_found <- ""
|
|
||||||
if (is.null(mo)) {
|
|
||||||
tryCatch({
|
|
||||||
df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
|
|
||||||
mo <- NULL
|
|
||||||
try({
|
|
||||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
|
||||||
}, silent = TRUE)
|
|
||||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
|
||||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
|
||||||
mo <- df[, mo, drop = TRUE]
|
|
||||||
}
|
|
||||||
}, error = function(e)
|
|
||||||
stop_('No information was supplied about the microorganisms (missing argument `mo`). See ?as.rsi.\n\n',
|
|
||||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
|
||||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
|
||||||
)
|
|
||||||
}
|
|
||||||
if (length(ab) == 1 && ab %like% "as.disk") {
|
|
||||||
stop_('No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.rsi.', call = FALSE)
|
|
||||||
}
|
|
||||||
|
|
||||||
ab_coerced <- suppressWarnings(as.ab(ab))
|
|
||||||
mo_coerced <- suppressWarnings(as.mo(mo))
|
|
||||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
|
||||||
if (is.na(ab_coerced)) {
|
|
||||||
message_("Returning NAs for unknown drug: '", font_bold(ab),
|
|
||||||
"'. Rename this column to a drug name or code, and check the output with `as.ab()`.",
|
|
||||||
add_fn = font_red,
|
|
||||||
as_note = FALSE)
|
|
||||||
return(as.rsi(rep(NA, length(x))))
|
|
||||||
}
|
|
||||||
if (length(mo_coerced) == 1) {
|
|
||||||
mo_coerced <- rep(mo_coerced, length(x))
|
|
||||||
}
|
|
||||||
if (length(uti) == 1) {
|
|
||||||
uti <- rep(uti, length(x))
|
|
||||||
}
|
|
||||||
|
|
||||||
agent_formatted <- paste0("'", font_bold(ab), "'")
|
|
||||||
agent_name <- ab_name(ab_coerced, tolower = TRUE, language = NULL)
|
|
||||||
if (generalise_antibiotic_name(ab) != generalise_antibiotic_name(agent_name)) {
|
|
||||||
agent_formatted <- paste0(agent_formatted, " (", ab_coerced, ", ", agent_name, ")")
|
|
||||||
}
|
|
||||||
message_("=> Interpreting disk zones of ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
|
||||||
agent_formatted,
|
|
||||||
mo_var_found,
|
|
||||||
" according to ", ifelse(identical(reference_data, AMR::rsi_translation),
|
|
||||||
font_bold(guideline_coerced),
|
|
||||||
"manually defined 'reference_data'"),
|
|
||||||
"... ",
|
|
||||||
appendLF = FALSE,
|
|
||||||
as_note = FALSE)
|
|
||||||
|
|
||||||
result <- exec_as.rsi(method = "disk",
|
|
||||||
x = x,
|
|
||||||
mo = mo_coerced,
|
|
||||||
ab = ab_coerced,
|
|
||||||
guideline = guideline_coerced,
|
|
||||||
uti = uti,
|
|
||||||
conserve_capped_values = FALSE,
|
|
||||||
add_intrinsic_resistance = add_intrinsic_resistance,
|
|
||||||
reference_data = reference_data) # exec_as.rsi will return message 'OK'
|
|
||||||
result
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname as.rsi
|
#' @rdname as.rsi
|
||||||
@ -745,6 +603,106 @@ get_guideline <- function(guideline, reference_data) {
|
|||||||
guideline_param
|
guideline_param
|
||||||
}
|
}
|
||||||
|
|
||||||
|
as_rsi_method <- function(method_short = "mic",
|
||||||
|
method_long = "MIC values",
|
||||||
|
x = x,
|
||||||
|
mo = NULL,
|
||||||
|
ab = deparse(substitute(x)),
|
||||||
|
guideline = "EUCAST",
|
||||||
|
uti = FALSE,
|
||||||
|
conserve_capped_values = FALSE,
|
||||||
|
add_intrinsic_resistance = FALSE,
|
||||||
|
reference_data = AMR::rsi_translation,
|
||||||
|
...) {
|
||||||
|
meet_criteria(x)
|
||||||
|
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||||
|
meet_criteria(ab, allow_class = c("ab", "character"))
|
||||||
|
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||||
|
meet_criteria(uti, allow_class = "logical", has_length = c(1, length(x)))
|
||||||
|
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1)
|
||||||
|
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
|
||||||
|
meet_criteria(reference_data, allow_class = "data.frame")
|
||||||
|
check_reference_data(reference_data)
|
||||||
|
|
||||||
|
# for dplyr's across()
|
||||||
|
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
||||||
|
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0)), error = function(e) FALSE)) {
|
||||||
|
# try to get current column, which will only be available when in across()
|
||||||
|
ab <- tryCatch(cur_column_dplyr(),
|
||||||
|
error = function(e) ab)
|
||||||
|
}
|
||||||
|
|
||||||
|
# for auto-determining mo
|
||||||
|
mo_var_found <- ""
|
||||||
|
if (is.null(mo)) {
|
||||||
|
tryCatch({
|
||||||
|
df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
|
||||||
|
mo <- NULL
|
||||||
|
try({
|
||||||
|
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||||
|
}, silent = TRUE)
|
||||||
|
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||||
|
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
||||||
|
mo <- df[, mo, drop = TRUE]
|
||||||
|
}
|
||||||
|
}, error = function(e) {
|
||||||
|
mo <- NULL
|
||||||
|
})
|
||||||
|
}
|
||||||
|
if (is.null(mo)) {
|
||||||
|
stop_("No information was supplied about the microorganisms (missing argument `mo` and no column of class <mo> found). See ?as.rsi.\n\n",
|
||||||
|
"To transform certain columns with e.g. mutate(), use `data %>% mutate(across(..., as.rsi, mo = x))`, where x is your column with microorganisms.\n",
|
||||||
|
"To tranform all ", method_long, " in a data set, use `data %>% as.rsi()` or `data %>% mutate(across(where(is.", method_short, "), as.rsi))`.", call = FALSE)
|
||||||
|
}
|
||||||
|
|
||||||
|
if (length(ab) == 1 && ab %like% paste0("as.", method_short)) {
|
||||||
|
stop_('No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.rsi.', call = FALSE)
|
||||||
|
}
|
||||||
|
|
||||||
|
ab_coerced <- suppressWarnings(as.ab(ab))
|
||||||
|
mo_coerced <- suppressWarnings(as.mo(mo))
|
||||||
|
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||||
|
if (is.na(ab_coerced)) {
|
||||||
|
message_("Returning NAs for unknown drug: '", font_bold(ab),
|
||||||
|
"'. Rename this column to a drug name or code, and check the output with `as.ab()`.",
|
||||||
|
add_fn = font_red,
|
||||||
|
as_note = FALSE)
|
||||||
|
return(as.rsi(rep(NA, length(x))))
|
||||||
|
}
|
||||||
|
if (length(mo_coerced) == 1) {
|
||||||
|
mo_coerced <- rep(mo_coerced, length(x))
|
||||||
|
}
|
||||||
|
if (length(uti) == 1) {
|
||||||
|
uti <- rep(uti, length(x))
|
||||||
|
}
|
||||||
|
|
||||||
|
agent_formatted <- paste0("'", font_bold(ab), "'")
|
||||||
|
agent_name <- ab_name(ab_coerced, tolower = TRUE, language = NULL)
|
||||||
|
if (generalise_antibiotic_name(ab) != generalise_antibiotic_name(agent_name)) {
|
||||||
|
agent_formatted <- paste0(agent_formatted, " (", ab_coerced, ", ", agent_name, ")")
|
||||||
|
}
|
||||||
|
message_("=> Interpreting ", method_long, " of ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||||
|
agent_formatted,
|
||||||
|
mo_var_found,
|
||||||
|
" according to ", ifelse(identical(reference_data, AMR::rsi_translation),
|
||||||
|
font_bold(guideline_coerced),
|
||||||
|
"manually defined 'reference_data'"),
|
||||||
|
"... ",
|
||||||
|
appendLF = FALSE,
|
||||||
|
as_note = FALSE)
|
||||||
|
|
||||||
|
result <- exec_as.rsi(method = method_short,
|
||||||
|
x = x,
|
||||||
|
mo = mo_coerced,
|
||||||
|
ab = ab_coerced,
|
||||||
|
guideline = guideline_coerced,
|
||||||
|
uti = uti,
|
||||||
|
conserve_capped_values = conserve_capped_values,
|
||||||
|
add_intrinsic_resistance = add_intrinsic_resistance,
|
||||||
|
reference_data = reference_data) # exec_as.rsi will return message 'OK'
|
||||||
|
result
|
||||||
|
}
|
||||||
|
|
||||||
exec_as.rsi <- function(method,
|
exec_as.rsi <- function(method,
|
||||||
x,
|
x,
|
||||||
mo,
|
mo,
|
||||||
@ -767,7 +725,7 @@ exec_as.rsi <- function(method,
|
|||||||
x <- as.disk(x) # when as.rsi.disk is called directly
|
x <- as.disk(x) # when as.rsi.disk is called directly
|
||||||
}
|
}
|
||||||
|
|
||||||
warned <- FALSE
|
rise_warning <- FALSE
|
||||||
method_param <- toupper(method)
|
method_param <- toupper(method)
|
||||||
|
|
||||||
genera <- mo_genus(mo, language = NULL)
|
genera <- mo_genus(mo, language = NULL)
|
||||||
@ -812,13 +770,6 @@ exec_as.rsi <- function(method,
|
|||||||
lookup_lancefield <- paste(mo_lancefield, ab)
|
lookup_lancefield <- paste(mo_lancefield, ab)
|
||||||
lookup_other <- paste(mo_other, ab)
|
lookup_other <- paste(mo_other, ab)
|
||||||
|
|
||||||
if (length(unique(paste(trans$mo, trans$ab))) == length(unique(paste(trans$mo, trans$ab, trans$uti))) &&
|
|
||||||
any(trans$uti == TRUE, na.rm = TRUE) && all(uti == FALSE)) {
|
|
||||||
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
|
||||||
warning_("Introducing NA: interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI). Use argument `uti` to set which isolates are from urine. See ?as.rsi.", call = FALSE)
|
|
||||||
warned <- TRUE
|
|
||||||
}
|
|
||||||
|
|
||||||
any_is_intrinsic_resistant <- FALSE
|
any_is_intrinsic_resistant <- FALSE
|
||||||
|
|
||||||
for (i in seq_len(length(x))) {
|
for (i in seq_len(length(x))) {
|
||||||
@ -828,7 +779,7 @@ exec_as.rsi <- function(method,
|
|||||||
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
|
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
|
||||||
if (guideline_coerced %unlike% "EUCAST") {
|
if (guideline_coerced %unlike% "EUCAST") {
|
||||||
if (message_not_thrown_before("as.rsi", "msg2")) {
|
if (message_not_thrown_before("as.rsi", "msg2")) {
|
||||||
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_("in `as.rsi()`: using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
new_rsi[i] <- "R"
|
new_rsi[i] <- "R"
|
||||||
@ -837,7 +788,7 @@ exec_as.rsi <- function(method,
|
|||||||
}
|
}
|
||||||
|
|
||||||
get_record <- trans %pm>%
|
get_record <- trans %pm>%
|
||||||
# no subsetting to UTI for now
|
# no subsetting to UTI here
|
||||||
subset(lookup %in% c(lookup_mo[i],
|
subset(lookup %in% c(lookup_mo[i],
|
||||||
lookup_genus[i],
|
lookup_genus[i],
|
||||||
lookup_family[i],
|
lookup_family[i],
|
||||||
@ -846,6 +797,11 @@ exec_as.rsi <- function(method,
|
|||||||
lookup_lancefield[i],
|
lookup_lancefield[i],
|
||||||
lookup_other[i]))
|
lookup_other[i]))
|
||||||
|
|
||||||
|
if (any(get_record$uti == TRUE, na.rm = TRUE) && message_not_thrown_before("as.rsi", "msg3", ab)) {
|
||||||
|
warning_("in `as.rsi()`: interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms. Use argument `uti` to set which isolates are from urine. See ?as.rsi.")
|
||||||
|
rise_warning <- TRUE
|
||||||
|
}
|
||||||
|
|
||||||
if (isTRUE(uti[i])) {
|
if (isTRUE(uti[i])) {
|
||||||
get_record <- get_record %pm>%
|
get_record <- get_record %pm>%
|
||||||
# be as specific as possible (i.e. prefer species over genus):
|
# be as specific as possible (i.e. prefer species over genus):
|
||||||
@ -885,11 +841,10 @@ exec_as.rsi <- function(method,
|
|||||||
|
|
||||||
if (any_is_intrinsic_resistant & guideline_coerced %like% "EUCAST" & !isTRUE(add_intrinsic_resistance)) {
|
if (any_is_intrinsic_resistant & guideline_coerced %like% "EUCAST" & !isTRUE(add_intrinsic_resistance)) {
|
||||||
# found some intrinsic resistance, but was not applied
|
# found some intrinsic resistance, but was not applied
|
||||||
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
if (message_not_thrown_before("as.rsi", "msg4")) {
|
||||||
if (message_not_thrown_before("as.rsi", "msg3")) {
|
warning_("in `as.rsi()`: found intrinsic resistance in some bug/drug combinations, although it was not applied.\nUse `as.rsi(..., add_intrinsic_resistance = TRUE)` to apply it.")
|
||||||
warning_("Found intrinsic resistance in some bug/drug combinations, although it was not applied.\nUse `as.rsi(..., add_intrinsic_resistance = TRUE)` to apply it.", call = FALSE)
|
|
||||||
}
|
}
|
||||||
warned <- TRUE
|
rise_warning <- TRUE
|
||||||
}
|
}
|
||||||
|
|
||||||
new_rsi <- x_bak %pm>%
|
new_rsi <- x_bak %pm>%
|
||||||
@ -898,7 +853,9 @@ exec_as.rsi <- function(method,
|
|||||||
by = "x_mo") %pm>%
|
by = "x_mo") %pm>%
|
||||||
pm_pull(new_rsi)
|
pm_pull(new_rsi)
|
||||||
|
|
||||||
if (warned == FALSE) {
|
if (isTRUE(rise_warning)) {
|
||||||
|
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||||
|
} else {
|
||||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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")
|
||||||
if (as_percent == TRUE) {
|
if (as_percent == TRUE) {
|
||||||
return(NA_character_)
|
return(NA_character_)
|
||||||
} else {
|
} else {
|
||||||
|
@ -193,7 +193,7 @@ translate_AMR <- function(from,
|
|||||||
any_form_in_patterns <- tryCatch(
|
any_form_in_patterns <- tryCatch(
|
||||||
any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")),
|
any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", 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).")
|
||||||
return(FALSE)
|
return(FALSE)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
Binary file not shown.
@ -43,7 +43,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="Released version">1.8.0</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -210,7 +210,7 @@ Content not found. Please use links in the navbar.
|
|||||||
|
|
||||||
<div class="pkgdown">
|
<div class="pkgdown">
|
||||||
<p></p>
|
<p></p>
|
||||||
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.0.</p>
|
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.2.</p>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
</footer>
|
</footer>
|
||||||
|
@ -17,7 +17,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="Released version">1.8.0</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -420,7 +420,7 @@ END OF TERMS AND CONDITIONS
|
|||||||
</div>
|
</div>
|
||||||
|
|
||||||
<div class="pkgdown">
|
<div class="pkgdown">
|
||||||
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.0.</p>
|
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.2.</p>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
</footer></div>
|
</footer></div>
|
||||||
|
@ -44,7 +44,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="Released version">1.8.0.9001</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -190,7 +190,7 @@
|
|||||||
<div class="page-header toc-ignore">
|
<div class="page-header toc-ignore">
|
||||||
<h1 data-toc-skip>Data sets for download / own use</h1>
|
<h1 data-toc-skip>Data sets for download / own use</h1>
|
||||||
|
|
||||||
<h4 data-toc-skip class="date">26 February 2022</h4>
|
<h4 data-toc-skip class="date">02 March 2022</h4>
|
||||||
|
|
||||||
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/HEAD/vignettes/datasets.Rmd" class="external-link"><code>vignettes/datasets.Rmd</code></a></small>
|
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/HEAD/vignettes/datasets.Rmd" class="external-link"><code>vignettes/datasets.Rmd</code></a></small>
|
||||||
<div class="hidden name"><code>datasets.Rmd</code></div>
|
<div class="hidden name"><code>datasets.Rmd</code></div>
|
||||||
|
@ -17,7 +17,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="Released version">1.8.0</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -218,7 +218,7 @@
|
|||||||
</p>
|
</p>
|
||||||
</li>
|
</li>
|
||||||
<li>
|
<li>
|
||||||
<p><strong>Anthony Underwood</strong>. Contributor. <a href="https://orcid.org/0000-0002-8547-427" target="orcid.widget" aria-label="ORCID" class="external-link"><span class="fab fa-orcid orcid" aria-hidden="true"></span></a>
|
<p><strong>Anthony Underwood</strong>. Contributor. <a href="https://orcid.org/0000-0002-8547-4277" target="orcid.widget" aria-label="ORCID" class="external-link"><span class="fab fa-orcid orcid" aria-hidden="true"></span></a>
|
||||||
</p>
|
</p>
|
||||||
</li>
|
</li>
|
||||||
</ul></div>
|
</ul></div>
|
||||||
@ -273,7 +273,7 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
|
|||||||
</div>
|
</div>
|
||||||
|
|
||||||
<div class="pkgdown">
|
<div class="pkgdown">
|
||||||
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.0.</p>
|
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.2.</p>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
</footer></div>
|
</footer></div>
|
||||||
|
@ -47,7 +47,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="Released version">1.8.0</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -214,7 +214,7 @@
|
|||||||
</h5>
|
</h5>
|
||||||
<div class="sourceCode" id="cb1"><pre class="downlit sourceCode r">
|
<div class="sourceCode" id="cb1"><pre class="downlit sourceCode r">
|
||||||
<code class="sourceCode R"><span class="co"># AMR works great with dplyr, but it's not required or neccesary</span>
|
<code class="sourceCode R"><span class="co"># AMR works great with dplyr, but it's not required or neccesary</span>
|
||||||
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://msberends.github.io/AMR">AMR</a></span><span class="op">)</span>
|
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://msberends.github.io/AMR/">AMR</a></span><span class="op">)</span>
|
||||||
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://dplyr.tidyverse.org" class="external-link">dplyr</a></span><span class="op">)</span>
|
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://dplyr.tidyverse.org" class="external-link">dplyr</a></span><span class="op">)</span>
|
||||||
|
|
||||||
<span class="va">example_isolates</span> <span class="op"><a href="https://magrittr.tidyverse.org/reference/pipe.html" class="external-link">%>%</a></span>
|
<span class="va">example_isolates</span> <span class="op"><a href="https://magrittr.tidyverse.org/reference/pipe.html" class="external-link">%>%</a></span>
|
||||||
@ -340,7 +340,7 @@
|
|||||||
</h4>
|
</h4>
|
||||||
<p>The development of this package is part of, related to, or made possible by:</p>
|
<p>The development of this package is part of, related to, or made possible by:</p>
|
||||||
<div align="center">
|
<div align="center">
|
||||||
<p><a href="https://www.rug.nl" title="University of Groningen" class="external-link"><img src="./logo_rug.png" class="partner_logo"></a> <a href="https://www.umcg.nl" title="University Medical Center Groningen" class="external-link"><img src="./logo_umcg.png" class="partner_logo"></a> <a href="https://www.certe.nl" title="Certe Medical Diagnostics and Advice Foundation" class="external-link"><img src="./logo_certe.png" class="partner_logo"></a> <a href="http://www.eurhealth-1health.eu" title="EurHealth-1-Health" class="external-link"><img src="./logo_eh1h.png" class="partner_logo"></a> <a href="https://www.deutschland-nederland.eu" title="INTERREG" class="external-link"><img src="./logo_interreg.png" class="partner_logo"></a></p>
|
<p><a href="https://www.rug.nl" title="University of Groningen" class="external-link"><img src="./logo_rug.png" class="partner_logo"></a> <a href="https://www.umcg.nl" title="University Medical Center Groningen" class="external-link"><img src="./logo_umcg.png" class="partner_logo"></a> <a href="https://www.certe.nl" title="Certe Medical Diagnostics and Advice Foundation" class="external-link"><img src="./logo_certe.png" class="partner_logo"></a> <a href="https://www.deutschland-nederland.eu" title="EurHealth-1-Health" class="external-link"><img src="./logo_eh1h.png" class="partner_logo"></a> <a href="https://www.deutschland-nederland.eu" title="INTERREG" class="external-link"><img src="./logo_interreg.png" class="partner_logo"></a></p>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
@ -561,7 +561,7 @@
|
|||||||
|
|
||||||
<div class="pkgdown">
|
<div class="pkgdown">
|
||||||
<p></p>
|
<p></p>
|
||||||
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.0.</p>
|
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.2.</p>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
</footer>
|
</footer>
|
||||||
|
@ -17,7 +17,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="Released version">1.8.0.9001</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -157,13 +157,13 @@
|
|||||||
</div>
|
</div>
|
||||||
|
|
||||||
<div class="section level2">
|
<div class="section level2">
|
||||||
<h2 class="page-header" data-toc-text="1.8.0.9001" id="amr-1809001">
|
<h2 class="page-header" data-toc-text="1.8.0.9002" id="amr-1809002">
|
||||||
<code>AMR</code> 1.8.0.9001<a class="anchor" aria-label="anchor" href="#amr-1809001"></a></h2>
|
<code>AMR</code> 1.8.0.9002<a class="anchor" aria-label="anchor" href="#amr-1809002"></a></h2>
|
||||||
<div class="section level3">
|
<div class="section level3">
|
||||||
<h3 id="last-updated-february-1-8-0-9001"><small>Last updated: 26 February 2022</small><a class="anchor" aria-label="anchor" href="#last-updated-february-1-8-0-9001"></a></h3>
|
<h3 id="last-updated-march-1-8-0-9002"><small>Last updated: 2 March 2022</small><a class="anchor" aria-label="anchor" href="#last-updated-march-1-8-0-9002"></a></h3>
|
||||||
<p>All functions in this package are considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months.</p>
|
<p>All functions in this package are considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months.</p>
|
||||||
<div class="section level4">
|
<div class="section level4">
|
||||||
<h4 id="changed-1-8-0-9001">Changed<a class="anchor" aria-label="anchor" href="#changed-1-8-0-9001"></a></h4>
|
<h4 id="changed-1-8-0-9002">Changed<a class="anchor" aria-label="anchor" href="#changed-1-8-0-9002"></a></h4>
|
||||||
<ul><li><p>Support for antibiotic interpretations of the MIPS laboratory system: <code>"U"</code> for S (‘susceptible urine’), <code>"D"</code> for I (‘susceptible dose-dependent’)</p></li>
|
<ul><li><p>Support for antibiotic interpretations of the MIPS laboratory system: <code>"U"</code> for S (‘susceptible urine’), <code>"D"</code> for I (‘susceptible dose-dependent’)</p></li>
|
||||||
<li>
|
<li>
|
||||||
<p>Improved algorithm of <code><a href="../reference/as.mo.html">as.mo()</a></code>, especially for ignoring non-taxonomic text, such as:</p>
|
<p>Improved algorithm of <code><a href="../reference/as.mo.html">as.mo()</a></code>, especially for ignoring non-taxonomic text, such as:</p>
|
||||||
@ -172,9 +172,10 @@
|
|||||||
<span class="fu"><a href="../reference/mo_property.html">mo_name</a></span><span class="op">(</span><span class="st">"methicillin-resistant S. aureus (MRSA)"</span><span class="op">)</span>
|
<span class="fu"><a href="../reference/mo_property.html">mo_name</a></span><span class="op">(</span><span class="st">"methicillin-resistant S. aureus (MRSA)"</span><span class="op">)</span>
|
||||||
<span class="co">#> [1] "Staphylococcus aureus"</span></code></pre></div>
|
<span class="co">#> [1] "Staphylococcus aureus"</span></code></pre></div>
|
||||||
</li>
|
</li>
|
||||||
|
<li><p>More informative warning messages</p></li>
|
||||||
</ul></div>
|
</ul></div>
|
||||||
<div class="section level4">
|
<div class="section level4">
|
||||||
<h4 id="other-1-8-0-9001">Other<a class="anchor" aria-label="anchor" href="#other-1-8-0-9001"></a></h4>
|
<h4 id="other-1-8-0-9002">Other<a class="anchor" aria-label="anchor" href="#other-1-8-0-9002"></a></h4>
|
||||||
<ul><li>Fix for unit testing on R 3.3</li>
|
<ul><li>Fix for unit testing on R 3.3</li>
|
||||||
<li>Fix for size of some image elements, as requested by CRAN</li>
|
<li>Fix for size of some image elements, as requested by CRAN</li>
|
||||||
</ul></div>
|
</ul></div>
|
||||||
|
@ -17,7 +17,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="Released version">1.8.0</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">1.8.0.9002</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@ -172,7 +172,7 @@
|
|||||||
</div>
|
</div>
|
||||||
|
|
||||||
<div class="pkgdown">
|
<div class="pkgdown">
|
||||||
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.0.</p>
|
<p></p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 2.0.2.</p>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
</footer></div>
|
</footer></div>
|
||||||
|
@ -142,14 +142,12 @@ if [ $lazy == "FALSE" ]; then
|
|||||||
Rscript -e "devtools::install(quiet = TRUE, dependencies = FALSE)"
|
Rscript -e "devtools::install(quiet = TRUE, dependencies = FALSE)"
|
||||||
Rscript -e "suppressMessages(pkgdown::build_site(lazy = FALSE, examples = FALSE, install = FALSE))"
|
Rscript -e "suppressMessages(pkgdown::build_site(lazy = FALSE, examples = FALSE, install = FALSE))"
|
||||||
else
|
else
|
||||||
|
# always build home page
|
||||||
|
Rscript -e "pkgdown::build_home()"
|
||||||
if ! git diff --quiet man; then
|
if ! git diff --quiet man; then
|
||||||
# documentation has changed
|
# documentation has changed
|
||||||
Rscript -e "pkgdown::build_reference(lazy = $lazy, examples = FALSE)"
|
Rscript -e "pkgdown::build_reference(lazy = $lazy, examples = FALSE)"
|
||||||
fi
|
fi
|
||||||
if ! git diff --quiet index.md; then
|
|
||||||
# home page has changed
|
|
||||||
Rscript -e "pkgdown::build_home()"
|
|
||||||
fi
|
|
||||||
if ! git diff --quiet NEWS.md; then
|
if ! git diff --quiet NEWS.md; then
|
||||||
# news has changed
|
# news has changed
|
||||||
Rscript -e "pkgdown::build_news()"
|
Rscript -e "pkgdown::build_news()"
|
||||||
|
@ -87,8 +87,9 @@ expect_identical(
|
|||||||
"Sthafilokkockus aureeuzz",
|
"Sthafilokkockus aureeuzz",
|
||||||
"Staphylococcus aureus",
|
"Staphylococcus aureus",
|
||||||
"MRSA",
|
"MRSA",
|
||||||
"VISA")))),
|
"VISA",
|
||||||
rep("B_STPHY_AURS", 9))
|
"meth.-resis. S. aureus (MRSA)")))),
|
||||||
|
rep("B_STPHY_AURS", 10))
|
||||||
expect_identical(
|
expect_identical(
|
||||||
as.character(
|
as.character(
|
||||||
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
|
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
|
||||||
@ -243,7 +244,7 @@ expect_stdout(print(mo_uncertainties()))
|
|||||||
expect_equal(suppressMessages(as.mo(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
|
expect_equal(suppressMessages(as.mo(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
|
||||||
as.mo(c("Salmonella enterica", "Salmonella enterica", "Salmonella")))
|
as.mo(c("Salmonella enterica", "Salmonella enterica", "Salmonella")))
|
||||||
|
|
||||||
# no virusses
|
# no viruses
|
||||||
expect_equal(as.character(as.mo("Virus")), NA_character_)
|
expect_equal(as.character(as.mo("Virus")), NA_character_)
|
||||||
|
|
||||||
# summary
|
# summary
|
||||||
|
@ -39,6 +39,7 @@ if (AMR:::pkg_is_available("ggplot2")) {
|
|||||||
}
|
}
|
||||||
expect_stdout(print(as.rsi(c("S", "I", "R"))))
|
expect_stdout(print(as.rsi(c("S", "I", "R"))))
|
||||||
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
|
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
|
||||||
|
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
|
||||||
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
|
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
|
||||||
expect_equal(summary(as.rsi(c("S", "R"))),
|
expect_equal(summary(as.rsi(c("S", "R"))),
|
||||||
structure(c("Class" = "rsi",
|
structure(c("Class" = "rsi",
|
||||||
@ -75,6 +76,7 @@ if (AMR:::pkg_is_available("skimr", min_version = "2.0.0")) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
expect_equal(as.rsi(c("", "-", NA, "NULL")), c(NA_rsi_, NA_rsi_, NA_rsi_, NA_rsi_))
|
||||||
|
|
||||||
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
|
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
|
||||||
expect_equal(as.character(
|
expect_equal(as.character(
|
||||||
|
Loading…
Reference in New Issue
Block a user