2018-08-28 13:51:13 +02:00
# ==================================================================== #
2023-07-08 17:30:05 +02:00
# TITLE: #
2022-10-05 09:12:22 +02:00
# AMR: An R Package for Working with Antimicrobial Resistance Data #
2018-08-28 13:51:13 +02:00
# #
2023-07-08 17:30:05 +02:00
# SOURCE CODE: #
2020-07-08 14:48:06 +02:00
# https://github.com/msberends/AMR #
2018-08-28 13:51:13 +02:00
# #
2023-07-08 17:30:05 +02:00
# PLEASE CITE THIS SOFTWARE AS: #
2024-07-16 14:51:57 +02:00
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
# Journal of Statistical Software, 104(3), 1-31. #
2023-05-27 10:39:22 +02:00
# https://doi.org/10.18637/jss.v104.i03 #
2022-10-05 09:12:22 +02:00
# #
2022-12-27 15:16:15 +01:00
# Developed at the University of Groningen and the University Medical #
# Center Groningen in The Netherlands, in collaboration with many #
# colleagues from around the world, see our website. #
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*.
2023-02-09 13:07:39 +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-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()]
2020-12-24 23:29:10 +01:00
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
2023-01-07 01:51:19 +01:00
#' @details All functions will, at default, **not** keep old taxonomic properties, as synonyms are automatically replaced with the current taxonomy. Take for example *Enterobacter aerogenes*, which was initially named in 1960 but renamed to *Klebsiella aerogenes* in 2017:
#' - `mo_genus("Enterobacter aerogenes")` will return `"Klebsiella"` (with a note about the renaming)
#' - `mo_genus("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Enterobacter"` (with a once-per-session warning that the name is outdated)
2024-07-17 14:29:55 +02:00
#' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note about the renaming)
#' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a once-per-session warning that the name is outdated)
2019-02-20 00:04:48 +01:00
#'
2023-01-07 01:51:19 +01:00
#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. 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*. As a result, `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
#'
2023-01-06 13:35:37 +01:00
#' Determination of human pathogenicity ([mo_pathogenicity()]) is strongly based on Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}). This function returns a [factor] with the levels *Pathogenic*, *Potentially pathogenic*, *Non-pathogenic*, and *Unknown*.
2022-08-28 10:31:50 +02:00
#'
2023-01-07 01:51:19 +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 later 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
#'
2024-07-17 14:29:55 +02:00
#' Determination of yeasts ([mo_is_yeast()]) will be based on the taxonomic kingdom and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
2023-01-06 13:35:37 +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).
2023-05-11 21:56:27 +02:00
#'
#' Determination of bacterial oxygen tolerance ([mo_oxygen_tolerance()]) will be based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicting an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic kingdom of Bacteria.
2019-02-20 00:04:48 +01:00
#'
2024-07-17 14:29:55 +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. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) will be used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
2022-08-28 10:31:50 +02:00
#'
2024-07-17 14:29:55 +02:00
#' SNOMED codes ([mo_snomed()]) was last updated on `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
#'
2023-02-22 14:38:57 +01:00
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()] (which will have the scientific reference as [name][base::names()]), the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
2023-01-07 01:51:19 +01:00
#'
#' All output [will be translated][translate] where possible.
2023-01-06 19:21:04 +01:00
#' @section Matching Score for Microorganisms:
#' This function uses [as.mo()] internally, which uses an advanced algorithm to translate arbitrary user input to valid taxonomy using a so-called matching score. You can read about this public algorithm on the [MO matching score page][mo_matching_score()].
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()]
2023-01-06 13:35:37 +01:00
#' - An [ordered factor][factor] in case of [mo_pathogenicity()]
2024-07-17 14:29:55 +02:00
#' - A [list] in case of [mo_taxonomy()], [mo_synonyms()], [mo_snomed()], and [mo_info()]
#' - A [logical] in case of [mo_is_anaerobic()], [mo_is_gram_negative()], [mo_is_gram_positive()], [mo_is_intrinsic_resistant()], and [mo_is_yeast()]
#' - A named [character] in case of [mo_synonyms()] and [mo_url()]
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 -----------------------------------------------------------
2023-01-06 13:35:37 +01:00
#'
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
#'
2023-01-06 13:35:37 +01:00
#'
#' # full names and short names -----------------------------------------------
#'
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
#'
2023-01-06 13:35:37 +01:00
#'
2019-08-09 14:28:46 +02:00
#' # other properties ---------------------------------------------------------
2023-01-06 13:35:37 +01:00
#'
#' mo_pathogenicity("Klebsiella pneumoniae")
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")
2023-01-06 13:35:37 +01:00
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
2024-04-19 10:18:21 +02:00
#'
2024-07-17 14:29:55 +02:00
#' mo_group_members(c("Streptococcus group A",
#' "Streptococcus group C",
2024-04-19 10:18:21 +02:00
#' "Streptococcus group G",
#' "Streptococcus group L"))
#'
2018-11-09 13:11:54 +01:00
#'
2019-08-09 14:28:46 +02:00
#' # scientific reference -----------------------------------------------------
2023-01-06 13:35:37 +01:00
#'
2023-02-22 14:38:57 +01:00
#' mo_ref("Klebsiella aerogenes")
#' mo_authors("Klebsiella aerogenes")
#' mo_year("Klebsiella aerogenes")
2024-07-17 14:29:55 +02:00
#' mo_synonyms("Klebsiella aerogenes")
2023-02-22 14:38:57 +01:00
#' mo_lpsn("Klebsiella aerogenes")
#' mo_gbif("Klebsiella aerogenes")
2024-07-16 14:51:57 +02:00
#' mo_mycobank("Candida albicans")
2024-07-17 14:29:55 +02:00
#' mo_mycobank("Candida krusei")
#' mo_mycobank("Candida krusei", keep_synonyms = TRUE)
#'
2018-08-28 13:51:13 +02:00
#'
2019-08-09 14:28:46 +02:00
#' # abbreviations known in the field -----------------------------------------
2023-01-06 13:35:37 +01:00
#'
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")
2023-02-22 14:38:57 +01:00
#' mo_species("EIEC")
#' mo_name("UPEC")
2018-08-28 13:51:13 +02:00
#'
2023-01-06 13:35:37 +01:00
#'
2019-08-09 14:28:46 +02:00
#' # known subspecies ---------------------------------------------------------
2023-01-06 13:35:37 +01: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 ----------------------------------------
2023-01-06 13:35:37 +01:00
#'
2023-01-07 14:53:14 +01:00
#' mo_fullname("Staph epidermidis")
#' mo_fullname("Staph epidermidis", Becker = TRUE)
#' mo_shortname("Staph epidermidis")
#' mo_shortname("Staph epidermidis", Becker = TRUE)
2018-09-04 11:33:30 +02:00
#'
2023-01-06 13:35:37 +01:00
#'
2019-08-09 14:28:46 +02:00
#' # Lancefield classification, see ?as.mo ------------------------------------
2023-01-06 13:35:37 +01:00
#'
2023-01-07 14:53:14 +01:00
#' mo_fullname("Strep agalactiae")
#' mo_fullname("Strep agalactiae", Lancefield = TRUE)
#' mo_shortname("Strep agalactiae")
#' mo_shortname("Strep agalactiae", Lancefield = TRUE)
2018-09-08 16:06:47 +02:00
#'
#'
2020-11-09 13:07:02 +01:00
#' # language support --------------------------------------------------------
2023-01-06 13:35:37 +01:00
#'
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
2023-01-23 15:01:21 +01:00
#'
2023-01-07 01:51:19 +01:00
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
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
#'
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
#' # 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")) {
2020-11-16 11:03:24 +01:00
#' 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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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
2024-07-16 14:51:57 +02:00
mo_fullname <- 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_fullname" )
}
mo_name ( x = x , language = language , keep_synonyms = keep_synonyms , ... )
}
2018-08-28 13:51:13 +02:00
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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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[.]" ]
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
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
2024-02-24 15:16:52 +01:00
shortnames [mo_rank ( x.mo ) %in% c ( " kingdom" , " phylum" , " class" , " order" , " family" ) ] <- mo_name ( x.mo [mo_rank ( x.mo ) %in% c ( " kingdom" , " phylum" , " class" , " order" , " family" ) ] , language = NULL , keep_synonyms = keep_synonyms )
2022-10-30 14:31:45 +01:00
2020-12-24 23:29:10 +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
}
2021-07-04 12:00:41 +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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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
2018-08-28 13:51:13 +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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 )
2018-08-28 13:51:13 +02:00
}
2020-06-22 11:18:40 +02:00
#' @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 , ... )
}
2020-06-22 11:18:40 +02:00
2018-08-28 13:51:13 +02:00
#' @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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 )
}
2023-01-06 13:35:37 +01:00
#' @rdname mo_property
#' @export
mo_pathogenicity <- 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_pathogenicity" )
}
meet_criteria ( x , allow_NA = TRUE )
language <- validate_language ( language )
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2023-01-21 23:47:20 +01:00
add_MO_lookup_to_AMR_env ( )
2023-01-06 13:35:37 +01:00
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
metadata <- get_mo_uncertainties ( )
prev <- AMR_env $ MO_lookup $ prevalence [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
kngd <- AMR_env $ MO_lookup $ kingdom [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
rank <- AMR_env $ MO_lookup $ rank [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
2023-07-10 13:41:52 +02:00
out <- factor ( case_when_AMR ( prev == 1 & kngd == " Bacteria" & rank != " genus" ~ " Pathogenic" ,
( prev < 2 & kngd == " Fungi" ) ~ " Potentially pathogenic" ,
prev == 2 & kngd == " Bacteria" ~ " Non-pathogenic" ,
kngd == " Bacteria" ~ " Potentially pathogenic" ,
TRUE ~ " Unknown" ) ,
levels = c ( " Pathogenic" , " Potentially pathogenic" , " Non-pathogenic" , " Unknown" ) ,
ordered = TRUE
2023-01-23 15:01:21 +01:00
)
2023-01-06 13:35:37 +01:00
load_mo_uncertainties ( metadata )
out
}
2022-10-05 09:12:22 +02:00
#' @rdname mo_property
#' @export
mo_gramstain <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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
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-10-05 09:12:22 +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-10-05 09:12:22 +02:00
x [ ( mo_phylum ( x.mo , language = NULL , keep_synonyms = keep_synonyms ) %in% c (
2022-12-09 10:30:25 +01:00
# 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" ,
2022-12-09 10:30:25 +01:00
" 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
) &
2022-12-09 10:30:25 +01: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
2023-04-17 11:26:19 +02:00
| x.mo %in% c ( " B_GRAMP" , " B_ANAER-POS" ) ] <- " Gram-positive"
2022-08-28 10:31:50 +02:00
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
}
2020-10-19 17:09:19 +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 ) , ... ) {
2020-11-09 13:07:02 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 )
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-10-05 09:12:22 +02:00
mo_is_gram_positive <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2020-11-09 13:07:02 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 )
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-10-05 09:12:22 +02:00
mo_is_yeast <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2021-01-12 22:08:04 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-12 22:08:04 +01:00
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
2024-07-17 14:29:55 +02:00
out <- x.mo == " F_YEAST" | ( x.kingdom == " Fungi" & x.class %in% c ( " Saccharomycetes" , " Pichiomycetes" ) )
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-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 ) , ... ) {
2020-11-16 11:03:24 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 , ... )
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
2022-10-05 09:12:22 +02:00
# show used version number once per session (AMR_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
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-11-16 11:03:24 +01:00
}
2023-05-11 21:56:27 +02:00
#' @rdname mo_property
#' @export
mo_oxygen_tolerance <- 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_oxygen_tolerance" )
}
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 = " oxygen_tolerance" , language = language , keep_synonyms = keep_synonyms , ... )
}
#' @rdname mo_property
#' @export
mo_is_anaerobic <- 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_is_anaerobic" )
}
meet_criteria ( x , allow_NA = TRUE )
language <- validate_language ( language )
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
metadata <- get_mo_uncertainties ( )
oxygen <- mo_oxygen_tolerance ( x.mo , language = NULL , keep_synonyms = keep_synonyms )
load_mo_uncertainties ( metadata )
out <- oxygen == " anaerobe" & ! is.na ( oxygen )
out [x.mo %in% c ( NA_character_ , " UNKNOWN" ) ] <- NA
out
}
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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 , ... )
2018-08-28 13:51:13 +02:00
}
2018-09-08 16:06:47 +02:00
#' @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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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
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-10-05 09:12:22 +02:00
mo_year <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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
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-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 , ... )
}
2024-07-16 14:51:57 +02:00
#' @rdname mo_property
#' @export
mo_mycobank <- 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_mycobank" )
}
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 = " mycobank" , language = language , keep_synonyms = keep_synonyms , ... )
}
2022-10-05 09:12:22 +02:00
#' @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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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-08 16:06:47 +02:00
}
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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 )
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-10-05 09:12:22 +02:00
mo_synonyms <- function ( x , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-10-05 09:12:22 +02:00
language <- validate_language ( language )
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2023-01-23 15:01:21 +01:00
2023-01-21 23:47:20 +01:00
add_MO_lookup_to_AMR_env ( )
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 ) {
2022-12-27 15:16:15 +01:00
gbif <- AMR_env $ MO_lookup $ gbif [match ( y , AMR_env $ MO_lookup $ mo ) ]
lpsn <- AMR_env $ MO_lookup $ lpsn [match ( y , AMR_env $ MO_lookup $ mo ) ]
2023-02-22 14:38:57 +01:00
fullname <- AMR_env $ MO_lookup [which ( AMR_env $ MO_lookup $ lpsn_renamed_to == lpsn | AMR_env $ MO_lookup $ gbif_renamed_to == gbif ) , " fullname" , drop = TRUE ]
if ( length ( fullname ) == 0 ) {
2019-06-22 14:49:12 +02:00
NULL
} else {
2023-02-22 14:38:57 +01:00
ref <- AMR_env $ MO_lookup [which ( AMR_env $ MO_lookup $ lpsn_renamed_to == lpsn | AMR_env $ MO_lookup $ gbif_renamed_to == gbif ) , " ref" , drop = TRUE ]
names ( fullname ) <- ref
fullname
2019-06-22 14:49:12 +02:00
}
} )
2022-10-05 09:12:22 +02:00
2023-02-22 14:38:57 +01:00
if ( length ( syns ) == 1 ) {
syns <- unlist ( syns )
2019-06-16 21:42:40 +02:00
}
2023-03-11 14:24:34 +01:00
2022-10-05 09:12:22 +02:00
load_mo_uncertainties ( metadata )
2023-02-22 14:38:57 +01:00
syns
2019-06-16 21:42:40 +02:00
}
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 )
2024-07-17 14:29:55 +02:00
x.mo <- suppressWarnings ( as.mo ( x , keep_synonyms = TRUE , info = FALSE , ... ) )
2022-10-10 10:12:08 +02:00
out <- synonym_mo_to_accepted_mo ( x.mo , fill_in_accepted = TRUE )
mo_name ( out , language = language )
}
2024-04-19 10:18:21 +02:00
#' @rdname mo_property
#' @export
mo_group_members <- 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_synonyms" )
}
meet_criteria ( x , allow_NA = TRUE )
language <- validate_language ( language )
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
add_MO_lookup_to_AMR_env ( )
x.mo <- as.mo ( x , language = language , keep_synonyms = keep_synonyms , ... )
metadata <- get_mo_uncertainties ( )
members <- lapply ( x.mo , function ( y ) {
AMR :: microorganisms.groups $ mo_name [which ( AMR :: microorganisms.groups $ mo_group == y ) ]
} )
names ( members ) <- mo_name ( x , keep_synonyms = TRUE , language = language )
if ( length ( members ) == 1 ) {
members <- unname ( unlist ( members ) )
}
load_mo_uncertainties ( metadata )
members
}
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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-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 (
2023-01-19 12:54:53 +01:00
list ( mo = as.character ( x ) ) ,
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 ) ,
2023-05-11 21:56:27 +02:00
oxygen_tolerance = mo_oxygen_tolerance ( y , language = language , keep_synonyms = keep_synonyms ) ,
2022-10-05 09:12:22 +02:00
url = unname ( mo_url ( y , open = FALSE , keep_synonyms = keep_synonyms ) ) ,
ref = mo_ref ( y , keep_synonyms = keep_synonyms ) ,
2023-05-11 21:56:27 +02:00
snomed = unlist ( mo_snomed ( y , keep_synonyms = keep_synonyms ) ) ,
lpsn = mo_lpsn ( y , language = language , keep_synonyms = keep_synonyms ) ,
2024-09-19 11:44:56 +02:00
mycobank = mo_mycobank ( y , language = language , keep_synonyms = keep_synonyms ) ,
2024-04-19 10:18:21 +02:00
gbif = mo_gbif ( y , language = language , keep_synonyms = keep_synonyms ) ,
group_members = mo_group_members ( y , language = language , 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-10-05 09:12:22 +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-10-05 09:12:22 +02:00
mo_url <- function ( x , open = FALSE , language = get_AMR_locale ( ) , keep_synonyms = getOption ( " AMR_keep_synonyms" , FALSE ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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-10-05 09:12:22 +02:00
language <- validate_language ( language )
meet_criteria ( keep_synonyms , allow_class = " logical" , has_length = 1 )
2023-01-23 15:01:21 +01:00
2023-01-21 23:47:20 +01:00
add_MO_lookup_to_AMR_env ( )
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-12-27 15:16:15 +01:00
x.rank <- AMR_env $ MO_lookup $ rank [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
x.name <- AMR_env $ MO_lookup $ fullname [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
2024-07-17 14:29:55 +02:00
2022-12-27 15:16:15 +01:00
x.lpsn <- AMR_env $ MO_lookup $ lpsn [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
2024-07-17 14:29:55 +02:00
x.mycobank <- AMR_env $ MO_lookup $ mycobank [match ( x.mo , AMR_env $ MO_lookup $ mo ) ]
2022-12-27 15:16:15 +01:00
x.gbif <- AMR_env $ MO_lookup $ gbif [match ( x.mo , AMR_env $ MO_lookup $ 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 ) )
2024-07-17 14:29:55 +02:00
# overwrite with MycoBank (bacteria from LPSN will not be overwritten since MycoBank has no bacteria)
2024-07-19 18:04:45 +02:00
u [ ! is.na ( x.mycobank ) ] <- paste0 ( TAXONOMY_VERSION $ MycoBank $ url , " /mb/" , gsub ( " " , " %20" , tolower ( x.mycobank [ ! is.na ( x.mycobank ) ] ) , 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
2021-11-29 10:38:38 +01:00
if ( isTRUE ( open ) ) {
2019-02-22 22:12:10 +01:00
if ( length ( u ) > 1 ) {
2024-07-17 14:29:55 +02:00
warning_ ( " in `mo_url()`: only the first URL will be opened, as R's built-in function `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 ) , ... ) {
2020-12-24 23:29:10 +01:00
if ( missing ( x ) ) {
2022-10-19 11:47:57 +02:00
# this tries to find the data and an 'mo' column
2021-01-03 23:40:05 +01:00
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 )
2023-01-21 23:47:20 +01:00
meet_criteria ( property , allow_class = " character" , has_length = 1 , is_in = colnames ( AMR :: microorganisms ) )
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 = 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-10-05 09:12:22 +02:00
mo_validate <- function ( x , property , language , keep_synonyms = keep_synonyms , ... ) {
2023-01-21 23:47:20 +01:00
add_MO_lookup_to_AMR_env ( )
2023-01-23 15:01:21 +01:00
2022-10-05 09:12:22 +02:00
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
2022-12-27 15:16:15 +01:00
tryCatch ( x [1L ] %in% unlist ( AMR_env $ MO_lookup [1 , property , drop = TRUE ] ) ,
2022-10-05 09:12:22 +02:00
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" )
2023-07-10 16:43:46 +02:00
if ( isFALSE ( has_Becker_or_Lancefield ) && isTRUE ( keep_synonyms ) && all ( x %in% c ( AMR_env $ MO_lookup $ mo , NA ) ) ) {
# fastest way to get properties
if ( property == " snomed" ) {
x <- lapply ( x , function ( y ) unlist ( AMR_env $ MO_lookup $ snomed [match ( y , AMR_env $ MO_lookup $ mo ) ] ) )
} else {
x <- AMR_env $ MO_lookup [ [property ] ] [match ( x , AMR_env $ MO_lookup $ mo ) ]
}
2023-02-10 16:18:00 +01:00
} else {
2023-07-10 16:43:46 +02:00
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
mo_data_check <- AMR_env $ MO_lookup [which ( AMR_env $ MO_lookup $ status %in% if ( isTRUE ( keep_synonyms ) ) c ( " synonym" , " accepted" ) else " accepted" ) , , drop = FALSE ]
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 , ... )
}
# get property reeaaally fast using match()
if ( property == " snomed" ) {
x <- lapply ( x , function ( y ) unlist ( AMR_env $ MO_lookup $ snomed [match ( y , AMR_env $ MO_lookup $ mo ) ] ) )
} else {
x <- AMR_env $ MO_lookup [ [property ] ] [match ( x , AMR_env $ MO_lookup $ mo ) ]
}
2023-02-10 16:18:00 +01:00
}
2023-02-09 13:07:39 +01: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" ) {
2023-02-10 16:18:00 +01:00
return ( x )
2023-01-19 12:54:53 +01:00
} else if ( property == " prevalence" ) {
return ( as.double ( x ) )
2018-09-27 23:23:48 +02:00
} 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 ) )
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
}
}