AMR/R/mo_property.R

868 lines
37 KiB
R
Raw Normal View History

# ==================================================================== #
# TITLE #
2022-10-05 09:12:22 +02:00
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
2020-07-08 14:48:06 +02:00
# https://github.com/msberends/AMR #
# #
2022-10-05 09:12:22 +02:00
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
2020-10-08 11:16:03 +02:00
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
2020-10-26 12:23:03 +01:00
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
2019-01-02 23:24:07 +01:00
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
2020-10-08 11:16:03 +02:00
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Get Properties of a Microorganism
#'
#' 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*.
2021-05-12 18:15:03 +02:00
#' @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"`
2022-10-05 09:12:22 +02:00
#' @inheritParams as.mo
#' @param ... other arguments passed on to [as.mo()], such as 'minimum_matching_score', 'ignore_pattern', and 'remove_from_input'
2022-11-13 13:44:25 +01:00
#' @param ab any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()]
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
2022-10-05 09:12:22 +02:00
#' @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:
2022-12-09 13:37:08 +01:00
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a note about the renaming)
#' - `mo_ref("Escherichia blattae", keep_synonyms = TRUE)` will return `"Burgess et al., 1973"` (without a note)
#' - `mo_ref("Shimwellia blattae", keep_synonyms = FALSE)` will return `"Priest et al., 2010"` (without a note)
2019-02-20 00:04:48 +01:00
#'
2020-12-17 16:22:25 +01:00
#' The short name - [mo_shortname()] - almost always returns the first character of the genus and the full species, like `"E. coli"`. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. In other words, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
2020-10-26 12:23:03 +01:00
#'
#' Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions [mo_kingdom()] and [mo_domain()] return the exact same results.
#'
2022-12-09 13:37:08 +01:00
#' Determination of the Gram stain - [mo_gramstain()] - will be based on the taxonomic kingdom and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318/)), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, [PMID 34694987](https://pubmed.ncbi.nlm.nih.gov/34694987/)). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
2022-08-28 10:31:50 +02:00
#'
#' Determination of yeasts - [mo_is_yeast()] - will be based on the taxonomic kingdom and class. *Budding yeasts* are fungi of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes). *True yeasts* are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
2022-08-28 10:31:50 +02:00
#'
2022-12-09 13:37:08 +01:00
#' Determination of intrinsic resistance - [mo_is_intrinsic_resistant()] - will be based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.3)`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antibiotics).
2019-02-20 00:04:48 +01:00
#'
#' All output [will be translated][translate] where possible.
2019-05-10 16:44:59 +02:00
#'
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
2022-08-28 10:31:50 +02:00
#'
2022-10-05 09:12:22 +02:00
#' SNOMED codes - [mo_snomed()] - are from the version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
2022-10-30 14:31:45 +01:00
#'
2022-10-10 10:12:08 +02:00
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()], the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
#' @inheritSection mo_matching_score Matching Score for Microorganisms
2018-09-24 23:33:29 +02:00
#' @inheritSection as.mo Source
#' @rdname mo_property
#' @name mo_property
#' @return
#' - An [integer] in case of [mo_year()]
2022-10-10 10:12:08 +02:00
#' - A [list] in case of [mo_taxonomy()], [mo_synonyms()] and [mo_info()]
#' - A named [character] in case of [mo_url()]
2021-03-11 21:42:30 +01:00
#' - A [numeric] in case of [mo_snomed()]
#' - A [character] in all other cases
#' @export
2021-07-04 15:26:50 +02:00
#' @seealso Data set [microorganisms]
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
#' # taxonomic tree -----------------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_kingdom("Klebsiella pneumoniae")
#' mo_phylum("Klebsiella pneumoniae")
#' mo_class("Klebsiella pneumoniae")
#' mo_order("Klebsiella pneumoniae")
#' mo_family("Klebsiella pneumoniae")
#' mo_genus("Klebsiella pneumoniae")
#' mo_species("Klebsiella pneumoniae")
#' mo_subspecies("Klebsiella pneumoniae")
2018-11-09 13:11:54 +01:00
#'
#' # colloquial properties ----------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_name("Klebsiella pneumoniae")
#' mo_fullname("Klebsiella pneumoniae")
#' mo_shortname("Klebsiella pneumoniae")
2018-11-09 13:11:54 +01:00
#'
#' # other properties ---------------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_gramstain("Klebsiella pneumoniae")
#' mo_snomed("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
#' mo_rank("Klebsiella pneumoniae")
#' mo_url("Klebsiella pneumoniae")
#' mo_synonyms("Klebsiella pneumoniae")
2018-11-09 13:11:54 +01:00
#'
#' # scientific reference -----------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_ref("Klebsiella pneumoniae")
#' mo_authors("Klebsiella pneumoniae")
#' mo_year("Klebsiella pneumoniae")
#' mo_lpsn("Klebsiella pneumoniae")
2022-10-06 11:33:30 +02:00
#' mo_gbif("Klebsiella pneumoniae")
#'
#' # abbreviations known in the field -----------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_genus("MRSA")
#' mo_species("MRSA")
#' mo_shortname("VISA")
#' mo_gramstain("VISA")
#'
2022-08-21 16:37:20 +02:00
#' mo_genus("EHEC")
#' mo_species("EHEC")
#'
#' # known subspecies ---------------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_fullname("K. pneu rh")
#' mo_shortname("K. pneu rh")
#'
#' \donttest{
#' # Becker classification, see ?as.mo ----------------------------------------
2022-10-06 12:11:51 +02:00
#' mo_fullname("Staph. epidermidis")
#' mo_fullname("Staph. epidermidis", Becker = TRUE)
#' mo_shortname("Staph. epidermidis")
#' mo_shortname("Staph. epidermidis", Becker = TRUE)
#'
#' # Lancefield classification, see ?as.mo ------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_fullname("S. pyo")
#' mo_fullname("S. pyo", Lancefield = TRUE)
#' mo_shortname("S. pyo")
#' mo_shortname("S. pyo", Lancefield = TRUE)
#'
#'
#' # language support --------------------------------------------------------
2022-10-06 11:33:30 +02:00
#' mo_gramstain("Klebsiella pneumoniae", language = "de") # German
#' mo_gramstain("Klebsiella pneumoniae", language = "nl") # Dutch
#' mo_gramstain("Klebsiella pneumoniae", language = "es") # Spanish
#' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
#' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
#'
2018-11-09 13:11:54 +01:00
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain official
2022-08-21 16:37:20 +02:00
#' mo_kingdom("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
2022-10-06 12:11:51 +02:00
#' mo_kingdom("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
2022-10-30 14:31:45 +01:00
#' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
2018-11-09 13:11:54 +01:00
#'
2022-10-06 11:33:30 +02:00
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "de")
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "uk")
2018-09-17 20:53:32 +02:00
#'
#'
#' # other --------------------------------------------------------------------
2022-08-28 10:31:50 +02:00
#'
2022-08-21 16:37:20 +02:00
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
2022-08-28 10:31:50 +02:00
#'
2022-08-21 16:37:20 +02:00
#' # gram stains and intrinsic resistance can be used as a filter in dplyr verbs
2020-11-09 15:18:36 +01:00
#' if (require("dplyr")) {
#' example_isolates %>%
2022-10-30 14:31:45 +01:00
#' filter(mo_is_gram_positive()) %>%
2022-10-06 12:11:51 +02:00
#' count(mo_genus(), sort = TRUE)
2022-10-06 11:33:30 +02:00
#' }
#' if (require("dplyr")) {
#' example_isolates %>%
2022-10-30 14:31:45 +01:00
#' filter(mo_is_intrinsic_resistant(ab = "vanco")) %>%
2022-10-06 12:11:51 +02:00
#' count(mo_genus(), sort = TRUE)
2020-11-09 15:18:36 +01:00
#' }
2022-08-28 10:31:50 +02:00
#'
#'
2019-05-10 16:44:59 +02:00
#' # get a list with the complete taxonomy (from kingdom to subspecies)
2022-08-21 16:37:20 +02:00
#' mo_taxonomy("Klebsiella pneumoniae")
2022-08-28 10:31:50 +02:00
#'
2021-03-11 21:42:30 +01:00
#' # get a list with the taxonomy, the authors, Gram-stain,
2022-08-21 16:37:20 +02:00
#' # SNOMED codes, and URL to the online database
#' mo_info("Klebsiella pneumoniae")
2021-05-24 09:00:11 +02:00
#' }
2022-10-05 09:12:22 +02:00
mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_name")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "fullname", language = language, keep_synonyms = keep_synonyms, ...),
2022-08-28 10:31:50 +02:00
language = language,
only_unknown = FALSE,
only_affect_mo_names = TRUE
)
2019-05-13 12:21:57 +02:00
}
#' @rdname mo_property
#' @export
2019-06-11 14:18:25 +02:00
mo_fullname <- mo_name
2018-09-05 10:51:46 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_shortname")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
2019-07-10 21:36:51 +02:00
replace_empty <- function(x) {
x[x == ""] <- "spp."
x
}
2022-08-28 10:31:50 +02:00
2019-06-27 11:57:45 +02:00
# get first char of genus and complete species in English
2022-10-05 09:12:22 +02:00
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)))
2022-08-28 10:31:50 +02:00
2020-08-26 11:33:54 +02:00
# exceptions for where no species is known
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
# exceptions for staphylococci
2019-10-11 17:21:02 +02:00
shortnames[shortnames == "S. coagulase-negative"] <- "CoNS"
shortnames[shortnames == "S. coagulase-positive"] <- "CoPS"
# exceptions for streptococci: Group A Streptococcus -> GAS
2022-12-20 22:18:50 +01:00
shortnames[shortnames %like_case% "S. Group [ABCDFGHK]"] <- paste0("G", gsub("S. Group ([ABCDFGHK])", "\\1", shortnames[shortnames %like_case% "S. Group [ABCDFGHK]"], perl = TRUE), "S")
2020-08-26 11:33:54 +02:00
# unknown species etc.
2022-10-05 09:12:22 +02:00
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
2022-08-28 10:31:50 +02:00
2022-10-29 14:15:23 +02:00
shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo, language = NULL, keep_synonyms = keep_synonyms)
2022-10-30 14:31:45 +01:00
shortnames[is.na(x.mo)] <- NA_character_
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
2022-08-19 12:33:14 +02:00
translate_into_language(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE)
2018-09-05 10:51:46 +02:00
}
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_subspecies")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_species")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "species", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_genus")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "genus", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_family")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "family", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_order")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "order", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_class")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "class", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_phylum")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "phylum", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
2018-09-17 20:53:32 +02:00
}
2018-09-05 10:51:46 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_kingdom")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
2022-12-09 13:37:08 +01:00
mo_domain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_domain")
}
mo_kingdom(x = x, language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_type")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
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"
2022-08-19 12:33:14 +02:00
translate_into_language(out, language = language, only_unknown = FALSE)
2018-11-09 13:11:54 +01:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_status <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2022-10-05 09:12:22 +02:00
x <- find_mo_col(fn = "mo_status")
}
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 = "status", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_gramstain")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
x <- rep(NA_character_, length(x))
2019-06-11 14:18:25 +02:00
# make all bacteria Gram negative
2022-10-05 09:12:22 +02:00
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)
2022-10-05 09:12:22 +02:00
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
# no longer in use, does not hurt to keep here:
2022-08-28 10:31:50 +02:00
"Actinobacteria",
"Chloroflexi",
"Firmicutes",
2022-10-05 09:12:22 +02:00
"Tenericutes",
"Actinomycetota", # since 2021, old name was Actinobacteria
"Chloroflexota", # since 2021, old name was Chloroflexi
"Bacillota", # since 2021, old name was Firmicutes
"Mycoplasmatota" # since 2021, old name was Tenericutes
2022-08-28 10:31:50 +02:00
) &
# but class Negativicutes (of phylum Bacillota) are Gram-negative!
2022-10-05 09:12:22 +02:00
mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms) != "Negativicutes")
2022-08-28 10:31:50 +02:00
# and of course our own ID for Gram-positives
| x.mo == "B_GRAMP"] <- "Gram-positive"
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
2022-08-19 12:33:14 +02:00
translate_into_language(x, language = language, only_unknown = FALSE)
2018-10-01 11:39:43 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_is_gram_negative")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_uncertainties(metadata)
out <- grams == "Gram-negative" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_is_gram_positive")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_uncertainties(metadata)
out <- grams == "Gram-positive" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_is_yeast")
}
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
2022-08-28 10:31:50 +02:00
out <- rep(FALSE, length(x))
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(ab, allow_NA = FALSE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
ab <- as.ab(ab, language = NULL, flag_multiple_results = FALSE, info = FALSE)
2022-08-28 10:31:50 +02:00
if (length(x) == 1 & length(ab) > 1) {
x <- rep(x, length(ab))
} else if (length(ab) == 1 & length(x) > 1) {
ab <- rep(ab, length(x))
}
if (length(x) != length(ab)) {
stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
}
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
# show used version number once per session (AMR_env will reload every session)
if (message_not_thrown_before("mo_is_intrinsic_resistant", "version.mo", entire_session = TRUE)) {
2022-08-28 10:31:50 +02:00
message_(
"Determining intrinsic resistance based on ",
format_eucast_version_nr(3.3, markdown = FALSE), ". ",
font_red("This note will be shown once per session.")
)
2020-12-03 22:30:14 +01:00
}
2022-08-28 10:31:50 +02:00
2022-10-30 21:05:46 +01:00
# runs against internal vector: intrinsic_resistant (see zzz.R)
add_intrinsic_resistance_to_AMR_env()
paste(x, ab) %in% AMR_env$intrinsic_resistant
}
2020-01-27 19:14:23 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_snomed")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
mo_validate(x = x, property = "snomed", language = language, keep_synonyms = keep_synonyms, ...)
2020-01-27 19:14:23 +01:00
}
2018-10-01 11:39:43 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_ref")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_authors")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
2019-06-22 14:49:12 +02:00
# 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)
2019-02-22 22:12:10 +01:00
suppressWarnings(x)
2018-11-09 13:11:54 +01:00
}
2018-09-24 23:33:29 +02:00
2018-11-09 13:11:54 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_year")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
2018-11-09 13:11:54 +01:00
# get last 4 digits
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)], perl = TRUE)
2019-02-22 22:12:10 +01:00
suppressWarnings(as.integer(x))
}
2021-12-09 10:48:25 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
2021-12-09 10:48:25 +01:00
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2022-10-05 09:12:22 +02:00
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", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2022-10-05 09:12:22 +02:00
x <- find_mo_col(fn = "mo_gbif")
2021-12-09 10:48:25 +01:00
}
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
mo_validate(x = x, property = "gbif", language = language, keep_synonyms = keep_synonyms, ...)
2021-12-09 10:48:25 +01:00
}
2019-02-22 22:12:10 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_rank")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
mo_validate(x = x, property = "rank", language = language, keep_synonyms = keep_synonyms, ...)
}
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_taxonomy")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
out <- list(
2022-10-05 09:12:22 +02:00
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)
2022-08-28 10:31:50 +02:00
)
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
out
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_synonyms")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
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 == lpsn | AMR::microorganisms$gbif_renamed_to == gbif), "fullname", drop = TRUE]
if (length(out) == 0) {
2019-06-22 14:49:12 +02:00
NULL
} else {
2022-10-05 09:12:22 +02:00
out
2019-06-22 14:49:12 +02:00
}
})
2022-10-05 09:12:22 +02:00
2019-06-22 14:49:12 +02:00
if (length(syns) > 1) {
2022-10-10 10:12:08 +02:00
names(syns) <- mo_name(x, language = language)
result <- syns
2019-06-22 14:49:12 +02:00
} else {
result <- unlist(syns)
}
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
result
}
2022-10-10 10:12:08 +02:00
#' @rdname mo_property
#' @export
mo_current <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
x.mo <- suppressWarnings(as.mo(x, keep_synonyms = TRUE, ...))
out <- synonym_mo_to_accepted_mo(x.mo, fill_in_accepted = TRUE)
mo_name(out, language = language)
}
2019-06-11 14:18:25 +02:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_info")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
info <- lapply(x, function(y) {
c(
2022-10-05 09:12:22 +02:00
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
2022-08-28 10:31:50 +02:00
list(
2022-10-05 09:12:22 +02:00
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
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))
2022-08-28 10:31:50 +02:00
)
)
})
2019-06-22 14:49:12 +02:00
if (length(info) > 1) {
names(info) <- mo_name(x)
result <- info
2019-06-22 14:49:12 +02:00
} else {
result <- info[[1L]]
2019-06-22 14:49:12 +02:00
}
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
result
2019-06-11 14:18:25 +02:00
}
2019-02-20 00:04:48 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_url")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
meet_criteria(open, allow_class = "logical", has_length = 1)
2022-10-05 09:12:22 +02:00
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
metadata <- get_mo_uncertainties()
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
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)]
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
u <- character(length(x))
u[!is.na(x.gbif)] <- paste0(TAXONOMY_VERSION$GBIF$url, "/species/", x.gbif[!is.na(x.gbif)])
# overwrite with LPSN:
u[!is.na(x.lpsn)] <- paste0(TAXONOMY_VERSION$LPSN$url, "/", x.rank[!is.na(x.lpsn)], "/", gsub(" ", "-", tolower(x.name[!is.na(x.lpsn)]), fixed = TRUE))
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
names(u) <- x.name
2022-08-28 10:31:50 +02:00
if (isTRUE(open)) {
2019-02-22 22:12:10 +01:00
if (length(u) > 1) {
warning_("in `mo_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
2019-02-22 22:12:10 +01:00
}
2020-05-16 13:05:47 +02:00
utils::browseURL(u[1L])
2019-02-22 22:12:10 +01:00
}
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
load_mo_uncertainties(metadata)
2019-02-20 00:04:48 +01:00
u
}
2018-11-09 13:11:54 +01:00
#' @rdname mo_property
#' @export
2022-10-05 09:12:22 +02:00
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
x <- find_mo_col(fn = "mo_property")
}
2020-10-19 20:44:45 +02:00
meet_criteria(x, allow_NA = TRUE)
2022-10-05 09:12:22 +02:00
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)
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
translate_into_language(mo_validate(x = x, property = property, language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
2022-10-05 09:12:22 +02:00
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
tryCatch(x[1L] %in% unlist(AMR::microorganisms[1, property, drop = TRUE]),
error = function(e) stop(e$message, call. = FALSE)
)
2018-10-01 11:39:43 +02:00
dots <- list(...)
Becker <- dots$Becker
2022-10-05 09:12:22 +02:00
if (is.null(Becker) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
2018-10-01 11:39:43 +02:00
Becker <- FALSE
}
Lancefield <- dots$Lancefield
2022-10-05 09:12:22 +02:00
if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
2018-10-01 11:39:43 +02:00
Lancefield <- FALSE
}
2022-10-05 09:12:22 +02:00
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
mo_data_check <- AMR::microorganisms[which(AMR::microorganisms$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
# do nothing, just don't run the other if-else's
} else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
# no need to do anything, just return it
return(x)
} else {
# we need to get MO codes now
x <- replace_old_mo_codes(x, property = property)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
2019-06-22 14:49:12 +02:00
}
2022-08-28 10:31:50 +02:00
2022-10-05 09:12:22 +02:00
# get property reeaaally fast using match()
x <- AMR::microorganisms[[property]][match(x, AMR::microorganisms$mo)]
2019-06-22 14:49:12 +02:00
if (property == "mo") {
2020-11-16 20:02:20 +01:00
return(set_clean_class(x, new_class = c("mo", "character")))
2020-01-27 19:14:23 +01:00
} else if (property == "snomed") {
2022-10-05 09:12:22 +02:00
return(sort(as.character(eval(parse(text = x)))))
} else {
2022-12-20 16:14:04 +01:00
# everything else as character
2022-10-05 09:12:22 +02:00
return(as.character(x))
}
}
find_mo_col <- function(fn) {
# this function tries to find an mo column in the data the function was called in,
# which is useful when functions are used within dplyr verbs
df <- get_current_data(arg_name = "x", call = -3) # will return an error if not found
mo <- NULL
2022-08-28 10:31:50 +02:00
try(
{
mo <- suppressMessages(search_type_in_df(df, "mo"))
},
silent = TRUE
)
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
if (message_not_thrown_before(fn = fn)) {
message_("Using column '", font_bold(mo), "' as input for `", fn, "()`")
}
return(df[, mo, drop = TRUE])
} else {
stop_("argument `x` is missing and no column with info about microorganisms could be found.", call = -2)
}
}