AMR/R/mo_property.R

610 lines
30 KiB
R
Raw Normal View History

# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
2019-01-02 23:24:07 +01:00
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
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. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
2019-04-05 18:47:39 +02:00
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
#' Property of a microorganism
#'
#' Use these functions to return a specific property of a microorganism from the \code{\link{microorganisms}} data set. All input values will be evaluated internally with \code{\link{as.mo}}.
#' @param x any (vector of) text that can be coerced to a valid microorganism code with \code{\link{as.mo}}
2018-09-25 16:44:40 +02:00
#' @param property one of the column names of one of the \code{\link{microorganisms}} data set or \code{"shortname"}
2018-11-09 13:11:54 +01:00
#' @param language language of the returned text, defaults to system language (see \code{\link{get_locale}}) and can also be set with \code{\link{getOption}("AMR_locale")}. Use \code{language = NULL} or \code{language = ""} to prevent translation.
#' @param ... other parameters passed on to \code{\link{as.mo}}
2019-03-18 14:29:41 +01:00
#' @param open browse the URL using \code{\link[utils]{browseURL}()}
2019-02-20 00:04:48 +01:00
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for \code{mo_ref}, \code{mo_authors} and \code{mo_year}. This leads to the following results:
2018-11-09 13:11:54 +01:00
#' \itemize{
#' \item{\code{mo_fullname("Chlamydia psittaci")} will return \code{"Chlamydophila psittaci"} (with a warning about the renaming)}
#' \item{\code{mo_ref("Chlamydia psittaci")} will return \code{"Page, 1968"} (with a warning about the renaming)}
#' \item{\code{mo_ref("Chlamydophila psittaci")} will return \code{"Everett et al., 1999"} (without a warning)}
#' }
2019-02-20 00:04:48 +01:00
#'
2019-03-18 14:29:41 +01:00
#' The Gram stain - \code{mo_gramstain()} - will be determined on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002) who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram positive - all other bacteria are considered Gram negative. Species outside the kingdom of Bacteria will return a value \code{NA}.
2019-02-20 00:04:48 +01:00
#'
2019-03-18 14:29:41 +01:00
#' The function \code{mo_url()} will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
2018-11-05 13:20:32 +01:00
#' @inheritSection get_locale Supported languages
2019-02-20 00:04:48 +01:00
#' @inheritSection catalogue_of_life Catalogue of Life
2018-09-24 23:33:29 +02:00
#' @inheritSection as.mo Source
#' @rdname mo_property
#' @name mo_property
2018-11-09 13:11:54 +01:00
#' @return \itemize{
2019-02-18 02:33:37 +01:00
#' \item{An \code{integer} in case of \code{mo_year}}
2018-11-09 13:11:54 +01:00
#' \item{A \code{list} in case of \code{mo_taxonomy}}
2019-02-22 22:12:10 +01:00
#' \item{A named \code{character} in case of \code{mo_url}}
2018-11-09 13:11:54 +01:00
#' \item{A \code{character} in all other cases}
#' }
#' @export
#' @seealso \code{\link{microorganisms}}
2019-01-02 23:24:07 +01:00
#' @inheritSection AMR Read more on our website!
#' @examples
2019-02-22 22:12:10 +01:00
#' ## taxonomic tree
2018-11-09 13:11:54 +01:00
#' mo_kingdom("E. coli") # "Bacteria"
2018-09-17 20:53:32 +02:00
#' mo_phylum("E. coli") # "Proteobacteria"
#' mo_class("E. coli") # "Gammaproteobacteria"
#' mo_order("E. coli") # "Enterobacteriales"
#' mo_family("E. coli") # "Enterobacteriaceae"
#' mo_genus("E. coli") # "Escherichia"
#' mo_species("E. coli") # "coli"
2019-02-20 00:04:48 +01:00
#' mo_subspecies("E. coli") # ""
2018-11-09 13:11:54 +01:00
#'
#' ## colloquial properties
#' mo_fullname("E. coli") # "Escherichia coli"
2018-09-05 10:51:46 +02:00
#' mo_shortname("E. coli") # "E. coli"
2018-11-09 13:11:54 +01:00
#'
#' ## other properties
2018-09-24 23:33:29 +02:00
#' mo_gramstain("E. coli") # "Gram negative"
2018-11-09 13:11:54 +01:00
#' mo_type("E. coli") # "Bacteria" (equal to kingdom)
2019-02-22 22:12:10 +01:00
#' mo_rank("E. coli") # "species"
#' mo_url("E. coli") # get the direct url to the Catalogue of Life
2018-11-09 13:11:54 +01:00
#'
#' ## scientific reference
2019-02-22 22:12:10 +01:00
#' mo_ref("E. coli") # "Castellani et al., 1919"
#' mo_authors("E. coli") # "Castellani et al."
2018-11-09 13:11:54 +01:00
#' mo_year("E. coli") # 1919
#'
#'
#' # Abbreviations known in the field
#' mo_genus("MRSA") # "Staphylococcus"
#' mo_species("MRSA") # "aureus"
2018-09-05 10:51:46 +02:00
#' mo_shortname("MRSA") # "S. aureus"
2018-09-24 23:33:29 +02:00
#' mo_gramstain("MRSA") # "Gram positive"
#'
#' mo_genus("VISA") # "Staphylococcus"
#' mo_species("VISA") # "aureus"
#'
#'
#' # Known subspecies
#' mo_genus("doylei") # "Campylobacter"
#' mo_species("doylei") # "jejuni"
2018-09-24 23:33:29 +02:00
#' mo_fullname("doylei") # "Campylobacter jejuni doylei"
#'
2018-09-24 23:33:29 +02:00
#' mo_fullname("K. pneu rh") # "Klebsiella pneumoniae rhinoscleromatis"
2018-09-05 10:51:46 +02:00
#' mo_shortname("K. pneu rh") # "K. pneumoniae"
#'
#'
#' # Becker classification, see ?as.mo
2018-09-05 12:21:27 +02:00
#' mo_fullname("S. epi") # "Staphylococcus epidermidis"
2019-03-18 14:29:41 +01:00
#' mo_fullname("S. epi", Becker = TRUE) # "Coagulase-negative Staphylococcus (CoNS)"
2018-09-05 12:21:27 +02:00
#' mo_shortname("S. epi") # "S. epidermidis"
#' mo_shortname("S. epi", Becker = TRUE) # "CoNS"
#'
#' # Lancefield classification, see ?as.mo
2018-09-05 12:21:27 +02:00
#' mo_fullname("S. pyo") # "Streptococcus pyogenes"
#' mo_fullname("S. pyo", Lancefield = TRUE) # "Streptococcus group A"
#' mo_shortname("S. pyo") # "S. pyogenes"
2018-11-09 13:11:54 +01:00
#' mo_shortname("S. pyo", Lancefield = TRUE) # "GAS" ('Group A streptococci')
#'
#'
2019-02-22 22:12:10 +01:00
#' # language support for German, Dutch, Spanish, Portuguese, Italian and French
2018-09-24 23:33:29 +02:00
#' mo_gramstain("E. coli", language = "de") # "Gramnegativ"
#' mo_gramstain("E. coli", language = "nl") # "Gram-negatief"
#' mo_gramstain("E. coli", language = "es") # "Gram negativo"
#'
2018-11-09 13:11:54 +01:00
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain official
#' mo_kingdom("E. coli") # "Bacteria" on a German system
#' mo_type("E. coli") # "Bakterien" on a German system
#' mo_type("E. coli") # "Bacteria" on an English system
#'
2018-09-09 12:11:44 +02:00
#' mo_fullname("S. pyogenes",
#' Lancefield = TRUE,
#' language = "de") # "Streptococcus Gruppe A"
2018-09-09 12:11:44 +02:00
#' mo_fullname("S. pyogenes",
#' Lancefield = TRUE,
#' language = "nl") # "Streptococcus groep A"
2018-09-17 20:53:32 +02:00
#'
#'
2019-02-22 22:12:10 +01:00
#' # get a list with the complete taxonomy (kingdom to subspecies)
2018-09-17 20:53:32 +02:00
#' mo_taxonomy("E. coli")
2018-11-05 13:20:32 +01:00
mo_fullname <- function(x, language = get_locale(), ...) {
2018-10-01 11:39:43 +02:00
x <- mo_validate(x = x, property = "fullname", ...)
2019-02-26 13:02:04 +01:00
mo_translate(x, language = language)
}
2018-09-05 10:51:46 +02:00
#' @rdname mo_property
2019-04-05 18:47:39 +02:00
#' @importFrom dplyr %>% mutate pull
2018-09-05 10:51:46 +02:00
#' @export
2018-11-05 13:20:32 +01:00
mo_shortname <- function(x, language = get_locale(), ...) {
2018-10-01 11:39:43 +02:00
dots <- list(...)
Becker <- dots$Becker
if (is.null(Becker)) {
Becker <- FALSE
}
Lancefield <- dots$Lancefield
if (is.null(Lancefield)) {
Lancefield <- FALSE
}
2019-02-26 12:33:26 +01:00
shorten <- function(x) {
# easiest: no transformations needed
x <- mo_fullname(x, language = "en")
# shorten for the ones that have a space: shorten first word and write out second word
shorten_these <- x %like% " " & !x %like% "Streptococcus group "
x[shorten_these] <- paste0(substr(x[shorten_these], 1, 1),
". ",
x[shorten_these] %>%
strsplit(" ", fixed = TRUE) %>%
unlist() %>%
.[2])
x
}
if (isFALSE(Becker) & isFALSE(Lancefield)) {
result <- shorten(x)
} else {
# get result without transformations
2018-10-01 11:39:43 +02:00
res1 <- AMR::as.mo(x, Becker = FALSE, Lancefield = FALSE, reference_df = dots$reference_df)
2019-02-26 12:33:26 +01:00
# and result with transformations
2018-10-01 11:39:43 +02:00
res2 <- suppressWarnings(AMR::as.mo(res1, ...))
2019-02-26 12:33:26 +01:00
if (res1 == res2
& !res1 %like% "^B_STRPT_GR") {
result <- shorten(x)
} else {
res2_fullname <- mo_fullname(res2, language = language)
res2_fullname[res2_fullname %like% " \\(CoNS\\)"] <- "CoNS"
res2_fullname[res2_fullname %like% " \\(CoPS\\)"] <- "CoPS"
res2_fullname[res2_fullname %like% " \\(KNS\\)"] <- "KNS"
res2_fullname[res2_fullname %like% " \\(KPS\\)"] <- "KPS"
res2_fullname[res2_fullname %like% " \\(CNS\\)"] <- "CNS"
res2_fullname[res2_fullname %like% " \\(CPS\\)"] <- "CPS"
res2_fullname <- gsub("Streptococcus (group|Gruppe|gruppe|groep|grupo|gruppo|groupe) (.)",
"G\\2S",
res2_fullname) # turn "Streptococcus group A" and "Streptococcus grupo A" to "GAS"
res2_fullname_vector <- res2_fullname[res2_fullname == mo_fullname(res1)]
res2_fullname[res2_fullname == mo_fullname(res1)] <- paste0(substr(mo_genus(res2_fullname_vector), 1, 1),
". ",
suppressWarnings(mo_species(res2_fullname_vector)))
if (sum(res1 == res2, na.rm = TRUE) > 0) {
res1[res1 == res2] <- paste0(substr(mo_genus(res1[res1 == res2]), 1, 1),
". ",
suppressWarnings(mo_species(res1[res1 == res2])))
}
res1[res1 != res2] <- res2_fullname
result <- as.character(res1)
2018-09-05 10:51:46 +02:00
}
}
2019-02-26 12:33:26 +01:00
2019-02-26 13:02:04 +01:00
mo_translate(result, language = language)
2018-09-05 10:51:46 +02:00
}
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2018-11-05 13:20:32 +01:00
mo_subspecies <- function(x, language = get_locale(), ...) {
2019-02-26 13:02:04 +01:00
mo_translate(mo_validate(x = x, property = "subspecies", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2018-11-05 13:20:32 +01:00
mo_species <- function(x, language = get_locale(), ...) {
2018-10-01 11:39:43 +02:00
mo_translate(mo_validate(x = x, property = "species", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2018-11-05 13:20:32 +01:00
mo_genus <- function(x, language = get_locale(), ...) {
2018-10-01 11:39:43 +02:00
mo_translate(mo_validate(x = x, property = "genus", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_family <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "family", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_order <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "order", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_class <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "class", ...), language = language)
2018-09-17 20:53:32 +02:00
}
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_phylum <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "phylum", ...), language = language)
2018-09-17 20:53:32 +02:00
}
2018-09-05 10:51:46 +02:00
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_kingdom <- function(x, language = get_locale(), ...) {
2019-04-09 10:34:40 +02:00
if (all(x %in% AMR::microorganisms$kingdom)) {
return(x)
}
x <- as.mo(x, language = "en", ...)
2019-04-05 18:47:39 +02:00
kngdm <- mo_validate(x = x, property = "kingdom", ...)
if (language != "en") {
2019-04-09 10:34:40 +02:00
kngdm[x == "UNKNOWN"] <- mo_translate(kngdm[x == "UNKNOWN"], language = language)
2019-04-05 18:47:39 +02:00
}
kngdm
}
#' @rdname mo_property
#' @export
2018-11-05 13:20:32 +01:00
mo_type <- function(x, language = get_locale(), ...) {
2018-11-09 13:11:54 +01:00
mo_translate(mo_validate(x = x, property = "kingdom", ...), language = language)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_locale(), ...) {
2019-04-05 18:47:39 +02:00
x.mo <- as.mo(x, language = "en", ...)
x.phylum <- mo_phylum(x.mo, language = "en")
2019-02-28 13:56:28 +01:00
x[x.phylum %in% c("Actinobacteria",
"Chloroflexi",
"Firmicutes",
"Tenericutes")] <- "Gram positive"
2019-02-18 02:33:37 +01:00
x[x != "Gram positive"] <- "Gram negative"
2019-04-05 18:47:39 +02:00
x[mo_kingdom(x.mo, language = "en") != "Bacteria"] <- NA_character_
2019-02-28 13:56:28 +01:00
x[x.mo == "B_GRAMP"] <- "Gram positive"
x[x.mo == "B_GRAMN"] <- "Gram negative"
2019-02-18 02:33:37 +01:00
mo_translate(x, language = language)
2018-10-01 11:39:43 +02:00
}
#' @rdname mo_property
#' @export
2018-11-09 13:11:54 +01:00
mo_ref <- function(x, ...) {
mo_validate(x = x, property = "ref", ...)
}
#' @rdname mo_property
#' @export
2018-11-09 13:11:54 +01:00
mo_authors <- function(x, ...) {
x <- mo_validate(x = x, property = "ref", ...)
2019-02-22 22:12:10 +01:00
# remove last 4 digits and presumably the comma and space that preceeds them
2018-11-09 13:11:54 +01:00
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)])
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
mo_year <- function(x, ...) {
x <- mo_validate(x = x, property = "ref", ...)
# get last 4 digits
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)])
2019-02-22 22:12:10 +01:00
suppressWarnings(as.integer(x))
}
#' @rdname mo_property
#' @export
mo_rank <- function(x, ...) {
mo_validate(x = x, property = "rank", ...)
}
2018-09-17 20:53:32 +02:00
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_taxonomy <- function(x, language = get_locale(), ...) {
2018-10-01 11:39:43 +02:00
x <- AMR::as.mo(x, ...)
2019-03-09 08:21:00 +01:00
base::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))
2018-09-17 20:53:32 +02:00
}
2019-02-20 00:04:48 +01:00
#' @rdname mo_property
2019-02-22 22:12:10 +01:00
#' @importFrom utils browseURL
2019-03-18 14:29:41 +01:00
#' @importFrom dplyr %>% left_join select mutate case_when
2019-02-20 00:04:48 +01:00
#' @export
2019-02-22 22:12:10 +01:00
mo_url <- function(x, open = FALSE, ...) {
2019-03-18 14:29:41 +01:00
mo <- AMR::as.mo(x = x, ... = ...)
df <- data.frame(mo, stringsAsFactors = FALSE) %>%
left_join(select(AMR::microorganisms, mo, source, species_id), by = "mo") %>%
mutate(url = case_when(source == "CoL" ~
paste0(gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE), "details/species/id/", species_id),
source == "DSMZ" ~
paste0(catalogue_of_life$url_DSMZ, "?bnu_no=", species_id, "#", species_id),
TRUE ~
NA_character_))
u <- df$url
names(u) <- mo_fullname(mo)
2019-02-22 22:12:10 +01:00
if (open == TRUE) {
if (length(u) > 1) {
2019-03-18 14:29:41 +01:00
warning("only the first URL will be opened, as `browseURL()` only suports one string.")
2019-02-22 22:12:10 +01:00
}
browseURL(u[1L])
}
2019-02-20 00:04:48 +01:00
u
}
2018-11-09 13:11:54 +01:00
#' @rdname mo_property
#' @importFrom data.table data.table as.data.table setkey
#' @export
mo_property <- function(x, property = 'fullname', language = get_locale(), ...) {
if (length(property) != 1L) {
stop("'property' must be of length 1.")
}
if (!property %in% colnames(AMR::microorganisms)) {
stop("invalid property: '", property, "' - use a column name of the `microorganisms` data set")
}
mo_translate(mo_validate(x = x, property = property, ...), language = language)
}
#' @importFrom dplyr %>% case_when
mo_translate <- function(x, language) {
if (is.null(language)) {
2018-11-05 13:20:32 +01:00
return(x)
}
if (language %in% c("en", "")) {
return(x)
}
supported <- c("en", "de", "nl", "es", "pt", "it", "fr")
if (!language %in% supported) {
stop("Unsupported language: '", language, "' - use one of: ", paste0("'", sort(supported), "'", collapse = ", "), call. = FALSE)
}
2018-11-09 13:11:54 +01:00
x_tobetranslated <- grepl(x = x,
2019-03-18 14:29:41 +01:00
pattern = "(Coagulase-negative Staphylococcus|Coagulase-positive Staphylococcus|Beta-haemolytic Streptococcus|unknown Gram negatives|unknown Gram positives|unknown name|unknown kingdom|unknown phylum|unknown class|unknown order|unknown family|unknown genus|unknown species|unknown subspecies|unknown rank|CoNS|CoPS|Gram negative|Gram positive|Bacteria|Fungi|Protozoa|biogroup|biotype|vegetative|group|Group)")
2018-11-09 13:11:54 +01:00
if (sum(x_tobetranslated, na.rm = TRUE) == 0) {
return(x)
}
# only translate the ones that need translation
x[x_tobetranslated] <- case_when(
# German
2018-11-09 13:11:54 +01:00
language == "de" ~ x[x_tobetranslated] %>%
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Koagulase-negative Staphylococcus", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Koagulase-positive Staphylococcus", ., fixed = TRUE) %>%
gsub("Beta-haemolytic Streptococcus", "Beta-h\u00e4molytischer Streptococcus", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("unknown Gram negatives", "unbekannte Gramnegativen", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "unbekannte Grampositiven", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "unbekannte Name", ., fixed = TRUE) %>%
gsub("unknown kingdom", "unbekanntes Reich", ., fixed = TRUE) %>%
gsub("unknown phylum", "unbekannter Stamm", ., fixed = TRUE) %>%
gsub("unknown class", "unbekannte Klasse", ., fixed = TRUE) %>%
gsub("unknown order", "unbekannte Ordnung", ., fixed = TRUE) %>%
gsub("unknown family", "unbekannte Familie", ., fixed = TRUE) %>%
gsub("unknown genus", "unbekannte Gattung", ., fixed = TRUE) %>%
gsub("unknown species", "unbekannte Art", ., fixed = TRUE) %>%
gsub("unknown subspecies", "unbekannte Unterart", ., fixed = TRUE) %>%
gsub("unknown rank", "unbekannter Rang", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("(CoNS)", "(KNS)", ., fixed = TRUE) %>%
gsub("(CoPS)", "(KPS)", ., fixed = TRUE) %>%
2018-09-24 23:33:29 +02:00
gsub("Gram negative", "Gramnegativ", ., fixed = TRUE) %>%
gsub("Gram positive", "Grampositiv", ., fixed = TRUE) %>%
gsub("Bacteria", "Bakterien", ., fixed = TRUE) %>%
gsub("Fungi", "Hefen/Pilze", ., fixed = TRUE) %>%
gsub("Protozoa", "Protozoen", ., fixed = TRUE) %>%
gsub("biogroup", "Biogruppe", ., fixed = TRUE) %>%
gsub("biotype", "Biotyp", ., fixed = TRUE) %>%
gsub("vegetative", "vegetativ", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1Gruppe", .) %>%
2018-11-09 13:11:54 +01:00
gsub("([([ ]*?)Group", "\\1Gruppe", .) %>%
iconv(to = "UTF-8"),
# Dutch
2018-11-09 13:11:54 +01:00
language == "nl" ~ x[x_tobetranslated] %>%
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Coagulase-negatieve Staphylococcus", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Coagulase-positieve Staphylococcus", ., fixed = TRUE) %>%
gsub("Beta-haemolytic Streptococcus", "Beta-hemolytische Streptococcus", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("unknown Gram negatives", "onbekende Gram-negatieven", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "onbekende Gram-positieven", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "onbekende naam", ., fixed = TRUE) %>%
gsub("unknown kingdom", "onbekend koninkrijk", ., fixed = TRUE) %>%
gsub("unknown phylum", "onbekende fylum", ., fixed = TRUE) %>%
gsub("unknown class", "onbekende klasse", ., fixed = TRUE) %>%
gsub("unknown order", "onbekende orde", ., fixed = TRUE) %>%
gsub("unknown family", "onbekende familie", ., fixed = TRUE) %>%
gsub("unknown genus", "onbekend geslacht", ., fixed = TRUE) %>%
gsub("unknown species", "onbekende soort", ., fixed = TRUE) %>%
gsub("unknown subspecies", "onbekende ondersoort", ., fixed = TRUE) %>%
gsub("unknown rank", "onbekende rang", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("(CoNS)", "(CNS)", ., fixed = TRUE) %>%
gsub("(CoPS)", "(CPS)", ., fixed = TRUE) %>%
2018-09-24 23:33:29 +02:00
gsub("Gram negative", "Gram-negatief", ., fixed = TRUE) %>%
gsub("Gram positive", "Gram-positief", ., fixed = TRUE) %>%
gsub("Bacteria", "Bacteri\u00ebn", ., fixed = TRUE) %>%
gsub("Fungi", "Schimmels/gisten", ., fixed = TRUE) %>%
gsub("Protozoa", "protozo\u00ebn", ., fixed = TRUE) %>%
gsub("biogroup", "biogroep", ., fixed = TRUE) %>%
# gsub("biotype", "biotype", ., fixed = TRUE) %>%
gsub("vegetative", "vegetatief", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1groep", .) %>%
2018-11-09 13:11:54 +01:00
gsub("([([ ]*?)Group", "\\1Groep", .) %>%
iconv(to = "UTF-8"),
# Spanish
2018-11-09 13:11:54 +01:00
language == "es" ~ x[x_tobetranslated] %>%
2019-03-26 14:24:03 +01:00
# not 'negativa'
# https://www.sciencedirect.com/science/article/pii/S0123939215000739
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Staphylococcus coagulasa negativo", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Staphylococcus coagulasa positivo", ., fixed = TRUE) %>%
gsub("Beta-haemolytic Streptococcus", "Streptococcus Beta-hemol\u00edtico", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("unknown Gram negatives", "Gram negativos desconocidos", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "Gram positivos desconocidos", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "nombre desconocido", ., fixed = TRUE) %>%
gsub("unknown kingdom", "reino desconocido", ., fixed = TRUE) %>%
gsub("unknown phylum", "filo desconocido", ., fixed = TRUE) %>%
gsub("unknown class", "clase desconocida", ., fixed = TRUE) %>%
gsub("unknown order", "orden desconocido", ., fixed = TRUE) %>%
gsub("unknown family", "familia desconocida", ., fixed = TRUE) %>%
gsub("unknown genus", "g\u00e9nero desconocido", ., fixed = TRUE) %>%
gsub("unknown species", "especie desconocida", ., fixed = TRUE) %>%
gsub("unknown subspecies", "subespecie desconocida", ., fixed = TRUE) %>%
gsub("unknown rank", "rango desconocido", ., fixed = TRUE) %>%
2019-03-26 14:24:03 +01:00
gsub("(CoNS)", "(SCN)", ., fixed = TRUE) %>%
gsub("(CoPS)", "(SCP)", ., fixed = TRUE) %>%
2018-09-24 23:33:29 +02:00
gsub("Gram negative", "Gram negativo", ., fixed = TRUE) %>%
gsub("Gram positive", "Gram positivo", ., fixed = TRUE) %>%
gsub("Bacteria", "Bacterias", ., fixed = TRUE) %>%
gsub("Fungi", "Hongos", ., fixed = TRUE) %>%
gsub("Protozoa", "Protozoarios", ., fixed = TRUE) %>%
gsub("biogroup", "biogrupo", ., fixed = TRUE) %>%
gsub("biotype", "biotipo", ., fixed = TRUE) %>%
gsub("vegetative", "vegetativo", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1grupo", .) %>%
2018-11-09 13:11:54 +01:00
gsub("([([ ]*?)Group", "\\1Grupo", .) %>%
iconv(to = "UTF-8"),
# Italian
2018-11-09 13:11:54 +01:00
language == "it" ~ x[x_tobetranslated] %>%
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Staphylococcus negativo coagulasi", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Staphylococcus positivo coagulasi", ., fixed = TRUE) %>%
gsub("Beta-haemolytic Streptococcus", "Streptococcus Beta-emolitico", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("unknown Gram negatives", "Gram negativi sconosciuti", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "Gram positivi sconosciuti", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "nome sconosciuto", ., fixed = TRUE) %>%
gsub("unknown kingdom", "regno sconosciuto", ., fixed = TRUE) %>%
gsub("unknown phylum", "phylum sconosciuto", ., fixed = TRUE) %>%
gsub("unknown class", "classe sconosciuta", ., fixed = TRUE) %>%
gsub("unknown order", "ordine sconosciuto", ., fixed = TRUE) %>%
gsub("unknown family", "famiglia sconosciuta", ., fixed = TRUE) %>%
gsub("unknown genus", "genere sconosciuto", ., fixed = TRUE) %>%
gsub("unknown species", "specie sconosciute", ., fixed = TRUE) %>%
gsub("unknown subspecies", "sottospecie sconosciute", ., fixed = TRUE) %>%
gsub("unknown rank", "grado sconosciuto", ., fixed = TRUE) %>%
2018-09-24 23:33:29 +02:00
gsub("Gram negative", "Gram negativo", ., fixed = TRUE) %>%
gsub("Gram positive", "Gram positivo", ., fixed = TRUE) %>%
gsub("Bacteria", "Batteri", ., fixed = TRUE) %>%
gsub("Fungi", "Fungo", ., fixed = TRUE) %>%
gsub("Protozoa", "Protozoi", ., fixed = TRUE) %>%
gsub("biogroup", "biogruppo", ., fixed = TRUE) %>%
gsub("biotype", "biotipo", ., fixed = TRUE) %>%
gsub("vegetative", "vegetativo", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1gruppo", .) %>%
gsub("([([ ]*?)Group", "\\1Gruppo", .),
# French
2018-11-09 13:11:54 +01:00
language == "fr" ~ x[x_tobetranslated] %>%
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Staphylococcus \u00e0 coagulase n\u00e9gative", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Staphylococcus \u00e0 coagulase positif", ., fixed = TRUE) %>%
gsub("Beta-haemolytic Streptococcus", "Streptococcus B\u00eata-h\u00e9molytique", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("unknown Gram negatives", "Gram n\u00e9gatifs inconnus", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "Gram positifs inconnus", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "nom inconnu", ., fixed = TRUE) %>%
gsub("unknown kingdom", "r\u00e8gme inconnu", ., fixed = TRUE) %>%
gsub("unknown phylum", "embranchement inconnu", ., fixed = TRUE) %>%
gsub("unknown class", "classe inconnue", ., fixed = TRUE) %>%
gsub("unknown order", "ordre inconnu", ., fixed = TRUE) %>%
gsub("unknown family", "famille inconnue", ., fixed = TRUE) %>%
gsub("unknown genus", "genre inconnu", ., fixed = TRUE) %>%
gsub("unknown species", "esp\u00e8ce inconnue", ., fixed = TRUE) %>%
gsub("unknown subspecies", "sous-esp\u00e8ce inconnue", ., fixed = TRUE) %>%
gsub("unknown rank", "rang inconnu", ., fixed = TRUE) %>%
2018-09-24 23:33:29 +02:00
gsub("Gram negative", "Gram n\u00e9gatif", ., fixed = TRUE) %>%
gsub("Gram positive", "Gram positif", ., fixed = TRUE) %>%
gsub("Bacteria", "Bact\u00e9ries", ., fixed = TRUE) %>%
gsub("Fungi", "Champignons", ., fixed = TRUE) %>%
gsub("Protozoa", "Protozoaires", ., fixed = TRUE) %>%
gsub("biogroup", "biogroupe", ., fixed = TRUE) %>%
# gsub("biotype", "biotype", ., fixed = TRUE) %>%
gsub("vegetative", "v\u00e9g\u00e9tatif", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1groupe", .) %>%
2018-11-09 13:11:54 +01:00
gsub("([([ ]*?)Group", "\\1Groupe", .) %>%
iconv(to = "UTF-8"),
2018-11-05 13:20:32 +01:00
# Portuguese
2018-11-09 13:11:54 +01:00
language == "pt" ~ x[x_tobetranslated] %>%
2019-03-18 14:29:41 +01:00
gsub("Coagulase-negative Staphylococcus","Staphylococcus coagulase negativo", ., fixed = TRUE) %>%
gsub("Coagulase-positive Staphylococcus","Staphylococcus coagulase positivo", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("Beta-haemolytic Streptococcus", "Streptococcus Beta-hemol\u00edtico", ., fixed = TRUE) %>%
gsub("unknown Gram negatives", "Gram negativos desconhecidos", ., fixed = TRUE) %>%
gsub("unknown Gram positives", "Gram positivos desconhecidos", ., fixed = TRUE) %>%
2019-03-02 22:47:04 +01:00
gsub("unknown name", "nome desconhecido", ., fixed = TRUE) %>%
gsub("unknown kingdom", "reino desconhecido", ., fixed = TRUE) %>%
gsub("unknown phylum", "filo desconhecido", ., fixed = TRUE) %>%
gsub("unknown class", "classe desconhecida", ., fixed = TRUE) %>%
gsub("unknown order", "ordem desconhecido", ., fixed = TRUE) %>%
gsub("unknown family", "fam\u00edlia desconhecida", ., fixed = TRUE) %>%
gsub("unknown genus", "g\u00eanero desconhecido", ., fixed = TRUE) %>%
gsub("unknown species", "esp\u00e9cies desconhecida", ., fixed = TRUE) %>%
gsub("unknown subspecies", "subesp\u00e9cies desconhecida", ., fixed = TRUE) %>%
gsub("unknown rank", "classifica\u00e7\u00e3o desconhecido", ., fixed = TRUE) %>%
2018-11-05 13:20:32 +01:00
gsub("Gram negative", "Gram negativo", ., fixed = TRUE) %>%
gsub("Gram positive", "Gram positivo", ., fixed = TRUE) %>%
gsub("Bacteria", "Bact\u00e9rias", ., fixed = TRUE) %>%
gsub("Fungi", "Fungos", ., fixed = TRUE) %>%
gsub("Protozoa", "Protozo\u00e1rios", ., fixed = TRUE) %>%
gsub("biogroup", "biogrupo", ., fixed = TRUE) %>%
gsub("biotype", "bi\u00f3tipo", ., fixed = TRUE) %>%
gsub("vegetative", "vegetativo", ., fixed = TRUE) %>%
gsub("([([ ]*?)group", "\\1grupo", .) %>%
2018-11-09 13:11:54 +01:00
gsub("([([ ]*?)Group", "\\1Grupo", .) %>%
iconv(to = "UTF-8"))
2018-11-09 13:11:54 +01:00
x
}
2018-10-01 11:39:43 +02:00
mo_validate <- function(x, property, ...) {
dots <- list(...)
Becker <- dots$Becker
if (is.null(Becker)) {
Becker <- FALSE
}
Lancefield <- dots$Lancefield
if (is.null(Lancefield)) {
Lancefield <- FALSE
}
2018-12-06 14:36:39 +01:00
if (!"AMR" %in% base::.packages()) {
library("AMR")
2019-02-18 02:33:37 +01:00
# check onLoad() in R/zzz.R: data tables are created there.
2018-12-06 14:36:39 +01:00
}
2019-03-26 14:24:03 +01:00
# try to catch an error when inputting an invalid parameter
# so the call can be set to FALSE
tryCatch(x[1L] %in% AMR::microorganisms[1, property],
error = function(e) stop(e$message, call. = FALSE))
if (!all(x %in% AMR::microorganisms[, property])
2018-10-31 12:10:49 +01:00
| Becker %in% c(TRUE, "all")
| Lancefield %in% c(TRUE, "all")) {
2018-10-01 11:39:43 +02:00
exec_as.mo(x, property = property, ...)
} else {
if (property == "mo") {
return(structure(x, class = "mo"))
} else {
return(x)
}
}
}