mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 06:51:48 +02:00
New mo algorithm, prepare for 2.0
This commit is contained in:
Dr. Matthijs Berends
committed by
GitHub
GitHub
parent
63fe160322
commit
cd2acc4a29
437
R/mo_property.R
437
R/mo_property.R
@ -1,12 +1,16 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2022 Berends MS, Luz CF et al. #
|
||||
# CITE AS #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# doi:10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
@ -28,14 +32,14 @@
|
||||
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
|
||||
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
|
||||
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
|
||||
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
|
||||
#' @inheritParams as.mo
|
||||
#' @param ... other arguments passed on to [as.mo()], such as 'minimum_matching_score', 'ignore_pattern', and 'remove_from_input'
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
|
||||
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
|
||||
#' @details All functions will, at default, keep old taxonomic properties. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
|
||||
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming)
|
||||
#' - `mo_ref("Escherichia blattae")` will return `"Burgess et al., 1973"` (with a message about the renaming)
|
||||
#' - `mo_ref("Shimwellia blattae")` will return `"Priest et al., 2010"` (without a message)
|
||||
#' - `mo_ref("Escherichia blattae", keep_synonyms = TRUE)` will return `"Burgess et al., 1973"` (with a warning about the renaming)
|
||||
#' - `mo_ref("Shimwellia blattae", keep_synonyms = FALSE)` will return `"Priest et al., 2010"` (without a message)
|
||||
#'
|
||||
#' 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"`.
|
||||
#'
|
||||
@ -51,9 +55,8 @@
|
||||
#'
|
||||
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
|
||||
#'
|
||||
#' SNOMED codes - [mo_snomed()] - are from the `r SNOMED_VERSION$current_source`. See *Source* and the [microorganisms] data set for more info.
|
||||
#' 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.
|
||||
#' @inheritSection mo_matching_score Matching Score for Microorganisms
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @inheritSection as.mo Source
|
||||
#' @rdname mo_property
|
||||
#' @name mo_property
|
||||
@ -169,15 +172,16 @@
|
||||
#' # SNOMED codes, and URL to the online database
|
||||
#' mo_info("Klebsiella pneumoniae")
|
||||
#' }
|
||||
mo_name <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_name")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "fullname", language = language, ...),
|
||||
translate_into_language(mo_validate(x = x, property = "fullname", language = language, keep_synonyms = keep_synonyms, ...),
|
||||
language = language,
|
||||
only_unknown = FALSE,
|
||||
only_affect_mo_names = TRUE
|
||||
@ -190,17 +194,18 @@ mo_fullname <- mo_name
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_shortname <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_shortname")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
replace_empty <- function(x) {
|
||||
x[x == ""] <- "spp."
|
||||
@ -208,8 +213,8 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
|
||||
}
|
||||
|
||||
# get first char of genus and complete species in English
|
||||
genera <- mo_genus(x.mo, language = NULL)
|
||||
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL)))
|
||||
genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms)))
|
||||
|
||||
# exceptions for where no species is known
|
||||
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
|
||||
@ -219,10 +224,10 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
|
||||
# exceptions for streptococci: Group A Streptococcus -> GAS
|
||||
shortnames[shortnames %like% "S. group [ABCDFGHK]"] <- paste0("G", gsub("S. group ([ABCDFGHK])", "\\1", shortnames[shortnames %like% "S. group [ABCDFGHK]"], perl = TRUE), "S")
|
||||
# unknown species etc.
|
||||
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
|
||||
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
|
||||
|
||||
shortnames[is.na(x.mo)] <- NA_character_
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
translate_into_language(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE)
|
||||
}
|
||||
|
||||
@ -230,106 +235,114 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_subspecies <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_subspecies")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_species <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_species")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "species", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_genus <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_genus")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "genus", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_family <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_family")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "family", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_order <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_order")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "order", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_class <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_class")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "class", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_phylum <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_phylum")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "phylum", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_kingdom <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_kingdom")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@ -338,67 +351,85 @@ mo_domain <- mo_kingdom
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_type <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_type")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
out <- mo_kingdom(x.mo, language = NULL)
|
||||
out[which(mo_is_yeast(x.mo))] <- "Yeasts"
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
out <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
|
||||
translate_into_language(out, language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_status <- 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_status")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = "status", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_gramstain")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
x <- rep(NA_character_, length(x))
|
||||
# make all bacteria Gram negative
|
||||
x[mo_kingdom(x.mo) == "Bacteria"] <- "Gram-negative"
|
||||
x[mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
|
||||
# overwrite these 4 phyla with Gram-positives
|
||||
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
|
||||
x[(mo_phylum(x.mo) %in% c(
|
||||
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
|
||||
"Actinobacteria",
|
||||
"Chloroflexi",
|
||||
"Firmicutes",
|
||||
"Tenericutes"
|
||||
"Tenericutes",
|
||||
"Bacillota" # this one is new! It was renamed from Firmicutes by Gibbons et al., 2021
|
||||
) &
|
||||
# but class Negativicutes (of phylum Firmicutes) are Gram-negative!
|
||||
mo_class(x.mo) != "Negativicutes")
|
||||
mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms) != "Negativicutes")
|
||||
# and of course our own ID for Gram-positives
|
||||
| x.mo == "B_GRAMP"] <- "Gram-positive"
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
translate_into_language(x, language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_is_gram_negative")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
grams <- mo_gramstain(x.mo, language = NULL)
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
load_mo_uncertainties(metadata)
|
||||
out <- grams == "Gram-negative" & !is.na(grams)
|
||||
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
||||
out
|
||||
@ -406,18 +437,19 @@ mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_is_gram_positive")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
grams <- mo_gramstain(x.mo, language = NULL)
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
load_mo_uncertainties(metadata)
|
||||
out <- grams == "Gram-positive" & !is.na(grams)
|
||||
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
||||
out
|
||||
@ -425,21 +457,22 @@ mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
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)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
x.kingdom <- mo_kingdom(x.mo, language = NULL)
|
||||
x.class <- mo_class(x.mo, language = NULL)
|
||||
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
|
||||
out <- rep(FALSE, length(x))
|
||||
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
|
||||
@ -449,16 +482,17 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
|
||||
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(ab, allow_NA = FALSE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
ab <- as.ab(ab, language = NULL, flag_multiple_results = FALSE, info = FALSE)
|
||||
|
||||
if (length(x) == 1 & length(ab) > 1) {
|
||||
@ -470,7 +504,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
|
||||
stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
|
||||
}
|
||||
|
||||
# show used version number once per session (pkg_env will reload every session)
|
||||
# show used version number once per session (AMR_env will reload every session)
|
||||
if (message_not_thrown_before("mo_is_intrinsic_resistant", "version.mo", entire_session = TRUE)) {
|
||||
message_(
|
||||
"Determining intrinsic resistance based on ",
|
||||
@ -485,41 +519,44 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_snomed <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_snomed")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "snomed", language = language, ...)
|
||||
mo_validate(x = x, property = "snomed", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_ref <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_ref")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "ref", language = language, ...)
|
||||
mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_authors <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_authors")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- mo_validate(x = x, property = "ref", language = language, ...)
|
||||
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
# remove last 4 digits and presumably the comma and space that preceed them
|
||||
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)], perl = TRUE)
|
||||
suppressWarnings(x)
|
||||
@ -527,15 +564,16 @@ mo_authors <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_year <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_year")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- mo_validate(x = x, property = "ref", language = language, ...)
|
||||
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
# get last 4 digits
|
||||
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)], perl = TRUE)
|
||||
suppressWarnings(as.integer(x))
|
||||
@ -543,80 +581,100 @@ mo_year <- function(x, language = get_AMR_locale(), ...) {
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_lpsn <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_lpsn")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "lpsn", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_gbif")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "gbif", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_rank")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "species_id", language = language, ...)
|
||||
mo_validate(x = x, property = "rank", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_rank <- function(x, language = get_AMR_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_rank")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
mo_validate(x = x, property = "rank", language = language, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_taxonomy <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_taxonomy")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
out <- list(
|
||||
kingdom = mo_kingdom(x, language = language),
|
||||
phylum = mo_phylum(x, language = language),
|
||||
class = mo_class(x, language = language),
|
||||
order = mo_order(x, language = language),
|
||||
family = mo_family(x, language = language),
|
||||
genus = mo_genus(x, language = language),
|
||||
species = mo_species(x, language = language),
|
||||
subspecies = mo_subspecies(x, language = language)
|
||||
kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
|
||||
phylum = mo_phylum(x, language = language, keep_synonyms = keep_synonyms),
|
||||
class = mo_class(x, language = language, keep_synonyms = keep_synonyms),
|
||||
order = mo_order(x, language = language, keep_synonyms = keep_synonyms),
|
||||
family = mo_family(x, language = language, keep_synonyms = keep_synonyms),
|
||||
genus = mo_genus(x, language = language, keep_synonyms = keep_synonyms),
|
||||
species = mo_species(x, language = language, keep_synonyms = keep_synonyms),
|
||||
subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
|
||||
)
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", 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)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
IDs <- mo_name(x = x, language = NULL)
|
||||
syns <- lapply(IDs, function(newname) {
|
||||
res <- sort(microorganisms.old[which(microorganisms.old$fullname_new == newname), "fullname", drop = TRUE])
|
||||
if (length(res) == 0) {
|
||||
syns <- lapply(x.mo, function(y) {
|
||||
gbif <- AMR::microorganisms$gbif[match(y, AMR::microorganisms$mo)]
|
||||
lpsn <- AMR::microorganisms$lpsn[match(y, AMR::microorganisms$mo)]
|
||||
out <- AMR::microorganisms[which(AMR::microorganisms$lpsn_renamed_to == lpsn | AMR::microorganisms$gbif_renamed_to == gbif), "fullname", drop = TRUE]
|
||||
if (length(out) == 0) {
|
||||
NULL
|
||||
} else {
|
||||
res
|
||||
out
|
||||
}
|
||||
})
|
||||
|
||||
if (length(syns) > 1) {
|
||||
names(syns) <- mo_name(x)
|
||||
result <- syns
|
||||
@ -624,32 +682,34 @@ mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
|
||||
result <- unlist(syns)
|
||||
}
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
result
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_AMR_locale(), ...) {
|
||||
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_info")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
info <- lapply(x, function(y) {
|
||||
c(
|
||||
mo_taxonomy(y, language = language),
|
||||
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
|
||||
list(
|
||||
synonyms = mo_synonyms(y),
|
||||
gramstain = mo_gramstain(y, language = language),
|
||||
url = unname(mo_url(y, open = FALSE)),
|
||||
ref = mo_ref(y),
|
||||
snomed = unlist(mo_snomed(y))
|
||||
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
|
||||
synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
|
||||
gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
|
||||
url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
|
||||
ref = mo_ref(y, keep_synonyms = keep_synonyms),
|
||||
snomed = unlist(mo_snomed(y, keep_synonyms = keep_synonyms))
|
||||
)
|
||||
)
|
||||
})
|
||||
@ -660,37 +720,36 @@ mo_info <- function(x, language = get_AMR_locale(), ...) {
|
||||
result <- info[[1L]]
|
||||
}
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
result
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
|
||||
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_url")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
x.mo <- as.mo(x = x, language = language, ... = ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
df <- microorganisms[match(x.mo, microorganisms$mo), c("mo", "fullname", "source", "kingdom", "rank"), drop = FALSE]
|
||||
df$url <- ifelse(df$source == "LPSN",
|
||||
paste0(CATALOGUE_OF_LIFE$url_LPSN, "/species/", gsub(" ", "-", tolower(df$fullname), fixed = TRUE)),
|
||||
paste0(CATALOGUE_OF_LIFE$url_CoL, "/data/search?type=EXACT&q=", gsub(" ", "%20", df$fullname, fixed = TRUE))
|
||||
)
|
||||
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)]
|
||||
|
||||
genera <- which(df$kingdom == "Bacteria" & df$rank == "genus")
|
||||
df$url[genera] <- gsub("/species/", "/genus/", df$url[genera], fixed = TRUE)
|
||||
subsp <- which(df$kingdom == "Bacteria" & df$rank %in% c("subsp.", "infraspecies"))
|
||||
df$url[subsp] <- gsub("/species/", "/subspecies/", df$url[subsp], fixed = TRUE)
|
||||
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))
|
||||
|
||||
u <- df$url
|
||||
names(u) <- df$fullname
|
||||
names(u) <- x.name
|
||||
|
||||
if (isTRUE(open)) {
|
||||
if (length(u) > 1) {
|
||||
@ -699,61 +758,69 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
load_mo_uncertainties(metadata)
|
||||
u
|
||||
}
|
||||
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), ...) {
|
||||
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_property")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
translate_into_language(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE)
|
||||
translate_into_language(mo_validate(x = x, property = property, language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
mo_validate <- function(x, property, language, ...) {
|
||||
check_dataset_integrity()
|
||||
mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) {
|
||||
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% unlist(AMR::microorganisms[1, property, drop = TRUE]),
|
||||
error = function(e) stop(e$message, call. = FALSE)
|
||||
)
|
||||
|
||||
dots <- list(...)
|
||||
Becker <- dots$Becker
|
||||
if (is.null(Becker) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
if (is.null(Becker) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
Becker <- FALSE
|
||||
}
|
||||
Lancefield <- dots$Lancefield
|
||||
if (is.null(Lancefield) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") | Lancefield %in% c(TRUE, "all")
|
||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
|
||||
|
||||
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & !has_Becker_or_Lancefield, error = function(e) FALSE)) {
|
||||
# special case for mo_* functions where class is already <mo>
|
||||
x <- MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]
|
||||
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
|
||||
mo_data_check <- AMR::microorganisms[which(AMR::microorganisms$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
|
||||
|
||||
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 {
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE)
|
||||
)
|
||||
|
||||
if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) {
|
||||
x <- exec_as.mo(x, property = property, language = language, ...)
|
||||
}
|
||||
# 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()
|
||||
x <- AMR::microorganisms[[property]][match(x, AMR::microorganisms$mo)]
|
||||
|
||||
if (property == "mo") {
|
||||
return(set_clean_class(x, new_class = c("mo", "character")))
|
||||
} else if (property == "species_id") {
|
||||
return(as.double(x))
|
||||
} else if (property == "snomed") {
|
||||
return(as.double(eval(parse(text = x))))
|
||||
return(sort(as.character(eval(parse(text = x)))))
|
||||
} else {
|
||||
return(x)
|
||||
# everything else is character
|
||||
return(as.character(x))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user