Browse Source

(v1.7.1.9023) Removed filter_ functions, new set_ab_names(), ATC code update, ab selector update, fixes #46 and fixed #47

development
parent
commit
a2d249962f
  1. 3
      .Rbuildignore
  2. 8
      .github/workflows/check.yaml
  3. 120
      DESCRIPTION
  4. 29
      NAMESPACE
  5. 30
      NEWS.md
  6. 20
      R/aa_helper_functions.R
  7. 88
      R/ab.R
  8. 301
      R/ab_class_selectors.R
  9. 177
      R/ab_property.R
  10. 12
      R/custom_eucast_rules.R
  11. 6
      R/data.R
  12. 454
      R/deprecated.R
  13. 6
      R/eucast_rules.R
  14. 5
      R/ggplot_rsi.R
  15. 2
      R/mdro.R
  16. 68
      R/mo.R
  17. 2
      R/mo_matching_score.R
  18. 31
      R/mo_property.R
  19. 2
      R/random.R
  20. 11
      R/rsi.R
  21. BIN
      R/sysdata.rda
  22. 7
      R/zzz.R
  23. 7
      _pkgdown.yml
  24. BIN
      data-raw/AMR_latest.tar.gz
  25. 24
      data-raw/_install_deps.R
  26. 108
      data-raw/_internals.R
  27. 2
      data-raw/ab.md5
  28. BIN
      data-raw/antibiotics.dta
  29. BIN
      data-raw/antibiotics.rds
  30. BIN
      data-raw/antibiotics.sas
  31. BIN
      data-raw/antibiotics.sav
  32. 914
      data-raw/antibiotics.txt
  33. 54
      data-raw/reproduction_of_antibiotics.R
  34. BIN
      data/antibiotics.rda
  35. 5
      docs/404.html
  36. 5
      docs/LICENSE-text.html
  37. 467
      docs/articles/AMR.html
  38. 15
      docs/articles/AMR_files/accessible-code-block-0.0.1/empty-anchor.js
  39. 4
      docs/articles/AMR_files/anchor-sections-1.0/anchor-sections.css
  40. 33
      docs/articles/AMR_files/anchor-sections-1.0/anchor-sections.js
  41. BIN
      docs/articles/AMR_files/figure-html/disk_plots-1.png
  42. BIN
      docs/articles/AMR_files/figure-html/disk_plots_mo_ab-1.png
  43. BIN
      docs/articles/AMR_files/figure-html/mic_plots-1.png
  44. BIN
      docs/articles/AMR_files/figure-html/mic_plots-2.png
  45. BIN
      docs/articles/AMR_files/figure-html/mic_plots_mo_ab-1.png
  46. BIN
      docs/articles/AMR_files/figure-html/mic_plots_mo_ab-2.png
  47. BIN
      docs/articles/AMR_files/figure-html/plot 1-1.png
  48. BIN
      docs/articles/AMR_files/figure-html/plot 3-1.png
  49. BIN
      docs/articles/AMR_files/figure-html/plot 4-1.png
  50. BIN
      docs/articles/AMR_files/figure-html/plot 5-1.png
  51. 12
      docs/articles/AMR_files/header-attrs-2.3/header-attrs.js
  52. 12
      docs/articles/AMR_files/header-attrs-2.4/header-attrs.js
  53. 12
      docs/articles/AMR_files/header-attrs-2.6/header-attrs.js
  54. 12
      docs/articles/AMR_files/header-attrs-2.8/header-attrs.js
  55. 5
      docs/articles/EUCAST.html
  56. 15
      docs/articles/EUCAST_files/accessible-code-block-0.0.1/empty-anchor.js
  57. 4
      docs/articles/EUCAST_files/anchor-sections-1.0/anchor-sections.css
  58. 33
      docs/articles/EUCAST_files/anchor-sections-1.0/anchor-sections.js
  59. 12
      docs/articles/EUCAST_files/header-attrs-2.3/header-attrs.js
  60. 12
      docs/articles/EUCAST_files/header-attrs-2.4/header-attrs.js
  61. 12
      docs/articles/EUCAST_files/header-attrs-2.6/header-attrs.js
  62. 12
      docs/articles/EUCAST_files/header-attrs-2.8/header-attrs.js
  63. 61
      docs/articles/MDR.html
  64. 15
      docs/articles/MDR_files/accessible-code-block-0.0.1/empty-anchor.js
  65. 4
      docs/articles/MDR_files/anchor-sections-1.0/anchor-sections.css
  66. 33
      docs/articles/MDR_files/anchor-sections-1.0/anchor-sections.js
  67. 12
      docs/articles/MDR_files/header-attrs-2.3/header-attrs.js
  68. 12
      docs/articles/MDR_files/header-attrs-2.4/header-attrs.js
  69. 12
      docs/articles/MDR_files/header-attrs-2.6/header-attrs.js
  70. 12
      docs/articles/MDR_files/header-attrs-2.8/header-attrs.js
  71. 5
      docs/articles/PCA.html
  72. 15
      docs/articles/PCA_files/accessible-code-block-0.0.1/empty-anchor.js
  73. 4
      docs/articles/PCA_files/anchor-sections-1.0/anchor-sections.css
  74. 33
      docs/articles/PCA_files/anchor-sections-1.0/anchor-sections.js
  75. 12
      docs/articles/PCA_files/header-attrs-2.3/header-attrs.js
  76. 12
      docs/articles/PCA_files/header-attrs-2.4/header-attrs.js
  77. 12
      docs/articles/PCA_files/header-attrs-2.6/header-attrs.js
  78. 12
      docs/articles/PCA_files/header-attrs-2.8/header-attrs.js
  79. 9
      docs/articles/SPSS.html
  80. 15
      docs/articles/SPSS_files/accessible-code-block-0.0.1/empty-anchor.js
  81. 4
      docs/articles/SPSS_files/anchor-sections-1.0/anchor-sections.css
  82. 33
      docs/articles/SPSS_files/anchor-sections-1.0/anchor-sections.js
  83. 12
      docs/articles/SPSS_files/header-attrs-2.3/header-attrs.js
  84. 12
      docs/articles/SPSS_files/header-attrs-2.4/header-attrs.js
  85. 12
      docs/articles/SPSS_files/header-attrs-2.6/header-attrs.js
  86. 12
      docs/articles/SPSS_files/header-attrs-2.8/header-attrs.js
  87. 5
      docs/articles/WHONET.html
  88. 15
      docs/articles/WHONET_files/accessible-code-block-0.0.1/empty-anchor.js
  89. 4
      docs/articles/WHONET_files/anchor-sections-1.0/anchor-sections.css
  90. 33
      docs/articles/WHONET_files/anchor-sections-1.0/anchor-sections.js
  91. 12
      docs/articles/WHONET_files/header-attrs-2.3/header-attrs.js
  92. 12
      docs/articles/WHONET_files/header-attrs-2.4/header-attrs.js
  93. 12
      docs/articles/WHONET_files/header-attrs-2.6/header-attrs.js
  94. 12
      docs/articles/WHONET_files/header-attrs-2.8/header-attrs.js
  95. 73
      docs/articles/benchmarks.html
  96. 15
      docs/articles/benchmarks_files/accessible-code-block-0.0.1/empty-anchor.js
  97. 4
      docs/articles/benchmarks_files/anchor-sections-1.0/anchor-sections.css
  98. 33
      docs/articles/benchmarks_files/anchor-sections-1.0/anchor-sections.js
  99. BIN
      docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png
  100. BIN
      docs/articles/benchmarks_files/figure-html/unnamed-chunk-6-1.png

