Browse Source

(v1.4.0.9044) mo tibble printing, mo_shortname() fix

main
parent
commit
df37584189
  1. 4
      DESCRIPTION
  2. 8
      NEWS.md
  3. 27
      R/aa_helper_functions.R
  4. 10
      R/count.R
  5. 25
      R/eucast_rules.R
  6. 18
      R/mdro.R
  7. 29
      R/mo.R
  8. 198
      R/mo_property.R
  9. 8
      R/mo_source.R
  10. 15
      R/rsi.R
  11. 7
      R/rsi_calc.R
  12. 7
      R/zzz.R
  13. 3
      _pkgdown.yml
  14. 2
      data-raw/eucast_rules.tsv
  15. 39
      docs/404.html
  16. 39
      docs/LICENSE-text.html
  17. 543
      docs/articles/AMR.html
  18. BIN
      docs/articles/AMR_files/figure-html/plot 1-1.png
  19. BIN
      docs/articles/AMR_files/figure-html/plot 3-1.png
  20. BIN
      docs/articles/AMR_files/figure-html/plot 4-1.png
  21. BIN
      docs/articles/AMR_files/figure-html/plot 5-1.png
  22. 27
      docs/articles/EUCAST.html
  23. 126
      docs/articles/MDR.html
  24. 27
      docs/articles/PCA.html
  25. 29
      docs/articles/SPSS.html
  26. 27
      docs/articles/WHONET.html
  27. 99
      docs/articles/benchmarks.html
  28. BIN
      docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png
  29. 27
      docs/articles/datasets.html
  30. 39
      docs/articles/index.html
  31. 33
      docs/articles/resistance_predict.html
  32. 27
      docs/articles/welcome_to_AMR.html
  33. 39
      docs/authors.html
  34. 27
      docs/index.html
  35. 91
      docs/news/index.html
  36. 45
      docs/pkgdown.css
  37. 2
      docs/pkgdown.yml
  38. 39
      docs/reference/AMR-deprecated.html
  39. 39
      docs/reference/AMR.html
  40. 39
      docs/reference/WHOCC.html
  41. 39
      docs/reference/WHONET.html
  42. 39
      docs/reference/ab_from_text.html
  43. 39
      docs/reference/ab_property.html
  44. 39
      docs/reference/age.html
  45. 39
      docs/reference/age_groups.html
  46. 39
      docs/reference/antibiotic_class_selectors.html
  47. 39
      docs/reference/antibiotics.html
  48. 39
      docs/reference/as.ab.html
  49. 39
      docs/reference/as.disk.html
  50. 39
      docs/reference/as.mic.html
  51. 39
      docs/reference/as.mo.html
  52. 39
      docs/reference/as.rsi.html
  53. 39
      docs/reference/atc_online.html
  54. 39
      docs/reference/availability.html
  55. 39
      docs/reference/bug_drug_combinations.html
  56. 39
      docs/reference/catalogue_of_life.html
  57. 39
      docs/reference/catalogue_of_life_version.html
  58. 39
      docs/reference/count.html
  59. 41
      docs/reference/eucast_rules.html
  60. 39
      docs/reference/example_isolates.html
  61. 39
      docs/reference/example_isolates_unclean.html
  62. 39
      docs/reference/filter_ab_class.html
  63. 39
      docs/reference/first_isolate.html
  64. 39
      docs/reference/g.test.html
  65. 39
      docs/reference/ggplot_pca.html
  66. 39
      docs/reference/ggplot_rsi.html
  67. 39
      docs/reference/guess_ab_col.html
  68. 39
      docs/reference/index.html
  69. 39
      docs/reference/intrinsic_resistant.html
  70. 39
      docs/reference/is_new_episode.html
  71. 39
      docs/reference/join.html
  72. 39
      docs/reference/key_antibiotics.html
  73. 39
      docs/reference/kurtosis.html
  74. 39
      docs/reference/lifecycle.html
  75. 39
      docs/reference/like.html
  76. 41
      docs/reference/mdro.html
  77. 39
      docs/reference/microorganisms.codes.html
  78. 39
      docs/reference/microorganisms.html
  79. 39
      docs/reference/microorganisms.old.html
  80. 39
      docs/reference/mo_matching_score.html
  81. 43
      docs/reference/mo_property.html
  82. 51
      docs/reference/mo_source.html
  83. 39
      docs/reference/pca.html
  84. 39
      docs/reference/plot.html
  85. 39
      docs/reference/proportion.html
  86. 39
      docs/reference/random.html
  87. 39
      docs/reference/resistance_predict.html
  88. 39
      docs/reference/rsi_translation.html
  89. 39
      docs/reference/skewness.html
  90. 39
      docs/reference/translate.html
  91. 39
      docs/survey.html
  92. 2
      man/eucast_rules.Rd
  93. 2
      man/mdro.Rd
  94. 4
      man/mo_property.Rd
  95. 8
      man/mo_source.Rd
  96. 39
      vignettes/MDR.Rmd

