mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 11:41:58 +02:00
(v0.7.0.9005) ab algorithm update
This commit is contained in:
32
R/ab.R
32
R/ab.R
@ -70,15 +70,15 @@ as.ab <- function(x) {
|
||||
|
||||
x_bak <- x
|
||||
# remove suffices
|
||||
x_bak_clean <- gsub("_(mic|rsi|disk|disc)$", "", x, ignore.case = TRUE)
|
||||
x_bak_clean <- gsub("_(mic|rsi|dis[ck])$", "", x, ignore.case = TRUE)
|
||||
# remove disk concentrations, like LVX_NM -> LVX
|
||||
x_bak_clean <- gsub("_[A-Z]{2}[0-9_]{0,3}$", "", x_bak_clean, ignore.case = TRUE)
|
||||
# clean rest of it
|
||||
x_bak_clean <- gsub("[^A-Z0-9/-]", "", x_bak_clean, ignore.case = TRUE)
|
||||
# keep only a-z when it's not an ATC code or only numbers
|
||||
x_bak_clean[!x_bak_clean %like% "^([A-Z][0-9]{2}[A-Z]{2}[0-9]{2}|[0-9]+)$"] <- gsub("[^a-zA-Z]+",
|
||||
"",
|
||||
x_bak_clean[!x_bak_clean %like% "^([A-Z][0-9]{2}[A-Z]{2}[0-9]{2}|[0-9]+)$"])
|
||||
# remove part between brackets if that's followed by another string
|
||||
x_bak_clean <- gsub("(.*)+ [(].*[)]", "\\1", x_bak_clean)
|
||||
# keep only a-Z, 0-9, space, slash and dash
|
||||
x_bak_clean <- gsub("[^A-Z0-9 /-]", "", x_bak_clean, ignore.case = TRUE)
|
||||
# keep only max 1 space
|
||||
x_bak_clean <- trimws(gsub(" +", " ", x_bak_clean, ignore.case = TRUE))
|
||||
x <- unique(x_bak_clean)
|
||||
x_new <- rep(NA_character_, length(x))
|
||||
x_unknown <- character(0)
|
||||
@ -200,6 +200,24 @@ as.ab <- function(x) {
|
||||
next
|
||||
}
|
||||
|
||||
# try by removing all spaces
|
||||
if (x[i] %like% " ") {
|
||||
found <- suppressWarnings(as.ab(gsub(" +", "", x[i])))
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# try by removing all spaces and numbers
|
||||
if (x[i] %like% " " | x[i] %like% "[0-9]") {
|
||||
found <- suppressWarnings(as.ab(gsub("[ 0-9]", "", x[i])))
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# not found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
@ -73,14 +73,13 @@
|
||||
#' ab_name(21319) # "Flucloxacillin" (using CID)
|
||||
#' ab_name("J01CF05") # "Flucloxacillin" (using ATC)
|
||||
ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
|
||||
x <- ab_validate(x = x, property = "name", ...)
|
||||
res <- t(x, language = language)
|
||||
x <- translate_AMR(ab_validate(x = x, property = "name", ...), language = language)
|
||||
if (tolower == TRUE) {
|
||||
# use perl to only transform the first character
|
||||
# as we want "polymyxin B", not "polymyxin b"
|
||||
res <- gsub("^([A-Z])", "\\L\\1", res, perl = TRUE)
|
||||
x <- gsub("^([A-Z])", "\\L\\1", x, perl = TRUE)
|
||||
}
|
||||
res
|
||||
x
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
@ -116,19 +115,19 @@ ab_tradenames <- function(x, ...) {
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_group <- function(x, language = get_locale(), ...) {
|
||||
t(ab_validate(x = x, property = "group", ...), language = language)
|
||||
translate_AMR(ab_validate(x = x, property = "group", ...), language = language)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group1 <- function(x, language = get_locale(), ...) {
|
||||
t(ab_validate(x = x, property = "atc_group1", ...), language = language)
|
||||
translate_AMR(ab_validate(x = x, property = "atc_group1", ...), language = language)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group2 <- function(x, language = get_locale(), ...) {
|
||||
t(ab_validate(x = x, property = "atc_group2", ...), language = language)
|
||||
translate_AMR(ab_validate(x = x, property = "atc_group2", ...), language = language)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
@ -150,8 +149,8 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
|
||||
#' @export
|
||||
ab_info <- function(x, language = get_locale(), ...) {
|
||||
x <- AMR::as.ab(x, ...)
|
||||
base::list(ab = x,
|
||||
atc = ab_atc(x),
|
||||
base::list(ab = as.character(x),
|
||||
atc = as.character(ab_atc(x)),
|
||||
cid = ab_cid(x),
|
||||
name = ab_name(x, language = language),
|
||||
group = ab_group(x, language = language),
|
||||
@ -174,7 +173,7 @@ ab_property <- function(x, property = 'name', language = get_locale(), ...) {
|
||||
stop("invalid property: '", property, "' - use a column name of the `antibiotics` data set")
|
||||
}
|
||||
|
||||
t(ab_validate(x = x, property = property, ...), language = language)
|
||||
translate_AMR(ab_validate(x = x, property = property, ...), language = language)
|
||||
}
|
||||
|
||||
ab_validate <- function(x, property, ...) {
|
||||
|
@ -71,19 +71,17 @@
|
||||
#' # [1] "Castellani et al., 1919"
|
||||
#'
|
||||
#' # Do not get mistaken - the package only includes microorganisms
|
||||
#' mo_phylum("C. elegans")
|
||||
#' # [1] "Cyanobacteria" # Bacteria?!
|
||||
#' mo_fullname("C. elegans")
|
||||
#' mo_kingdom("C. elegans")
|
||||
#' # [1] "Bacteria" # Bacteria?!
|
||||
#' mo_name("C. elegans")
|
||||
#' # [1] "Chroococcus limneticus elegans" # Because a microorganism was found
|
||||
NULL
|
||||
|
||||
#' Version info of included Catalogue of Life
|
||||
#'
|
||||
#' This function returns information about the included data from the Catalogue of Life. It also shows if the included version is their latest annual release. The Catalogue of Life releases their annual release in March each year.
|
||||
#' This function returns information about the included data from the Catalogue of Life.
|
||||
#' @seealso \code{\link{microorganisms}}
|
||||
#' @details The list item \code{...$catalogue_of_life$is_latest_annual_release} is based on the system date.
|
||||
#'
|
||||
#' For DSMZ, see \code{?microorganisms}.
|
||||
#' @details For DSMZ, see \code{?microorganisms}.
|
||||
#' @return a \code{list}, which prints in pretty format
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
@ -99,8 +97,6 @@ catalogue_of_life_version <- function() {
|
||||
lst <- list(catalogue_of_life =
|
||||
list(version = gsub("{year}", catalogue_of_life$year, catalogue_of_life$version, fixed = TRUE),
|
||||
url = gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE),
|
||||
# annual release always somewhere in May, so before June is TRUE, FALSE otherwise
|
||||
is_latest_annual_release = Sys.Date() < as.Date(paste0(catalogue_of_life$year + 1, "-06-01")),
|
||||
n = nrow(filter(AMR::microorganisms, source == "CoL"))),
|
||||
deutsche_sammlung_von_mikroorganismen_und_zellkulturen =
|
||||
list(version = "Prokaryotic Nomenclature Up-to-Date from DSMZ",
|
||||
@ -125,7 +121,6 @@ print.catalogue_of_life_version <- function(x, ...) {
|
||||
underline(lst$catalogue_of_life$version), "\n",
|
||||
" Available at: ", lst$catalogue_of_life$url, "\n",
|
||||
" Number of included species: ", format(lst$catalogue_of_life$n, big.mark = ","), "\n",
|
||||
" (based on your system time, this is most likely ", ifelse(lst$catalogue_of_life$is_latest_annual_release, "", "not "), "the latest annual release)\n\n",
|
||||
underline(paste0(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$version, " (",
|
||||
lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
|
||||
" Available at: ", lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$url, "\n",
|
||||
|
2
R/data.R
2
R/data.R
@ -22,7 +22,7 @@
|
||||
#' Data set with ~450 antibiotics
|
||||
#'
|
||||
#' A data set containing all antibiotics. Use \code{\link{as.ab}} or one of the \code{\link{ab_property}} functions to retrieve values from this data set. Three identifiers are included in this data set: an antibiotic ID (\code{ab}, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (\code{atc}) as defined by the WHO, and a Compound ID (\code{cid}) as found in PubChem. Other properties in this data set are derived from one or more of these codes.
|
||||
#' @format A \code{\link{data.frame}} with 454 observations and 13 variables:
|
||||
#' @format A \code{\link{data.frame}} with 453 observations and 13 variables:
|
||||
#' \describe{
|
||||
#' \item{\code{ab}}{Antibiotic ID as used in this package (like \code{AMC}), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available}
|
||||
#' \item{\code{atc}}{ATC code (Anatomical Therapeutic Chemical) as defined by the WHOCC, like \code{J01CR02}}
|
||||
|
@ -26,17 +26,17 @@
|
||||
#' @param y,z characters to compare
|
||||
#' @inheritParams first_isolate
|
||||
#' @param universal_1,universal_2,universal_3,universal_4,universal_5,universal_6 column names of \strong{broad-spectrum} antibiotics, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link{guess_ab_col}}.
|
||||
#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for \strong{Gram positives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link{guess_ab_col}}.
|
||||
#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for \strong{Gram negatives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link{guess_ab_col}}.
|
||||
#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for \strong{Gram-positives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link{guess_ab_col}}.
|
||||
#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for \strong{Gram-negatives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link{guess_ab_col}}.
|
||||
#' @param warnings give warning about missing antibiotic columns, they will anyway be ignored
|
||||
#' @param ... other parameters passed on to function
|
||||
#' @details The function \code{key_antibiotics} returns a character vector with 12 antibiotic results for every isolate. These isolates can then be compared using \code{key_antibiotics_equal}, to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (\code{"."}). The \code{\link{first_isolate}} function only uses this function on the same microbial species from the same patient. Using this, an MRSA will be included after a susceptible \emph{S. aureus} (MSSA) found within the same episode (see \code{episode} parameter of \code{\link{first_isolate}}). Without key antibiotic comparison it would not.
|
||||
#'
|
||||
#' At default, the antibiotics that are used for \strong{Gram positive bacteria} are (colum names): \cr
|
||||
#' \code{"amox"}, \code{"amcl"}, \code{"cfur"}, \code{"pita"}, \code{"cipr"}, \code{"trsu"} (until here is universal), \code{"vanc"}, \code{"teic"}, \code{"tetr"}, \code{"eryt"}, \code{"oxac"}, \code{"rifa"}.
|
||||
#' At default, the antibiotics that are used for \strong{Gram-positive bacteria} are: \cr
|
||||
#' amoxicillin, amoxicillin/clavulanic acid, cefuroxime, piperacillin/tazobactam, ciprofloxacin, trimethoprim/sulfamethoxazole (until here is universal), vancomycin, teicoplanin, tetracycline, erythromycin, oxacillin, rifampin.
|
||||
#'
|
||||
#' At default, the antibiotics that are used for \strong{Gram negative bacteria} are (colum names): \cr
|
||||
#' \code{"amox"}, \code{"amcl"}, \code{"cfur"}, \code{"pita"}, \code{"cipr"}, \code{"trsu"} (until here is universal), \code{"gent"}, \code{"tobr"}, \code{"coli"}, \code{"cfot"}, \code{"cfta"}, \code{"mero"}.
|
||||
#' At default, the antibiotics that are used for \strong{Gram-negative bacteria} are: \cr
|
||||
#' amoxicillin, amoxicillin/clavulanic acid, cefuroxime, piperacillin/tazobactam, ciprofloxacin, trimethoprim/sulfamethoxazole (until here is universal), gentamicin, tobramycin, colistin, cefotaxime, ceftazidime, meropenem.
|
||||
#'
|
||||
#'
|
||||
#' The function \code{key_antibiotics_equal} checks the characters returned by \code{key_antibiotics} for equality, and returns a logical vector.
|
||||
@ -50,7 +50,7 @@
|
||||
#' @examples
|
||||
#' # septic_patients is a dataset available in the AMR package
|
||||
#' ?septic_patients
|
||||
|
||||
#'
|
||||
#' library(dplyr)
|
||||
#' # set key antibiotics to a new variable
|
||||
#' my_patients <- septic_patients %>%
|
||||
@ -78,24 +78,24 @@
|
||||
#' # FALSE, because I is not ignored and so the 4th value differs
|
||||
key_antibiotics <- function(x,
|
||||
col_mo = NULL,
|
||||
universal_1 = guess_ab_col(x, "AMX"),
|
||||
universal_2 = guess_ab_col(x, "AMC"),
|
||||
universal_3 = guess_ab_col(x, "CXM"),
|
||||
universal_4 = guess_ab_col(x, "TZP"),
|
||||
universal_5 = guess_ab_col(x, "CIP"),
|
||||
universal_6 = guess_ab_col(x, "SXT"),
|
||||
GramPos_1 = guess_ab_col(x, "VAN"),
|
||||
GramPos_2 = guess_ab_col(x, "TEC"),
|
||||
GramPos_3 = guess_ab_col(x, "TCY"),
|
||||
GramPos_4 = guess_ab_col(x, "ERY"),
|
||||
GramPos_5 = guess_ab_col(x, "OXA"),
|
||||
GramPos_6 = guess_ab_col(x, "RIF"),
|
||||
GramNeg_1 = guess_ab_col(x, "GEN"),
|
||||
GramNeg_2 = guess_ab_col(x, "TOB"),
|
||||
GramNeg_3 = guess_ab_col(x, "COL"),
|
||||
GramNeg_4 = guess_ab_col(x, "CTX"),
|
||||
GramNeg_5 = guess_ab_col(x, "CAZ"),
|
||||
GramNeg_6 = guess_ab_col(x, "MEM"),
|
||||
universal_1 = guess_ab_col(x, "amoxicillin"),
|
||||
universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
|
||||
universal_3 = guess_ab_col(x, "cefuroxime"),
|
||||
universal_4 = guess_ab_col(x, "piperacillin/tazobactam"),
|
||||
universal_5 = guess_ab_col(x, "ciprofloxacin"),
|
||||
universal_6 = guess_ab_col(x, "trimethoprim/sulfamethoxazole"),
|
||||
GramPos_1 = guess_ab_col(x, "vancomycin"),
|
||||
GramPos_2 = guess_ab_col(x, "teicoplanin"),
|
||||
GramPos_3 = guess_ab_col(x, "tetracycline"),
|
||||
GramPos_4 = guess_ab_col(x, "erythromycin"),
|
||||
GramPos_5 = guess_ab_col(x, "oxacillin"),
|
||||
GramPos_6 = guess_ab_col(x, "rifampin"),
|
||||
GramNeg_1 = guess_ab_col(x, "gentamicin"),
|
||||
GramNeg_2 = guess_ab_col(x, "tobramycin"),
|
||||
GramNeg_3 = guess_ab_col(x, "colistin"),
|
||||
GramNeg_4 = guess_ab_col(x, "cefotaxime"),
|
||||
GramNeg_5 = guess_ab_col(x, "ceftazidime"),
|
||||
GramNeg_6 = guess_ab_col(x, "meropenem"),
|
||||
warnings = TRUE,
|
||||
...) {
|
||||
|
||||
@ -170,7 +170,7 @@ key_antibiotics <- function(x,
|
||||
gram_positive <- gram_positive[!is.null(gram_positive)]
|
||||
gram_positive <- gram_positive[!is.na(gram_positive)]
|
||||
if (length(gram_positive) < 12) {
|
||||
warning("only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram positives. See ?key_antibiotics.", call. = FALSE)
|
||||
warning("only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call. = FALSE)
|
||||
}
|
||||
|
||||
gram_negative = c(universal,
|
||||
@ -179,7 +179,7 @@ key_antibiotics <- function(x,
|
||||
gram_negative <- gram_negative[!is.null(gram_negative)]
|
||||
gram_negative <- gram_negative[!is.na(gram_negative)]
|
||||
if (length(gram_negative) < 12) {
|
||||
warning("only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram negatives. See ?key_antibiotics.", call. = FALSE)
|
||||
warning("only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call. = FALSE)
|
||||
}
|
||||
|
||||
# join to microorganisms data set
|
||||
@ -191,7 +191,7 @@ key_antibiotics <- function(x,
|
||||
|
||||
# Gram +
|
||||
x <- x %>% mutate(key_ab =
|
||||
if_else(gramstain == "Gram positive",
|
||||
if_else(gramstain == "Gram-positive",
|
||||
apply(X = x[, gram_positive],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
@ -199,7 +199,7 @@ key_antibiotics <- function(x,
|
||||
|
||||
# Gram -
|
||||
x <- x %>% mutate(key_ab =
|
||||
if_else(gramstain == "Gram negative",
|
||||
if_else(gramstain == "Gram-negative",
|
||||
apply(X = x[, gram_negative],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
@ -209,7 +209,8 @@ key_antibiotics <- function(x,
|
||||
key_abs <- x %>%
|
||||
pull(key_ab) %>%
|
||||
gsub('(NA|NULL)', '.', .) %>%
|
||||
gsub('[^SIR]', '.', ., ignore.case = TRUE)
|
||||
gsub('[^SIR]', '.', ., ignore.case = TRUE) %>%
|
||||
toupper()
|
||||
|
||||
key_abs
|
||||
|
||||
@ -295,7 +296,7 @@ key_antibiotics_equal <- function(y,
|
||||
result[i] <- points >= points_threshold
|
||||
|
||||
} else {
|
||||
stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?first_isolate.')
|
||||
stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
|
||||
}
|
||||
}
|
||||
}
|
||||
|
5
R/misc.R
5
R/misc.R
@ -253,7 +253,7 @@ stopifnot_installed_package <- function(package) {
|
||||
|
||||
# translate strings based on inst/translations.tsv
|
||||
#' @importFrom dplyr %>% filter
|
||||
t <- function(from, language = get_locale()) {
|
||||
translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
|
||||
# if (getOption("AMR_locale", "en") != language) {
|
||||
# language <- getOption("AMR_locale", "en")
|
||||
# }
|
||||
@ -274,6 +274,9 @@ t <- function(from, language = get_locale()) {
|
||||
}
|
||||
|
||||
df_trans <- df_trans %>% filter(lang == language)
|
||||
if (only_unknown == TRUE) {
|
||||
df_trans <- df_trans %>% filter(pattern %like% "unknown")
|
||||
}
|
||||
|
||||
# default case sensitive if value if 'ignore.case' is missing:
|
||||
df_trans$ignore.case[is.na(df_trans$ignore.case)] <- FALSE
|
||||
|
@ -69,8 +69,8 @@
|
||||
#' mo_shortname("E. coli") # "E. coli"
|
||||
#'
|
||||
#' ## other properties
|
||||
#' mo_gramstain("E. coli") # "Gram negative"
|
||||
#' mo_type("E. coli") # "Bacteria" (equal to kingdom)
|
||||
#' mo_gramstain("E. coli") # "Gram-negative"
|
||||
#' mo_type("E. coli") # "Bacteria" (equal to kingdom, but may be translated)
|
||||
#' mo_rank("E. coli") # "species"
|
||||
#' mo_url("E. coli") # get the direct url to the online database entry
|
||||
#'
|
||||
@ -84,7 +84,7 @@
|
||||
#' mo_genus("MRSA") # "Staphylococcus"
|
||||
#' mo_species("MRSA") # "aureus"
|
||||
#' mo_shortname("MRSA") # "S. aureus"
|
||||
#' mo_gramstain("MRSA") # "Gram positive"
|
||||
#' mo_gramstain("MRSA") # "Gram-positive"
|
||||
#'
|
||||
#' mo_genus("VISA") # "Staphylococcus"
|
||||
#' mo_species("VISA") # "aureus"
|
||||
@ -133,15 +133,15 @@
|
||||
#'
|
||||
#' # get a list with the complete taxonomy (from kingdom to subspecies)
|
||||
#' mo_taxonomy("E. coli")
|
||||
#' # get a list with the taxonomy, the authors and the URL to the online database
|
||||
#' mo_info("E. coli")
|
||||
mo_name <- function(x, language = get_locale(), ...) {
|
||||
mo_fullname(x = x, language = language, ... = ...)
|
||||
translate_AMR(mo_validate(x = x, property = "fullname", ...), language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_fullname <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "fullname", ...), language = language)
|
||||
}
|
||||
mo_fullname <- mo_name
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @importFrom dplyr %>% mutate pull
|
||||
@ -184,70 +184,61 @@ mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
res1[res1 != res2] <- res2_fullname
|
||||
result <- as.character(res1)
|
||||
|
||||
t(result, language = language)
|
||||
translate_AMR(result, language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_subspecies <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "subspecies", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "subspecies", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_species <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "species", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "species", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_genus <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "genus", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "genus", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_family <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "family", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "family", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_order <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "order", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "order", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_class <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "class", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "class", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_phylum <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "phylum", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "phylum", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_kingdom <- function(x, language = get_locale(), ...) {
|
||||
if (all(x %in% AMR::microorganisms$kingdom)) {
|
||||
return(x)
|
||||
}
|
||||
x <- as.mo(x, ...)
|
||||
kngdm <- mo_validate(x = x, property = "kingdom", ...)
|
||||
if (language != "en") {
|
||||
# translate only unknown, so "Bacteria" (the official taxonomic name) would not change
|
||||
kngdm[identical(x, "UNKNOWN")] <- t(kngdm[identical(x, "UNKNOWN")], language = language)
|
||||
}
|
||||
kngdm
|
||||
translate_AMR(mo_validate(x = x, property = "kingdom", ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_type <- function(x, language = get_locale(), ...) {
|
||||
t(mo_validate(x = x, property = "kingdom", ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = "kingdom", ...), language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@ -255,16 +246,26 @@ mo_type <- function(x, language = get_locale(), ...) {
|
||||
mo_gramstain <- function(x, language = get_locale(), ...) {
|
||||
x.mo <- as.mo(x, ...)
|
||||
x.phylum <- mo_phylum(x.mo, language = "en")
|
||||
# DETERMINE GRAM STAIN FOR BACTERIA
|
||||
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097
|
||||
# It says this:
|
||||
# Kingdom Bacteria (Cavalier-Smith, 2002)
|
||||
# Subkingdom Posibacteria (Cavalier-Smith, 2002)
|
||||
# Direct Children:
|
||||
# Phylum Actinobacteria (Cavalier-Smith, 2002)
|
||||
# Phylum Chloroflexi (Garrity and Holt, 2002)
|
||||
# Phylum Firmicutes (corrig. Gibbons and Murray, 1978)
|
||||
# Phylum Tenericutes (Murray, 1984)
|
||||
x <- NA_character_
|
||||
# make all bacteria Gram negative
|
||||
x[mo_kingdom(x.mo, language = "en") == "Bacteria"] <- "Gram-negative"
|
||||
# overwrite these phyla with Gram positive
|
||||
x[x.phylum %in% c("Actinobacteria",
|
||||
"Chloroflexi",
|
||||
"Firmicutes",
|
||||
"Tenericutes")] <- "Gram positive"
|
||||
x[x != "Gram positive"] <- "Gram negative"
|
||||
x[mo_kingdom(x.mo, language = "en") != "Bacteria"] <- NA_character_
|
||||
x[x.mo == "B_GRAMP"] <- "Gram positive"
|
||||
x[x.mo == "B_GRAMN"] <- "Gram negative"
|
||||
|
||||
t(x, language = language)
|
||||
"Tenericutes")
|
||||
| x.mo == "B_GRAMP"] <- "Gram-positive"
|
||||
translate_AMR(x, language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@ -311,6 +312,15 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
subspecies = mo_subspecies(x, language = language))
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_locale(), ...) {
|
||||
x <- AMR::as.mo(x, ...)
|
||||
c(mo_taxonomy(x, language = language),
|
||||
list(url = unname(mo_url(x, open = FALSE)),
|
||||
ref = mo_ref(x)))
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @importFrom utils browseURL
|
||||
#' @importFrom dplyr %>% left_join select mutate case_when
|
||||
@ -349,7 +359,7 @@ mo_property <- function(x, property = 'fullname', language = get_locale(), ...)
|
||||
stop("invalid property: '", property, "' - use a column name of the `microorganisms` data set")
|
||||
}
|
||||
|
||||
t(mo_validate(x = x, property = property, ...), language = language)
|
||||
translate_AMR(mo_validate(x = x, property = property, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
mo_validate <- function(x, property, ...) {
|
||||
|
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
Reference in New Issue
Block a user