3
.Rbuildignore

@ -23,8 +23,11 @@
^data-raw$
^\.lintr$
^tests/testthat/_snaps$
^vignettes/AMR.Rmd$
^vignettes/benchmarks.Rmd$
^vignettes/datasets.Rmd$
^vignettes/EUCAST.Rmd$
^vignettes/MDR.Rmd$
^vignettes/PCA.Rmd$
^vignettes/resistance_predict.Rmd$
^vignettes/SPSS.Rmd$

8
.github/workflows/check.yaml

@ -53,9 +53,9 @@ jobs:
matrix:
config:
# these are the developmental version of R - we allow those tests to fail
- {os: macOS-latest, r: 'devel', allowfail: true}
- {os: windows-latest, r: 'devel', allowfail: true}
- {os: ubuntu-20.04, r: 'devel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
- {os: macOS-latest, r: 'devel', allowfail: false}
- {os: windows-latest, r: 'devel', allowfail: false}
- {os: ubuntu-20.04, r: 'devel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
# test all systems against all released versions of R >= 3.0, we support them all!
- {os: macOS-latest, r: '4.1', allowfail: false}
@ -65,7 +65,7 @@ jobs:
- {os: windows-latest, r: '4.0', allowfail: false}
- {os: ubuntu-20.04, r: '4.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
- {os: macOS-latest, r: '3.6', allowfail: false}
- {os: windows-latest, r: '3.6', allowfail: true}
- {os: windows-latest, r: '3.6', allowfail: false}
- {os: ubuntu-20.04, r: '3.6', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
- {os: macOS-latest, r: '3.5', allowfail: false}
- {os: windows-latest, r: '3.5', allowfail: false}

120
DESCRIPTION

@ -1,65 +1,73 @@
Package: AMR
Version: 1.7.1.9022
Date: 2021-07-23
Version: 1.7.1.9023
Date: 2021-08-16
Title: Antimicrobial Resistance Data Analysis
Authors@R: c(
person(role = c("aut", "cre"),
family = "Berends", given = c("Matthijs", "S."), email = "m.s.berends@umcg.nl", comment = c(ORCID = "0000-0001-7620-1800")),
person(role = c("aut", "ctb"),
family = "Luz", given = c("Christian", "F."), email = "c.f.luz@umcg.nl", comment = c(ORCID = "0000-0001-5809-5995")),
person(role = c("aut", "ths"),
family = "Friedrich", given = c("Alexander", "W."), email = "alex.friedrich@umcg.nl", comment = c(ORCID = "0000-0003-4881-038X")),
person(role = c("aut", "ths"),
family = "Sinha", given = c("Bhanu", "N.", "M."), email = "b.sinha@umcg.nl", comment = c(ORCID = "0000-0003-1634-0010")),
person(role = c("aut", "ths"),
family = "Albers", given = c("Casper", "J."), email = "c.j.albers@rug.nl", comment = c(ORCID = "0000-0002-9213-6743")),
person(role = c("aut", "ths"),
family = "Glasner", given = "Corinna", email = "c.glasner@umcg.nl", comment = c(ORCID = "0000-0003-1241-1328")),
person(role = "ctb",
family = "Fonville", given = c("Judith", "M."), email = "j.fonville@pamm.nl"),
person(role = "ctb",
family = "Hassing", given = c("Erwin", "E.", "A."), email = "e.hassing@certe.nl"),
person(role = "ctb",
family = "Hazenberg", given = c("Eric", "H.", "L.", "C.", "M."), email = "e.hazenberg@jbz.nl"),
person(role = "ctb",
family = "Knight", given = "Gwen", email = "gwen.knight@lshtm.ac.uk"),
person(role = "ctb",
family = "Lenglet", given = "Annick", email = "annick.lenglet@amsterdam.msf.org"),
person(role = "ctb",
family = "Meijer", given = c("Bart", "C."), email = "b.meijerg@certe.nl"),
person(role = "ctb",
family = "Ny", given = "Sofia", email = "sofia.ny@folkhalsomyndigheten.se"),
person(role = "ctb",
family = "Schade", given = c("Rogier", "P."), email = "r.schade@amsterdamumc.nl"),
person(role = "ctb",
family = "Souverein", given = "Dennis", email = "d.souvereing@streeklabhaarlem.nl"),
person(role = "ctb",
family = "Underwood", given = "Anthony", email = "au3@sanger.ac.uk"))
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by
using evidence-based methods and reliable reference data such as LPSN
<doi:10.1099/ijsem.0.004332>.
Depends:
R (>= 3.0.0)
Suggests:
cleaner,
curl,
dplyr,
ggplot2,
ggtext,
knitr,
microbenchmark,
pillar,
readxl,
rmarkdown,
rstudioapi,
rvest,
skimr,
tidyr,
tinytest,
vctrs,
xml2
VignetteBuilder: knitr,rmarkdown
Authors@R: c(
person(given = c("Matthijs", "S."),
family = "Berends",
email = "m.s.berends@umcg.nl",
role = c("aut", "cre"),
comment = c(ORCID = "0000-0001-7620-1800")),
person(given = c("Christian", "F."),
family = "Luz",
role = c("aut", "ctb"),
comment = c(ORCID = "0000-0001-5809-5995")),
person(given = c("Alexander", "W."),
family = "Friedrich",
role = c("aut", "ths"),
comment = c(ORCID = "0000-0003-4881-038X")),
person(given = c("Bhanu", "N.", "M."),
family = "Sinha",
role = c("aut", "ths"),
comment = c(ORCID = "0000-0003-1634-0010")),
person(given = c("Casper", "J."),
family = "Albers",
role = c("aut", "ths"),
comment = c(ORCID = "0000-0002-9213-6743")),
person(given = "Corinna",
family = "Glasner",
role = c("aut", "ths"),
comment = c(ORCID = "0000-0003-1241-1328")),
person(given = c("Judith", "M."),
family = "Fonville",
role = "ctb"),
person(given = c("Erwin", "E.", "A."),
family = "Hassing",
role = "ctb"),
person(given = c("Eric", "H.", "L.", "C.", "M."),
family = "Hazenberg",
role = "ctb"),
person(given = "Gwen",
family = "Knight",
role = "ctb",
comment = c(ORCID = "0000-0002-7263-9896")),
person(given = "Annick",
family = "Lenglet",
role = "ctb",
comment = c(ORCID = "0000-0003-2013-8405")),
person(given = c("Bart", "C."),
family = "Meijer",
role = "ctb"),
person(given = "Sofia",
family = "Ny",
role = "ctb",
comment = c(ORCID = "0000-0002-2017-1363")),
person(given = c("Rogier", "P."),
family = "Schade",
role = "ctb"),
person(given = "Dennis",
family = "Souverein",
role = "ctb",
comment = c(ORCID = "0000-0003-0455-0336")),
person(given = "Anthony",
family = "Underwood",
role = "ctb",
comment = c(ORCID = "0000-0002-8547-427")))
Depends: R (>= 3.0.0)
URL: https://github.com/msberends/AMR, https://msberends.github.io/AMR
BugReports: https://github.com/msberends/AMR/issues
License: GPL-2 | file LICENSE

29
NAMESPACE

@ -5,6 +5,7 @@ S3method("!=",ab_selector)
S3method("!=",mic)
S3method("%%",mic)
S3method("%/%",mic)
S3method("&",ab_selector)
S3method("&",mic)
S3method("*",mic)
S3method("+",mic)
@ -35,6 +36,7 @@ S3method("[[<-",mic)
S3method("[[<-",mo)
S3method("[[<-",rsi)
S3method("^",mic)
S3method("|",ab_selector)
S3method("|",mic)
S3method(abs,mic)
S3method(acos,mic)
@ -161,22 +163,28 @@ export(ab_atc_group2)
export(ab_cid)
export(ab_class)
export(ab_ddd)
export(ab_ddd_units)
export(ab_from_text)
export(ab_group)
export(ab_info)
export(ab_loinc)
export(ab_name)
export(ab_property)
export(ab_selector)
export(ab_synonyms)
export(ab_tradenames)
export(ab_url)
export(administrable_iv)
export(administrable_per_os)
export(age)
export(age_groups)
export(all_antimicrobials)
export(aminoglycosides)
export(aminopenicillins)
export(anti_join_microorganisms)
export(antifungals)
export(antimicrobials_equal)
export(antimycobacterials)
export(as.ab)
export(as.disk)
export(as.mic)
@ -212,24 +220,7 @@ export(eucast_dosage)
export(eucast_exceptional_phenotypes)
export(eucast_rules)
export(facet_rsi)
export(filter_1st_cephalosporins)
export(filter_2nd_cephalosporins)
export(filter_3rd_cephalosporins)
export(filter_4th_cephalosporins)
export(filter_5th_cephalosporins)
export(filter_ab_class)
export(filter_aminoglycosides)
export(filter_betalactams)
export(filter_carbapenems)
export(filter_cephalosporins)
export(filter_first_isolate)
export(filter_first_weighted_isolate)
export(filter_fluoroquinolones)
export(filter_glycopeptides)
export(filter_macrolides)
export(filter_oxazolidinones)
export(filter_penicillins)
export(filter_tetracyclines)
export(first_isolate)
export(fluoroquinolones)
export(full_join_microorganisms)
@ -253,8 +244,6 @@ export(is.rsi.eligible)
export(is_new_episode)
export(italicise_taxonomy)
export(italicize_taxonomy)
export(key_antibiotics)
export(key_antibiotics_equal)
export(key_antimicrobials)
export(kurtosis)
export(labels_rsi_count)
@ -323,12 +312,14 @@ export(rsi_predict)
export(scale_rsi_colours)
export(scale_y_percent)
export(semi_join_microorganisms)
export(set_ab_names)
export(set_mo_source)
export(skewness)
export(streptogramins)
export(susceptibility)
export(tetracyclines)
export(theme_rsi)
export(trimethoprims)
export(ureidopenicillins)
importFrom(graphics,arrows)
importFrom(graphics,axis)

30
NEWS.md

@ -1,13 +1,30 @@
# `AMR` 1.7.1.9022
## <small>Last updated: 23 July 2021</small>
# `AMR` 1.7.1.9023
## <small>Last updated: 16 August 2021</small>
### Breaking changes
* Removed all `filter_*()` functions (except for `filter_first_isolate()`), which were all deprecated in a previous package version
* Removed the `key_antibiotics()` and `key_antibiotics_equal()` functions, which were deprecated and superseded by `key_antimicrobials()` and `antimicrobials_equal()`
* Removed all previously implemented `ggplot2::ggplot()` generics for classes `<mic>`, `<disk>`, `<rsi>` and `<resistance_predict>` as they did not follow the `ggplot2` logic. They were replaced with `ggplot2::autoplot()` generics.
### New
* Function `set_ab_names()` to rename data set columns that resemble antimicrobial drugs. This allows for quickly renaming columns to official names, ATC codes, etc.
### Changed
* Previously implemented `ggplot2::ggplot()` generics for classes `<mic>`, `<disk>`, `<rsi>` and `<resistance_predict>` did not follow the `ggplot2` logic, and were replaced with `autoplot()` generics.
* Antibiotic class selectors (see `ab_class()`)
* The `antibiotics` data set now contains **all ATC codes** that are available through the [WHOCC website](https://www.whocc.no), regardless of drugs being present in more than one ATC group. This means that:
* Some drugs now contain multiple ATC codes (e.g., metronidazole contains 5)
* `antibiotics$atc` is now a `list` instead of a `character`, and this `atc` column was moved to the 5th position of the `antibiotics` data set
* `ab_atc()` does not always return a character vector with length 1, and returns a `list` if the input is larger than length 1
* Antibiotic selectors
* They now also work in R-3.0 and R-3.1, supporting every version of R since 2013
* Added more selectors: `aminopenicillins()`, `lincosamides()`, `lipoglycopeptides()`, `polymyxins()`, `quinolones()`, `streptogramins()` and `ureidopenicillins()`
* Added more selectors for antibiotic classes: `aminopenicillins()`, `antifungals()`, `antimycobacterials()`, `lincosamides()`, `lipoglycopeptides()`, `polymyxins()`, `quinolones()`, `streptogramins()`, `trimethoprims()` and `ureidopenicillins()`
* Added specific selectors for certain types for treatment: `administrable_per_os()` and `administrable_iv()`, which are based on available Defined Daily Doses (DDDs), as defined by the WHOCC. These are ideal for e.g. analysing pathogens in primary care where IV treatment is not an option. They can be combined with other AB selectors, e.g. to select penicillins that are only administrable per os (i.e., orally):
```r
example_isolates[, penicillins() & administrable_per_os()] # base R
example_isolates %>% select(penicillins() & administrable_per_os()) # dplyr
```
* Fix for using selectors multiple times in one call (e.g., using them in `dplyr::filter()` and immediately after in `dplyr::select()`)
* Added argument `only_treatable`, which defaults to `TRUE` and will exclude drugs that are only for laboratory tests and not for treating patients (such as imipenem/EDTA and gentamicin-high)
* Fixed the Gram stain (`mo_gramstain()`) determination of the class Negativicutes within the phylum of Firmicutes - they were considered Gram-positives because of their phylum but are actually Gram-negative. This impacts 137 taxonomic species, genera and families, such as *Negativicoccus* and *Veillonella*.
* Fix for duplicate ATC codes in the `antibiotics` data set
* Fix to prevent introducing `NA`s for old MO codes when running `as.mo()` on them
* Added more informative error messages when any of the `proportion_*()` and `count_*()` functions fail
@ -16,12 +33,13 @@
* The right input types for `random_mic()`, `random_disk()` and `random_rsi()` are now enforced
* `as.rsi()` can now correct for textual input (such as "Susceptible", "Resistant") in Dutch, English, French, German, Italian, Portuguese and Spanish
* When warnings are thrown because of too few isolates in any `count_*()`, `proportion_*()` function (or `resistant()` or `susceptible()`), the `dplyr` group will be shown, if available
* `ab_name()` gained argument `snake_case`, which is useful for column renaming
* Fix for legends created with `scale_rsi_colours()` when using `ggplot2` v3.3.4 or higher (this is ggplot2 bug 4511, soon to be fixed)
* Fix for minor translation errors
* Fix for the MIC interpretation of *Morganellaceae* (such as *Morganella* and *Proteus*) when using the EUCAST 2021 guideline
* Improved algorithm for generating random MICs with `random_mic()`
* Improved plot legends for MICs and disk diffusion values
* Improved speed of `as.ab()` and all `ab_*()` functions
# AMR 1.7.1

20
R/aa_helper_functions.R

@ -544,7 +544,7 @@ create_eucast_ab_documentation <- function() {
out
}
vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, last_sep = " or ") {
vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, last_sep = " or ") {
# makes unique and sorts, and this also removed NAs
v <- unique(v)
if (isTRUE(sort)) {
@ -560,6 +560,9 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, last_sep =
} else {
quotes <- quotes[1L]
}
if (isTRUE(initial_captital)) {
v[1] <- gsub("^([a-z])", "\\U\\1", v[1], perl = TRUE)
}
if (length(v) == 1) {
return(paste0(quotes, v, quotes))
}
@ -572,8 +575,9 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, last_sep =
last_sep, paste0(quotes, v[length(v)], quotes))
}
vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE) {
vector_or(v = v, quotes = quotes, reverse = reverse, sort = sort, last_sep = " and ")
vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE) {
vector_or(v = v, quotes = quotes, reverse = reverse, sort = sort,
initial_captital = initial_captital, last_sep = " and ")
}
format_class <- function(class, plural = FALSE) {
@ -840,17 +844,17 @@ unique_call_id <- function(entire_session = FALSE) {
}
message_not_thrown_before <- function(fn, entire_session = FALSE) {
# this is to prevent that messages/notes will be printed for every dplyr group
# this is to prevent that messages/notes will be printed for every dplyr group or more than once per session
# e.g. this would show a msg 4 times: example_isolates %>% group_by(hospital_id) %>% filter(mo_is_gram_negative())
test_out <- is.null(pkg_env[[paste0("thrown_msg.", fn)]]) || !identical(pkg_env[[paste0("thrown_msg.", fn)]],
unique_call_id(entire_session = entire_session))
if (isTRUE(test_out)) {
not_thrown_before <- is.null(pkg_env[[paste0("thrown_msg.", fn)]]) || !identical(pkg_env[[paste0("thrown_msg.", fn)]],
unique_call_id(entire_session = entire_session))
if (isTRUE(not_thrown_before)) {
# message was not thrown before - remember this so on the next run it will return FALSE:
assign(x = paste0("thrown_msg.", fn),
value = unique_call_id(entire_session = entire_session),
envir = pkg_env)
}
test_out
not_thrown_before
}
has_colour <- function() {

88
R/ab.R

@ -33,7 +33,7 @@
#' @param ... arguments passed on to internal functions
#' @rdname as.ab
#' @inheritSection WHOCC WHOCC
#' @details All entries in the [antibiotics] data set have three different identifiers: a human readable EARS-Net code (column `ab`, used by ECDC and WHONET), an ATC code (column `atc`, used by WHO), and a CID code (column `cid`, Compound ID, used by PubChem). The data set contains more than 5,000 official brand names from many different countries, as found in PubChem.
#' @details All entries in the [antibiotics] data set have three different identifiers: a human readable EARS-Net code (column `ab`, used by ECDC and WHONET), an ATC code (column `atc`, used by WHO), and a CID code (column `cid`, Compound ID, used by PubChem). The data set contains more than 5,000 official brand names from many different countries, as found in PubChem. Not that some drugs contain multiple ATC codes.
#'
#' All these properties will be searched for the user input. The [as.ab()] can correct for different forms of misspelling:
#'
@ -101,6 +101,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
if (is.ab(x)) {
return(x)
}
if (all(x %in% c(AB_lookup$ab, NA))) {
# all valid AB codes, but not yet right class
return(set_clean_class(x,
new_class = c("ab", "character")))
}
initial_search <- is.null(list(...)$initial_search)
already_regex <- isTRUE(list(...)$already_regex)
@ -110,24 +115,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x <- toupper(x)
x_nonNA <- x[!is.na(x)]
if (all(x_nonNA %in% antibiotics$ab, na.rm = TRUE)) {
# all valid AB codes, but not yet right class
return(set_clean_class(x,
new_class = c("ab", "character")))
}
if (all(x_nonNA %in% toupper(antibiotics$name), na.rm = TRUE)) {
# all valid AB names
out <- antibiotics$ab[match(x, toupper(antibiotics$name))]
out[is.na(x)] <- NA_character_
return(out)
}
if (all(x_nonNA %in% antibiotics$atc, na.rm = TRUE)) {
# all valid ATC codes
out <- antibiotics$ab[match(x, antibiotics$atc)]
out[is.na(x)] <- NA_character_
return(out)
}
# remove diacritics
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
x <- gsub('"', "", x, fixed = TRUE)
@ -155,13 +142,29 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
found[1L]
}
if (initial_search == TRUE) {
progress <- progress_ticker(n = length(x), n_min = 25, print = info) # start if n >= 25
# Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase)
known_names <- x %in% AB_lookup$generalised_name
x_new[known_names] <- AB_lookup$ab[match(x[known_names], AB_lookup$generalised_name)]
known_codes_ab <- x %in% AB_lookup$ab
known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AB_lookup$atc), USE.NAMES = FALSE)
known_codes_cid <- x %in% AB_lookup$cid
x_new[known_codes_ab] <- AB_lookup$ab[match(x[known_codes_ab], AB_lookup$ab)]
x_new[known_codes_atc] <- AB_lookup$ab[vapply(FUN.VALUE = integer(1),
x[known_codes_atc],
function(x_) which(vapply(FUN.VALUE = logical(1),
AB_lookup$atc,
function(atc) x_ %in% atc)),
USE.NAMES = FALSE)]
x_new[known_codes_cid] <- AB_lookup$ab[match(x[known_codes_cid], AB_lookup$cid)]
already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid
if (initial_search == TRUE & sum(already_known) < length(x)) {
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
on.exit(close(progress))
}
for (i in seq_len(length(x))) {
for (i in which(!already_known)) {
if (initial_search == TRUE) {
progress$tick()
}
@ -189,34 +192,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
next
}
# exact name
found <- antibiotics[which(AB_lookup$generalised_name == x[i]), ]$ab
if (length(found) > 0) {
x_new[i] <- found[1L]
next
}
# exact AB code
found <- antibiotics[which(antibiotics$ab == x[i]), ]$ab
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# exact ATC code
found <- antibiotics[which(antibiotics$atc == x[i]), ]$ab
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# exact CID code
found <- antibiotics[which(antibiotics$cid == x[i]), ]$ab
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# exact LOINC code
loinc_found <- unlist(lapply(AB_lookup$generalised_loinc,
function(s) x[i] %in% s))
@ -296,7 +271,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# INITIAL SEARCH - More uncertain results ----
if (initial_search == TRUE && fast_mode == FALSE) {
@ -461,7 +436,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
}
if (initial_search == TRUE) {
if (initial_search == TRUE & sum(already_known) < length(x)) {
close(progress)
}
@ -479,11 +454,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
vector_and(x_unknown), ".",
call = FALSE)
}
x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %pm>%
pm_left_join(data.frame(x = x, x_new = x_new, stringsAsFactors = FALSE), by = "x") %pm>%
pm_pull(x_new)
x_result <- x_new[match(x_bak_clean, x)]
if (length(x_result) == 0) {
x_result <- NA_character_
}

301
R/ab_class_selectors.R

@ -23,23 +23,31 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Antibiotic Class Selectors
#' Antibiotic Selectors
#'
#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations.
#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial agent, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param ab_class an antimicrobial class, such as `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
#' @param only_treatable a [logical] to indicate whether agents that are only for laboratory tests should be excluded (defaults to `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
#' @details
#' These functions can be used in data set calls for selecting columns and filtering rows. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but also work in base \R and not only in `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
#'
#' All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc. Use the [ab_class()] function to filter/select on a manually defined antibiotic class.
#' All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
#'
#' @section Full list of supported agents:
#' The [ab_class()] function can be used to filter/select on a manually defined antibiotic class. It searches for results in the [antibiotics] data set within the columns `name`, `atc_group1` and `atc_group2`.
#'
#' `r paste0("* ", sapply(c("AMINOGLYCOSIDES", "AMINOPENICILLINS", "BETALACTAMS", "CARBAPENEMS", "CEPHALOSPORINS", "CEPHALOSPORINS_1ST", "CEPHALOSPORINS_2ND", "CEPHALOSPORINS_3RD", "CEPHALOSPORINS_4TH", "CEPHALOSPORINS_5TH", "FLUOROQUINOLONES", "GLYCOPEPTIDES", "LINCOSAMIDES", "LIPOGLYCOPEPTIDES", "MACROLIDES", "OXAZOLIDINONES", "PENICILLINS", "POLYMYXINS", "STREPTOGRAMINS", "QUINOLONES", "TETRACYCLINES", "UREIDOPENICILLINS"), function(x) paste0("``", tolower(x), "()`` can select ", vector_and(paste0(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), " (", eval(parse(text = x), envir = asNamespace("AMR")), ")"), quotes = FALSE))), "\n", collapse = "")`
#' The [ab_selector()] function can be used to internally filter the [antibiotics] data set on any results, see *Examples*. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
#'
#' The [administrable_per_os()] and [administrable_iv()] functions also rely on the [antibiotics] data set - antibiotic columns will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the [antibiotics] data set.
#'
#' @section Full list of supported (antibiotic) classes:
#'
#' `r paste0(" * ", na.omit(sapply(DEFINED_AB_GROUPS, function(ab) ifelse(tolower(gsub("^AB_", "", ab)) %in% ls(envir = asNamespace("AMR")), paste0("[", tolower(gsub("^AB_", "", ab)), "()] can select: \\cr ", vector_and(paste0(ab_name(eval(parse(text = ab), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), " (", eval(parse(text = ab), envir = asNamespace("AMR")), ")"), quotes = FALSE, sort = TRUE)), character(0)), USE.NAMES = FALSE)), "\n", collapse = "")`
#' @rdname antibiotic_class_selectors
#' @name antibiotic_class_selectors
#' @return (internally) a [character] vector of column names, with additional class `"ab_selector"`
#' @export
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
@ -55,6 +63,9 @@
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' example_isolates[, administrable_per_os()]
#'
#' # filter using any() or all()
#' example_isolates[any(carbapenems() == "R"), ]
#' subset(example_isolates, any(carbapenems() == "R"))
@ -69,6 +80,13 @@
#' # filter + select in one go: get penicillins in carbapenems-resistant strains
#' example_isolates[any(carbapenems() == "R"), penicillins()]
#'
#' # You can combine selectors with '&' to be more specific. For example,
#' # penicillins() would select benzylpenicillin ('peni G') and
#' # administrable_per_os() would select erythromycin. Yet, when combined these
#' # drugs are both omitted since benzylpenicillin is not administrable per os
#' # and erythromycin is not a penicillin:
#' example_isolates[, penicillins() & administrable_per_os()]
#'
#'
#' # dplyr -------------------------------------------------------------------
#' \donttest{
@ -78,6 +96,16 @@
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' summarise(across(aminoglycosides(), resistance))
#'
#' # You can combine selectors with '&' to be more specific:
#' example_isolates %>%
#' select(penicillins() & administrable_per_os())
#'
#' # get susceptibility for antibiotics whose name contains "trim":
#' example_isolates %>%
#' filter(first_isolate()) %>%
#' group_by(hospital_id) %>%
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' example_isolates %>%
@ -129,22 +157,146 @@ ab_class <- function(ab_class,
meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_selector(NULL, only_rsi_columns = only_rsi_columns, ab_class = ab_class, only_treatable = only_treatable)
ab_select_exec(NULL, only_rsi_columns = only_rsi_columns, ab_class = ab_class, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
#' @export
ab_selector <- function(filter,
only_rsi_columns = FALSE,
only_treatable = TRUE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# but it only takes a couple of milliseconds
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
call <- substitute(filter)
agents <- tryCatch(AMR::antibiotics[which(eval(call, envir = AMR::antibiotics)), "ab", drop = TRUE],
error = function(e) stop_(e$message, call = -5))
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(function_name = "ab_selector",
agents = agents,
ab_group = NULL,
examples = "",
call = call)
structure(unname(agents),
class = c("ab_selector", "character"))
}
#' @rdname antibiotic_class_selectors
#' @export
administrable_per_os <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# but it only takes a couple of milliseconds
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
agents_all <- antibiotics[which(!is.na(antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- antibiotics[which(antibiotics$ab %in% ab_in_data & !is.na(antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(function_name = "administrable_per_os",
agents = agents,
ab_group = "administrable_per_os",
examples = paste0(" (such as ",
vector_or(ab_name(sample(agents_all,
size = min(5, length(agents_all)),
replace = FALSE),
tolower = TRUE,
language = NULL),
quotes = FALSE),
")"))
structure(unname(agents),
class = c("ab_selector", "character"))
}
#' @rdname antibiotic_class_selectors
#' @export
administrable_iv <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# but it only takes a couple of milliseconds
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
agents_all <- antibiotics[which(!is.na(antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- antibiotics[which(antibiotics$ab %in% ab_in_data & !is.na(antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(function_name = "administrable_iv",
agents = agents,
ab_group = "administrable_iv",
examples = "")
structure(unname(agents),
class = c("ab_selector", "character"))
}
# nolint start
# #' @rdname antibiotic_class_selectors
# #' @export
# not_intrinsic_resistant <- function(mo, ..., only_rsi_columns = FALSE) {
# meet_criteria(mo, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), has_length = 1, allow_NA = FALSE)
# meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
#
# x <- as.mo(mo, ...)
# wont_work <- intrinsic_resistant[which(intrinsic_resistant$microorganism == mo_name(x, language = NULL)),
# "antibiotic",
# drop = TRUE]
#
# # get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# # but it only takes a couple of milliseconds
# vars_df <- get_current_data(arg_name = NA, call = -2)
# # to improve speed, get_column_abx() will only run once when e.g. in a select or group call
# ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
#
# agents <- ab_in_data[!names(ab_in_data) %in% as.character(as.ab(wont_work))]
#
# # show used version number once per session (pkg_env will reload every session)
# if (message_not_thrown_before("intrinsic_resistant_version.ab", entire_session = TRUE)) {
# message_("Determining intrinsic resistance based on ",
# format_eucast_version_nr(3.2, markdown = FALSE), ". ",
# font_red("This note will be shown once per session."))
# }
#
# message_agent_names(function_name = "not_intrinsic_resistant",
# agents = ab_in_data,
# ab_group = NULL,
# examples = "",
# call = mo_name(x, language = NULL))
#
# agents
# }
# nolint end
#' @rdname antibiotic_class_selectors
#' @export
aminoglycosides <- function(only_rsi_columns = FALSE, only_treatable = TRUE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_selector("aminoglycosides", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
ab_select_exec("aminoglycosides", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
#' @export
aminopenicillins <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("aminopenicillins", only_rsi_columns = only_rsi_columns)
ab_select_exec("aminopenicillins", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
antifungals <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_select_exec("antifungals", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
#' @export
antimycobacterials <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_select_exec("antimycobacterials", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
@ -152,7 +304,7 @@ aminopenicillins <- function(only_rsi_columns = FALSE) {
betalactams <- function(only_rsi_columns = FALSE, only_treatable = TRUE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_selector("betalactams", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
ab_select_exec("betalactams", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
@ -160,98 +312,98 @@ betalactams <- function(only_rsi_columns = FALSE, only_treatable = TRUE) {
carbapenems <- function(only_rsi_columns = FALSE, only_treatable = TRUE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_selector("carbapenems", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
ab_select_exec("carbapenems", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_1st <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins_1st", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins_1st", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_2nd <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins_2nd", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins_2nd", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_3rd <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins_3rd", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins_3rd", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_4th <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins_4th", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins_4th", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_5th <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("cephalosporins_5th", only_rsi_columns = only_rsi_columns)
ab_select_exec("cephalosporins_5th", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
fluoroquinolones <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("fluoroquinolones", only_rsi_columns = only_rsi_columns)
ab_select_exec("fluoroquinolones", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
glycopeptides <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("glycopeptides", only_rsi_columns = only_rsi_columns)
ab_select_exec("glycopeptides", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
lincosamides <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("lincosamides", only_rsi_columns = only_rsi_columns)
ab_select_exec("lincosamides", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
lipoglycopeptides <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("lipoglycopeptides", only_rsi_columns = only_rsi_columns)
ab_select_exec("lipoglycopeptides", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
macrolides <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("macrolides", only_rsi_columns = only_rsi_columns)
ab_select_exec("macrolides", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
oxazolidinones <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("oxazolidinones", only_rsi_columns = only_rsi_columns)
ab_select_exec("oxazolidinones", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
penicillins <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("penicillins", only_rsi_columns = only_rsi_columns)
ab_select_exec("penicillins", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
@ -259,47 +411,54 @@ penicillins <- function(only_rsi_columns = FALSE) {
polymyxins <- function(only_rsi_columns = FALSE, only_treatable = TRUE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_selector("polymyxins", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
ab_select_exec("polymyxins", only_rsi_columns = only_rsi_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
#' @export
streptogramins <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("streptogramins", only_rsi_columns = only_rsi_columns)
ab_select_exec("streptogramins", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
quinolones <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("quinolones", only_rsi_columns = only_rsi_columns)
ab_select_exec("quinolones", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
tetracyclines <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("tetracyclines", only_rsi_columns = only_rsi_columns)
ab_select_exec("tetracyclines", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
trimethoprims <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_select_exec("trimethoprims", only_rsi_columns = only_rsi_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
ureidopenicillins <- function(only_rsi_columns = FALSE) {
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
ab_selector("ureidopenicillins", only_rsi_columns = only_rsi_columns)
ab_select_exec("ureidopenicillins", only_rsi_columns = only_rsi_columns)
}
ab_selector <- function(function_name,
only_rsi_columns,
only_treatable = FALSE,
ab_class = NULL) {
ab_select_exec <- function(function_name,
only_rsi_columns = FALSE,
only_treatable = FALSE,
ab_class = NULL) {
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# but it only takes a couple of milliseconds
vars_df <- get_current_data(arg_name = NA, call = -3)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE)
# untreatable drugs
untreatable <- antibiotics[which(antibiotics$name %like% "-high|EDTA|polysorbate"), "ab", drop = TRUE]
if (only_treatable == TRUE & any(untreatable %in% names(ab_in_data))) {
@ -323,7 +482,8 @@ ab_selector <- function(function_name,
if (is.null(ab_class)) {
# their upper case equivalent are vectors with class <ab>, created in data-raw/_internals.R
abx <- get(toupper(function_name), envir = asNamespace("AMR"))
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
ab_group <- function_name
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
tolower = TRUE,
@ -339,27 +499,14 @@ ab_selector <- function(function_name,
function_name <- "ab_class"
examples <- paste0(" (such as ", find_ab_names(ab_class, 2), ")")
}
# get the columns with a group names in the chosen ab class
agents <- ab_in_data[names(ab_in_data) %in% abx]
if (message_not_thrown_before(paste0(function_name, ".", paste(sort(agents), collapse = "|")))) {
if (length(agents) == 0) {
message_("No antimicrobial agents of class '", ab_group, "' found", examples, ".")
} else {
agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'")
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
message_("For `", function_name, "(",
ifelse(function_name == "ab_class",
paste0("\"", ab_class, "\""),
""),
")` using ",
ifelse(length(agents) == 1, "column ", "columns "),
vector_and(agents_formatted, quotes = FALSE, sort = FALSE))
}
}
message_agent_names(function_name = function_name,
agents = agents,
ab_group = ab_group,
examples = examples)
structure(unname(agents),
class = c("ab_selector", "character"))
@ -486,6 +633,25 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
class = c("ab_selector_any_all", "logical"))
}
#' @method & ab_selector
#' @export
#' @noRd
`&.ab_selector` <- function(e1, e2) {
# this is only required for base R, since tidyselect has already implemented this
# e.g., for: example_isolates[, penicillins() & administrable_per_os()]
structure(intersect(unclass(e1), unclass(e2)),
class = c("ab_selector", "character"))
}
#' @method | ab_selector
#' @export
#' @noRd
`|.ab_selector` <- function(e1, e2) {
# this is only required for base R, since tidyselect has already implemented this
# e.g., for: example_isolates[, penicillins() | administrable_per_os()]
structure(union(unclass(e1), unclass(e2)),
class = c("ab_selector", "character"))
}
is_any <- function(el1) {
syscall <- paste0(trimws(deparse(sys.calls()[[1]])), collapse = " ")
el1 <- gsub("(.*),.*", "\\1", el1)
@ -497,7 +663,6 @@ is_all <- function(el1) {
syscall %like% paste0("[^_a-zA-Z0-9]all\\(", "(c\\()?", el1)
}
find_ab_group <- function(ab_class) {
ab_class <- gsub("[^a-zA-Z0-9]", ".*", ab_class)
AB_lookup %pm>%
@ -534,3 +699,33 @@ find_ab_names <- function(ab_group, n = 3) {
language = NULL),
quotes = FALSE)
}
message_agent_names <- function(function_name, agents, ab_group = NULL, examples = "", call = NULL) {
if (message_not_thrown_before(paste0(function_name, ".", paste(sort(agents), collapse = "|")))) {
if (length(agents) == 0) {
if (is.null(ab_group)) {
message_("For `", function_name, "()` no antimicrobial agents found", examples, ".")
} else if (ab_group == "administrable_per_os") {
message_("No orally administrable agents found", examples, ".")
} else if (ab_group == "administrable_iv") {
message_("No IV administrable agents found", examples, ".")
} else {
message_("No antimicrobial agents of class '", ab_group, "' found", examples, ".")
}
} else {
agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'")
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
message_("For `", function_name, "(",
ifelse(function_name == "ab_class",
paste0("\"", ab_class, "\""),
ifelse(!is.null(call),
paste0(deparse(call), collapse = " "),
"")),
")` using ",
ifelse(length(agents) == 1, "column ", "columns "),
vector_and(agents_formatted, quotes = FALSE, sort = FALSE))
}
}
}

177
R/ab_property.R

@ -29,23 +29,26 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
#' @param snake_case a [logical] to indicate whether the names should be returned in so-called [snake case](https://en.wikipedia.org/wiki/Snake_case): in lower case and all spaces/slashes replaced with an underscore (`_`). This is useful for column renaming.
#' @param property one of the column names of one of the [antibiotics] data set
#' @param property one of the column names of one of the [antibiotics] data set: `vector_or(colnames(antibiotics), sort = FALSE)`.
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param administration way of administration, either `"oral"` or `"iv"`
#' @param units a [logical] to indicate whether the units instead of the DDDs itself must be returned, see *Examples*
#' @param open browse the URL using [utils::browseURL()]
#' @param ... other arguments passed on to [as.ab()]
#' @param data a [data.frame] of which the columns need to be renamed
#' @param snake_case a [logical] to indicate whether the names should be in so-called [snake case](https://en.wikipedia.org/wiki/Snake_case): in lower case and all spaces/slashes replaced with an underscore (`_`)
#' @details All output [will be translated][translate] where possible.
#'
#' The function [ab_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
#'
#' The function [set_ab_names()] is a special column renaming function for [data.frame]s. It renames columns names that resemble antimicrobial drugs. It always makes sure that the new column names are unique. If `property = "atc"` is set, preference is given to ATC codes from the J-group.
#' @inheritSection as.ab Source
#' @rdname ab_property
#' @name ab_property
#' @return
#' - An [integer] in case of [ab_cid()]
#' - A named [list] in case of [ab_info()] and multiple [ab_synonyms()]/[ab_tradenames()]
#' - A named [list] in case of [ab_info()] and multiple [ab_atc()]/[ab_synonyms()]/[ab_tradenames()]
#' - A [double] in case of [ab_ddd()]
#' - A [data.frame] in case of [set_ab_names()]
#' - A [character] in all other cases
#' @export
#' @seealso [antibiotics]
@ -69,10 +72,10 @@
#' tolower = TRUE) # "amoxicillin/clavulanic acid" "polymyxin B"
#'
#' # defined daily doses (DDD)
#' ab_ddd("AMX", "oral") # 1
#' ab_ddd("AMX", "oral", units = TRUE) # "g"
#' ab_ddd("AMX", "iv") # 1
#' ab_ddd("AMX", "iv", units = TRUE) # "g"
#' ab_ddd("AMX", "oral") # 1.5
#' ab_ddd_units("AMX", "oral") # "g"
#' ab_ddd("AMX", "iv") # 3
#' ab_ddd_units("AMX", "iv") # "g"
#'
#' ab_info("AMX") # all properties as a list
#'
@ -89,11 +92,23 @@
#' ab_atc("cephtriaxone")
#' ab_atc("cephthriaxone")
#' ab_atc("seephthriaaksone")
ab_name <- function(x, language = get_locale(), tolower = FALSE, snake_case = FALSE, ...) {
#'
#' # use set_ab_names() for renaming columns
#' colnames(example_isolates)
#' colnames(set_ab_names(example_isolates))
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' set_ab_names()
#' # set_ab_names() works with any AB property:
#' example_isolates %>%
#' set_ab_names("atc")
#' }
#' }
ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(tolower, allow_class = "logical", has_length = 1)
meet_criteria(snake_case, allow_class = "logical", has_length = 1)
x <- translate_AMR(ab_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
if (tolower == TRUE) {
@ -101,10 +116,69 @@ ab_name <- function(x, language = get_locale(), tolower = FALSE, snake_case = FA
# as we want "polymyxin B", not "polymyxin b"
x <- gsub("^([A-Z])", "\\L\\1", x, perl = TRUE)
}
x
}
#' @rdname ab_property
#' @aliases ATC
#' @export
set_ab_names <- function(data, property = "name", language = get_locale(), snake_case = property == "name") {
meet_criteria(data, allow_class = "data.frame")
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1, ignore.case = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(snake_case, allow_class = "logical", has_length = 1)
x_deparsed <- deparse(substitute(data))
if (length(x_deparsed) > 1 || any(x_deparsed %unlike% "[a-z]+")) {
x_deparsed <- "your_data"
}
property <- tolower(property)
columns <- get_column_abx(data, info = FALSE, only_rsi_columns = FALSE, sort = FALSE)
if (length(columns) == 0) {
message_("No columns with antibiotic results found for `set_ab_names()`, leaving names unchanged.")
return(data)
}
x <- vapply(FUN.VALUE = character(1),
ab_property(columns, property = property, language = language),
function(x) {
if (property == "atc") {
# try to get the J-group
if (any(x %like% "^J")) {
x[x %like% "^J"][1L]
} else {
as.character(x[1L])
}
} else {
as.character(x[1L])
}
})
if (any(x %in% c("", NA))) {
warning_("No ", property, " found for column(s): ", vector_and(columns[x %in% c("", NA)], sort = FALSE), call = FALSE)
x[x %in% c("", NA)] <- columns[x %in% c("", NA)]
}
if (snake_case == TRUE) {
x <- tolower(gsub("[^a-zA-Z0-9]+", "_", x))
}
x
if (any(duplicated(x))) {
# very hacky way of adding the index to each duplicate
# so "Amoxicillin", "Amoxicillin", "Amoxicillin"
# will be "Amoxicillin", "Amoxicillin_2", "Amoxicillin_3"
invisible(lapply(unique(x),
function(u) {
dups <- which(x == u)
if (length(dups) > 1) {
# there are duplicates
dup_add_int <- dups[2:length(dups)]
x[dup_add_int] <<- paste0(x[dup_add_int], "_", c(2:length(dups)))
}
}))
}
colnames(data)[colnames(data) %in% columns] <- x
data
}
#' @rdname ab_property
@ -112,7 +186,13 @@ ab_name <- function(x, language = get_locale(), tolower = FALSE, snake_case = FA
#' @export
ab_atc <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
ab_validate(x = x, property = "atc", ...)
atcs <- ab_validate(x = x, property = "atc", ...)
names(atcs) <- x
if (length(atcs) == 1) {
unname(unlist(atcs))
} else {
atcs
}
}
#' @rdname ab_property
@ -181,18 +261,47 @@ ab_loinc <- function(x, ...) {
#' @rdname ab_property
#' @export
ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
ab_ddd <- function(x, administration = "oral", ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
meet_criteria(units, allow_class = "logical", has_length = 1)
x <- as.ab(x, ...)
if (any(ab_name(x, language = NULL) %like% "/")) {
warning_("DDDs of combined products are available for different dose combinations and not (yet) part of the AMR package. ",
"Please refer to the WHOCC website:\n",
"www.whocc.no/ddd/list_of_ddds_combined_products/", call = FALSE)
}
ddd_prop <- administration
if (units == TRUE) {
# old behaviour
units <- list(...)$units
if (!is.null(units) && isTRUE(units)) {
if (message_not_thrown_before("ab_ddd", entire_session = TRUE)) {
warning_("Using `ab_ddd(..., units = TRUE)` is deprecated, use `ab_ddd_units()` instead. ",
"This warning will be shown once per session.", call = FALSE)
}
ddd_prop <- paste0(ddd_prop, "_units")
} else {
ddd_prop <- paste0(ddd_prop, "_ddd")
}
ab_validate(x = x, property = ddd_prop, ...)
ab_validate(x = x, property = ddd_prop)
}
#' @rdname ab_property
#' @export
ab_ddd_units <- function(x, administration = "oral", ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
x <- as.ab(x, ...)
if (any(ab_name(x, language = NULL) %like% "/")) {
warning_("DDDs of combined products are available for different dose combinations and not (yet) part of the AMR package. ",
"Please refer to the WHOCC website:\n",
"www.whocc.no/ddd/list_of_ddds_combined_products/", call = FALSE)
}
ddd_prop <- paste0(administration, "_units")
ab_validate(x = x, property = ddd_prop)
}
#' @rdname ab_property
@ -210,10 +319,10 @@ ab_info <- function(x, language = get_locale(), ...) {
atc_group1 = ab_atc_group1(x, language = language),
atc_group2 = ab_atc_group2(x, language = language),
tradenames = ab_tradenames(x),
ddd = list(oral = list(amount = ab_ddd(x, administration = "oral", units = FALSE),
units = ab_ddd(x, administration = "oral", units = TRUE)),
iv = list(amount = ab_ddd(x, administration = "iv", units = FALSE),
units = ab_ddd(x, administration = "iv", units = TRUE))))
ddd = list(oral = list(amount = ab_ddd(x, administration = "oral"),
units = ab_ddd_units(x, administration = "oral")),
iv = list(amount = ab_ddd(x, administration = "iv"),
units = ab_ddd_units(x, administration = "iv"))))
}
@ -257,16 +366,22 @@ ab_validate <- function(x, property, ...) {
check_dataset_integrity()
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% antibiotics[1, property],
error = function(e) stop(e$message, call. = FALSE))
x_bak <- x
if (!all(x %in% antibiotics[, property])) {
x <- data.frame(ab = as.ab(x, ...), stringsAsFactors = FALSE) %pm>%
pm_left_join(antibiotics, by = "ab") %pm>%
pm_pull(property)
if (tryCatch(all(x[!is.na(x)] %in% AB_lookup$ab), error = function(e) FALSE)) {
# special case for ab_* functions where class is already <ab>
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE]
} else {
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% antibiotics[1, property],
error = function(e) stop(e$message, call. = FALSE))
if (!all(x %in% AB_lookup[, property])) {
x <- as.ab(x, ...)
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE]
}
}
if (property == "ab") {
return(set_clean_class(x, new_class = c("ab", "character")))
} else if (property == "cid") {
@ -274,7 +389,7 @@ ab_validate <- function(x, property, ...) {
} else if (property %like% "ddd") {
return(as.double(x))
} else {
x[is.na(x) & !is.na(x_bak)] <- NA
x[is.na(x)] <- NA
return(x)
}
}

12
R/custom_eucast_rules.R

@ -89,9 +89,9 @@
#'
#' ### Usage of antibiotic group names
#'
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the antibiotic agents that will be matched when running the rule.
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the agents that will be matched when running the rule.
#'
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("``", tolower(x), "``\\cr(", paste0(sort(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE)), collapse = ", "), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("``", tolower(gsub("^AB_", "", x)), "``\\cr(", vector_and(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
#' @returns A [list] containing the custom rules
#' @inheritSection AMR Read more on Our Website!
#' @export
@ -140,12 +140,12 @@ custom_eucast_rules <- function(...) {
stop_ifnot(deparse(result) %like% "==",
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`")
result_group <- as.character(result)[[2]]
if (paste0(toupper(result_group), "S") %in% DEFINED_AB_GROUPS) {
if (paste0("AB_", toupper(result_group), "S") %in% DEFINED_AB_GROUPS) {
# support for e.g. 'aminopenicillin' if user meant 'aminopenicillins'
result_group <- paste0(result_group, "s")
}
if (toupper(result_group) %in% DEFINED_AB_GROUPS) {
result_group <- eval(parse(text = toupper(result_group)), envir = asNamespace("AMR"))
if (paste0("AB_", toupper(result_group)) %in% DEFINED_AB_GROUPS) {
result_group <- eval(parse(text = paste0("AB_", toupper(result_group))), envir = asNamespace("AMR"))
} else {
result_group <- tryCatch(
suppressWarnings(as.ab(result_group,
@ -157,7 +157,7 @@ custom_eucast_rules <- function(...) {
stop_if(any(is.na(result_group)),
"this result of rule ", i, " could not be translated to a single antimicrobial agent/group: \"",
as.character(result)[[2]], "\".\n\nThe input can be a name or code of an antimicrobial agent, or be one of: ",
vector_or(tolower(DEFINED_AB_GROUPS), quotes = FALSE), ".")
vector_or(tolower(gsub("AB_", "", DEFINED_AB_GROUPS)), quotes = FALSE), ".")
result_value <- as.character(result)[[3]]
result_value[result_value == "NA"] <- NA
stop_ifnot(result_value %in% c("R", "S", "I", NA),

6
R/data.R

@ -25,14 +25,14 @@
#' Data Sets with `r format(nrow(antibiotics) + nrow(antivirals), big.mark = ",")` Antimicrobials
#'
#' Two data sets containing all antibiotics/antimycotics and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antibiotics] data set. Three identifiers are included in this data set: an antibiotic ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes.
#' Two data sets containing all antibiotics/antimycotics and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antibiotics] data set. Three identifiers are included in this data set: an antibiotic ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes. Note that some drugs have multiple ATC codes.
#' @format
#' ## For the [antibiotics] data set: a [data.frame] with `r nrow(antibiotics)` observations and `r ncol(antibiotics)` variables:
#' - `ab`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
#' - `atc`\cr ATC code (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02`
#' - `cid`\cr Compound ID as found in PubChem
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
#' - `group`\cr A short and concise group name, based on WHONET and WHOCC definitions
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02`
#' - `atc_group1`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC, like `"Macrolides, lincosamides and streptogramins"`
#' - `atc_group2`\cr Official chemical subgroup (4th level ATC code) as defined by the WHOCC, like `"Macrolides"`
#' - `abbr`\cr List of abbreviations as used in many countries, also for antibiotic susceptibility testing (AST)