mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 22:22:03 +02:00
(v1.4.0.9044) mo tibble printing, mo_shortname() fix
This commit is contained in:
@ -187,13 +187,16 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (!is.null(found) & info == TRUE) {
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.")
|
||||
if (type %in% c("keyantibiotics", "specimen")) {
|
||||
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
|
||||
if (message_not_thrown_before(fn = paste0("search_", type))) {
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.")
|
||||
if (type %in% c("keyantibiotics", "specimen")) {
|
||||
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
|
||||
}
|
||||
message_(msg)
|
||||
remember_thrown_message(fn = paste0("search_", type))
|
||||
}
|
||||
message_(msg)
|
||||
}
|
||||
found
|
||||
}
|
||||
@ -534,6 +537,20 @@ get_current_data <- function(arg_name, call) {
|
||||
call = call - 4))
|
||||
}
|
||||
|
||||
get_root_env_address <- function() {
|
||||
sub('<environment: (.*)>', '\\1', utils::capture.output(sys.frames()[[1]]))
|
||||
}
|
||||
|
||||
remember_thrown_message <- function(fn) {
|
||||
assign(x = paste0("address_", fn),
|
||||
value = get_root_env_address(),
|
||||
envir = mo_env)
|
||||
}
|
||||
|
||||
message_not_thrown_before <- function(fn) {
|
||||
is.null(mo_env[[paste0("address_", fn)]]) || !identical(mo_env[[paste0("address_", fn)]], get_root_env_address())
|
||||
}
|
||||
|
||||
has_colour <- function() {
|
||||
# this is a base R version of crayon::has_color
|
||||
enabled <- getOption("crayon.enabled")
|
||||
|
||||
10
R/count.R
10
R/count.R
@ -134,7 +134,10 @@ count_R <- function(..., only_all_tested = FALSE) {
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_IR <- function(..., only_all_tested = FALSE) {
|
||||
warning_("Using 'count_IR' is discouraged; use 'count_resistant()' instead to not consider \"I\" being resistant.", call = FALSE)
|
||||
if (message_not_thrown_before("count_IR")) {
|
||||
warning_("Using count_IR() is discouraged; use count_resistant() instead to not consider \"I\" being resistant.", call = FALSE)
|
||||
remember_thrown_message("count_IR")
|
||||
}
|
||||
rsi_calc(...,
|
||||
ab_result = c("I", "R"),
|
||||
only_all_tested = only_all_tested,
|
||||
@ -162,7 +165,10 @@ count_SI <- function(..., only_all_tested = FALSE) {
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_S <- function(..., only_all_tested = FALSE) {
|
||||
warning_("Using 'count_S' is discouraged; use 'count_susceptible()' instead to also consider \"I\" being susceptible.", call = FALSE)
|
||||
if (message_not_thrown_before("count_S")) {
|
||||
warning_("Using count_S() is discouraged; use count_susceptible() instead to also consider \"I\" being susceptible.", call = FALSE)
|
||||
remember_thrown_message("count_S")
|
||||
}
|
||||
rsi_calc(...,
|
||||
ab_result = "S",
|
||||
only_all_tested = only_all_tested,
|
||||
|
||||
@ -87,7 +87,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#'
|
||||
#' The following antibiotics are used for the functions [eucast_rules()] and [mdro()]. These are shown below in the format 'name (`antimicrobial ID`, [ATC code](https://www.whocc.no/atc/structure_and_principles/))', sorted alphabetically:
|
||||
#'
|
||||
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "ATM", "AVO", "AZL", "AZM", "BAM", "BPR", "CAC", "CAP", "CAT", "CAZ", "CCV", "CDR", "CDZ", "CEC", "CED", "CEI", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CHL", "CID", "CIP", "CLI", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPM", "CPO", "CPR", "CPT", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTF", "CTL", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZD", "CZO", "CZX", "DAL", "DAP", "DIR", "DIT", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERV", "ERY", "ETH", "ETP", "FDX", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOX", "FOX1", "FUS", "GAT", "GEH", "GEM", "GEN", "GRX", "HAP", "HET", "INH", "IPM", "ISE", "JOS", "KAN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "MTR", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "OMC", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHN", "PIP", "PLB", "PME", "PRI", "PRL", "PRU", "PVM", "PZA", "QDA", "RAM", "RFL", "RFP", "RIB", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SMX", "SPI", "SPT", "SPX", "STH", "STR", "STR1", "SUD", "SUT", "SXT", "SZO", "TAL", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
|
||||
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "ATM", "AVO", "AZL", "AZM", "BAM", "BPR", "CAC", "CAT", "CAZ", "CCP", "CCV", "CCX", "CDC", "CDR", "CDZ", "CEC", "CED", "CEI", "CEM", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CFZ", "CHE", "CHL", "CID", "CIP", "CLI", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPI", "CPL", "CPM", "CPO", "CPR", "CPT", "CPX", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTC", "CTF", "CTL", "CTS", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZA", "CZD", "CZO", "CZP", "CZX", "DAL", "DAP", "DIR", "DIT", "DIX", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERY", "ETP", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOV", "FOX", "FOX1", "FUS", "GAT", "GEM", "GEN", "GRX", "HAP", "HET", "IPM", "ISE", "JOS", "KAN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHN", "PIP", "PLB", "PME", "PRI", "PRL", "PRU", "PVM", "QDA", "RAM", "RFL", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SMX", "SPI", "SPX", "STR", "STR1", "SUD", "SUT", "SXT", "SZO", "TAL", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TIO", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
|
||||
#' @aliases EUCAST
|
||||
#' @rdname eucast_rules
|
||||
#' @export
|
||||
@ -278,53 +278,66 @@ eucast_rules <- function(x,
|
||||
CAC <- cols_ab["CAC"]
|
||||
CAT <- cols_ab["CAT"]
|
||||
CAZ <- cols_ab["CAZ"]
|
||||
CCP <- cols_ab["CCP"]
|
||||
CCV <- cols_ab["CCV"]
|
||||
CCX <- cols_ab["CCX"]
|
||||
CDC <- cols_ab["CDC"]
|
||||
CDR <- cols_ab["CDR"]
|
||||
CDZ <- cols_ab["CDZ"]
|
||||
CEC <- cols_ab["CEC"]
|
||||
CED <- cols_ab["CED"]
|
||||
CEI <- cols_ab["CEI"]
|
||||
CEM <- cols_ab["CEM"]
|
||||
CEP <- cols_ab["CEP"]
|
||||
CFM <- cols_ab["CFM"]
|
||||
CFM1 <- cols_ab["CFM1"]
|
||||
CFP <- cols_ab["CFP"]
|
||||
CFR <- cols_ab["CFR"]
|
||||
CFS <- cols_ab["CFS"]
|
||||
CFZ <- cols_ab["CFZ"]
|
||||
CHE <- cols_ab["CHE"]
|
||||
CHL <- cols_ab["CHL"]
|
||||
CID <- cols_ab["CID"]
|
||||
CIP <- cols_ab["CIP"]
|
||||
CLI <- cols_ab["CLI"]
|
||||
CLI <- cols_ab["CLI"]
|
||||
CLR <- cols_ab["CLR"]
|
||||
CMX <- cols_ab["CMX"]
|
||||
CMZ <- cols_ab["CMZ"]
|
||||
CND <- cols_ab["CND"]
|
||||
COL <- cols_ab["COL"]
|
||||
CPD <- cols_ab["CPD"]
|
||||
CPI <- cols_ab["CPI"]
|
||||
CPL <- cols_ab["CPL"]
|
||||
CPM <- cols_ab["CPM"]
|
||||
CPO <- cols_ab["CPO"]
|
||||
CPR <- cols_ab["CPR"]
|
||||
CPT <- cols_ab["CPT"]
|
||||
CPX <- cols_ab["CPX"]
|
||||
CRB <- cols_ab["CRB"]
|
||||
CRD <- cols_ab["CRD"]
|
||||
CRN <- cols_ab["CRN"]
|
||||
CRO <- cols_ab["CRO"]
|
||||
CSL <- cols_ab["CSL"]
|
||||
CTB <- cols_ab["CTB"]
|
||||
CTC <- cols_ab["CTC"]
|
||||
CTF <- cols_ab["CTF"]
|
||||
CTL <- cols_ab["CTL"]
|
||||
CTS <- cols_ab["CTS"]
|
||||
CTT <- cols_ab["CTT"]
|
||||
CTX <- cols_ab["CTX"]
|
||||
CTZ <- cols_ab["CTZ"]
|
||||
CXM <- cols_ab["CXM"]
|
||||
CYC <- cols_ab["CYC"]
|
||||
CZA <- cols_ab["CZA"]
|
||||
CZD <- cols_ab["CZD"]
|
||||
CZO <- cols_ab["CZO"]
|
||||
CZP <- cols_ab["CZP"]
|
||||
CZX <- cols_ab["CZX"]
|
||||
DAL <- cols_ab["DAL"]
|
||||
DAP <- cols_ab["DAP"]
|
||||
DIR <- cols_ab["DIR"]
|
||||
DIT <- cols_ab["DIT"]
|
||||
DIX <- cols_ab["DIX"]
|
||||
DIZ <- cols_ab["DIZ"]
|
||||
DKB <- cols_ab["DKB"]
|
||||
DOR <- cols_ab["DOR"]
|
||||
@ -338,6 +351,7 @@ eucast_rules <- function(x,
|
||||
FLE <- cols_ab["FLE"]
|
||||
FLR1 <- cols_ab["FLR1"]
|
||||
FOS <- cols_ab["FOS"]
|
||||
FOV <- cols_ab["FOV"]
|
||||
FOX <- cols_ab["FOX"]
|
||||
FOX1 <- cols_ab["FOX1"]
|
||||
FUS <- cols_ab["FUS"]
|
||||
@ -391,7 +405,6 @@ eucast_rules <- function(x,
|
||||
PRU <- cols_ab["PRU"]
|
||||
PVM <- cols_ab["PVM"]
|
||||
QDA <- cols_ab["QDA"]
|
||||
QDA <- cols_ab["QDA"]
|
||||
RAM <- cols_ab["RAM"]
|
||||
RFL <- cols_ab["RFL"]
|
||||
RID <- cols_ab["RID"]
|
||||
@ -441,6 +454,7 @@ eucast_rules <- function(x,
|
||||
TGC <- cols_ab["TGC"]
|
||||
THA <- cols_ab["THA"]
|
||||
TIC <- cols_ab["TIC"]
|
||||
TIO <- cols_ab["TIO"]
|
||||
TLT <- cols_ab["TLT"]
|
||||
TLV <- cols_ab["TLV"]
|
||||
TMP <- cols_ab["TMP"]
|
||||
@ -474,9 +488,10 @@ eucast_rules <- function(x,
|
||||
aminoglycosides <- c(AMK, DKB, GEN, ISE, KAN, NEO, NET, RST, SIS, STR, STR1, TOB)
|
||||
aminopenicillins <- c(AMP, AMX)
|
||||
carbapenems <- c(DOR, ETP, IPM, MEM, MEV)
|
||||
cephalosporins <- c(CDZ, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
|
||||
cephalosporins <- c(CDZ, CCP, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
|
||||
cephalosporins_1st <- c(CAC, CFR, RID, CTZ, CZD, CZO, CRD, CTL, LEX, CEP, HAP, CED)
|
||||
cephalosporins_2nd <- c(CEC, MAN, CMZ, CID, CND, CTT, CTF, FOX, CPR, CXM, LOR)
|
||||
cephalosporins_3rd <- c(CDZ, CCP, CCX, CDR, DIT, DIX, CAT, CPI, CFM, CMX, DIZ, CFP, CSL, CTX, CTC, CTS, CHE, FOV, CFZ, CPM, CPD, CPX, CDC, CFS, CAZ, CZA, CCV, CEM, CPL, CTB, TIO, CZX, CZP, CRO, LTM)
|
||||
cephalosporins_except_CAZ <- cephalosporins[cephalosporins != ifelse(is.null(CAZ), "", CAZ)]
|
||||
fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
|
||||
glycopeptides <- c(AVO, NVA, RAM, TEC, TCM, VAN) # dalba/orita/tela are in lipoglycopeptides
|
||||
@ -796,7 +811,7 @@ eucast_rules <- function(x,
|
||||
word_wrap(
|
||||
expertrules_info$title, " (",
|
||||
font_red(paste0(expertrules_info$version_txt, ", ", expertrules_info$year)), ")\n")),
|
||||
""))))
|
||||
""))), "\n")
|
||||
}
|
||||
# Print rule -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
|
||||
18
R/mdro.R
18
R/mdro.R
@ -192,7 +192,7 @@ mdro <- function(x,
|
||||
if (guideline$code == "cmi2012") {
|
||||
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
|
||||
guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL"
|
||||
guideline$version <- "N/A"
|
||||
guideline$version <- NA
|
||||
guideline$source <- "Clinical Microbiology and Infection 18:3, 2012. DOI: 10.1111/j.1469-0691.2011.03570.x"
|
||||
guideline$type <- "MDRs/XDRs/PDRs"
|
||||
|
||||
@ -221,7 +221,7 @@ mdro <- function(x,
|
||||
} else if (guideline$code == "mrgn") {
|
||||
guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
|
||||
guideline$author <- "M\u00fcller J, Voss A, K\u00f6ck R, ..., Kern WV, Wendt C, Friedrich AW"
|
||||
guideline$version <- "N/A"
|
||||
guideline$version <- NA
|
||||
guideline$source <- "Antimicrobial Resistance and Infection Control 4:7, 2015. DOI: 10.1186/s13756-015-0047-6"
|
||||
guideline$type <- "MRGNs"
|
||||
|
||||
@ -568,11 +568,13 @@ mdro <- function(x,
|
||||
} else {
|
||||
cat(font_red("\nResults with 'R' or 'I' are considered as resistance. Use `combine_SI = TRUE` to only consider 'R' as resistance.\n"))
|
||||
}
|
||||
cat("\nDetermining multidrug-resistant organisms (MDRO), according to:\n",
|
||||
font_bold("Guideline: "), font_italic(guideline$name), "\n",
|
||||
font_bold("Version: "), guideline$version, "\n",
|
||||
font_bold("Author: "), guideline$author, "\n",
|
||||
font_bold("Source: "), guideline$source, "\n",
|
||||
cat("\n", word_wrap("Determining multidrug-resistant organisms (MDRO), according to:"), "\n",
|
||||
word_wrap(paste0(font_bold("Guideline: "), font_italic(guideline$name)), extra_indent = 11, as_note = FALSE), "\n",
|
||||
word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n",
|
||||
ifelse(!is.na(guideline$version),
|
||||
paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"),
|
||||
""),
|
||||
word_wrap(paste0(font_bold("Source: "), guideline$source), extra_indent = 11, as_note = FALSE), "\n",
|
||||
"\n", sep = "")
|
||||
}
|
||||
|
||||
@ -1237,7 +1239,7 @@ mdro <- function(x,
|
||||
if (guideline$code == "cmi2012") {
|
||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||
warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)")
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
|
||||
# set these -1s to NA
|
||||
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_
|
||||
}
|
||||
|
||||
29
R/mo.R
29
R/mo.R
@ -276,7 +276,7 @@ exec_as.mo <- function(x,
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
|
||||
lookup <- function(needle,
|
||||
column = property,
|
||||
haystack = reference_data_to_use,
|
||||
@ -358,6 +358,9 @@ exec_as.mo <- function(x,
|
||||
x[trimws2(x) %like% paste0("^(", translate_AMR("no|not", language = language), ") [a-z]+")] <- "UNKNOWN"
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
# keep track of time - give some hints to improve speed if it takes a long time
|
||||
start_time <- Sys.time()
|
||||
|
||||
mo_env$mo_failures <- NULL
|
||||
mo_env$mo_uncertainties <- NULL
|
||||
mo_env$mo_renamed <- NULL
|
||||
@ -1524,8 +1527,24 @@ exec_as.mo <- function(x,
|
||||
}
|
||||
# this will save the uncertain items as attribute, so they can be bound to `uncertainties` in the uncertain_fn() function
|
||||
x <- structure(x, uncertainties = uncertainties)
|
||||
} else {
|
||||
# keep track of time - give some hints to improve speed if it takes a long time
|
||||
end_time <- Sys.time()
|
||||
delta_time <- difftime(end_time, start_time, units = "secs")
|
||||
if (delta_time >= 30) {
|
||||
message_("Using `as.mo()` took ", delta_time, " seconds, which is a long time. Some suggestions to improve speed include:")
|
||||
message_(word_wrap("- Try to use as many valid taxonomic names as possible for your input.",
|
||||
extra_indent = 2),
|
||||
as_note = FALSE)
|
||||
message_(word_wrap("- Save the output and use it as input for future calculations, e.g. create a new variable to your data using `as.mo()`. All functions in this package that rely on microorganism codes will automatically use that new column where possible. All `mo_*()` functions also do not require you to set their `x` argument as long as you have the dplyr package installed and you have a column of class <mo>.",
|
||||
extra_indent = 2),
|
||||
as_note = FALSE)
|
||||
message_(word_wrap("- Use `set_mo_source()` to continually transform your organisation codes to microorganisms codes used by this package, please see `?mo_source`.",
|
||||
extra_indent = 2),
|
||||
as_note = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
x
|
||||
}
|
||||
|
||||
@ -1585,9 +1604,13 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
|
||||
|
||||
# make it always fit exactly
|
||||
max_char <- max(nchar(x))
|
||||
if (is.na(max_char)) {
|
||||
max_char <- 7
|
||||
}
|
||||
create_pillar_column(out,
|
||||
align = "left",
|
||||
width = max(nchar(x)) + ifelse(any(x %in% c(NA, "UNKNOWN")), 2, 0))
|
||||
width = max_char + ifelse(any(x %in% c(NA, "UNKNOWN")), 2, 0))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
|
||||
198
R/mo_property.R
198
R/mo_property.R
@ -27,12 +27,12 @@
|
||||
#'
|
||||
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. Please see *Examples*.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be omitted for auto-guessing in `mo_is_*()` functions when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()], please see *Examples*.
|
||||
#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be omitted for auto-guessing the column containing microorganism codes when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()], please see *Examples*.
|
||||
#' @param property one of the column names of the [microorganisms] data set: `r paste0('"``', colnames(microorganisms), '\``"', collapse = ", ")`, or must be `"shortname"`
|
||||
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
|
||||
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
|
||||
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming)
|
||||
#' - `mo_ref("Escherichia blattae")` will return `"Burgess et al., 1973"` (with a message about the renaming)
|
||||
@ -161,9 +161,13 @@
|
||||
#' mo_info("E. coli")
|
||||
#' }
|
||||
mo_name <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "fullname", language = language, ...), language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
@ -174,22 +178,26 @@ mo_fullname <- mo_name
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
|
||||
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
replace_empty <- function(x) {
|
||||
x[x == ""] <- "spp."
|
||||
x
|
||||
}
|
||||
|
||||
|
||||
# get first char of genus and complete species in English
|
||||
genera <- mo_genus(x.mo, language = NULL)
|
||||
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL)))
|
||||
|
||||
|
||||
# exceptions for where no species is known
|
||||
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
|
||||
# exceptions for staphylococci
|
||||
@ -199,7 +207,8 @@ mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
shortnames[shortnames %like% "S. group [ABCDFGHK]"] <- paste0("G", gsub("S. group ([ABCDFGHK])", "\\1", shortnames[shortnames %like% "S. group [ABCDFGHK]"]), "S")
|
||||
# unknown species etc.
|
||||
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"])), ")")
|
||||
|
||||
|
||||
shortnames[is.na(x.mo)] <- NA_character_
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
translate_AMR(shortnames, language = language, only_unknown = FALSE)
|
||||
}
|
||||
@ -207,72 +216,104 @@ mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_subspecies <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_species <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_genus <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_family <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_order <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_class <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_phylum <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_kingdom <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
@ -283,21 +324,29 @@ mo_domain <- mo_kingdom
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_type <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gramstain <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
x.phylum <- mo_phylum(x.mo)
|
||||
# DETERMINE GRAM STAIN FOR BACTERIA
|
||||
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097
|
||||
@ -318,7 +367,7 @@ mo_gramstain <- function(x, language = get_locale(), ...) {
|
||||
"Firmicutes",
|
||||
"Tenericutes")
|
||||
| x.mo == "B_GRAMP"] <- "Gram-positive"
|
||||
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
translate_AMR(x, language = language, only_unknown = FALSE)
|
||||
}
|
||||
@ -327,12 +376,12 @@ mo_gramstain <- function(x, language = get_locale(), ...) {
|
||||
#' @export
|
||||
mo_is_gram_negative <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_gram_negative())
|
||||
x <- find_mo_col("mo_is_gram_negative")
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
grams <- mo_gramstain(x.mo, language = NULL)
|
||||
@ -346,12 +395,12 @@ mo_is_gram_negative <- function(x, language = get_locale(), ...) {
|
||||
#' @export
|
||||
mo_is_gram_positive <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_gram_positive())
|
||||
x <- find_mo_col("mo_is_gram_positive")
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
grams <- mo_gramstain(x.mo, language = NULL)
|
||||
@ -399,27 +448,39 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_snomed <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
mo_validate(x = x, property = "snomed", language = language, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_ref <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
mo_validate(x = x, property = "ref", language = language, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_authors <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x <- mo_validate(x = x, property = "ref", language = language, ...)
|
||||
# remove last 4 digits and presumably the comma and space that preceed them
|
||||
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)])
|
||||
@ -429,9 +490,13 @@ mo_authors <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_year <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x <- mo_validate(x = x, property = "ref", language = language, ...)
|
||||
# get last 4 digits
|
||||
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)])
|
||||
@ -441,21 +506,29 @@ mo_year <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_rank <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
mo_validate(x = x, property = "rank", language = language, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
result <- list(kingdom = mo_kingdom(x, language = language),
|
||||
phylum = mo_phylum(x, language = language),
|
||||
class = mo_class(x, language = language),
|
||||
@ -464,7 +537,7 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
genus = mo_genus(x, language = language),
|
||||
species = mo_species(x, language = language),
|
||||
subspecies = mo_subspecies(x, language = language))
|
||||
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
result
|
||||
}
|
||||
@ -472,12 +545,16 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_synonyms <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
IDs <- mo_name(x = x, language = NULL)
|
||||
syns <- lapply(IDs, function(newname) {
|
||||
res <- sort(microorganisms.old[which(microorganisms.old$fullname_new == newname), "fullname"])
|
||||
@ -493,7 +570,7 @@ mo_synonyms <- function(x, language = get_locale(), ...) {
|
||||
} else {
|
||||
result <- unlist(syns)
|
||||
}
|
||||
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
result
|
||||
}
|
||||
@ -501,12 +578,16 @@ mo_synonyms <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
x <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
info <- lapply(x, function(y)
|
||||
c(mo_taxonomy(y, language = language),
|
||||
list(synonyms = mo_synonyms(y),
|
||||
@ -519,7 +600,7 @@ mo_info <- function(x, language = get_locale(), ...) {
|
||||
} else {
|
||||
result <- info[[1L]]
|
||||
}
|
||||
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
result
|
||||
}
|
||||
@ -527,14 +608,18 @@ mo_info <- function(x, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
mo <- as.mo(x = x, language = language, ... = ...)
|
||||
mo_names <- mo_name(mo)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
|
||||
df <- data.frame(mo, stringsAsFactors = FALSE) %pm>%
|
||||
pm_left_join(pm_select(microorganisms, mo, source, species_id), by = "mo")
|
||||
df$url <- ifelse(df$source == "CoL",
|
||||
@ -544,14 +629,14 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
|
||||
NA_character_))
|
||||
u <- df$url
|
||||
names(u) <- mo_names
|
||||
|
||||
|
||||
if (open == TRUE) {
|
||||
if (length(u) > 1) {
|
||||
warning_("Only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
}
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
u
|
||||
}
|
||||
@ -560,21 +645,25 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_property <- function(x, property = "fullname", language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this supports using in dplyr verbs: ... %>% filter(mo_is_intrinsic_resistant(ab = "amox"))
|
||||
x <- find_mo_col("mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE)
|
||||
}
|
||||
|
||||
mo_validate <- function(x, property, language, ...) {
|
||||
check_dataset_integrity()
|
||||
|
||||
|
||||
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & length(list(...)) == 0, error = function(e) FALSE)) {
|
||||
# special case for mo_* functions where class is already <mo>
|
||||
return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE])
|
||||
}
|
||||
|
||||
|
||||
dots <- list(...)
|
||||
Becker <- dots$Becker
|
||||
if (is.null(Becker)) {
|
||||
@ -584,12 +673,12 @@ mo_validate <- function(x, property, language, ...) {
|
||||
if (is.null(Lancefield)) {
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
|
||||
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
|
||||
if (is.mo(x)
|
||||
& !Becker %in% c(TRUE, "all")
|
||||
& !Lancefield %in% c(TRUE, "all")) {
|
||||
@ -601,7 +690,7 @@ mo_validate <- function(x, property, language, ...) {
|
||||
| Lancefield %in% c(TRUE, "all")) {
|
||||
x <- exec_as.mo(x, property = property, language = language, ...)
|
||||
}
|
||||
|
||||
|
||||
if (property == "mo") {
|
||||
return(set_clean_class(x, new_class = c("mo", "character")))
|
||||
} else if (property == "snomed") {
|
||||
@ -614,13 +703,16 @@ mo_validate <- function(x, property, language, ...) {
|
||||
find_mo_col <- function(fn) {
|
||||
# this function tries to find an mo column using dplyr::cur_data_all() for mo_is_*() functions,
|
||||
# which is useful when functions are used within dplyr verbs
|
||||
df <- get_current_data("x", call = -3) # will return an error if not found
|
||||
df <- get_current_data(arg_name = "x", call = -3) # will return an error if not found
|
||||
mo <- NULL
|
||||
try({
|
||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||
}, silent = TRUE)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
message_("Using column '", font_bold(mo), "' as input for ", fn, "()")
|
||||
if (message_not_thrown_before(fn = fn)) {
|
||||
message_("Using column '", font_bold(mo), "' as input for ", fn, "()")
|
||||
remember_thrown_message(fn = fn)
|
||||
}
|
||||
return(df[, mo, drop = TRUE])
|
||||
} else {
|
||||
stop_("argument `x` is missing and no column with info about microorganisms could be found.", call = -2)
|
||||
|
||||
@ -25,9 +25,9 @@
|
||||
|
||||
#' User-defined reference data set for microorganisms
|
||||
#'
|
||||
#' @description These functions can be used to predefine your own reference to be used in [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()].
|
||||
#' @description These functions can be used to predefine your own reference to be used in [as.mo()] and consequently all [`mo_*`][mo_property()] functions (such as [mo_genus()] and [mo_gramstain()]).
|
||||
#'
|
||||
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package.
|
||||
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package, since you don't have to bother about it again after setting it up once.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param path location of your reference file, see Details. Can be `""`, `NULL` or `FALSE` to delete the reference file.
|
||||
#' @param destination destination of the compressed data file, default to the user's home directory.
|
||||
@ -103,7 +103,7 @@
|
||||
#' ```
|
||||
#' as.mo("lab_mo_ecoli")
|
||||
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> "Organisation XYZ" and "mo"
|
||||
#' #> Class <mo>
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
@ -119,7 +119,7 @@
|
||||
#' #> Removed mo_source file '/Users/me/mo_source.rds'
|
||||
#' ```
|
||||
#'
|
||||
#' If the original Excel file is moved or deleted, the mo_source file will be removed upon the next use of [as.mo()].
|
||||
#' If the original file (in the previous case an Excel file) is moved or deleted, the `mo_source.rds` file will be removed upon the next use of [as.mo()] or any [`mo_*`][mo_property()] function.
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
|
||||
15
R/rsi.R
15
R/rsi.R
@ -709,7 +709,10 @@ exec_as.rsi <- function(method,
|
||||
|
||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||
if (guideline_coerced != guideline) {
|
||||
message_("Using guideline ", font_bold(guideline_coerced), " as input for `guideline`.")
|
||||
if (message_not_thrown_before("as.rsi")) {
|
||||
message_("Using guideline ", font_bold(guideline_coerced), " as input for `guideline`.")
|
||||
remember_thrown_message("as.rsi")
|
||||
}
|
||||
}
|
||||
|
||||
new_rsi <- rep(NA_character_, length(x))
|
||||
@ -745,7 +748,10 @@ exec_as.rsi <- function(method,
|
||||
|
||||
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
|
||||
if (!guideline_coerced %like% "EUCAST") {
|
||||
warning_("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call = FALSE)
|
||||
if (message_not_thrown_before("as.rsi2")) {
|
||||
warning_("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call = FALSE)
|
||||
remember_thrown_message("as.rsi2")
|
||||
}
|
||||
} else {
|
||||
new_rsi[i] <- "R"
|
||||
next
|
||||
@ -811,7 +817,10 @@ exec_as.rsi <- function(method,
|
||||
if (any_is_intrinsic_resistant & guideline_coerced %like% "EUCAST" & !isTRUE(add_intrinsic_resistance)) {
|
||||
# found some intrinsic resistance, but was not applied
|
||||
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
warning_("Found intrinsic resistance in some bug/drug combinations, although it was not applied.\nUse `as.rsi(..., add_intrinsic_resistance = TRUE)` to apply it.", call = FALSE)
|
||||
if (message_not_thrown_before("as.rsi3")) {
|
||||
warning_("Found intrinsic resistance in some bug/drug combinations, although it was not applied.\nUse `as.rsi(..., add_intrinsic_resistance = TRUE)` to apply it.", call = FALSE)
|
||||
remember_thrown_message("as.rsi3")
|
||||
}
|
||||
warned <- TRUE
|
||||
}
|
||||
|
||||
|
||||
@ -147,8 +147,11 @@ rsi_calc <- function(...,
|
||||
}
|
||||
|
||||
if (print_warning == TRUE) {
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)",
|
||||
call = FALSE)
|
||||
if (message_not_thrown_before("rsi_calc")) {
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand: your_data %pm>% mutate_if(is.rsi.eligible, as.rsi)",
|
||||
call = FALSE)
|
||||
remember_thrown_message("rsi_calc")
|
||||
}
|
||||
}
|
||||
|
||||
if (only_count == TRUE) {
|
||||
|
||||
7
R/zzz.R
7
R/zzz.R
@ -75,6 +75,13 @@
|
||||
s3_register("skimr::get_skimmers", "rsi")
|
||||
s3_register("skimr::get_skimmers", "mic")
|
||||
s3_register("skimr::get_skimmers", "disk")
|
||||
|
||||
# if mo source exists, fire it up (see mo_source())
|
||||
try({
|
||||
if (file.exists(getOption("AMR_mo_source", "~/mo_source.rds"))) {
|
||||
invisible(get_mo_source())
|
||||
}
|
||||
}, silent = TRUE)
|
||||
}
|
||||
|
||||
.onAttach <- function(...) {
|
||||
|
||||
Reference in New Issue
Block a user