Support for German and Spanish microorganism properties, cleanup

2025-07-09 02:03:04 +02:00 · 2018-09-04 11:33:30 +02:00
parent 5405002119
commit b388e3fee7
20 changed files with 256 additions and 157 deletions
--- a/R/mo_property.R
+++ b/R/mo_property.R
@ -18,59 +18,80 @@

 #' Property of a microorganism
 #'
-#' Use these functions to return a specific property of a microorganism from the \code{\link{microorganisms}} data set, based on their \code{mo}. Get such an ID with \code{\link{as.mo}}.
-#' @param x a (vector of a) valid \code{\link{mo}} or any text that can be coerced to a valid microorganism code with \code{\link{as.mo}}
+#' 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}}
 #' @param property one of the column names of one of the \code{\link{microorganisms}} data set, like \code{"mo"}, \code{"bactsys"}, \code{"family"}, \code{"genus"}, \code{"species"}, \code{"fullname"}, \code{"gramstain"} and \code{"aerobic"}
+#' @inheritParams as.mo
+#' @param language language of the returned text, either one of \code{"en"} (English), \code{"de"} (German) or \code{"nl"} (Dutch)
+#' @source
+#' [1] Becker K \emph{et al.} \strong{Coagulase-Negative Staphylococci}. 2014. Clin Microbiol Rev. 27(4): 870–926. \url{https://dx.doi.org/10.1128/CMR.00109-13}
+#'
+#' [2] Lancefield RC \strong{A serological differentiation of human and other groups of hemolytic streptococci}. 1933. J Exp Med. 57(4): 571–95. \url{https://dx.doi.org/10.1084/jem.57.4.571}
 #' @rdname mo_property
 #' @export
 #' @importFrom dplyr %>% left_join pull
 #' @seealso \code{\link{microorganisms}}
 #' @examples
 #' # All properties
-#' mo_family("E. coli")       # Enterobacteriaceae
-#' mo_genus("E. coli")        # Escherichia
-#' mo_species("E. coli")      # coli
-#' mo_subspecies("E. coli")   # <NA>
-#' mo_fullname("E. coli")     # Escherichia coli
-#' mo_type("E. coli")         # Bacteria
-#' mo_gramstain("E. coli")    # Negative rods
-#' mo_aerobic("E. coli")      # TRUE
-#' mo_type_nl("E. coli")      # Bacterie
-#' mo_gramstain_nl("E. coli") # Negatieve staven
+#' mo_family("E. coli")          # "Enterobacteriaceae"
+#' mo_genus("E. coli")           # "Escherichia"
+#' mo_species("E. coli")         # "coli"
+#' mo_subspecies("E. coli")      # <NA>
+#' mo_fullname("E. coli")        # "Escherichia coli"
+#' mo_type("E. coli")            # "Bacteria"
+#' mo_gramstain("E. coli")       # "Negative rods"
+#' mo_aerobic("E. coli")         # TRUE
+#'
+#' # language support for Spanish, German and Dutch
+#' mo_type("E. coli", "es")      # "Bakteria"
+#' mo_type("E. coli", "de")      # "Bakterien"
+#' mo_type("E. coli", "nl")      # "Bacterie"
+#' mo_gramstain("E. coli", "es") # "Bacilos negativos"
+#' mo_gramstain("E. coli", "de") # "Negative Staebchen"
+#' mo_gramstain("E. coli", "nl") # "Negatieve staven"
 #'
 #'
 #' # Abbreviations known in the field
-#' mo_genus("EHEC")           # Escherichia
-#' mo_species("EHEC")         # coli
-#' mo_subspecies("EHEC")      # EHEC
-#' mo_fullname("EHEC")        # Escherichia coli (EHEC)
+#' mo_genus("MRSA")              # "Staphylococcus"
+#' mo_species("MRSA")            # "aureus"
+#' mo_gramstain("MRSA")          # "Positive cocci"
 #'
-#' mo_genus("MRSA")           # Staphylococcus
-#' mo_species("MRSA")         # aureus
-#' mo_gramstain("MRSA")       # Positive cocci
-#'
-#' mo_genus("VISA")           # Staphylococcus
-#' mo_species("VISA")         # aureus
+#' mo_genus("VISA")              # "Staphylococcus"
+#' mo_species("VISA")            # "aureus"
 #'
 #'
 #' # Known subspecies