4
DESCRIPTION

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
Package: AMR
Version: 1.4.0.9043
Date: 2020-12-22
Version: 1.4.0.9044
Date: 2020-12-24
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),

8
NEWS.md

@ -1,5 +1,5 @@ @@ -1,5 +1,5 @@
# AMR 1.4.0.9043
## <small>Last updated: 22 December 2020</small>
# AMR 1.4.0.9044
## <small>Last updated: 24 December 2020</small>
### New
* Function `is_new_episode()` to determine patient episodes which are not necessarily based on microorganisms. It also supports grouped variables with e.g. `mutate()`, `filter()` and `summarise()` of the `dplyr` package:
@ -45,12 +45,14 @@ @@ -45,12 +45,14 @@
* Fix for plotting MIC values with `plot()`
* Added `plot()` generic to class `<disk>`
* LA-MRSA and CA-MRSA are now recognised as an abbreviation for *Staphylococcus aureus*, meaning that e.g. `mo_genus("LA-MRSA")` will return `"Staphylococcus"` and `mo_is_gram_positive("LA-MRSA")` will return `TRUE`.
* Fix for printing class <mo> in tibbles when all values are `NA`
* Fix for `mo_shortname()` when the input contains `NA`
* If `as.mo()` takes more than 30 seconds, some suggestions will be done to improve speed
### Other
* All messages and warnings thrown by this package now break sentences on whole words
* More extensive unit tests
* Internal calls to `options()` were all removed in favour of a new internal environment `mo_env`
* Our website now also has a dark theme, that switches on automatically based on system settings (such as Night Mode in macOS)
# AMR 1.4.0

27
R/aa_helper_functions.R

