P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 14:01:55 +02:00
Code Releases Activity

add mo_current()

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-10-10 10:12:08 +02:00
parent b753b84128
commit 43c638d122
7 changed files with 37 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
R/mo.R
View File

@ -1094,14 +1094,19 @@ load_mo_uncertainties <- function(metadata) {
AMR_env$mo_uncertainties <- metadata$uncertainties
}
synonym_mo_to_accepted_mo <- function(x) {
synonym_mo_to_accepted_mo <- function(x, fill_in_accepted = FALSE) {
x_gbif <- AMR::microorganisms$gbif_renamed_to[match(x, AMR::microorganisms$mo)]
x_lpsn <- AMR::microorganisms$lpsn_renamed_to[match(x, AMR::microorganisms$mo)]
x_gbif[!x_gbif %in% AMR::microorganisms$gbif] <- NA
x_lpsn[!x_lpsn %in% AMR::microorganisms$lpsn] <- NA
ifelse(is.na(x_lpsn),
out <- ifelse(is.na(x_lpsn),
AMR::microorganisms$mo[match(x_gbif, AMR::microorganisms$gbif)],
AMR::microorganisms$mo[match(x_lpsn, AMR::microorganisms$lpsn)]
)
if (isTRUE(fill_in_accepted)) {
x_accepted <- which(AMR::microorganisms$status[match(x, AMR::microorganisms$mo)] == "accepted")
out[x_accepted] <- x[x_accepted]
}
out
}

16
R/mo_property.R
View File

@ -56,13 +56,15 @@
#' 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 version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
#'
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()], the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
#' @inheritSection mo_matching_score Matching Score for Microorganisms
#' @inheritSection as.mo Source
#' @rdname mo_property
#' @name mo_property
#' @return
#' - An [integer] in case of [mo_year()]
#' - A [list] in case of [mo_taxonomy()] and [mo_info()]
#' - A [list] in case of [mo_taxonomy()], [mo_synonyms()] and [mo_info()]
#' - A named [character] in case of [mo_url()]
#' - A [numeric] in case of [mo_snomed()]
#' - A [character] in all other cases
@ -672,7 +674,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
})
if (length(syns) > 1) {
names(syns) <- mo_name(x)
names(syns) <- mo_name(x, language = language)
result <- syns
} else {
result <- unlist(syns)
@ -682,6 +684,16 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
result
}
#' @rdname mo_property
#' @export
mo_current <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
x.mo <- suppressWarnings(as.mo(x, keep_synonyms = TRUE, ...))
out <- synonym_mo_to_accepted_mo(x.mo, fill_in_accepted = TRUE)
mo_name(out, language = language)
}
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {