diff --git a/R/mo.R b/R/mo.R index 6cfd0561..cc506973 100644 --- a/R/mo.R +++ b/R/mo.R @@ -146,7 +146,7 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) { if (identical(x_trimmed[i], "")) { # empty values x[i] <- NA - failures <- c(failures, x_backup[i]) + #failures <- c(failures, x_backup[i]) next } if (x_backup[i] %in% AMR::microorganisms$mo) { diff --git a/R/mo_property.R b/R/mo_property.R index 93dfc33d..2dc4f308 100644 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -28,6 +28,7 @@ #' #' [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 +#' @return Character or logical (only \code{mo_aerobic}) #' @export #' @importFrom dplyr %>% left_join pull #' @seealso \code{\link{microorganisms}} @@ -36,7 +37,7 @@ #' mo_family("E. coli") # "Enterobacteriaceae" #' mo_genus("E. coli") # "Escherichia" #' mo_species("E. coli") # "coli" -#' mo_subspecies("E. coli") # +#' mo_subspecies("E. coli") # "" #' mo_fullname("E. coli") # "Escherichia coli" #' mo_shortname("E. coli") # "E. coli" #' mo_type("E. coli") # "Bacteria" @@ -84,27 +85,32 @@ #' #' #' # Becker classification, see ?as.mo -#' mo_fullname("S. epidermidis") # "Staphylococcus epidermidis" -#' mo_fullname("S. epidermidis", Becker = TRUE) # "Coagulase Negative Staphylococcus (CoNS)" -#' mo_shortname("S. epidermidis") # "S. epidermidis" -#' mo_shortname("S. epidermidis", Becker = TRUE) # "CoNS" +#' mo_fullname("S. epi") # "Staphylococcus epidermidis" +#' mo_fullname("S. epi", Becker = TRUE) # "Coagulase Negative Staphylococcus (CoNS)" +#' mo_shortname("S. epi") # "S. epidermidis" +#' mo_shortname("S. epi", Becker = TRUE) # "CoNS" #' #' # Lancefield classification, see ?as.mo -#' mo_fullname("S. pyogenes") # "Streptococcus pyogenes" -#' mo_fullname("S. pyogenes", Lancefield = TRUE) # "Streptococcus group A" -#' mo_shortname("S. pyogenes") # "S. pyogenes" -#' mo_shortname("S. pyogenes", Lancefield = TRUE) # "GAS" +#' mo_fullname("S. pyo") # "Streptococcus pyogenes" +#' mo_fullname("S. pyo", Lancefield = TRUE) # "Streptococcus group A" +#' mo_shortname("S. pyo") # "S. pyogenes" +#' mo_shortname("S. pyo", Lancefield = TRUE) # "GAS" 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 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) %>% + result1 <- as.mo(x = x, Becker = Becker, Lancefield = Lancefield) # this will give a warning if x cannot be coerced + result2 <- suppressWarnings( + data.frame(mo = result1, stringsAsFactors = FALSE) %>% left_join(AMR::microorganisms, by = "mo") %>% pull(property) ) + if (property != "aerobic") { + # will else not retain logical class + result2[x %in% c("", NA) | result2 %in% c("", NA, "(no MO)")] <- "" + } + result2 } #' @rdname mo_property @@ -142,7 +148,7 @@ mo_fullname <- function(x, Becker = FALSE, Lancefield = FALSE) { mo_shortname <- function(x, Becker = FALSE, Lancefield = FALSE) { if (Becker %in% c(TRUE, "all") | Lancefield == TRUE) { res1 <- as.mo(x) - res2 <- as.mo(x, Becker = Becker, Lancefield = Lancefield) + res2 <- suppressWarnings(as.mo(x, Becker = Becker, Lancefield = Lancefield)) res2_fullname <- mo_fullname(res2) res2_fullname[res2_fullname %like% "\\(CoNS\\)"] <- "CoNS" res2_fullname[res2_fullname %like% "\\(CoPS\\)"] <- "CoPS" @@ -151,18 +157,20 @@ mo_shortname <- function(x, Becker = FALSE, Lancefield = FALSE) { res2_fullname) # turn "Streptococcus group A" to "GAS" res2_fullname[res2_fullname == mo_fullname(x)] <- paste0(substr(mo_genus(res2_fullname), 1, 1), ". ", - mo_species(res2_fullname)) + suppressWarnings(mo_species(res2_fullname))) if (sum(res1 == res2, na.rm = TRUE) > 0) { res1[res1 == res2] <- paste0(substr(mo_genus(res1[res1 == res2]), 1, 1), ". ", - mo_species(res1[res1 == res2])) + suppressWarnings(mo_species(res1[res1 == res2]))) } res1[res1 != res2] <- res2_fullname - as.character(res1) + result <- as.character(res1) } else { # return G. species - paste0(substr(mo_genus(x), 1, 1), ". ", mo_species(x)) + result <- paste0(substr(mo_genus(x), 1, 1), ". ", suppressWarnings(mo_species(x))) } + result[result %in% c(". ")] <- "" + result } diff --git a/man/mo_property.Rd b/man/mo_property.Rd index 90c04468..2b32bd4b 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -54,6 +54,9 @@ mo_aerobic(x) \item{language}{language of the returned text, either one of \code{"en"} (English), \code{"de"} (German) or \code{"nl"} (Dutch)} } +\value{ +Character or logical (only \code{mo_aerobic}) +} \description{ 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}}. } @@ -62,7 +65,7 @@ Use these functions to return a specific property of a microorganism from the \c mo_family("E. coli") # "Enterobacteriaceae" mo_genus("E. coli") # "Escherichia" mo_species("E. coli") # "coli" -mo_subspecies("E. coli") # +mo_subspecies("E. coli") # "" mo_fullname("E. coli") # "Escherichia coli" mo_shortname("E. coli") # "E. coli" mo_type("E. coli") # "Bacteria" @@ -110,16 +113,16 @@ 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)" -mo_shortname("S. epidermidis") # "S. epidermidis" -mo_shortname("S. epidermidis", Becker = TRUE) # "CoNS" +mo_fullname("S. epi") # "Staphylococcus epidermidis" +mo_fullname("S. epi", Becker = TRUE) # "Coagulase Negative Staphylococcus (CoNS)" +mo_shortname("S. epi") # "S. epidermidis" +mo_shortname("S. epi", Becker = TRUE) # "CoNS" # Lancefield classification, see ?as.mo -mo_fullname("S. pyogenes") # "Streptococcus pyogenes" -mo_fullname("S. pyogenes", Lancefield = TRUE) # "Streptococcus group A" -mo_shortname("S. pyogenes") # "S. pyogenes" -mo_shortname("S. pyogenes", Lancefield = TRUE) # "GAS" +mo_fullname("S. pyo") # "Streptococcus pyogenes" +mo_fullname("S. pyo", Lancefield = TRUE) # "Streptococcus group A" +mo_shortname("S. pyo") # "S. pyogenes" +mo_shortname("S. pyo", Lancefield = TRUE) # "GAS" } \seealso{ \code{\link{microorganisms}} diff --git a/tests/testthat/test-mo_property.R b/tests/testthat/test-mo_property.R index d17a9ac6..f3e77946 100644 --- a/tests/testthat/test-mo_property.R +++ b/tests/testthat/test-mo_property.R @@ -4,7 +4,7 @@ test_that("mo_property works", { expect_equal(mo_family("E. coli"), "Enterobacteriaceae") expect_equal(mo_genus("E. coli"), "Escherichia") expect_equal(mo_species("E. coli"), "coli") - expect_equal(mo_subspecies("E. coli"), NA_character_) + expect_equal(mo_subspecies("E. coli"), "") expect_equal(mo_fullname("E. coli"), "Escherichia coli") expect_equal(mo_type("E. coli"), "Bacteria") expect_equal(mo_gramstain("E. coli"), "Negative rods")