mirror of
https://github.com/msberends/AMR.git
synced 2025-07-10 15:41:49 +02:00
(v0.9.0.9023) EUCAST 2020 guidelines
This commit is contained in:
39
R/ab.R
39
R/ab.R
@ -66,11 +66,14 @@
|
||||
#' ab_name("J01FA01") # "Erythromycin"
|
||||
#' ab_name("eryt") # "Erythromycin"
|
||||
as.ab <- function(x, ...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (is.ab(x)) {
|
||||
return(x)
|
||||
}
|
||||
|
||||
if (all(toupper(x) %in% AMR::antibiotics$ab)) {
|
||||
if (all(toupper(x) %in% antibiotics$ab)) {
|
||||
# valid AB code, but not yet right class
|
||||
return(structure(.Data = toupper(x),
|
||||
class = "ab"))
|
||||
@ -117,67 +120,67 @@ as.ab <- function(x, ...) {
|
||||
}
|
||||
|
||||
# exact AB code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$ab == toupper(x[i])), ]$ab
|
||||
found <- antibiotics[which(antibiotics$ab == toupper(x[i])), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact ATC code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$atc == toupper(x[i])), ]$ab
|
||||
found <- antibiotics[which(antibiotics$atc == toupper(x[i])), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact CID code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$cid == x[i]), ]$ab
|
||||
found <- antibiotics[which(antibiotics$cid == x[i]), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact name
|
||||
found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) == toupper(x[i])), ]$ab
|
||||
found <- antibiotics[which(toupper(antibiotics$name) == toupper(x[i])), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact LOINC code
|
||||
loinc_found <- unlist(lapply(AMR::antibiotics$loinc,
|
||||
loinc_found <- unlist(lapply(antibiotics$loinc,
|
||||
function(s) if (x[i] %in% s) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[loinc_found == TRUE]
|
||||
found <- antibiotics$ab[loinc_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact synonym
|
||||
synonym_found <- unlist(lapply(AMR::antibiotics$synonyms,
|
||||
synonym_found <- unlist(lapply(antibiotics$synonyms,
|
||||
function(s) if (toupper(x[i]) %in% toupper(s)) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[synonym_found == TRUE]
|
||||
found <- antibiotics$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact abbreviation
|
||||
abbr_found <- unlist(lapply(AMR::antibiotics$abbreviations,
|
||||
abbr_found <- unlist(lapply(antibiotics$abbreviations,
|
||||
function(a) if (toupper(x[i]) %in% toupper(a)) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[abbr_found == TRUE]
|
||||
found <- antibiotics$ab[abbr_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
@ -185,7 +188,7 @@ as.ab <- function(x, ...) {
|
||||
|
||||
# first >=4 characters of name
|
||||
if (nchar(x[i]) >= 4) {
|
||||
found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) %like% paste0("^", x[i])), ]$ab
|
||||
found <- antibiotics[which(toupper(antibiotics$name) %like% paste0("^", x[i])), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
@ -215,19 +218,19 @@ as.ab <- function(x, ...) {
|
||||
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling)
|
||||
|
||||
# try if name starts with it
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$name %like% paste0("^", x_spelling)), ]$ab
|
||||
found <- antibiotics[which(antibiotics$name %like% paste0("^", x_spelling)), ]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
# and try if any synonym starts with it
|
||||
synonym_found <- unlist(lapply(AMR::antibiotics$synonyms,
|
||||
synonym_found <- unlist(lapply(antibiotics$synonyms,
|
||||
function(s) if (any(s %like% paste0("^", x_spelling))) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[synonym_found == TRUE]
|
||||
found <- antibiotics$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
@ -374,7 +377,7 @@ as.data.frame.ab <- function(x, ...) {
|
||||
"[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
#' @exportMethod [[<-.ab
|
||||
#' @export
|
||||
@ -382,7 +385,7 @@ as.data.frame.ab <- function(x, ...) {
|
||||
"[[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
#' @exportMethod c.ab
|
||||
#' @export
|
||||
@ -390,7 +393,7 @@ as.data.frame.ab <- function(x, ...) {
|
||||
c.ab <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
|
||||
#' @importFrom pillar type_sum
|
||||
|
@ -168,7 +168,7 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_info <- function(x, language = get_locale(), ...) {
|
||||
x <- AMR::as.ab(x, ...)
|
||||
x <- as.ab(x, ...)
|
||||
base::list(ab = as.character(x),
|
||||
atc = ab_atc(x),
|
||||
cid = ab_cid(x),
|
||||
@ -189,7 +189,7 @@ ab_property <- function(x, property = "name", language = get_locale(), ...) {
|
||||
if (length(property) != 1L) {
|
||||
stop("'property' must be of length 1.")
|
||||
}
|
||||
if (!property %in% colnames(AMR::antibiotics)) {
|
||||
if (!property %in% colnames(antibiotics)) {
|
||||
stop("invalid property: '", property, "' - use a column name of the `antibiotics` data set")
|
||||
}
|
||||
|
||||
@ -197,14 +197,17 @@ ab_property <- function(x, property = "name", language = get_locale(), ...) {
|
||||
}
|
||||
|
||||
ab_validate <- function(x, property, ...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# try to catch an error when inputting an invalid parameter
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% AMR::antibiotics[1, property],
|
||||
tryCatch(x[1L] %in% antibiotics[1, property],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
x_bak <- x
|
||||
if (!all(x %in% AMR::antibiotics[, property])) {
|
||||
x <- data.frame(ab = AMR::as.ab(x, ...), stringsAsFactors = FALSE) %>%
|
||||
left_join(AMR::antibiotics, by = "ab") %>%
|
||||
if (!all(x %in% antibiotics[, property])) {
|
||||
x <- data.frame(ab = as.ab(x, ...), stringsAsFactors = FALSE) %>%
|
||||
left_join(antibiotics, by = "ab") %>%
|
||||
pull(property)
|
||||
}
|
||||
if (property == "ab") {
|
||||
|
@ -76,12 +76,14 @@ atc_online_property <- function(atc_code,
|
||||
property,
|
||||
administration = "O",
|
||||
url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no") {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (!all(c("curl", "rvest", "xml2") %in% rownames(utils::installed.packages()))) {
|
||||
stop("Packages 'xml2', 'rvest' and 'curl' are required for this function")
|
||||
}
|
||||
|
||||
if (!all(atc_code %in% AMR::antibiotics)) {
|
||||
if (!all(atc_code %in% antibiotics)) {
|
||||
atc_code <- as.character(ab_atc(atc_code))
|
||||
}
|
||||
|
||||
|
@ -91,20 +91,23 @@ NULL
|
||||
#' microorganisms %>% freq(kingdom)
|
||||
#' microorganisms %>% group_by(kingdom) %>% freq(phylum, nmax = NULL)
|
||||
catalogue_of_life_version <- function() {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# see the `catalogue_of_life` list in R/data.R
|
||||
lst <- list(catalogue_of_life =
|
||||
list(version = gsub("{year}", catalogue_of_life$year, catalogue_of_life$version, fixed = TRUE),
|
||||
url = gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE),
|
||||
n = nrow(filter(AMR::microorganisms, source == "CoL"))),
|
||||
n = nrow(filter(microorganisms, source == "CoL"))),
|
||||
deutsche_sammlung_von_mikroorganismen_und_zellkulturen =
|
||||
list(version = "Prokaryotic Nomenclature Up-to-Date from DSMZ",
|
||||
url = catalogue_of_life$url_DSMZ,
|
||||
yearmonth = catalogue_of_life$yearmonth_DSMZ,
|
||||
n = nrow(filter(AMR::microorganisms, source == "DSMZ"))),
|
||||
n = nrow(filter(microorganisms, source == "DSMZ"))),
|
||||
total_included =
|
||||
list(
|
||||
n_total_species = nrow(AMR::microorganisms),
|
||||
n_total_synonyms = nrow(AMR::microorganisms.old)))
|
||||
n_total_species = nrow(microorganisms),
|
||||
n_total_synonyms = nrow(microorganisms.old)))
|
||||
|
||||
structure(.Data = lst,
|
||||
class = c("catalogue_of_life_version", "list"))
|
||||
|
@ -30,7 +30,7 @@
|
||||
#' @rdname AMR-deprecated
|
||||
p.symbol <- function(...) {
|
||||
.Deprecated("p_symbol()", package = "AMR")
|
||||
AMR::p_symbol(...)
|
||||
p_symbol(...)
|
||||
}
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
|
@ -202,6 +202,8 @@ eucast_rules <- function(x,
|
||||
verbose = FALSE,
|
||||
...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (verbose == TRUE & interactive()) {
|
||||
txt <- paste0("WARNING: In Verbose mode, the eucast_rules() function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way.",
|
||||
"\n\nThis may overwrite your existing data if you use e.g.:",
|
||||
@ -564,7 +566,7 @@ eucast_rules <- function(x,
|
||||
strsplit(",") %>%
|
||||
unlist() %>%
|
||||
trimws() %>%
|
||||
sapply(function(x) if (x %in% AMR::antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %>%
|
||||
sapply(function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %>%
|
||||
sort() %>%
|
||||
paste(collapse = ", ")
|
||||
x <- gsub("_", " ", x, fixed = TRUE)
|
||||
@ -664,8 +666,8 @@ eucast_rules <- function(x,
|
||||
# Print rule -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
# is new rule within group, print its name
|
||||
if (rule_current %in% c(AMR::microorganisms$family,
|
||||
AMR::microorganisms$fullname)) {
|
||||
if (rule_current %in% c(microorganisms$family,
|
||||
microorganisms$fullname)) {
|
||||
cat(italic(rule_current))
|
||||
} else {
|
||||
cat(rule_current)
|
||||
@ -681,7 +683,7 @@ eucast_rules <- function(x,
|
||||
# be sure to comprise all coagulase-negative/-positive Staphylococci when they are mentioned
|
||||
if (eucast_rules_df[i, 3] %like% "coagulase-") {
|
||||
suppressWarnings(
|
||||
all_staph <- AMR::microorganisms %>%
|
||||
all_staph <- microorganisms %>%
|
||||
filter(genus == "Staphylococcus") %>%
|
||||
mutate(CNS_CPS = mo_name(mo, Becker = "all"))
|
||||
)
|
||||
|
@ -24,7 +24,7 @@
|
||||
#' Filter isolates on results in specific antibiotic variables based on their class (ATC groups). This makes it easy to get a list of isolates that were tested for e.g. any aminoglycoside.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x a data set
|
||||
#' @param ab_class an antimicrobial class, like `"carbapenems"`, as can be found in [`AMR::antibiotics$group`][antibiotics]
|
||||
#' @param ab_class an antimicrobial class, like `"carbapenems"`, as can be found in [`antibiotics$group`][antibiotics]
|
||||
#' @param result an antibiotic result: S, I or R (or a combination of more of them)
|
||||
#' @param scope the scope to check which variables to check, can be `"any"` (default) or `"all"`
|
||||
#' @param ... parameters passed on to `filter_at` from the `dplyr` package
|
||||
@ -67,6 +67,9 @@ filter_ab_class <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
scope <- scope[1L]
|
||||
if (is.null(result)) {
|
||||
result <- c("S", "I", "R")
|
||||
@ -276,7 +279,7 @@ filter_tetracyclines <- function(x,
|
||||
#' @importFrom dplyr %>% filter_at vars any_vars select
|
||||
ab_class_vars <- function(ab_class) {
|
||||
ab_class <- gsub("[^a-z0-9]+", ".*", ab_class)
|
||||
ab_vars <- AMR::antibiotics %>%
|
||||
ab_vars <- antibiotics %>%
|
||||
filter(group %like% ab_class) %>%
|
||||
select(ab:name, abbreviations, synonyms) %>%
|
||||
unlist() %>%
|
||||
@ -289,7 +292,7 @@ ab_class_vars <- function(ab_class) {
|
||||
ab_vars <- ab_vars[!ab_vars %in% c(NA, "", "NA") & nchar(ab_vars) > 2]
|
||||
if (length(ab_vars) == 0) {
|
||||
# try again, searching atc_group1 and atc_group2 columns
|
||||
ab_vars <- AMR::antibiotics %>%
|
||||
ab_vars <- antibiotics %>%
|
||||
filter_at(vars(c("atc_group1", "atc_group2")), any_vars(. %like% ab_class)) %>%
|
||||
select(ab:name, abbreviations, synonyms) %>%
|
||||
unlist() %>%
|
||||
@ -314,7 +317,7 @@ find_ab_group <- function(ab_class) {
|
||||
"macrolide",
|
||||
"tetracycline"),
|
||||
paste0(ab_class, "s"),
|
||||
AMR::antibiotics %>%
|
||||
antibiotics %>%
|
||||
filter(ab %in% ab_class_vars(ab_class)) %>%
|
||||
pull(group) %>%
|
||||
unique() %>%
|
||||
|
6
R/freq.R
6
R/freq.R
@ -58,14 +58,14 @@ freq.mo <- function(x, ...) {
|
||||
freq.rsi <- function(x, ...) {
|
||||
x_name <- deparse(substitute(x))
|
||||
x_name <- gsub(".*[$]", "", x_name)
|
||||
ab <- suppressMessages(suppressWarnings(AMR::as.ab(x_name)))
|
||||
ab <- suppressMessages(suppressWarnings(as.ab(x_name)))
|
||||
if (!is.na(ab)) {
|
||||
freq.default(x = x, ...,
|
||||
.add_header = list(Drug = paste0(ab_name(ab), " (", ab, ", ", ab_atc(ab), ")"),
|
||||
group = ab_group(ab),
|
||||
`%SI` = AMR::susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
`%SI` = susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
} else {
|
||||
freq.default(x = x, ...,
|
||||
.add_header = list(`%SI` = AMR::susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
.add_header = list(`%SI` = susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
}
|
||||
}
|
||||
|
@ -303,7 +303,7 @@ geom_rsi <- function(position = NULL,
|
||||
ggplot2::layer(geom = "bar", stat = "identity", position = position,
|
||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||
params = list(...), data = function(x) {
|
||||
AMR::rsi_df(data = x,
|
||||
rsi_df(data = x,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
combine_SI = combine_SI,
|
||||
|
@ -126,7 +126,7 @@ get_column_abx <- function(x,
|
||||
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
|
||||
# or already have the rsi class (as.rsi)
|
||||
# and that have no more than 50% invalid values
|
||||
vectr_antibiotics <- unique(toupper(unlist(AMR::antibiotics[, c("ab", "atc", "name", "abbreviations", "synonyms")])))
|
||||
vectr_antibiotics <- unique(toupper(unlist(antibiotics[, c("ab", "atc", "name", "abbreviations", "synonyms")])))
|
||||
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
|
||||
x_columns <- sapply(colnames(x), function(col, df = x_bak) {
|
||||
if (toupper(col) %in% vectr_antibiotics |
|
||||
@ -205,7 +205,7 @@ get_column_abx <- function(x,
|
||||
# missing a soft dependency may lower the reliability
|
||||
missing <- soft_dependencies[!soft_dependencies %in% names(x)]
|
||||
missing_txt <- data.frame(missing = missing,
|
||||
missing_names = AMR::ab_name(missing, tolower = TRUE),
|
||||
missing_names = ab_name(missing, tolower = TRUE),
|
||||
stringsAsFactors = FALSE) %>%
|
||||
mutate(txt = paste0(bold(missing), " (", missing_names, ")")) %>%
|
||||
arrange(missing_names) %>%
|
||||
|
@ -54,7 +54,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
join <- suppressWarnings(
|
||||
dplyr::inner_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
|
||||
dplyr::inner_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
if (nrow(join) > nrow(x)) {
|
||||
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
@ -69,7 +69,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
join <- suppressWarnings(
|
||||
dplyr::left_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
|
||||
dplyr::left_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
if (nrow(join) > nrow(x)) {
|
||||
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
@ -84,7 +84,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
join <- suppressWarnings(
|
||||
dplyr::right_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
|
||||
dplyr::right_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
if (nrow(join) > nrow(x)) {
|
||||
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
@ -99,7 +99,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
join <- suppressWarnings(
|
||||
dplyr::full_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
|
||||
dplyr::full_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
if (nrow(join) > nrow(x)) {
|
||||
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
@ -114,7 +114,7 @@ semi_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
suppressWarnings(
|
||||
dplyr::semi_join(x = x, y = AMR::microorganisms, by = by, ...)
|
||||
dplyr::semi_join(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
}
|
||||
|
||||
@ -125,7 +125,7 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
suppressWarnings(
|
||||
dplyr::anti_join(x = x, y = AMR::microorganisms, by = by, ...)
|
||||
dplyr::anti_join(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
}
|
||||
|
||||
@ -149,7 +149,7 @@ joins_check_df <- function(x, by) {
|
||||
message('Joining, by = "', by, '"') # message same as dplyr::join functions
|
||||
}
|
||||
if (is.null(names(by))) {
|
||||
joinby <- colnames(AMR::microorganisms)[1]
|
||||
joinby <- colnames(microorganisms)[1]
|
||||
names(joinby) <- by
|
||||
} else {
|
||||
joinby <- by
|
||||
|
6
R/like.R
6
R/like.R
@ -45,15 +45,15 @@
|
||||
#'
|
||||
#' # also supports multiple patterns, length must be equal to x
|
||||
#' a <- c("Test case", "Something different", "Yet another thing")
|
||||
#' b <- c("case", "diff", "yet")
|
||||
#' b <- c( "case", "diff", "yet")
|
||||
#' a %like% b
|
||||
#' #> TRUE TRUE TRUE
|
||||
#'
|
||||
#' # get frequencies of bacteria whose name start with 'Ent' or 'ent'
|
||||
#' library(dplyr)
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_genus(mo) %like% '^ent') %>%
|
||||
#' freq(mo_fullname(mo))
|
||||
#' filter(mo_name(mo) %like% '^ent') %>%
|
||||
#' freq(mo_genus(mo))
|
||||
like <- function(x, pattern, ignore.case = TRUE) {
|
||||
if (length(pattern) > 1) {
|
||||
if (length(x) != length(pattern)) {
|
||||
|
4
R/mdro.R
4
R/mdro.R
@ -90,6 +90,8 @@ mdro <- function(x,
|
||||
verbose = FALSE,
|
||||
...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (verbose == TRUE & interactive()) {
|
||||
txt <- paste0("WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.",
|
||||
"\n\nThis may overwrite your existing data if you use e.g.:",
|
||||
@ -147,7 +149,7 @@ mdro <- function(x,
|
||||
if (is.null(col_mo) & guideline$code == "tb") {
|
||||
message(blue("NOTE: No column found as input for `col_mo`,",
|
||||
bold("assuming all records contain", italic("Mycobacterium tuberculosis.\n"))))
|
||||
x$mo <- AMR::as.mo("Mycobacterium tuberculosis")
|
||||
x$mo <- as.mo("Mycobacterium tuberculosis")
|
||||
col_mo <- "mo"
|
||||
}
|
||||
if (is.null(col_mo)) {
|
||||
|
24
R/misc.R
24
R/misc.R
@ -29,12 +29,23 @@ addin_insert_like <- function() {
|
||||
rstudioapi::insertText(" %like% ")
|
||||
}
|
||||
|
||||
load_AMR_package <- function() {
|
||||
if (!"package:AMR" %in% base::search()) {
|
||||
require(AMR)
|
||||
# check onLoad() in R/zzz.R: data tables are created there.
|
||||
check_dataset_integrity <- function() {
|
||||
if (!all(colnames(microorganisms) %in% c("mo", "fullname", "kingdom", "phylum",
|
||||
"class", "order", "family", "genus",
|
||||
"species", "subspecies", "rank",
|
||||
"col_id", "species_id", "source",
|
||||
"ref", "prevalence", "snomed"),
|
||||
na.rm = TRUE) |
|
||||
NROW(microorganisms) != NROW(microorganismsDT) |
|
||||
!all(colnames(antibiotics) %in% c("ab", "atc", "cid", "name", "group",
|
||||
"atc_group1", "atc_group2", "abbreviations",
|
||||
"synonyms", "oral_ddd", "oral_units",
|
||||
"iv_ddd", "iv_units", "loinc"),
|
||||
na.rm = TRUE)) {
|
||||
stop("Data set `microorganisms` or data set `antibiotics` is overwritten by your global environment and prevents the AMR package from working correctly. Please rename your object before using this function.", call. = FALSE)
|
||||
}
|
||||
base::invisible()
|
||||
|
||||
invisible(TRUE)
|
||||
}
|
||||
|
||||
#' @importFrom crayon blue bold red
|
||||
@ -155,9 +166,6 @@ dataset_UTF8_to_ASCII <- function(df) {
|
||||
col <- df[, i]
|
||||
if (is.list(col)) {
|
||||
col <- lapply(col, function(j) trans(j))
|
||||
# for (j in seq_len(length(col))) {
|
||||
# col[[j]] <- trans(col[[j]])
|
||||
# }
|
||||
df[, i] <- list(col)
|
||||
} else {
|
||||
if (is.factor(col)) {
|
||||
|
30
R/mo.R
30
R/mo.R
@ -175,7 +175,7 @@ as.mo <- function(x,
|
||||
reference_df = get_mo_source(),
|
||||
...) {
|
||||
|
||||
load_AMR_package()
|
||||
check_dataset_integrity()
|
||||
|
||||
# WHONET: xxx = no growth
|
||||
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
|
||||
@ -238,7 +238,7 @@ is.mo <- function(x) {
|
||||
#' @importFrom data.table data.table as.data.table setkey
|
||||
#' @importFrom crayon magenta red blue silver italic
|
||||
#' @importFrom cleaner percentage
|
||||
# param property a column name of AMR::microorganisms
|
||||
# param property a column name of microorganisms
|
||||
# param initial_search logical - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too
|
||||
# param dyslexia_mode logical - also check for characters that resemble others
|
||||
# param debug logical - show different lookup texts while searching
|
||||
@ -254,7 +254,7 @@ exec_as.mo <- function(x,
|
||||
debug = FALSE,
|
||||
reference_data_to_use = microorganismsDT) {
|
||||
|
||||
load_AMR_package()
|
||||
check_dataset_integrity()
|
||||
|
||||
# WHONET: xxx = no growth
|
||||
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
|
||||
@ -365,7 +365,7 @@ exec_as.mo <- function(x,
|
||||
suppressWarnings(
|
||||
x <- data.frame(x = x, stringsAsFactors = FALSE) %>%
|
||||
left_join(reference_df, by = "x") %>%
|
||||
left_join(AMR::microorganisms, by = "mo") %>%
|
||||
left_join(microorganisms, by = "mo") %>%
|
||||
pull(property)
|
||||
)
|
||||
|
||||
@ -393,9 +393,9 @@ exec_as.mo <- function(x,
|
||||
on = "fullname_lower",
|
||||
..property][[1]]
|
||||
|
||||
} else if (all(toupper(x) %in% AMR::microorganisms.codes$code)) {
|
||||
} else if (all(toupper(x) %in% microorganisms.codes$code)) {
|
||||
# commonly used MO codes
|
||||
y <- as.data.table(AMR::microorganisms.codes)[data.table(code = toupper(x)),
|
||||
y <- as.data.table(microorganisms.codes)[data.table(code = toupper(x)),
|
||||
on = "code", ]
|
||||
|
||||
x <- reference_data_to_use[data.table(mo = y[["mo"]]),
|
||||
@ -412,7 +412,7 @@ exec_as.mo <- function(x,
|
||||
..property][[1]]
|
||||
x <- y
|
||||
|
||||
} else if (!all(x %in% AMR::microorganisms[, property])) {
|
||||
} else if (!all(x %in% microorganisms[, property])) {
|
||||
|
||||
strip_whitespace <- function(x, dyslexia_mode) {
|
||||
# all whitespaces (tab, new lines, etc.) should be one space
|
||||
@ -632,8 +632,8 @@ exec_as.mo <- function(x,
|
||||
}
|
||||
|
||||
# WHONET and other common LIS codes
|
||||
if (any(toupper(c(x_backup[i], x_backup_without_spp[i])) %in% AMR::microorganisms.codes$code)) {
|
||||
mo_found <- AMR::microorganisms.codes[which(AMR::microorganisms.codes$code %in% toupper(c(x_backup[i], x_backup_without_spp[i]))), "mo"][1L]
|
||||
if (any(toupper(c(x_backup[i], x_backup_without_spp[i])) %in% microorganisms.codes$code)) {
|
||||
mo_found <- microorganisms.codes[which(microorganisms.codes$code %in% toupper(c(x_backup[i], x_backup_without_spp[i]))), "mo"][1L]
|
||||
if (length(mo_found) > 0) {
|
||||
x[i] <- microorganismsDT[mo == mo_found,
|
||||
..property][[1]][1L]
|
||||
@ -1476,8 +1476,7 @@ exec_as.mo <- function(x,
|
||||
msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ", "))
|
||||
}
|
||||
msg <- paste0(msg, ". Use mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).")
|
||||
cat("\n")
|
||||
warning(red(msg),
|
||||
warning(red(paste0("\n", msg)),
|
||||
call. = FALSE,
|
||||
immediate. = TRUE) # thus will always be shown, even if >= warnings
|
||||
}
|
||||
@ -1491,8 +1490,7 @@ exec_as.mo <- function(x,
|
||||
}
|
||||
msg <- paste0("Result", plural[1], " of ", nr2char(NROW(uncertainties)), " value", plural[1],
|
||||
" ", plural[3], " guessed with uncertainty. Use mo_uncertainties() to review ", plural[2], ".")
|
||||
cat("\n")
|
||||
warning(red(msg),
|
||||
warning(red(paste0("\n", msg)),
|
||||
call. = FALSE,
|
||||
immediate. = TRUE) # thus will always be shown, even if >= warnings
|
||||
}
|
||||
@ -1753,7 +1751,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
"[<-.mo" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "microorganism code", c(as.character(AMR::microorganisms$mo),
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
#' @exportMethod [[<-.mo
|
||||
@ -1762,7 +1760,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
"[[<-.mo" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "microorganism code", c(as.character(AMR::microorganisms$mo),
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
#' @exportMethod c.mo
|
||||
@ -1771,7 +1769,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
c.mo <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
class_integrity_check(y, "microorganism code", c(as.character(AMR::microorganisms$mo),
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
|
||||
|
@ -145,7 +145,7 @@ mo_fullname <- mo_name
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
x.mo <- AMR::as.mo(x, ...)
|
||||
x.mo <- as.mo(x, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
replace_empty <- function(x) {
|
||||
@ -223,7 +223,7 @@ mo_type <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gramstain <- function(x, language = get_locale(), ...) {
|
||||
x.mo <- AMR::as.mo(x, ...)
|
||||
x.mo <- as.mo(x, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
x.phylum <- mo_phylum(x.mo)
|
||||
@ -290,17 +290,17 @@ mo_rank <- function(x, ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
x <- AMR::as.mo(x, ...)
|
||||
x <- as.mo(x, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
result <- base::list(kingdom = AMR::mo_kingdom(x, language = language),
|
||||
phylum = AMR::mo_phylum(x, language = language),
|
||||
class = AMR::mo_class(x, language = language),
|
||||
order = AMR::mo_order(x, language = language),
|
||||
family = AMR::mo_family(x, language = language),
|
||||
genus = AMR::mo_genus(x, language = language),
|
||||
species = AMR::mo_species(x, language = language),
|
||||
subspecies = AMR::mo_subspecies(x, language = language))
|
||||
result <- base::list(kingdom = mo_kingdom(x, language = language),
|
||||
phylum = mo_phylum(x, language = language),
|
||||
class = mo_class(x, language = language),
|
||||
order = mo_order(x, language = language),
|
||||
family = mo_family(x, language = language),
|
||||
genus = mo_genus(x, language = language),
|
||||
species = mo_species(x, language = language),
|
||||
subspecies = mo_subspecies(x, language = language))
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
result
|
||||
@ -309,12 +309,12 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_synonyms <- function(x, ...) {
|
||||
x <- AMR::as.mo(x, ...)
|
||||
x <- as.mo(x, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
IDs <- AMR::mo_property(x = x, property = "col_id", language = NULL)
|
||||
IDs <- mo_property(x = x, property = "col_id", language = NULL)
|
||||
syns <- lapply(IDs, function(col_id) {
|
||||
res <- sort(AMR::microorganisms.old[which(AMR::microorganisms.old$col_id_new == col_id), "fullname"])
|
||||
res <- sort(microorganisms.old[which(microorganisms.old$col_id_new == col_id), "fullname"])
|
||||
if (length(res) == 0) {
|
||||
NULL
|
||||
} else {
|
||||
@ -335,7 +335,7 @@ mo_synonyms <- function(x, ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_locale(), ...) {
|
||||
x <- AMR::as.mo(x, ...)
|
||||
x <- as.mo(x, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
info <- lapply(x, function(y)
|
||||
@ -360,12 +360,12 @@ mo_info <- function(x, language = get_locale(), ...) {
|
||||
#' @importFrom dplyr %>% left_join select mutate case_when
|
||||
#' @export
|
||||
mo_url <- function(x, open = FALSE, ...) {
|
||||
mo <- AMR::as.mo(x = x, ... = ...)
|
||||
mo_names <- AMR::mo_name(mo)
|
||||
mo <- as.mo(x = x, ... = ...)
|
||||
mo_names <- mo_name(mo)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
df <- data.frame(mo, stringsAsFactors = FALSE) %>%
|
||||
left_join(select(AMR::microorganisms, mo, source, species_id), by = "mo") %>%
|
||||
left_join(select(microorganisms, mo, source, species_id), by = "mo") %>%
|
||||
mutate(url = case_when(source == "CoL" ~
|
||||
paste0(gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE), "details/species/id/", species_id),
|
||||
source == "DSMZ" ~
|
||||
@ -394,7 +394,7 @@ mo_property <- function(x, property = "fullname", language = get_locale(), ...)
|
||||
if (length(property) != 1L) {
|
||||
stop("'property' must be of length 1.")
|
||||
}
|
||||
if (!property %in% colnames(AMR::microorganisms)) {
|
||||
if (!property %in% colnames(microorganisms)) {
|
||||
stop("invalid property: '", property, "' - use a column name of the `microorganisms` data set")
|
||||
}
|
||||
|
||||
@ -403,7 +403,7 @@ mo_property <- function(x, property = "fullname", language = get_locale(), ...)
|
||||
|
||||
mo_validate <- function(x, property, ...) {
|
||||
|
||||
load_AMR_package()
|
||||
check_dataset_integrity()
|
||||
|
||||
dots <- list(...)
|
||||
Becker <- dots$Becker
|
||||
@ -417,7 +417,7 @@ mo_validate <- function(x, property, ...) {
|
||||
|
||||
# try to catch an error when inputting an invalid parameter
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% AMR::microorganisms[1, property],
|
||||
tryCatch(x[1L] %in% microorganisms[1, property],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
if (is.mo(x)
|
||||
@ -426,7 +426,7 @@ mo_validate <- function(x, property, ...) {
|
||||
# this will not reset mo_uncertainties and mo_failures
|
||||
# because it's already a valid MO
|
||||
x <- exec_as.mo(x, property = property, initial_search = FALSE, ...)
|
||||
} else if (!all(x %in% pull(AMR::microorganisms, property))
|
||||
} else if (!all(x %in% pull(microorganisms, property))
|
||||
| Becker %in% c(TRUE, "all")
|
||||
| Lancefield %in% c(TRUE, "all")) {
|
||||
x <- exec_as.mo(x, property = property, ...)
|
||||
|
@ -202,6 +202,9 @@ get_mo_source <- function() {
|
||||
}
|
||||
|
||||
mo_source_isvalid <- function(x) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (deparse(substitute(x)) == "get_mo_source()") {
|
||||
return(TRUE)
|
||||
}
|
||||
@ -217,5 +220,5 @@ mo_source_isvalid <- function(x) {
|
||||
if (!"mo" %in% colnames(x)) {
|
||||
return(FALSE)
|
||||
}
|
||||
all(x$mo %in% c("", AMR::microorganisms$mo, microorganisms.translation$mo_old), na.rm = TRUE)
|
||||
all(x$mo %in% c("", microorganisms$mo, microorganisms.translation$mo_old), na.rm = TRUE)
|
||||
}
|
||||
|
26
R/rsi.R
26
R/rsi.R
@ -28,10 +28,10 @@
|
||||
#' @param mo a microorganism code, generated with [as.mo()]
|
||||
#' @param ab an antimicrobial code, generated with [as.ab()]
|
||||
#' @inheritParams first_isolate
|
||||
#' @param guideline defaults to the latest included EUCAST guideline, run `unique(AMR::rsi_translation$guideline)` for all options
|
||||
#' @param guideline defaults to the latest included EUCAST guideline, run `unique(rsi_translation$guideline)` for all options
|
||||
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, please see *Examples*
|
||||
#' @param ... parameters passed on to methods
|
||||
#' @details Run `unique(AMR::rsi_translation$guideline)` for a list of all supported guidelines. The repository of this package contains [this machine readable version](https://gitlab.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt) of these guidelines.
|
||||
#' @details Run `unique(rsi_translation$guideline)` for a list of all supported guidelines. The repository of this package contains [this machine readable version](https://gitlab.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt) of these guidelines.
|
||||
#'
|
||||
#' These guidelines are machine readable, since [](https://gitlab.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt).
|
||||
#'
|
||||
@ -66,11 +66,12 @@
|
||||
#' # interpret MIC values
|
||||
#' as.rsi(x = as.mic(2),
|
||||
#' mo = as.mo("S. pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#' ab = "AMP",
|
||||
#' guideline = "EUCAST")
|
||||
#' as.rsi(x = as.mic(4),
|
||||
#' mo = as.mo("S. pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#'
|
||||
#' as.rsi(x = as.disk(18),
|
||||
#' mo = "Strep pneu", # `mo` will be coerced with as.mo()
|
||||
#' ab = "ampicillin", # and `ab` with as.ab()
|
||||
#' guideline = "EUCAST")
|
||||
#'
|
||||
#' plot(rsi_data) # for percentages
|
||||
@ -188,7 +189,7 @@ as.rsi.disk <- function(x, mo, ab, guideline = "EUCAST", ...) {
|
||||
get_guideline <- function(guideline) {
|
||||
guideline_param <- toupper(guideline)
|
||||
if (guideline_param %in% c("CLSI", "EUCAST")) {
|
||||
guideline_param <- AMR::rsi_translation %>%
|
||||
guideline_param <- rsi_translation %>%
|
||||
filter(guideline %like% guideline_param) %>%
|
||||
pull(guideline) %>%
|
||||
sort() %>%
|
||||
@ -196,9 +197,9 @@ get_guideline <- function(guideline) {
|
||||
.[1]
|
||||
}
|
||||
|
||||
if (!guideline_param %in% AMR::rsi_translation$guideline) {
|
||||
if (!guideline_param %in% rsi_translation$guideline) {
|
||||
stop(paste0("invalid guideline: '", guideline,
|
||||
"'.\nValid guidelines are: ", paste0("'", rev(sort(unique(AMR::rsi_translation$guideline))), "'", collapse = ", ")),
|
||||
"'.\nValid guidelines are: ", paste0("'", rev(sort(unique(rsi_translation$guideline))), "'", collapse = ", ")),
|
||||
call. = FALSE)
|
||||
}
|
||||
|
||||
@ -222,6 +223,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
|
||||
mo_order <- as.mo(mo_order(mo))
|
||||
mo_becker <- as.mo(mo, Becker = TRUE)
|
||||
mo_lancefield <- as.mo(mo, Lancefield = TRUE)
|
||||
mo_other <- as.mo("other")
|
||||
|
||||
guideline_coerced <- get_guideline(guideline)
|
||||
if (guideline_coerced != guideline) {
|
||||
@ -229,7 +231,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
|
||||
}
|
||||
|
||||
new_rsi <- rep(NA_character_, length(x))
|
||||
trans <- AMR::rsi_translation %>%
|
||||
trans <- rsi_translation %>%
|
||||
filter(guideline == guideline_coerced & method == method_param) %>%
|
||||
mutate(lookup = paste(mo, ab))
|
||||
|
||||
@ -239,6 +241,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
|
||||
lookup_order <- paste(mo_order, ab)
|
||||
lookup_becker <- paste(mo_becker, ab)
|
||||
lookup_lancefield <- paste(mo_lancefield, ab)
|
||||
lookup_other <- paste(mo_other, ab)
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
get_record <- trans %>%
|
||||
@ -247,7 +250,8 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
|
||||
lookup_family[i],
|
||||
lookup_order[i],
|
||||
lookup_becker[i],
|
||||
lookup_lancefield[i])) %>%
|
||||
lookup_lancefield[i],
|
||||
lookup_other[i])) %>%
|
||||
# be as specific as possible (i.e. prefer species over genus):
|
||||
arrange(desc(nchar(mo))) %>%
|
||||
.[1L, ]
|
||||
|
@ -179,6 +179,8 @@ rsi_calc_df <- function(type, # "proportion" or "count"
|
||||
combine_IR = FALSE,
|
||||
combine_SI_missing = FALSE) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (!"data.frame" %in% class(data)) {
|
||||
stop(paste0("`", type, "_df` must be called on a data.frame"), call. = FALSE)
|
||||
}
|
||||
@ -252,7 +254,7 @@ rsi_calc_df <- function(type, # "proportion" or "count"
|
||||
arrange(antibiotic, interpretation)
|
||||
|
||||
if (!translate_ab == FALSE) {
|
||||
res <- res %>% mutate(antibiotic = AMR::ab_property(antibiotic, property = translate_ab, language = language))
|
||||
res <- res %>% mutate(antibiotic = ab_property(antibiotic, property = translate_ab, language = language))
|
||||
}
|
||||
|
||||
as.data.frame(res, stringsAsFactors = FALSE)
|
||||
|
Reference in New Issue
Block a user