@ -187,13 +187,16 @@ search_type_in_df <- function(x, type, info = TRUE) { @@ -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) { @@ -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

@ -134,7 +134,10 @@ count_R <- function(..., only_all_tested = FALSE) { @@ -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) { @@ -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,

25
R/eucast_rules.R

@ -87,7 +87,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { @@ -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, @@ -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, @@ -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, @@ -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, @@ -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, @@ -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, @@ -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

@ -192,7 +192,7 @@ mdro <- function(x, @@ -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, @@ -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, @@ -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, @@ -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

@ -276,7 +276,7 @@ exec_as.mo <- function(x, @@ -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, @@ -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, @@ -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, ...) { @@ -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

@ -27,12 +27,12 @@ @@ -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 @@ @@ -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 @@ -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(), ...) { @@ -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(), ...) { @@ -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 @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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(), ...) { @@ -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, ...) { @@ -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, ...) { @@ -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, ...) { @@ -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)

8
R/mo_source.R

@ -25,9 +25,9 @@ @@ -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 @@ @@ -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 @@ @@ -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

@ -709,7 +709,10 @@ exec_as.rsi <- function(method, @@ -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, @@ -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, @@ -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
}

7
R/rsi_calc.R

@ -147,8 +147,11 @@ rsi_calc <- function(..., @@ -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

@ -75,6 +75,13 @@ @@ -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(...) {

3
_pkgdown.yml

@ -213,7 +213,8 @@ authors: @@ -213,7 +213,8 @@ authors:
template:
# this requires the 'preferably' package, https://github.com/amirmasoudabdol/preferably/
package: preferably
# package: preferably
assets: "pkgdown/logos" # use logos in this folder
params:
noindex: false
template: "flatly"

2
data-raw/eucast_rules.tsv

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
# -------------------------------------------------------------------------------------------------------------------------------
# For editing this EUCAST reference file, these values can all be used for targeting antibiotics:
# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_except_CAZ',
# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_3rd', 'cephalosporins_except_CAZ',
# 'fluoroquinolones', 'glycopeptides', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'ureidopenicillins',
# and all separate EARS-Net letter codes like 'AMC'. They can be separated by comma: 'AMC, fluoroquinolones'.
# The 'if_mo_property' column can be any column name from the AMR::microorganisms data set, or "genus_species" or "gramstain".

Can't render this file because it contains an unexpected character in line 6 and column 96.

39
docs/404.html

@ -6,22 +6,6 @@ @@ -6,22 +6,6 @@
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<!-- Inform modern browsers that this page supports both dark and light color schemes,
and the page author prefers light. -->
<meta name="color-scheme" content="dark light">
<script>
// If `prefers-color-scheme` is not supported, fall back to light mode.
// i.e. In this case, inject the `light` CSS before the others, with
// no media filter so that it will be downloaded with highest priority.
if (window.matchMedia("(prefers-color-scheme: dark)").media === "not all") {
document.documentElement.style.display = "none";
document.head.insertAdjacentHTML(
"beforeend",
"<link id=\"css\" rel=\"stylesheet\" href=\"bootstrap.css\" onload=\"document.documentElement.style.display = ''\">"
);
}
</script>
<title>Page not found (404) • AMR (for R)</title>
<!-- favicons -->
@ -36,20 +20,9 @@ @@ -36,20 +20,9 @@
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.4.1/jquery.min.js" integrity="sha256-CSXorXvZcTkaix6Yvo6HppcZGetbYMGWSFlBw8HfCJo=" crossorigin="anonymous"></script>
<!-- Bootstrap -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script>
<!-- Flatly Theme - Light -->
<link id="css-light" rel="stylesheet" href="https://bootswatch.com/3/flatly/bootstrap.css" media="(prefers-color-scheme: light), (prefers-color-scheme: no-preference)">
<!-- Darkly Theme - Dark -->
<link id="css-dark" rel="stylesheet" href="https://bootswatch.com/3/darkly/bootstrap.css" media="(prefers-color-scheme: dark)">
<!-- preferably CSS -->
<link rel="stylesheet" href="https://msberends.github.io/AMR//preferably.css">
<link id="css-code-light" rel="stylesheet" href="https://msberends.github.io/AMR//code-color-scheme-light.css" media="(prefers-color-scheme: light), (prefers-color-scheme: no-preference)">
<link id="css-code-dark" rel="stylesheet" href="https://msberends.github.io/AMR//code-color-scheme-dark.css" media="(prefers-color-scheme: dark)">
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/css/bootstrap.min.css" integrity="sha256-bZLfwXAP04zRMK2BjiO8iu9pf4FbLqX6zitd+tIvLhE=" crossorigin="anonymous" />
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script>
<!-- bootstrap-toc -->
<link rel="stylesheet" href="https://msberends.github.io/AMR//bootstrap-toc.css">
@ -85,9 +58,6 @@ @@ -85,9 +58,6 @@
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
@ -111,7 +81,7 @@ @@ -111,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9043</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9044</span>
</span>
</div>
@ -235,7 +205,6 @@ @@ -235,7 +205,6 @@
</li>
</ul>
<ul class="nav navbar-nav navbar-right">
<li>
<a href="https://github.com/msberends/AMR">
<span class="fab fa-github"></span>
@ -286,7 +255,7 @@ Content not found. Please use links in the navbar. @@ -286,7 +255,7 @@ Content not found. Please use links in the navbar.
</div>
<div class="pkgdown">
<p>Made with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1, using <a href="https://preferably.amirmasoudabdol.name/?source=footer">preferably</a> template.</p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>

39
docs/LICENSE-text.html

@ -6,22 +6,6 @@ @@ -6,22 +6,6 @@
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<!-- Inform modern browsers that this page supports both dark and light color schemes,
and the page author prefers light. -->
<meta name="color-scheme" content="dark light">
<script>
// If `prefers-color-scheme` is not supported, fall back to light mode.
// i.e. In this case, inject the `light` CSS before the others, with
// no media filter so that it will be downloaded with highest priority.
if (window.matchMedia("(prefers-color-scheme: dark)").media === "not all") {
document.documentElement.style.display = "none";
document.head.insertAdjacentHTML(
"beforeend",
"<link id=\"css\" rel=\"stylesheet\" href=\"bootstrap.css\" onload=\"document.documentElement.style.display = ''\">"
);
}
</script>
<title>License • AMR (for R)</title>
<!-- favicons -->
@ -36,20 +20,9 @@ @@ -36,20 +20,9 @@
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.4.1/jquery.min.js" integrity="sha256-CSXorXvZcTkaix6Yvo6HppcZGetbYMGWSFlBw8HfCJo=" crossorigin="anonymous"></script>
<!-- Bootstrap -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script>
<!-- Flatly Theme - Light -->
<link id="css-light" rel="stylesheet" href="https://bootswatch.com/3/flatly/bootstrap.css" media="(prefers-color-scheme: light), (prefers-color-scheme: no-preference)">
<!-- Darkly Theme - Dark -->
<link id="css-dark" rel="stylesheet" href="https://bootswatch.com/3/darkly/bootstrap.css" media="(prefers-color-scheme: dark)">
<!-- preferably CSS -->
<link rel="stylesheet" href="preferably.css">
<link id="css-code-light" rel="stylesheet" href="code-color-scheme-light.css" media="(prefers-color-scheme: light), (prefers-color-scheme: no-preference)">
<link id="css-code-dark" rel="stylesheet" href="code-color-scheme-dark.css" media="(prefers-color-scheme: dark)">
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/css/bootstrap.min.css" integrity="sha256-bZLfwXAP04zRMK2BjiO8iu9pf4FbLqX6zitd+tIvLhE=" crossorigin="anonymous" />
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script>
<!-- bootstrap-toc -->