2018-08-28 13:51:13 +02:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
2018-08-28 13:51:13 +02:00
# #
# 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) #
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. #
# #
# 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. #
2018-08-28 13:51:13 +02:00
# ==================================================================== #
#' Property of a microorganism
#'
2018-09-04 11:33:30 +02:00
#' 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.
2018-10-09 13:53:33 +02:00
#' @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
2018-08-28 13:51:13 +02:00
#' @rdname mo_property
2018-09-08 16:06:47 +02:00
#' @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}
#' }
2018-08-28 13:51:13 +02:00
#' @export
#' @seealso \code{\link{microorganisms}}
2019-01-02 23:24:07 +01:00
#' @inheritSection AMR Read more on our website!
2018-08-28 13:51:13 +02:00
#' @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"
2018-09-04 11:33:30 +02:00
#' 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
2018-09-04 11:33:30 +02:00
#' 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
2018-08-28 13:51:13 +02:00
#'
#'
2018-09-04 11:33:30 +02:00
#' # 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"
2018-08-28 13:51:13 +02:00
#'
2018-09-04 11:33:30 +02:00
#' mo_genus("VISA") # "Staphylococcus"
#' mo_species("VISA") # "aureus"
2018-08-28 13:51:13 +02:00
#'
#'
#' # Known subspecies
2018-09-04 11:33:30 +02:00
#' mo_genus("doylei") # "Campylobacter"
#' mo_species("doylei") # "jejuni"
2018-09-24 23:33:29 +02:00
#' mo_fullname("doylei") # "Campylobacter jejuni doylei"
2018-09-04 11:33:30 +02:00
#'
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"
2018-08-28 13:51:13 +02:00
#'
#'
2018-09-04 11:33:30 +02:00
#' # 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"
2018-09-04 11:33:30 +02:00
#'
#' # 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')
2018-09-08 16:06:47 +02:00
#'
#'
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-09-08 16:06:47 +02:00
#'
2018-11-09 13:11:54 +01:00
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain official
#' 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",
2018-09-08 16:06:47 +02:00
#' Lancefield = TRUE,
#' language = "de") # "Streptococcus Gruppe A"
2018-09-09 12:11:44 +02:00
#' mo_fullname("S. pyogenes",
2018-09-08 16:06:47 +02:00
#' 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-08-28 13:51:13 +02:00
}
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
2018-08-28 13:51:13 +02:00
#' @rdname mo_property
#' @export
2019-03-09 08:21:00 +01:00
mo_kingdom <- function ( x , language = get_locale ( ) , ... ) {
2019-04-05 18:47:39 +02:00
kngdm <- mo_validate ( x = x , property = " kingdom" , ... )
if ( language != " en" ) {
unknowns <- as.mo ( x , ... ) == " UNKOWN"
kngdm [unknowns ] <- mo_translate ( kngdm [unknowns ] , language = language )
}
kngdm
2018-08-28 13:51:13 +02:00
}
#' @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-02-18 02:33:37 +01:00
x.bak <- x
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" , ... )
2018-08-28 13:51:13 +02:00
}
2018-09-08 16:06:47 +02:00
#' @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-08 16:06:47 +02:00
}
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 )
}
2018-09-08 16:06:47 +02:00
#' @importFrom dplyr %>% case_when
mo_translate <- function ( x , language ) {
if ( is.null ( language ) ) {
2018-11-05 13:20:32 +01:00
return ( x )
2018-09-04 11:33:30 +02:00
}
2018-09-08 16:06:47 +02:00
if ( language %in% c ( " en" , " " ) ) {
return ( x )
}
2018-09-10 15:45:25 +02:00
supported <- c ( " en" , " de" , " nl" , " es" , " pt" , " it" , " fr" )
2018-09-08 16:06:47 +02:00
if ( ! language %in% supported ) {
2018-09-10 15:45:25 +02:00
stop ( " Unsupported language: '" , language , " ' - use one of: " , paste0 ( " '" , sort ( supported ) , " '" , collapse = " , " ) , call. = FALSE )
2018-09-08 16:06:47 +02:00
}
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 (
2018-09-08 16:06:47 +02:00
# 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 ) %>%
2018-09-10 11:40:54 +02:00
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 ) %>%
2018-09-08 16:06:47 +02:00
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" ) ,
2018-09-08 16:06:47 +02:00
# 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 ) %>%
2018-09-10 11:40:54 +02:00
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 ) %>%
2018-09-08 16:06:47 +02:00
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" ) ,
2018-09-08 16:06:47 +02:00
# 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 ) %>%
2018-09-10 11:40:54 +02:00
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 ) %>%
2018-09-08 16:06:47 +02:00
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" ) ,
2018-09-08 16:06:47 +02:00
2018-09-10 15:45:25 +02:00
# 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 ) %>%
2018-09-10 15:45:25 +02:00
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 ) %>%
2018-09-10 15:45:25 +02:00
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 ) %>%
2018-09-10 15:45:25 +02:00
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 ) %>%
2018-09-10 15:45:25 +02:00
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-09-10 15:45:25 +02:00
2018-11-09 13:11:54 +01:00
x
2018-09-08 16:06:47 +02:00
}
2018-09-27 23:23:48 +02:00
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 , ... )
2018-09-27 23:23:48 +02:00
} else {
2019-01-08 16:23:45 +01:00
if ( property == " mo" ) {
return ( structure ( x , class = " mo" ) )
} else {
return ( x )
}
2018-09-27 23:23:48 +02:00
}
}