-#' mo_genus("doylei")         # Campylobacter
-#' mo_species("doylei")       # jejuni
-#' mo_fullname("doylei")      # Campylobacter jejuni (doylei)
+#' mo_genus("EHEC")              # "Escherichia"
+#' mo_species("EHEC")            # "coli"
+#' mo_subspecies("EHEC")         # "EHEC"
+#' mo_fullname("EHEC")           # "Escherichia coli (EHEC)"
+#'
+#' mo_genus("doylei")            # "Campylobacter"
+#' mo_species("doylei")          # "jejuni"
+#' mo_fullname("doylei")         # "Campylobacter jejuni (doylei)"
+#'
+#' mo_fullname("K. pneu rh")     # "Klebsiella pneumoniae (rhinoscleromatis)"
 #'
 #'
 #' # Anaerobic bacteria
-#' mo_genus("B. fragilis")    # Bacteroides
-#' mo_species("B. fragilis")  # fragilis
-#' mo_aerobic("B. fragilis")  # FALSE
-mo_property <- function(x, property = 'fullname') {
-  property <- property[1]
+#' mo_genus("B. fragilis")       # "Bacteroides"
+#' mo_species("B. fragilis")     # "fragilis"
+#' mo_aerobic("B. fragilis")     # FALSE
+#'
+#'
+#' # Becker classification, see ?as.mo
+#' mo_fullname("S. epidermidis")                 # "Staphylococcus epidermidis"
+#' mo_fullname("S. epidermidis", Becker = TRUE)  # "Coagulase Negative Staphylococcus (CoNS)"
+#'
+#' # Lancefield classification, see ?as.mo
+#' mo_fullname("S. pyogenes")                    # "Streptococcus pyogenes"
+#' mo_fullname("S. pyogenes", Lancefield = TRUE) # "Streptococcus group A"
+mo_property <- function(x, property = 'fullname', Becker = FALSE, Lancefield = FALSE) {
+  property <- tolower(property[1])
  if (!property %in% colnames(microorganisms)) {
-    stop("invalid property: ", property, " - use a column name of `microorganisms`")
-  }
-  if (!is.mo(x)) {
-    x <- as.mo(x) # this will give a warning if x cannot be coerced
+    stop("invalid property: ", property, " - use a column name of the `microorganisms` data set")
  }
+  x <- as.mo(x = x, Becker = Becker, Lancefield = Lancefield) # this will give a warning if x cannot be coerced
  suppressWarnings(
    data.frame(mo = x, stringsAsFactors = FALSE) %>%
      left_join(AMR::microorganisms, by = "mo") %>%
@ -92,32 +113,32 @@ mo_genus <- function(x) {

 #' @rdname mo_property
 #' @export
-mo_species <- function(x) {
-  mo_property(x, "species")
+mo_species <- function(x, Becker = FALSE, Lancefield = FALSE) {
+  mo_property(x, "species", Becker = Becker, Lancefield = Lancefield)
 }

 #' @rdname mo_property
 #' @export
-mo_subspecies <- function(x) {
-  mo_property(x, "subspecies")
+mo_subspecies <- function(x, Becker = FALSE, Lancefield = FALSE) {
+  mo_property(x, "subspecies", Becker = Becker, Lancefield = Lancefield)
 }

 #' @rdname mo_property
 #' @export
-mo_fullname <- function(x) {
-  mo_property(x, "fullname")
+mo_fullname <- function(x, Becker = FALSE, Lancefield = FALSE) {
+  mo_property(x, "fullname", Becker = Becker, Lancefield = Lancefield)
 }

 #' @rdname mo_property
 #' @export
-mo_type <- function(x) {
-  mo_property(x, "type")
+mo_type <- function(x, language = "en") {
+  mo_property(x, paste0("type", checklang(language)))
 }

 #' @rdname mo_property
 #' @export
-mo_gramstain <- function(x) {
-  mo_property(x, "gramstain")
+mo_gramstain <- function(x, language = "en") {
+  mo_property(x, paste0("gramstain", checklang(language)))
 }

 #' @rdname mo_property
@ -126,14 +147,15 @@ mo_aerobic <- function(x) {
  mo_property(x, "aerobic")
 }

-#' @rdname mo_property
-#' @export
-mo_type_nl <- function(x) {
-  mo_property(x, "type_nl")
-}
-
-#' @rdname mo_property
-#' @export
-mo_gramstain_nl <- function(x) {
-  mo_property(x, "gramstain_nl")
+checklang <- function(language) {
+  language <- tolower(language[1])
+  supported <- c("en", "de", "nl", "es")
+  if (!language %in% c(NULL, "", supported)) {
+    stop("invalid language: ", language, " - use one of ", paste0("'", sort(supported), "'", collapse = ", "), call. = FALSE)
+  }
+  if (language %in% c(NULL, "", "en")) {
+    ""
+  } else {
+    paste0("_", language)
+  }
 }