P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

fixes

This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-09-19 11:57:21 +02:00
parent a20293a0a3
commit 127d8d868d
12 changed files with 221 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.8.1.9056
Date: 2022-09-18
Version: 1.8.1.9057
Date: 2022-09-19
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.8.1.9056
# AMR 1.8.1.9057
This version will eventually become v2.0! We're happy to reach a new major milestone soon!

8
R/aa_helper_functions.R
View File

@ -960,8 +960,8 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
# combination of environment ID (such as "0x7fed4ee8c848")
# and relevant system call (where 'match_fn' is being called in)
calls <- sys.calls()
if (!identical(Sys.getenv("R_RUN_TINYTEST"), "true") &&
!any(as.character(calls[[1]]) %like_case% "run_test_dir|run_test_file|test_all|tinytest|test_package|testthat")) {
in_test <- any(as.character(calls[[1]]) %like_case% "run_test_dir|run_test_file|test_all|tinytest|test_package|testthat", na.rm = TRUE)
if (!isTRUE(in_test)) {
for (i in seq_len(length(calls))) {
call_clean <- gsub("[^a-zA-Z0-9_().-]", "", as.character(calls[[i]]), perl = TRUE)
if (any(call_clean %like% paste0(match_fn, "\\("), na.rm = TRUE)) {
@ -971,8 +971,6 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
))
}
}
} else if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
message("NOTE: env R_RUN_TINYTEST is set to 'true', unique_call_id() not working well")
}
c(
envir = paste0(sample(c(0:9, letters[1:6]), size = 32, replace = TRUE), collapse = ""),
@ -987,7 +985,7 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
# this is to prevent that messages/notes will be printed for every dplyr group or more than once per session
# e.g. this would show a msg 4 times: example_isolates %>% group_by(ward) %>% filter(mo_is_gram_negative())
salt <- gsub("[^a-zA-Z0-9|_-]", "?", paste(c(...), sep = "|", collapse = "|"), perl = TRUE)
salt <- gsub("[^a-zA-Z0-9|_-]", "?", paste(c(...)[seq_len(min(50, length(c(...))))], sep = "|", collapse = "|"), perl = TRUE)
not_thrown_before <- is.null(pkg_env[[paste0("thrown_msg.", fn, ".", salt)]]) ||
!identical(
pkg_env[[paste0("thrown_msg.", fn, ".", salt)]],

26
R/custom_eucast_rules.R
View File

@ -35,38 +35,54 @@
#'
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
#'
#' ```{r}
#' ```r
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
#' TZP == "R" ~ aminopenicillins == "R")
#' ```
#'
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
#'
#' ```{r}
#' ```r
#' x
#' #> A set of custom EUCAST rules:
#' #>
#' #> 1. If TZP is "S" then set to S :
#' #> amoxicillin (AMX), ampicillin (AMP)
#' #>
#' #> 2. If TZP is "R" then set to R :
#' #> amoxicillin (AMX), ampicillin (AMP)
#' ```
#'
#' The rules (the part *before* the tilde, in above example `TZP == "S"` and `TZP == "R"`) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column `TZP` must exist. We will create a sample data set and test the rules set:
#'
#' ```{r}
#' ```r
#' df <- data.frame(mo = c("Escherichia coli", "Klebsiella pneumoniae"),
#' TZP = as.rsi("R"),
#' ampi = as.rsi("S"),
#' cipro = as.rsi("S"))
#' df
#'
#' #> mo TZP ampi cipro
#' #> 1 Escherichia coli R S S
#' #> 2 Klebsiella pneumoniae R S S
#'
#' eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE)
#' #> mo TZP ampi cipro
#' #> 1 Escherichia coli R R S
#' #> 2 Klebsiella pneumoniae R R S
#' ```
#'
#' ### Using taxonomic properties in rules
#'
#' There is one exception in variables used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
#'
#' ```{r}
#' ```r
#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
#'
#' eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE)
#' #> mo TZP ampi cipro
#' #> 1 Escherichia coli R S S
#' #> 2 Klebsiella pneumoniae R R S
#' ```
#'
#' ### Usage of antibiotic group names

10
R/eucast_rules.R
View File

@ -74,19 +74,18 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#'
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The `AMR` package contains the full microbial taxonomy updated until `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`, see [microorganisms].
#'
#' ## Custom Rules
#' ### Custom Rules
#'
#' Custom rules can be created using [custom_eucast_rules()], e.g.:
#'
#' ```{r}
#' ```r
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
#'
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x, info = FALSE)
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x)
#' ```
#'
#'
#' ## 'Other' Rules
#' ### 'Other' Rules
#'
#' Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are:
#'
@ -117,7 +116,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 12.0, 2022. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_12.0_Breakpoint_Tables.xlsx)
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
#' \donttest{
#' a <- data.frame(

