mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 08:52:15 +02:00
speed improvement eucast_rules(), support more old MO codes
This commit is contained in:
@ -226,7 +226,7 @@ eucast_rules <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
cols_ab <- get_column_abx(tbl = x,
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
soft_dependencies = c("AMC",
|
||||
"AMK",
|
||||
"AMX",
|
||||
@ -291,8 +291,7 @@ eucast_rules <- function(x,
|
||||
"SXT",
|
||||
"VAN"),
|
||||
hard_dependencies = NULL,
|
||||
verbose = verbose,
|
||||
...)
|
||||
verbose = verbose)
|
||||
|
||||
AMC <- cols_ab['AMC']
|
||||
AMK <- cols_ab['AMK']
|
||||
@ -674,8 +673,11 @@ eucast_rules <- function(x,
|
||||
'out of', formatnr(nrow(tbl_original)),
|
||||
'rows, making a total of', formatnr(nrow(verbose_info)), 'edits\n')))
|
||||
|
||||
n_added <- verbose_info %>% filter(is.na(old)) %>% nrow()
|
||||
n_changed <- verbose_info %>% filter(!is.na(old)) %>% nrow()
|
||||
|
||||
# print added values ----
|
||||
if (verbose_info %>% filter(is.na(old)) %>% nrow() == 0) {
|
||||
if (n_added == 0) {
|
||||
colour <- cat # is function
|
||||
} else {
|
||||
colour <- blue # is function
|
||||
@ -685,7 +687,7 @@ eucast_rules <- function(x,
|
||||
filter(is.na(old)) %>%
|
||||
nrow()), "test results"),
|
||||
"\n")))
|
||||
if (verbose_info %>% filter(is.na(old)) %>% nrow() > 0) {
|
||||
if (n_added > 0) {
|
||||
verbose_info %>%
|
||||
filter(is.na(old)) %>%
|
||||
# sort it well: S < I < R
|
||||
@ -700,17 +702,20 @@ eucast_rules <- function(x,
|
||||
}
|
||||
|
||||
# print changed values ----
|
||||
if (verbose_info %>% filter(!is.na(old)) %>% nrow() == 0) {
|
||||
if (n_changed == 0) {
|
||||
colour <- cat # is function
|
||||
} else {
|
||||
colour <- blue # is function
|
||||
}
|
||||
cat(colour(paste0("\n=> ", wouldve, "changed ",
|
||||
if (n_added + n_changed > 0) {
|
||||
cat("\n")
|
||||
}
|
||||
cat(colour(paste0("=> ", wouldve, "changed ",
|
||||
bold(formatnr(verbose_info %>%
|
||||
filter(!is.na(old)) %>%
|
||||
nrow()), "test results"),
|
||||
"\n")))
|
||||
if (verbose_info %>% filter(!is.na(old)) %>% nrow() > 0) {
|
||||
if (n_changed > 0) {
|
||||
verbose_info %>%
|
||||
filter(!is.na(old)) %>%
|
||||
# sort it well: S < I < R
|
||||
|
||||
@ -56,15 +56,15 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
|
||||
if (is.null(x) & is.null(search_string)) {
|
||||
return(as.name("guess_ab_col"))
|
||||
}
|
||||
if (!is.data.frame(x)) {
|
||||
stop("`x` must be a data.frame")
|
||||
}
|
||||
|
||||
if (length(search_string) > 1) {
|
||||
warning("argument 'search_string' has length > 1 and only the first element will be used")
|
||||
search_string <- search_string[1]
|
||||
}
|
||||
search_string <- as.character(search_string)
|
||||
if (!is.data.frame(x)) {
|
||||
stop("`x` must be a data.frame")
|
||||
}
|
||||
|
||||
if (search_string %in% colnames(x)) {
|
||||
ab_result <- search_string
|
||||
|
||||
3
R/mdro.R
3
R/mdro.R
@ -110,8 +110,7 @@ mdro <- function(x,
|
||||
}
|
||||
|
||||
|
||||
cols_ab <- get_column_abx(tbl = x,
|
||||
...)
|
||||
cols_ab <- get_column_abx(x = x, verbose = verbose)
|
||||
|
||||
AMC <- cols_ab['AMC']
|
||||
AMK <- cols_ab['AMK']
|
||||
|
||||
176
R/misc.R
176
R/misc.R
@ -158,177 +158,45 @@ get_ab_col <- function(columns, ab) {
|
||||
columns[names(columns) == ab]
|
||||
}
|
||||
|
||||
get_column_abx <- function(tbl,
|
||||
get_column_abx <- function(x,
|
||||
soft_dependencies = NULL,
|
||||
hard_dependencies = NULL,
|
||||
verbose = FALSE,
|
||||
AMC = guess_ab_col(),
|
||||
AMK = guess_ab_col(),
|
||||
AMX = guess_ab_col(),
|
||||
AMP = guess_ab_col(),
|
||||
AZM = guess_ab_col(),
|
||||
AZL = guess_ab_col(),
|
||||
ATM = guess_ab_col(),
|
||||
RID = guess_ab_col(),
|
||||
FEP = guess_ab_col(),
|
||||
CTX = guess_ab_col(),
|
||||
FOX = guess_ab_col(),
|
||||
CED = guess_ab_col(),
|
||||
CAZ = guess_ab_col(),
|
||||
CRO = guess_ab_col(),
|
||||
CXM = guess_ab_col(),
|
||||
CHL = guess_ab_col(),
|
||||
CIP = guess_ab_col(),
|
||||
CLR = guess_ab_col(),
|
||||
CLI = guess_ab_col(),
|
||||
FLC = guess_ab_col(),
|
||||
COL = guess_ab_col(),
|
||||
CZO = guess_ab_col(),
|
||||
DAP = guess_ab_col(),
|
||||
DOX = guess_ab_col(),
|
||||
ETP = guess_ab_col(),
|
||||
ERY = guess_ab_col(),
|
||||
FOS = guess_ab_col(),
|
||||
FUS = guess_ab_col(),
|
||||
GEN = guess_ab_col(),
|
||||
IPM = guess_ab_col(),
|
||||
KAN = guess_ab_col(),
|
||||
LVX = guess_ab_col(),
|
||||
LIN = guess_ab_col(),
|
||||
LNZ = guess_ab_col(),
|
||||
MEM = guess_ab_col(),
|
||||
MTR = guess_ab_col(),
|
||||
MEZ = guess_ab_col(),
|
||||
MNO = guess_ab_col(),
|
||||
MFX = guess_ab_col(),
|
||||
NAL = guess_ab_col(),
|
||||
NEO = guess_ab_col(),
|
||||
NET = guess_ab_col(),
|
||||
NIT = guess_ab_col(),
|
||||
NOR = guess_ab_col(),
|
||||
NOV = guess_ab_col(),
|
||||
OFX = guess_ab_col(),
|
||||
OXA = guess_ab_col(),
|
||||
PEN = guess_ab_col(),
|
||||
PIP = guess_ab_col(),
|
||||
TZP = guess_ab_col(),
|
||||
PLB = guess_ab_col(),
|
||||
PRI = guess_ab_col(),
|
||||
QDA = guess_ab_col(),
|
||||
RIF = guess_ab_col(),
|
||||
RXT = guess_ab_col(),
|
||||
SIS = guess_ab_col(),
|
||||
TEC = guess_ab_col(),
|
||||
TCY = guess_ab_col(),
|
||||
TIC = guess_ab_col(),
|
||||
TGC = guess_ab_col(),
|
||||
TOB = guess_ab_col(),
|
||||
TMP = guess_ab_col(),
|
||||
SXT = guess_ab_col(),
|
||||
VAN = guess_ab_col()) {
|
||||
# check columns
|
||||
if (identical(AMC, as.name("guess_ab_col"))) AMC <- guess_ab_col(tbl, "AMC", verbose = verbose)
|
||||
if (identical(AMK, as.name("guess_ab_col"))) AMK <- guess_ab_col(tbl, "AMK", verbose = verbose)
|
||||
if (identical(AMX, as.name("guess_ab_col"))) AMX <- guess_ab_col(tbl, "AMX", verbose = verbose)
|
||||
if (identical(AMP, as.name("guess_ab_col"))) AMP <- guess_ab_col(tbl, "AMP", verbose = verbose)
|
||||
if (identical(AZM, as.name("guess_ab_col"))) AZM <- guess_ab_col(tbl, "AZM", verbose = verbose)
|
||||
if (identical(AZL, as.name("guess_ab_col"))) AZL <- guess_ab_col(tbl, "AZL", verbose = verbose)
|
||||
if (identical(ATM, as.name("guess_ab_col"))) ATM <- guess_ab_col(tbl, "ATM", verbose = verbose)
|
||||
if (identical(RID, as.name("guess_ab_col"))) RID <- guess_ab_col(tbl, "RID", verbose = verbose)
|
||||
if (identical(FEP, as.name("guess_ab_col"))) FEP <- guess_ab_col(tbl, "FEP", verbose = verbose)
|
||||
if (identical(CTX, as.name("guess_ab_col"))) CTX <- guess_ab_col(tbl, "CTX", verbose = verbose)
|
||||
if (identical(FOX, as.name("guess_ab_col"))) FOX <- guess_ab_col(tbl, "FOX", verbose = verbose)
|
||||
if (identical(CED, as.name("guess_ab_col"))) CED <- guess_ab_col(tbl, "CED", verbose = verbose)
|
||||
if (identical(CAZ, as.name("guess_ab_col"))) CAZ <- guess_ab_col(tbl, "CAZ", verbose = verbose)
|
||||
if (identical(CRO, as.name("guess_ab_col"))) CRO <- guess_ab_col(tbl, "CRO", verbose = verbose)
|
||||
if (identical(CXM, as.name("guess_ab_col"))) CXM <- guess_ab_col(tbl, "CXM", verbose = verbose)
|
||||
if (identical(CHL, as.name("guess_ab_col"))) CHL <- guess_ab_col(tbl, "CHL", verbose = verbose)
|
||||
if (identical(CIP, as.name("guess_ab_col"))) CIP <- guess_ab_col(tbl, "CIP", verbose = verbose)
|
||||
if (identical(CLR, as.name("guess_ab_col"))) CLR <- guess_ab_col(tbl, "CLR", verbose = verbose)
|
||||
if (identical(CLI, as.name("guess_ab_col"))) CLI <- guess_ab_col(tbl, "CLI", verbose = verbose)
|
||||
if (identical(FLC, as.name("guess_ab_col"))) FLC <- guess_ab_col(tbl, "FLC", verbose = verbose)
|
||||
if (identical(COL, as.name("guess_ab_col"))) COL <- guess_ab_col(tbl, "COL", verbose = verbose)
|
||||
if (identical(CZO, as.name("guess_ab_col"))) CZO <- guess_ab_col(tbl, "CZO", verbose = verbose)
|
||||
if (identical(DAP, as.name("guess_ab_col"))) DAP <- guess_ab_col(tbl, "DAP", verbose = verbose)
|
||||
if (identical(DOX, as.name("guess_ab_col"))) DOX <- guess_ab_col(tbl, "DOX", verbose = verbose)
|
||||
if (identical(ETP, as.name("guess_ab_col"))) ETP <- guess_ab_col(tbl, "ETP", verbose = verbose)
|
||||
if (identical(ERY, as.name("guess_ab_col"))) ERY <- guess_ab_col(tbl, "ERY", verbose = verbose)
|
||||
if (identical(FOS, as.name("guess_ab_col"))) FOS <- guess_ab_col(tbl, "FOS", verbose = verbose)
|
||||
if (identical(FUS, as.name("guess_ab_col"))) FUS <- guess_ab_col(tbl, "FUS", verbose = verbose)
|
||||
if (identical(GEN, as.name("guess_ab_col"))) GEN <- guess_ab_col(tbl, "GEN", verbose = verbose)
|
||||
if (identical(IPM, as.name("guess_ab_col"))) IPM <- guess_ab_col(tbl, "IPM", verbose = verbose)
|
||||
if (identical(KAN, as.name("guess_ab_col"))) KAN <- guess_ab_col(tbl, "KAN", verbose = verbose)
|
||||
if (identical(LVX, as.name("guess_ab_col"))) LVX <- guess_ab_col(tbl, "LVX", verbose = verbose)
|
||||
if (identical(LIN, as.name("guess_ab_col"))) LIN <- guess_ab_col(tbl, "LIN", verbose = verbose)
|
||||
if (identical(LNZ, as.name("guess_ab_col"))) LNZ <- guess_ab_col(tbl, "LNZ", verbose = verbose)
|
||||
if (identical(MEM, as.name("guess_ab_col"))) MEM <- guess_ab_col(tbl, "MEM", verbose = verbose)
|
||||
if (identical(MTR, as.name("guess_ab_col"))) MTR <- guess_ab_col(tbl, "MTR", verbose = verbose)
|
||||
if (identical(MEZ, as.name("guess_ab_col"))) MEZ <- guess_ab_col(tbl, "MEZ", verbose = verbose)
|
||||
if (identical(MNO, as.name("guess_ab_col"))) MNO <- guess_ab_col(tbl, "MNO", verbose = verbose)
|
||||
if (identical(MFX, as.name("guess_ab_col"))) MFX <- guess_ab_col(tbl, "MFX", verbose = verbose)
|
||||
if (identical(NAL, as.name("guess_ab_col"))) NAL <- guess_ab_col(tbl, "NAL", verbose = verbose)
|
||||
if (identical(NEO, as.name("guess_ab_col"))) NEO <- guess_ab_col(tbl, "NEO", verbose = verbose)
|
||||
if (identical(NET, as.name("guess_ab_col"))) NET <- guess_ab_col(tbl, "NET", verbose = verbose)
|
||||
if (identical(NIT, as.name("guess_ab_col"))) NIT <- guess_ab_col(tbl, "NIT", verbose = verbose)
|
||||
if (identical(NOR, as.name("guess_ab_col"))) NOR <- guess_ab_col(tbl, "NOR", verbose = verbose)
|
||||
if (identical(NOV, as.name("guess_ab_col"))) NOV <- guess_ab_col(tbl, "NOV", verbose = verbose)
|
||||
if (identical(OFX, as.name("guess_ab_col"))) OFX <- guess_ab_col(tbl, "OFX", verbose = verbose)
|
||||
if (identical(OXA, as.name("guess_ab_col"))) OXA <- guess_ab_col(tbl, "OXA", verbose = verbose)
|
||||
if (identical(PEN, as.name("guess_ab_col"))) PEN <- guess_ab_col(tbl, "PEN", verbose = verbose)
|
||||
if (identical(PIP, as.name("guess_ab_col"))) PIP <- guess_ab_col(tbl, "PIP", verbose = verbose)
|
||||
if (identical(TZP, as.name("guess_ab_col"))) TZP <- guess_ab_col(tbl, "TZP", verbose = verbose)
|
||||
if (identical(PLB, as.name("guess_ab_col"))) PLB <- guess_ab_col(tbl, "PLB", verbose = verbose)
|
||||
if (identical(PRI, as.name("guess_ab_col"))) PRI <- guess_ab_col(tbl, "PRI", verbose = verbose)
|
||||
if (identical(QDA, as.name("guess_ab_col"))) QDA <- guess_ab_col(tbl, "QDA", verbose = verbose)
|
||||
if (identical(RIF, as.name("guess_ab_col"))) RIF <- guess_ab_col(tbl, "RIF", verbose = verbose)
|
||||
if (identical(RXT, as.name("guess_ab_col"))) RXT <- guess_ab_col(tbl, "RXT", verbose = verbose)
|
||||
if (identical(SIS, as.name("guess_ab_col"))) SIS <- guess_ab_col(tbl, "SIS", verbose = verbose)
|
||||
if (identical(TEC, as.name("guess_ab_col"))) TEC <- guess_ab_col(tbl, "TEC", verbose = verbose)
|
||||
if (identical(TCY, as.name("guess_ab_col"))) TCY <- guess_ab_col(tbl, "TCY", verbose = verbose)
|
||||
if (identical(TIC, as.name("guess_ab_col"))) TIC <- guess_ab_col(tbl, "TIC", verbose = verbose)
|
||||
if (identical(TGC, as.name("guess_ab_col"))) TGC <- guess_ab_col(tbl, "TGC", verbose = verbose)
|
||||
if (identical(TOB, as.name("guess_ab_col"))) TOB <- guess_ab_col(tbl, "TOB", verbose = verbose)
|
||||
if (identical(TMP, as.name("guess_ab_col"))) TMP <- guess_ab_col(tbl, "TMP", verbose = verbose)
|
||||
if (identical(SXT, as.name("guess_ab_col"))) SXT <- guess_ab_col(tbl, "SXT", verbose = verbose)
|
||||
if (identical(VAN, as.name("guess_ab_col"))) VAN <- guess_ab_col(tbl, "VAN", verbose = verbose)
|
||||
columns_available <- c(AMC = AMC, AMK = AMK, AMX = AMX, AMP = AMP, AZM = AZM,
|
||||
AZL = AZL, ATM = ATM, RID = RID, FEP = FEP, CTX = CTX,
|
||||
FOX = FOX, CED = CED, CAZ = CAZ, CRO = CRO, CXM = CXM,
|
||||
CHL = CHL, CIP = CIP, CLR = CLR, CLI = CLI, FLC = FLC,
|
||||
COL = COL, CZO = CZO, DAP = DAP, DOX = DOX, ETP = ETP,
|
||||
ERY = ERY, FOS = FOS, FUS = FUS, GEN = GEN, IPM = IPM,
|
||||
KAN = KAN, LVX = LVX, LIN = LIN, LNZ = LNZ, MEM = MEM,
|
||||
MTR = MTR, MEZ = MEZ, MNO = MNO, MFX = MFX, NAL = NAL,
|
||||
NEO = NEO, NET = NET, NIT = NIT, NOR = NOR, NOV = NOV,
|
||||
OFX = OFX, OXA = OXA, PEN = PEN, PIP = PIP, TZP = TZP,
|
||||
PLB = PLB, PRI = PRI, QDA = QDA, RIF = RIF, RXT = RXT,
|
||||
SIS = SIS, TEC = TEC, TCY = TCY, TIC = TIC, TGC = TGC,
|
||||
TOB = TOB, TMP = TMP, SXT = SXT, VAN = VAN)
|
||||
verbose = FALSE) {
|
||||
|
||||
df_trans <- data.frame(colnames = colnames(x),
|
||||
abcode = suppressWarnings(as.ab(colnames(x))))
|
||||
df_trans <- df_trans[!is.na(df_trans$abcode),]
|
||||
x <- as.character(df_trans$colnames)
|
||||
names(x) <- df_trans$abcode
|
||||
# sort on name
|
||||
x <- x[sort(names(x))]
|
||||
|
||||
if (verbose == TRUE) {
|
||||
for (i in 1:length(x)) {
|
||||
message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
|
||||
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ").")))
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(hard_dependencies)) {
|
||||
if (!all(hard_dependencies %in% names(columns_available[!is.na(columns_available)]))) {
|
||||
if (!all(hard_dependencies %in% names(x))) {
|
||||
# missing a hard dependency will return NA and consequently the data will not be analysed
|
||||
missing <- hard_dependencies[!hard_dependencies %in% names(columns_available[!is.na(columns_available)])]
|
||||
missing <- hard_dependencies[!hard_dependencies %in% names(x)]
|
||||
generate_warning_abs_missing(missing, any = FALSE)
|
||||
return(NA)
|
||||
}
|
||||
}
|
||||
if (!is.null(soft_dependencies)) {
|
||||
if (!all(soft_dependencies %in% names(columns_available[!is.na(columns_available)]))) {
|
||||
if (!all(soft_dependencies %in% names(x))) {
|
||||
# missing a soft dependency may lower the reliability
|
||||
missing <- soft_dependencies[!soft_dependencies %in% names(columns_available[!is.na(columns_available)])]
|
||||
missing <- soft_dependencies[!soft_dependencies %in% names(x)]
|
||||
missing <- paste0("`", missing, "` (", ab_name(missing, tolower = TRUE), ")")
|
||||
warning('Reliability might be improved if these antimicrobial results would be available too: ', paste(missing, collapse = ", "),
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
}
|
||||
}
|
||||
#deps <- c(soft_dependencies, hard_dependencies)
|
||||
#if (length(deps) > 0) {
|
||||
# columns_available[names(columns_available) %in% deps]
|
||||
#} else {
|
||||
columns_available
|
||||
#}
|
||||
x
|
||||
}
|
||||
|
||||
generate_warning_abs_missing <- function(missing, any = FALSE) {
|
||||
|
||||
21
R/mo.R
21
R/mo.R
@ -111,18 +111,18 @@
|
||||
#' Use \code{mo_renamed()} to get a vector with all values that could be coerced based on an old, previously accepted taxonomic name.
|
||||
#'
|
||||
#' \strong{Microbial prevalence of pathogens in humans} \cr
|
||||
#' The intelligent rules takes into account microbial prevalence of pathogens in humans. It uses three groups and all (sub)species are in only one group. These groups are:
|
||||
#' The intelligent rules take into account microbial prevalence of pathogens in humans. It uses three groups and all (sub)species are in only one group. These groups are:
|
||||
#' \itemize{
|
||||
#' \item{1 (most prevalent): class is Gammaproteobacteria \strong{or} genus is one of: \emph{Enterococcus}, \emph{Staphylococcus}, \emph{Streptococcus}.}
|
||||
#' \item{2: phylum is one of: Proteobacteria, Firmicutes, Actinobacteria, Sarcomastigophora \strong{or} genus is one of: \emph{Aspergillus}, \emph{Bacteroides}, \emph{Candida}, \emph{Capnocytophaga}, \emph{Chryseobacterium}, \emph{Cryptococcus}, \emph{Elisabethkingia}, \emph{Flavobacterium}, \emph{Fusobacterium}, \emph{Giardia}, \emph{Leptotrichia}, \emph{Mycoplasma}, \emph{Prevotella}, \emph{Rhodotorula}, \emph{Treponema}, \emph{Trichophyton}, \emph{Ureaplasma}.}
|
||||
#' \item{3 (least prevalent): all others.}
|
||||
#' }
|
||||
#'
|
||||
#' Group 1 contains all common Gram negatives, like all Enterobacteriaceae and e.g. \emph{Pseudomonas} and \emph{Legionella}.
|
||||
#' Group 1 contains all common Gram positives and Gram negatives, like all Enterobacteriaceae and e.g. \emph{Pseudomonas} and \emph{Legionella}.
|
||||
#'
|
||||
#' Group 2 probably contains all other microbial pathogens ever found in humans.
|
||||
#' Group 2 probably contains less microbial pathogens; all other members of phyla that were found in humans in the Northern Netherlands between 2001 and 2018.
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
# (source as a section, so it can be inherited by other man pages)
|
||||
# (source as a section here, so it can be inherited by other man pages:)
|
||||
#' @section 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}
|
||||
#'
|
||||
@ -349,13 +349,24 @@ exec_as.mo <- function(x,
|
||||
|
||||
# conversion of old MO codes from v0.5.0 (ITIS) to later versions (Catalogue of Life)
|
||||
if (any(x %like% "^[BFP]_[A-Z]{3,7}") & !all(x %in% microorganisms$mo)) {
|
||||
x <- gsub("^F_CANDD_GLB$", "F_CANDD_GLA", x) # specific old code for C. glabrata
|
||||
leftpart <- gsub("^([BFP]_[A-Z]{3,7}).*", "\\1", x)
|
||||
if (any(leftpart %in% names(mo_codes_v0.5.0))) {
|
||||
rightpart <- gsub("^[BFP]_[A-Z]{3,7}(.*)", "\\1", x)
|
||||
leftpart <- mo_codes_v0.5.0[leftpart]
|
||||
x[!is.na(leftpart)] <- paste0(leftpart[!is.na(leftpart)], rightpart[!is.na(leftpart)])
|
||||
}
|
||||
# now check if some are still old
|
||||
still_old <- x[x %in% names(mo_codes_v0.5.0)]
|
||||
if (length(still_old) > 0) {
|
||||
x[x %in% names(mo_codes_v0.5.0)] <- data.frame(old = still_old, stringsAsFactors = FALSE) %>%
|
||||
left_join(data.frame(old = names(mo_codes_v0.5.0),
|
||||
new = mo_codes_v0.5.0,
|
||||
stringsAsFactors = FALSE), by = "old") %>%
|
||||
# if they couldn't be found, replace them with the old ones again,
|
||||
# so they will throw a warning in the end
|
||||
mutate(new = ifelse(is.na(new), old, new)) %>%
|
||||
pull(new)
|
||||
}
|
||||
}
|
||||
|
||||
# defined df to check for
|
||||
|
||||
@ -23,13 +23,13 @@
|
||||
#'
|
||||
#' 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 or \code{"shortname"}
|
||||
#' @param property one of the column names of the \code{\link{microorganisms}} data set or \code{"shortname"}
|
||||
#' @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}}
|
||||
#' @param open browse the URL using \code{\link[utils]{browseURL}()}
|
||||
#' @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:
|
||||
#' \itemize{
|
||||
#' \item{\code{mo_fullname("Chlamydia psittaci")} will return \code{"Chlamydophila psittaci"} (with a warning about the renaming)}
|
||||
#' \item{\code{mo_name("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)}
|
||||
#' }
|
||||
@ -91,9 +91,10 @@
|
||||
#'
|
||||
#'
|
||||
#' # Known subspecies
|
||||
#' mo_name("doylei") # "Campylobacter jejuni doylei"
|
||||
#' mo_genus("doylei") # "Campylobacter"
|
||||
#' mo_species("doylei") # "jejuni"
|
||||
#' mo_fullname("doylei") # "Campylobacter jejuni doylei"
|
||||
#' mo_subspecies("doylei") # "doylei"
|
||||
#'
|
||||
#' mo_fullname("K. pneu rh") # "Klebsiella pneumoniae rhinoscleromatis"
|
||||
#' mo_shortname("K. pneu rh") # "K. pneumoniae"
|
||||
@ -139,8 +140,7 @@ mo_name <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_fullname <- function(x, language = get_locale(), ...) {
|
||||
x <- mo_validate(x = x, property = "fullname", ...)
|
||||
t(x, language = language)
|
||||
t(mo_validate(x = x, property = "fullname", ...), language = language)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
|
||||
11
R/zzz.R
11
R/zzz.R
@ -104,7 +104,7 @@ make_DT <- function() {
|
||||
make_trans_tbl <- function() {
|
||||
# conversion of old MO codes from v0.5.0 (ITIS) to later versions (Catalogue of Life)
|
||||
c(B_ACHRMB = "B_ACHRM", B_ANNMA = "B_ACTNS", B_ACLLS = "B_ALCYC",
|
||||
B_AHNGM = "B_ARCHN", B_ARMTM = "B_ARMTMN", B_ARTHRS = "B_ARTHR",
|
||||
B_AHNGM = "B_ARCHN", B_ARMTM = "B_ARMTMN", B_ARTHR = "B_ARTHRB", B_ARTHRS = "B_ARTHR",
|
||||
B_APHLS = "B_AZRHZP", B_BRCHA = "B_BRCHY", B_BCTRM = "B_BRVBCT",
|
||||
B_CLRBCT = "B_CLRBC", B_CTRDM = "B_CLSTR", B_CPRMM = "B_CYLND",
|
||||
B_DLCLN = "B_DPLCL", B_DMCLM = "B_DSLFT", B_DSLFVB = "B_DSLFV",
|
||||
@ -288,5 +288,12 @@ make_trans_tbl <- function() {
|
||||
F_PRCHN = "P_PRCHN", F_PRMBD = "P_PRMBD", F_PRTPH = "P_PRTPH",
|
||||
F_PSRNA = "P_PSRNA", F_PYSRM = "P_PYSRM", F_RTCLR = "P_RTCLR",
|
||||
F_STMNT = "P_STMNT", F_SYMPH = "P_SYMPH", F_TRBRK = "P_TRBRK",
|
||||
F_TRICH = "P_TRICH", F_TUBFR = "P_TUBFR")
|
||||
F_TRICH = "P_TRICH", F_TUBFR = "P_TUBFR",
|
||||
B_GRDNR = "B_GRLLA", B_SGMNS = "B_SNGMNS", B_TCLLS = "B_THBCL",
|
||||
F_CCCCS = "F_CRYPT",
|
||||
# renamings of old genus + species
|
||||
F_CANDD_GLB = "F_CANDD_GLA", F_CANDD_KRU = "F_ISSTC_ORI",
|
||||
F_CANDD_LUS = "F_CLVSP_LUS", B_STRPT_TUS = "B_STRPT",
|
||||
B_PRVTL_OLA = "B_PRVTL_OULO", B_FSBCT_RUM = "B_FSBCT",
|
||||
B_CRYNB_EYI = "B_CRYNB_FRE", B_OLGLL_LIS = "B_OLGLL_URE")
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user