2018-08-28 13:51:13 +02:00
# ==================================================================== #
# TITLE #
2021-02-02 23:57:35 +01:00
# Antimicrobial Resistance (AMR) Data Analysis for R #
2018-08-28 13:51:13 +02:00
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
2020-07-08 14:48:06 +02:00
# https://github.com/msberends/AMR #
2018-08-28 13:51:13 +02:00
# #
# LICENCE #
2021-12-23 18:56:28 +01:00
# (c) 2018-2022 Berends MS, Luz CF et al. #
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. #
2018-08-28 13:51:13 +02:00
# #
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. #
2020-01-05 17:22:09 +01:00
# 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 #
2021-02-02 23:57:35 +01:00
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
2018-08-28 13:51:13 +02:00
# ==================================================================== #
2021-01-18 16:57:56 +01:00
#' Get Properties of a Microorganism
2018-08-28 13:51:13 +02:00
#'
2021-01-18 16:57:56 +01:00
#' 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*.
2021-02-04 16:48:16 +01:00
#' @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-09-19 11:57:21 +02:00
#' @inheritParams as.mo
2020-12-22 00:51:17 +01:00
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
2020-11-16 11:03:24 +01:00
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
2020-12-24 23:29:10 +01:00
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
2022-09-19 11:57:21 +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:
2020-06-22 11:18:40 +02:00
#' - `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)
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
#'
2020-06-22 11:18:40 +02: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.
2020-04-29 14:33:44 +02:00
#'
2021-08-16 21:54:34 +02:00
#' The Gram stain - [mo_gramstain()] - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318)), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive, except for members of the class Negativicutes which are Gram-negative. Members of other bacterial phyla are all 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` (except 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
#'
2021-02-08 14:18:42 +01:00
#' Determination of yeasts - [mo_is_yeast()] - will be based on the taxonomic kingdom and class. *Budding yeasts* are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). *True yeasts* are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (except when the input is `NA` or the MO code is `UNKNOWN`).
2022-08-28 10:31:50 +02:00
#'
2021-12-11 13:41:31 +01:00
#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.3)`. The [mo_is_intrinsic_resistant()] functions can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics).
2019-02-20 00:04:48 +01:00
#'
2021-02-08 14:18:42 +01:00
#' All output [will be translated][translate] where possible.
2019-05-10 16:44:59 +02:00
#'
2019-11-28 22:32:17 +01: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-09-16 23:15:23 +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.
2021-01-18 16:57:56 +01:00
#' @inheritSection mo_matching_score Matching Score for Microorganisms
2018-09-24 23:33:29 +02:00
#' @inheritSection as.mo Source
2018-08-28 13:51:13 +02:00
#' @rdname mo_property
2018-09-08 16:06:47 +02:00
#' @name mo_property
2019-11-28 22:32:17 +01:00
#' @return
2020-09-18 16:05:53 +02:00
#' - An [integer] in case of [mo_year()]
#' - A [list] in case of [mo_taxonomy()] 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()]
2020-09-18 16:05:53 +02:00
#' - A [character] in all other cases
2018-08-28 13:51:13 +02:00
#' @export
2021-07-04 15:26:50 +02:00
#' @seealso Data set [microorganisms]
2021-01-18 16:57:56 +01:00
#' @inheritSection AMR Reference Data Publicly Available
2018-08-28 13:51:13 +02:00
#' @examples
2019-08-09 14:28:46 +02:00
#' # 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
#'
2019-08-09 14:28:46 +02: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
#'
2019-08-09 14:28:46 +02: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
#'
2019-08-09 14:28:46 +02: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")
2018-08-28 13:51:13 +02:00
#'
2019-08-09 14:28:46 +02:00
#' # 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")
2018-08-28 13:51:13 +02:00
#'
2022-08-21 16:37:20 +02:00
#' mo_genus("EHEC")
#' mo_species("EHEC")
2018-08-28 13:51:13 +02:00
#'
2019-08-09 14:28:46 +02:00
#' # known subspecies ---------------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_name("doylei")
#' mo_genus("doylei")
#' mo_species("doylei")
#' mo_subspecies("doylei")
2018-09-04 11:33:30 +02:00
#'
2022-08-21 16:37:20 +02:00
#' mo_fullname("K. pneu rh")
#' mo_shortname("K. pneu rh")
2018-08-28 13:51:13 +02:00
#'
2019-08-09 14:28:46 +02:00
#' \donttest{
#' # Becker classification, see ?as.mo ----------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_fullname("S. epi")
#' mo_fullname("S. epi", Becker = TRUE)
#' mo_shortname("S. epi")
#' mo_shortname("S. epi", Becker = TRUE)
2018-09-04 11:33:30 +02:00
#'
2019-08-09 14:28:46 +02:00
#' # 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)
2018-09-08 16:06:47 +02:00
#'
#'
2020-11-09 13:07:02 +01:00
#' # language support --------------------------------------------------------
2022-08-21 16:37:20 +02:00
#' mo_gramstain("Klebsiella pneumoniae", language = "de")
#' mo_gramstain("Klebsiella pneumoniae", language = "nl")
#' mo_gramstain("Klebsiella pneumoniae", language = "es")
2018-09-08 16:06:47 +02:00
#'
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")
#' mo_type("Klebsiella pneumoniae")
2018-11-09 13:11:54 +01:00
#'
2018-09-09 12:11:44 +02:00
#' mo_fullname("S. pyogenes",
2022-08-28 10:31:50 +02:00
#' Lancefield = TRUE,
#' language = "de"
#' )
2018-09-09 12:11:44 +02:00
#' mo_fullname("S. pyogenes",
2022-08-28 10:31:50 +02:00
#' Lancefield = TRUE,
#' language = "nl"
#' )
2018-09-17 20:53:32 +02:00
#'
2020-11-16 11:03:24 +01: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 %>%
2020-11-16 11:03:24 +01:00
#' filter(mo_is_gram_positive())
2022-08-28 10:31:50 +02:00
#'
2020-11-16 11:03:24 +01:00
#' example_isolates %>%
#' filter(mo_is_intrinsic_resistant(ab = "vanco"))
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-09-19 11:57:21 +02:00
mo_name <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_name" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-08-28 13:51:13 +02:00
2018-09-05 10:51:46 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_shortname <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_shortname" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-08-28 10:31:50 +02:00
2022-09-23 14:56:00 +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-09-19 11:57:21 +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[.]" ]
2020-11-09 13:07:02 +01:00
# exceptions for staphylococci
2019-10-11 17:21:02 +02:00
shortnames [shortnames == " S. coagulase-negative" ] <- " CoNS"
shortnames [shortnames == " S. coagulase-positive" ] <- " CoPS"
2020-11-09 13:07:02 +01:00
# exceptions for streptococci: Group A Streptococcus -> GAS
2021-11-29 10:38:38 +01:00
shortnames [shortnames %like% " S. group [ABCDFGHK]" ] <- paste0 ( " G" , gsub ( " S. group ([ABCDFGHK])" , " \\1" , shortnames [shortnames %like% " S. group [ABCDFGHK]" ] , perl = TRUE ) , " S" )
2020-08-26 11:33:54 +02:00
# unknown species etc.
2021-11-29 10:38:38 +01:00
shortnames [shortnames %like% " unknown" ] <- paste0 ( " (" , trimws ( gsub ( " [^a-zA-Z -]" , " " , shortnames [shortnames %like% " unknown" ] , perl = TRUE ) ) , " )" )
2022-08-28 10:31:50 +02:00
2020-12-24 23:29:10 +01:00
shortnames [is.na ( x.mo ) ] <- NA_character_
2022-09-23 14:56:00 +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
}
2021-07-04 12:00:41 +02:00
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_subspecies <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_subspecies" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_species <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_species" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_genus <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_genus" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_family <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_family" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_order <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_order" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_class <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_class" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_phylum <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_phylum" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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
2018-08-28 13:51:13 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_kingdom <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_kingdom" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
translate_into_language ( mo_validate ( x = x , property = " kingdom" , language = language , keep_synonyms = keep_synonyms , ... ) , language = language , only_unknown = TRUE )
2018-08-28 13:51:13 +02:00
}
2020-06-22 11:18:40 +02:00
#' @rdname mo_property
#' @export
mo_domain <- mo_kingdom
2018-08-28 13:51:13 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_type <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_type" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_gramstain <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_gramstain" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-08-28 10:31:50 +02:00
2021-08-16 21:54:34 +02:00
x <- rep ( NA_character_ , length ( x ) )
2019-06-11 14:18:25 +02:00
# make all bacteria Gram negative
2022-09-19 11:57:21 +02:00
x [mo_kingdom ( x.mo , language = NULL , keep_synonyms = keep_synonyms ) == " Bacteria" ] <- " Gram-negative"
2021-08-16 21:54:34 +02:00
# overwrite these 4 phyla with Gram-positives
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
2022-09-19 11:57:21 +02:00
x [ ( mo_phylum ( x.mo , language = NULL , keep_synonyms = keep_synonyms ) %in% c (
2022-08-28 10:31:50 +02:00
" Actinobacteria" ,
" Chloroflexi" ,
" Firmicutes" ,
2022-09-16 23:15:23 +02:00
" Tenericutes" ,
" Bacillota" # this one is new! It was renamed from Firmicutes by Gibbons et al., 2021
2022-08-28 10:31:50 +02:00
) &
# but class Negativicutes (of phylum Firmicutes) are Gram-negative!
2022-09-19 11:57:21 +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-09-23 14:56:00 +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
}
2020-10-19 17:09:19 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_is_gram_negative <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-11-09 13:07:02 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_is_gram_negative" )
2020-11-09 13:07:02 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-09-19 11:57:21 +02:00
grams <- mo_gramstain ( x.mo , language = NULL , keep_synonyms = keep_synonyms )
2022-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2020-11-09 13:07:02 +01:00
out <- grams == " Gram-negative" & ! is.na ( grams )
2020-11-16 11:03:24 +01:00
out [x.mo %in% c ( NA_character_ , " UNKNOWN" ) ] <- NA
2020-11-09 13:07:02 +01:00
out
2020-10-19 17:09:19 +02:00
}
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_is_gram_positive <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-11-09 13:07:02 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_is_gram_positive" )
2020-11-09 13:07:02 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-09-19 11:57:21 +02:00
grams <- mo_gramstain ( x.mo , language = NULL , keep_synonyms = keep_synonyms )
2022-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2020-11-09 13:07:02 +01:00
out <- grams == " Gram-positive" & ! is.na ( grams )
2020-11-16 11:03:24 +01:00
out [x.mo %in% c ( NA_character_ , " UNKNOWN" ) ] <- NA
2020-11-09 13:07:02 +01:00
out
2020-10-19 17:09:19 +02:00
}
2021-01-12 22:08:04 +01:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_is_yeast <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2021-01-12 22:08:04 +01:00
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 )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2022-08-28 10:31:50 +02:00
2021-01-12 22:08:04 +01:00
out <- rep ( FALSE , length ( x ) )
2021-02-08 14:18:42 +01:00
out [x.kingdom == " Fungi" & x.class == " Saccharomycetes" ] <- TRUE
2021-01-12 22:08:04 +01:00
out [x.mo %in% c ( NA_character_ , " UNKNOWN" ) ] <- NA
out
}
2020-11-16 11:03:24 +01:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_is_intrinsic_resistant <- function ( x , ab , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-11-16 11:03:24 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_is_intrinsic_resistant" )
2020-11-16 11:03:24 +01:00
}
meet_criteria ( x , allow_NA = TRUE )
meet_criteria ( ab , allow_NA = FALSE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2020-12-07 16:06:42 +01:00
ab <- as.ab ( ab , language = NULL , flag_multiple_results = FALSE , info = FALSE )
2022-08-28 10:31:50 +02:00
2020-11-16 11:03:24 +01: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 ) ) {
2020-12-03 16:59:04 +01:00
stop_ ( " length of `x` and `ab` must be equal, or one of them must be of length 1." )
2020-11-16 11:03:24 +01:00
}
2022-08-28 10:31:50 +02:00
2021-01-03 23:40:05 +01:00
# show used version number once per session (pkg_env will reload every session)
2021-12-11 13:41:31 +01:00
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
2020-12-07 16:06:42 +01:00
# runs against internal vector: INTRINSIC_R (see zzz.R)
paste ( x , ab ) %in% INTRINSIC_R
2020-11-16 11:03:24 +01:00
}
2020-01-27 19:14:23 +01:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_snomed <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_snomed" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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-09-19 11:57:21 +02:00
mo_ref <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_ref" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
mo_validate ( x = x , property = " ref" , language = language , keep_synonyms = keep_synonyms , ... )
2018-08-28 13:51:13 +02:00
}
2018-09-08 16:06:47 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_authors <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_authors" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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
2021-11-29 10:38:38 +01:00
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-09-19 11:57:21 +02:00
mo_year <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_year" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +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
2021-11-29 10:38:38 +01:00
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-09-19 11:57:21 +02:00
mo_lpsn <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2021-12-09 10:48:25 +01:00
if ( missing ( x ) ) {
# this tries to find the data and an <mo> column
2022-09-19 11:57:21 +02:00
x <- find_mo_col ( fn = " mo_lpsn" )
2021-12-09 10:48:25 +01:00
}
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
mo_validate ( x = x , property = " lpsn" , language = language , keep_synonyms = keep_synonyms , ... )
}
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
#' @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 , ... )
2021-12-09 10:48:25 +01:00
}
2019-02-22 22:12:10 +01:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_rank <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_rank" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
mo_validate ( x = x , property = " rank" , language = language , keep_synonyms = keep_synonyms , ... )
2018-09-08 16:06:47 +02:00
}
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_taxonomy <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_taxonomy" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-08-28 10:31:50 +02:00
out <- list (
2022-09-19 11:57:21 +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-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2021-11-29 10:38:38 +01:00
out
2018-09-17 20:53:32 +02:00
}
2019-06-16 21:42:40 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_synonyms <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_synonyms" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-08-28 10:31:50 +02:00
2022-09-16 23:15:23 +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 ) ]
2022-09-19 11:57:21 +02:00
out <- AMR :: microorganisms [which ( AMR :: microorganisms $ lpsn_renamed_to %in% lpsn | AMR :: microorganisms $ gbif_renamed_to %in% gbif ) , " fullname" , drop = TRUE ]
2022-09-16 23:15:23 +02:00
if ( length ( out ) == 0 ) {
2019-06-22 14:49:12 +02:00
NULL
} else {
2022-09-16 23:15:23 +02:00
out
2019-06-22 14:49:12 +02:00
}
} )
2022-09-16 23:15:23 +02:00
2019-06-22 14:49:12 +02:00
if ( length ( syns ) > 1 ) {
2019-08-11 19:07:26 +02:00
names ( syns ) <- mo_name ( x )
2019-07-01 14:03:15 +02:00
result <- syns
2019-06-22 14:49:12 +02:00
} else {
2019-07-01 14:03:15 +02:00
result <- unlist ( syns )
2019-06-16 21:42:40 +02:00
}
2022-08-28 10:31:50 +02:00
2022-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2019-07-01 14:03:15 +02:00
result
2019-06-16 21:42:40 +02:00
}
2019-06-11 14:18:25 +02:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_info <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_info" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
x <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-08-28 10:31:50 +02:00
info <- lapply ( x , function ( y ) {
c (
2022-09-19 11:57:21 +02:00
mo_taxonomy ( y , language = language , keep_synonyms = keep_synonyms ) ,
2022-08-28 10:31:50 +02:00
list (
2022-09-19 11:57:21 +02:00
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 ) {
2019-08-11 19:07:26 +02:00
names ( info ) <- mo_name ( x )
2019-07-01 14:03:15 +02:00
result <- info
2019-06-22 14:49:12 +02:00
} else {
2019-07-01 14:03:15 +02:00
result <- info [ [1L ] ]
2019-06-22 14:49:12 +02:00
}
2022-08-28 10:31:50 +02:00
2022-09-23 14:56:00 +02:00
load_mo_uncertainties ( metadata )
2019-07-01 14:03:15 +02:00
result
2019-06-11 14:18:25 +02:00
}
2019-02-20 00:04:48 +01:00
#' @rdname mo_property
#' @export
2022-09-19 11:57:21 +02:00
mo_url <- function ( x , open = FALSE , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_url" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2020-10-19 17:09:19 +02:00
meet_criteria ( open , allow_class = " logical" , has_length = 1 )
2022-09-16 23:15:23 +02:00
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-09-16 23:15:23 +02:00
2022-09-19 11:57:21 +02:00
x.mo <- as.mo ( x = x , language = language , keep_synonyms = keep_synonyms , ... = ... )
2022-09-23 14:56:00 +02:00
metadata <- get_mo_uncertainties ( )
2022-09-17 12:58:43 +02:00
2022-09-19 11:57:21 +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-09-17 12:58:43 +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 ) )
names ( u ) <- x.name
2022-08-28 10:31:50 +02:00
2021-11-29 10:38:38 +01:00
if ( isTRUE ( open ) ) {
2019-02-22 22:12:10 +01:00
if ( length ( u ) > 1 ) {
2022-03-02 15:38:55 +01:00
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-09-23 14:56:00 +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-09-19 11:57:21 +02:00
mo_property <- function ( x , property = " fullname" , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , TRUE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2021-01-03 23:40:05 +01:00
# this tries to find the data and an <mo> column
x <- find_mo_col ( fn = " mo_property" )
2020-12-24 23:29:10 +01:00
}
2020-10-19 20:44:45 +02:00
meet_criteria ( x , allow_NA = TRUE )
2022-09-16 23:15:23 +02:00
meet_criteria ( property , allow_class = " character" , has_length = 1 , is_in = colnames ( AMR :: microorganisms ) )
language <- validate_language ( language )
2022-09-19 11:57:21 +02:00
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2022-08-28 10:31:50 +02:00
2022-09-19 11:57:21 +02:00
translate_into_language ( mo_validate ( x = x , property = property , language = language , keep_synonyms = keep_synonyms , ... ) , language = language , only_unknown = TRUE )
2018-09-08 16:06:47 +02:00
}
2018-09-27 23:23:48 +02:00
2022-09-19 11:57:21 +02:00
mo_validate <- function ( x , property , language , keep_synonyms = keep_synonyms , ... ) {
2022-09-16 23:15:23 +02:00
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch ( x [1L ] %in% 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-09-16 23:15:23 +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-09-16 23:15:23 +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-09-19 11:57:21 +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-09-19 11:57:21 +02:00
if ( all ( x %in% AMR :: microorganisms $ mo , na.rm = TRUE ) && ! has_Becker_or_Lancefield && isTRUE ( keep_synonyms ) ) {
2022-09-16 23:15:23 +02:00
# do nothing, just don't run the other if-else's
2022-09-19 11:57:21 +02:00
} else if ( all ( x %in% AMR :: microorganisms [ [property ] ] , na.rm = TRUE ) && ! has_Becker_or_Lancefield && isTRUE ( keep_synonyms ) ) {
2022-09-16 23:15:23 +02:00
# no need to do anything, just return it
return ( x )
2021-07-04 12:00:41 +02:00
} else {
2022-09-19 11:57:21 +02:00
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-09-16 23:15:23 +02:00
# get property reeaaally fast using match()
2022-09-19 11:57:21 +02:00
x <- AMR :: microorganisms [ [property ] ] [match ( x , AMR :: microorganisms $ mo ) ]
2022-09-16 23:15:23 +02:00
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-09-16 23:15:23 +02:00
return ( sort ( as.character ( eval ( parse ( text = x ) ) ) ) )
2018-09-27 23:23:48 +02:00
} else {
2022-09-16 23:15:23 +02:00
# everything else is character
return ( as.character ( x ) )
2018-09-27 23:23:48 +02:00
}
}
2020-11-16 11:03:24 +01:00
find_mo_col <- function ( fn ) {
2021-01-03 23:40:05 +01:00
# this function tries to find an mo column in the data the function was called in,
2020-11-16 11:03:24 +01:00
# which is useful when functions are used within dplyr verbs
2021-06-22 12:16:42 +02:00
df <- get_current_data ( arg_name = " x" , call = -3 ) # will return an error if not found
2020-12-07 16:06:42 +01:00
mo <- NULL
2022-08-28 10:31:50 +02:00
try (
{
mo <- suppressMessages ( search_type_in_df ( df , " mo" ) )
} ,
silent = TRUE
)
2020-12-07 16:06:42 +01:00
if ( ! is.null ( df ) && ! is.null ( mo ) && is.data.frame ( df ) ) {
2020-12-24 23:29:10 +01:00
if ( message_not_thrown_before ( fn = fn ) ) {
2021-06-22 12:16:42 +02:00
message_ ( " Using column '" , font_bold ( mo ) , " ' as input for `" , fn , " ()`" )
2020-12-24 23:29:10 +01:00
}
2020-12-07 16:06:42 +01:00
return ( df [ , mo , drop = TRUE ] )
2020-11-16 11:03:24 +01:00
} else {
2020-12-07 16:06:42 +01:00
stop_ ( " argument `x` is missing and no column with info about microorganisms could be found." , call = -2 )
2020-11-16 11:03:24 +01:00
}
}