51
R/mo.R
View File

@ -35,7 +35,7 @@
#' This excludes enterococci at default (who are in group D), use `Lancefield = "all"` to also categorise all enterococci as group D.
#' @param minimum_matching_score a numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic kingdom][microorganisms] and [human pathogenicity][mo_matching_score()].
#' @param allow_uncertain a number between `0` (or `"none"`) and `3` (or `"all"`), or `TRUE` (= `2`) or `FALSE` (= `0`) to indicate whether the input should be checked for less probable results, see *Details*
#' @param keep_synonyms a [logical] to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE` to always return the currently accepted names.
#' @param keep_synonyms a [logical] to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `TRUE`, which will return a note if old taxonomic names are returned. The default can be set with `options(AMR_keep_synonyms = ...)`.
#' @param reference_df a [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
#' @param ignore_pattern a regular expression (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option `AMR_ignore_pattern`, e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()])
@ -45,7 +45,7 @@
#' @aliases mo
#' @keywords mo Becker becker Lancefield lancefield guess
#' @details
#' ## General Info
#' ### General Info
#'
#' A microorganism (MO) code from this package (class: [`mo`]) is human readable and typically looks like these examples:
#' ```
@ -77,7 +77,7 @@
#'
#' This will lead to the effect that e.g. `"E. coli"` (a microorganism highly prevalent in humans) will return the microbial ID of *Escherichia coli* and not *Entamoeba coli* (a microorganism less prevalent in humans), although the latter would alphabetically come first.
#'
#' ## Coping with Uncertain Results
#' ### Coping with Uncertain Results
#'
#' In addition, the [as.mo()] function can differentiate four levels of uncertainty to guess valid results:
#' - Uncertainty level 0: no additional rules are applied;
@ -97,7 +97,7 @@
#' - Use [mo_failures()] to get a [character] [vector] with all values that could not be coerced to a valid value.
#' - Use [mo_renamed()] to get a [data.frame] with all values that could be coerced based on old, previously accepted taxonomic names.
#'
#' ## Microbial Prevalence of Pathogens in Humans
#' ### Microbial Prevalence of Pathogens in Humans
#'
#' The coercion rules consider the prevalence of microorganisms in humans grouped into three groups, which is available as the `prevalence` columns in the [microorganisms] data set. The grouping into human pathogenic prevalence is explained in the section *Matching Score for Microorganisms* below.
#' @inheritSection mo_matching_score Matching Score for Microorganisms
@ -133,8 +133,8 @@
#' "MRSA", # Methicillin Resistant S. aureus
#' "VISA", # Vancomycin Intermediate S. aureus
#' "VRSA", # Vancomycin Resistant S. aureus
#' 115329001
#' )) # SNOMED CT code
#' 115329001 # SNOMED CT code
#' ))
#'
#' # Dyslexia is no problem - these all work:
#' as.mo(c(
@ -153,25 +153,25 @@
#' as.mo("S. pyogenes", Lancefield = TRUE) # will not remain species: B_STRPT_GRPA
#'
#' # All mo_* functions use as.mo() internally too (see ?mo_property):
#' mo_genus("Esch coli")
#' mo_gramstain("E. coli")
#' mo_is_intrinsic_resistant("E. coli", "vanco")
#' mo_genus("E. coli")
#' mo_gramstain("ESCO")
#' mo_is_intrinsic_resistant("ESCCOL", ab = "vanco")
#' }
as.mo <- function(x,
Becker = FALSE,
Lancefield = FALSE,
minimum_matching_score = NULL,
allow_uncertain = TRUE,
keep_synonyms = FALSE,
keep_synonyms = getOption("AMR_keep_synonyms", TRUE),
reference_df = get_mo_source(),
ignore_pattern = getOption("AMR_ignore_pattern"),
ignore_pattern = getOption("AMR_ignore_pattern", NULL),
language = get_AMR_locale(),
info = interactive(),
...) {
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(keep_synonyms, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
meet_criteria(minimum_matching_score, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE)
meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE)
meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE)
@ -371,18 +371,18 @@ as.mo <- function(x,
} # end of loop over all yet unknowns
# Keep or replace synonyms ----
gbif_matches <- AMR::microorganisms$gbif_renamed_to[match(out, AMR::microorganisms$mo)]
lpsn_matches <- AMR::microorganisms$lpsn_renamed_to[match(out, AMR::microorganisms$mo)]
if (isFALSE(keep_synonyms)) {
out_old <- out
gbif_matches <- AMR::microorganisms$gbif_renamed_to[match(out, AMR::microorganisms$mo)]
gbif_matches[!gbif_matches %in% AMR::microorganisms$gbif] <- NA
out[which(!is.na(gbif_matches))] <- AMR::microorganisms$mo[match(gbif_matches[which(!is.na(gbif_matches))], AMR::microorganisms$gbif)]
lpsn_matches <- AMR::microorganisms$lpsn_renamed_to[match(out, AMR::microorganisms$mo)]
lpsn_matches[!lpsn_matches %in% AMR::microorganisms$lpsn] <- NA
out[which(!is.na(lpsn_matches))] <- AMR::microorganisms$mo[match(lpsn_matches[which(!is.na(lpsn_matches))], AMR::microorganisms$lpsn)]
if (isTRUE(info) && (any(!is.na(gbif_matches)) || any(!is.na(lpsn_matches))) && message_not_thrown_before("as.mo", gbif_matches[which(!is.na(gbif_matches))][1:5], lpsn_matches[which(!is.na(lpsn_matches))][1:5]) && length(c(lpsn_matches, gbif_matches)) > 0) {
if (isTRUE(info) && (any(!is.na(gbif_matches)) || any(!is.na(lpsn_matches))) && message_not_thrown_before("as.mo", gbif_matches[which(!is.na(gbif_matches))], lpsn_matches[which(!is.na(lpsn_matches))]) && length(c(lpsn_matches, gbif_matches)) > 0) {
total_old <- out_old[which(!is.na(gbif_matches) | !is.na(lpsn_matches))]
total_new <- out[which(!is.na(gbif_matches) | !is.na(lpsn_matches))]
@ -401,14 +401,19 @@ as.mo <- function(x,
message_(
"The following microorganism", ifelse(length(total_old) > 1, "s were", " was"), " taxonomically renamed (use `keep_synonyms = TRUE` to leave uncorrected):\n",
paste0(" ", microorganisms$fullname[match(total_old, microorganisms$mo)],
paste0(" ", font_italic(microorganisms$fullname[match(total_old, microorganisms$mo)], collapse = NULL),
refs_old,
" -> ", microorganisms$fullname[match(total_new, microorganisms$mo)],
" -> ", font_italic(microorganisms$fullname[match(total_new, microorganisms$mo)], collapse = NULL),
refs_new,
collapse = "\n"
)
)
}
} else {
# keep synonyms is TRUE, so check if any do have synonyms
if (any(!is.na(c(gbif_matches, lpsn_matches))) && message_not_thrown_before("as.mo", unique(c(gbif_matches, lpsn_matches)))) {
warning_("Function `as.mo()` returned some old taxonomic names. Use `as.mo(..., keep_synonyms = FALSE)` to clean the input to currently accepted taxonomic names, or set the R option `AMR_keep_synonyms` to `FALSE`.")
}
}
# Apply Becker ----
@ -496,10 +501,10 @@ pillar_shaft.mo <- function(x, ...) {
mo_cols <- NULL
}
if (!all(x[!is.na(x)] %in% MO_lookup$mo) |
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% MO_lookup$mo))) {
if (!all(x[!is.na(x)] %in% AMR::microorganisms$mo) |
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% AMR::microorganisms$mo))) {
# markup old mo codes
out[!x %in% MO_lookup$mo] <- font_italic(font_na(x[!x %in% MO_lookup$mo],
out[!x %in% AMR::microorganisms$mo] <- font_italic(font_na(x[!x %in% AMR::microorganisms$mo],
collapse = NULL
),
collapse = NULL
@ -596,7 +601,7 @@ print.mo <- function(x, print.shortnames = FALSE, ...) {
}
x <- as.character(x)
names(x) <- x_names
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
if (!all(x[!is.na(x)] %in% AMR::microorganisms$mo)) {
warning_(
"Some MO codes are from a previous AMR package version. ",
"Please update the MO codes with `as.mo()`."
@ -629,7 +634,7 @@ summary.mo <- function(object, ...) {
#' @export
#' @noRd
as.data.frame.mo <- function(x, ...) {
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
if (!all(x[!is.na(x)] %in% AMR::microorganisms$mo)) {
warning_(
"The data contains old MO codes (from a previous AMR package version). ",
"Please update your MO codes with `as.mo()`."
@ -960,7 +965,7 @@ parse_and_convert <- function(x) {
replace_old_mo_codes <- function(x, property) {
# this function transform old MO codes to current codes, such as:
# B_ESCH_COL (AMR v0.5.0) -> B_ESCHR_COLI
ind <- x %like_case% "^[A-Z]_[A-Z_]+$" & !x %in% MO_lookup$mo
ind <- x %like_case% "^[A-Z]_[A-Z_]+$" & !x %in% AMR::microorganisms$mo
if (any(ind)) {
# get the ones that match
affected <- x[ind]

250
R/mo_property.R
View File

@ -28,11 +28,11 @@
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
#' @inheritParams as.mo
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
#' @details All functions will return the most recently known taxonomic property [as included in this package][microorganisms], except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
#' @details All functions will, at default, keep old taxonomic properties. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming)
#' - `mo_ref("Escherichia blattae")` will return `"Burgess et al., 1973"` (with a message about the renaming)
#' - `mo_ref("Shimwellia blattae")` will return `"Priest et al., 2010"` (without a message)
@ -168,15 +168,16 @@
#' # SNOMED codes, and URL to the online database
#' mo_info("Klebsiella pneumoniae")
#' }
mo_name <- function(x, language = get_AMR_locale(), ...) {
mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_name")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "fullname", language = language, ...),
translate_into_language(mo_validate(x = x, property = "fullname", language = language, keep_synonyms = keep_synonyms, ...),
language = language,
only_unknown = FALSE,
only_affect_mo_names = TRUE
@ -189,15 +190,16 @@ mo_fullname <- mo_name
#' @rdname mo_property
#' @export
mo_shortname <- function(x, language = get_AMR_locale(), ...) {
mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_shortname")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
@ -207,8 +209,8 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
}
# get first char of genus and complete species in English
genera <- mo_genus(x.mo, language = NULL)
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL)))
genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms)
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms)))
# exceptions for where no species is known
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
@ -229,106 +231,114 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_subspecies <- function(x, language = get_AMR_locale(), ...) {
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_subspecies")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_species <- function(x, language = get_AMR_locale(), ...) {
mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_species")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "species", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_genus <- function(x, language = get_AMR_locale(), ...) {
mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_genus")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "genus", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_family <- function(x, language = get_AMR_locale(), ...) {
mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_family")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "family", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_order <- function(x, language = get_AMR_locale(), ...) {
mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_order")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "order", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_class <- function(x, language = get_AMR_locale(), ...) {
mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_class")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "class", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_phylum <- function(x, language = get_AMR_locale(), ...) {
mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_phylum")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "phylum", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_kingdom <- function(x, language = get_AMR_locale(), ...) {
mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_kingdom")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
@ -337,40 +347,41 @@ mo_domain <- mo_kingdom
#' @rdname mo_property
#' @export
mo_type <- function(x, language = get_AMR_locale(), ...) {
mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_type")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
out <- mo_kingdom(x.mo, language = NULL)
out[which(mo_is_yeast(x.mo))] <- "Yeasts"
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
out <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
translate_into_language(out, language = language, only_unknown = FALSE)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_gramstain")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
# keep_synonyms = TRUE to prevent messages - they won't change Gram stain anyway
x.mo <- as.mo(x, language = language, keep_synonyms = TRUE, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x <- rep(NA_character_, length(x))
# make all bacteria Gram negative
x[mo_kingdom(x.mo, language = NULL, keep_synonyms = TRUE) == "Bacteria"] <- "Gram-negative"
x[mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
# overwrite these 4 phyla with Gram-positives
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = TRUE) %in% c(
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
"Actinobacteria",
"Chloroflexi",
"Firmicutes",
@ -378,7 +389,7 @@ mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
"Bacillota" # this one is new! It was renamed from Firmicutes by Gibbons et al., 2021
) &
# but class Negativicutes (of phylum Firmicutes) are Gram-negative!
mo_class(x.mo, language = NULL, keep_synonyms = TRUE) != "Negativicutes")
mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms) != "Negativicutes")
# and of course our own ID for Gram-positives
| x.mo == "B_GRAMP"] <- "Gram-positive"
@ -388,17 +399,18 @@ mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_negative")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
grams <- mo_gramstain(x.mo, language = NULL)
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
out <- grams == "Gram-negative" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
@ -407,17 +419,18 @@ mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_positive")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
grams <- mo_gramstain(x.mo, language = NULL)
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
out <- grams == "Gram-positive" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
@ -426,19 +439,20 @@ mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_yeast")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.kingdom <- mo_kingdom(x.mo, language = NULL)
x.class <- mo_class(x.mo, language = NULL)
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
@ -450,7 +464,7 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
@ -458,8 +472,9 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(ab, allow_NA = FALSE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
ab <- as.ab(ab, language = NULL, flag_multiple_results = FALSE, info = FALSE)
if (length(x) == 1 & length(ab) > 1) {
@ -486,41 +501,44 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_snomed <- function(x, language = get_AMR_locale(), ...) {
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_snomed")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "snomed", language = language, ...)
mo_validate(x = x, property = "snomed", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_ref <- function(x, language = get_AMR_locale(), ...) {
mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_ref")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "ref", language = language, ...)
mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_authors <- function(x, language = get_AMR_locale(), ...) {
mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_authors")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- mo_validate(x = x, property = "ref", language = language, ...)
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
# remove last 4 digits and presumably the comma and space that preceed them
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)], perl = TRUE)
suppressWarnings(x)
@ -528,15 +546,16 @@ mo_authors <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_year <- function(x, language = get_AMR_locale(), ...) {
mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_year")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- mo_validate(x = x, property = "ref", language = language, ...)
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
# get last 4 digits
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)], perl = TRUE)
suppressWarnings(as.integer(x))
@ -544,52 +563,69 @@ mo_year <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_lpsn <- function(x, language = get_AMR_locale(), ...) {
mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_lpsn")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "lpsn", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_gbif")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "gbif", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "species_id", language = language, ...)
mo_validate(x = x, property = "rank", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_rank <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
mo_validate(x = x, property = "rank", language = language, ...)
}
#' @rdname mo_property
#' @export
mo_taxonomy <- function(x, language = get_AMR_locale(), ...) {
mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_taxonomy")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
out <- 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)
kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
phylum = mo_phylum(x, language = language, keep_synonyms = keep_synonyms),
class = mo_class(x, language = language, keep_synonyms = keep_synonyms),
order = mo_order(x, language = language, keep_synonyms = keep_synonyms),
family = mo_family(x, language = language, keep_synonyms = keep_synonyms),
genus = mo_genus(x, language = language, keep_synonyms = keep_synonyms),
species = mo_species(x, language = language, keep_synonyms = keep_synonyms),
subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
)
load_mo_failures_uncertainties_renamed(metadata)
@ -598,21 +634,22 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_synonyms")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
syns <- lapply(x.mo, function(y) {
gbif <- AMR::microorganisms$gbif[match(y, AMR::microorganisms$mo)]
lpsn <- AMR::microorganisms$lpsn[match(y, AMR::microorganisms$mo)]
out <- AMR::microorganisms[which(AMR::microorganisms$lpsn_renamed_to %in% c(gbif, lpsn)), "fullname", drop = TRUE]
out <- AMR::microorganisms[which(AMR::microorganisms$lpsn_renamed_to %in% lpsn | AMR::microorganisms$gbif_renamed_to %in% gbif), "fullname", drop = TRUE]
if (length(out) == 0) {
NULL
} else {
@ -633,26 +670,27 @@ mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_AMR_locale(), ...) {
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_info")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
info <- lapply(x, function(y) {
c(
mo_taxonomy(y, language = language),
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
list(
synonyms = mo_synonyms(y),
gramstain = mo_gramstain(y, language = language),
url = unname(mo_url(y, open = FALSE)),
ref = mo_ref(y),
snomed = unlist(mo_snomed(y))
synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
ref = mo_ref(y, keep_synonyms = keep_synonyms),
snomed = unlist(mo_snomed(y, keep_synonyms = keep_synonyms))
)
)
})
@ -669,7 +707,7 @@ mo_info <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_url")
@ -677,14 +715,15 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(open, allow_class = "logical", has_length = 1)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x = x, language = language, ... = ...)
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.rank <- microorganisms$rank[match(x.mo, microorganisms$mo)]
x.name <- microorganisms$fullname[match(x.mo, microorganisms$mo)]
x.lpsn <- microorganisms$lpsn[match(x.mo, microorganisms$mo)]
x.gbif <- microorganisms$gbif[match(x.mo, microorganisms$mo)]
x.rank <- AMR::microorganisms$rank[match(x.mo, AMR::microorganisms$mo)]
x.name <- AMR::microorganisms$fullname[match(x.mo, AMR::microorganisms$mo)]
x.lpsn <- AMR::microorganisms$lpsn[match(x.mo, AMR::microorganisms$mo)]
x.gbif <- AMR::microorganisms$gbif[match(x.mo, AMR::microorganisms$mo)]
u <- character(length(x))
u[!is.na(x.gbif)] <- paste0(TAXONOMY_VERSION$GBIF$url, "/species/", x.gbif[!is.na(x.gbif)])
@ -707,7 +746,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), ...) {
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", TRUE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_property")
@ -715,11 +754,12 @@ mo_property <- function(x, property = "fullname", language = get_AMR_locale(), .
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = property, language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
mo_validate <- function(x, property, language, ...) {
mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) {
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
@ -736,20 +776,20 @@ mo_validate <- function(x, property, language, ...) {
if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
Lancefield <- FALSE
}
keep_synonyms <- dots$keep_synonyms
has_Becker_or_Lancefield_or_synonyms <- !isFALSE(keep_synonyms) || Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
if (all(x %in% AMR::microorganisms$mo, na.rm = TRUE) && !has_Becker_or_Lancefield_or_synonyms) {
if (all(x %in% AMR::microorganisms$mo, na.rm = TRUE) && !has_Becker_or_Lancefield && isTRUE(keep_synonyms)) {
# do nothing, just don't run the other if-else's
} else if (all(x %in% AMR::microorganisms[[property]], na.rm = TRUE) && !has_Becker_or_Lancefield_or_synonyms) {
} else if (all(x %in% AMR::microorganisms[[property]], na.rm = TRUE) && !has_Becker_or_Lancefield && isTRUE(keep_synonyms)) {
# no need to do anything, just return it
return(x)
} else {
x <- as.mo(x, language = language, ...)
x <- replace_old_mo_codes(x, property = property)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
}
# get property reeaaally fast using match()
x <- microorganisms[[property]][match(x, microorganisms$mo)]
x <- AMR::microorganisms[[property]][match(x, AMR::microorganisms$mo)]
if (property == "mo") {
return(set_clean_class(x, new_class = c("mo", "character")))

6
R/translate.R
View File

@ -120,7 +120,11 @@ set_AMR_locale <- function(language) {
options(AMR_locale = language)
if (interactive() || identical(Sys.getenv("IN_PKGDOWN"), "true")) {
# show which language to use now
message_("Using the ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym, " language (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ") for the AMR package for this session.")
message_("Using ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym,
ifelse(language != "en",
paste0(" (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ")"),
""),
" for the AMR package for this session.")
}
}

4
inst/tinytest/test-mo_property.R
View File

@ -107,8 +107,8 @@ expect_identical(
mo_lpsn("Escherichia coli")
)
expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968")
expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999")
expect_identical(mo_ref("Chlamydia psittaci"), "Garcia-Lopez et al., 2019")
expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999")
expect_true(112283007 %in% mo_snomed("Escherichia coli"))
# old codes must throw a warning in mo_* family

10
man/as.mo.Rd
View File

@ -198,8 +198,8 @@ as.mo(c(
"MRSA", # Methicillin Resistant S. aureus
"VISA", # Vancomycin Intermediate S. aureus
"VRSA", # Vancomycin Resistant S. aureus
115329001
)) # SNOMED CT code
115329001 # SNOMED CT code
))
# Dyslexia is no problem - these all work:
as.mo(c(
@ -218,9 +218,9 @@ as.mo("S. pyogenes") # will remain species: B_STRPT_PYGN
as.mo("S. pyogenes", Lancefield = TRUE) # will not remain species: B_STRPT_GRPA
# All mo_* functions use as.mo() internally too (see ?mo_property):
mo_genus("Esch coli")
mo_gramstain("E. coli")
mo_is_intrinsic_resistant("E. coli", "vanco")
mo_genus("E. coli")
mo_gramstain("ESCO")
mo_is_intrinsic_resistant("ESCCOL", ab = "vanco")
}
}
\seealso{

22
man/eucast_rules.Rd
View File

@ -82,27 +82,7 @@ Custom rules can be created using \code{\link[=custom_eucast_rules]{custom_eucas
\if{html}{\out{<div class="sourceCode r">}}\preformatted{x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
eucast_rules(example_isolates, rules = "custom", custom_rules = x, info = FALSE)
#> # A tibble: 2,000 x 46
#> date patient age gender ward mo PEN OXA FLC AMX
#> * <date> <chr> <dbl> <chr> <chr> <mo> <rsi> <rsi> <rsi> <rsi>
#> 1 2002-01-02 A77334 65 F Clinical B_ESCHR_COLI R NA NA NA
#> 2 2002-01-03 A77334 65 F Clinical B_ESCHR_COLI R NA NA NA
#> 3 2002-01-07 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 4 2002-01-07 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 5 2002-01-13 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 6 2002-01-13 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 7 2002-01-14 462729 78 M Clinical B_STPHY_AURS R NA S R
#> 8 2002-01-14 462729 78 M Clinical B_STPHY_AURS R NA S R
#> 9 2002-01-16 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 10 2002-01-17 858515 79 F ICU B_STPHY_EPDR R NA S NA
#> # ... with 1,990 more rows, and 36 more variables: AMC <rsi>, AMP <rsi>,
#> # TZP <rsi>, CZO <rsi>, FEP <rsi>, CXM <rsi>, FOX <rsi>, CTX <rsi>,
#> # CAZ <rsi>, CRO <rsi>, GEN <rsi>, TOB <rsi>, AMK <rsi>, KAN <rsi>,
#> # TMP <rsi>, SXT <rsi>, NIT <rsi>, FOS <rsi>, LNZ <rsi>, CIP <rsi>,
#> # MFX <rsi>, VAN <rsi>, TEC <rsi>, TCY <rsi>, TGC <rsi>, DOX <rsi>,
#> # ERY <rsi>, CLI <rsi>, AZM <rsi>, IPM <rsi>, MEM <rsi>, MTR <rsi>,
#> # CHL <rsi>, COL <rsi>, MUP <rsi>, RIF <rsi>
eucast_rules(example_isolates, rules = "custom", custom_rules = x)
}\if{html}{\out{</div>}}
}

4
tests/tinytest.R
View File

@ -25,6 +25,9 @@
# we use {tinytest} instead of {testthat} because it does not rely on recent R versions - we want to test on R >= 3.0.
# Run them in RStudio using:
# rstudioapi::jobRunScript("tests/tinytest.R", name = "Tinytest Unit Tests", workingDir = getwd(), exportEnv = "tinytest_results")
# test only on GitHub Actions and at home - not on CRAN as tests are lengthy
if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
# env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so:
@ -51,3 +54,4 @@ if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
print(summary(out))
}
}