P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-24 18:46:14 +01:00
Code Releases Activity

new tibble export

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-08-27 20:49:37 +02:00
parent 164886f50b
commit 303d61b473
115 changed files with 836 additions and 996 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.Rbuildignore
View File

@ -24,8 +24,9 @@
^\.lintr$
^tests/testthat/_snaps$
^vignettes/AMR\.Rmd$
^vignettes/AMR_intro\.png$
^vignettes/benchmarks\.Rmd$
^vignettes/*\.not$
^vignettes/benchmarks\.Rmd\.not$
^vignettes/datasets\.Rmd$
^vignettes/EUCAST\.Rmd$
^vignettes/MDR\.Rmd$

5
AMR.Rproj
View File

@ -1,7 +1,7 @@
Version: 1.0
RestoreWorkspace: No
SaveWorkspace: Ask
SaveWorkspace: No
AlwaysSaveHistory: Yes
EnableCodeIndexing: Yes
@ -13,6 +13,7 @@ RnwWeave: Sweave
LaTeX: pdfLaTeX
AutoAppendNewline: Yes
LineEndingConversion: Posix
BuildType: Package
PackageUseDevtools: Yes
@ -20,3 +21,5 @@ PackageInstallArgs: --no-multiarch --with-keep.source
PackageBuildArgs: --no-build-vignettes
PackageCheckArgs: --no-build-vignettes --as-cran
PackageRoxygenize: rd,collate,namespace
UseNativePipeOperator: No

43
DESCRIPTION
View File

@ -1,35 +1,36 @@
Package: AMR
Version: 1.8.1.9030
Date: 2022-08-26
Version: 1.8.1.9031
Date: 2022-08-27
Title: Antimicrobial Resistance Data Analysis
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>.
Authors@R: c(
person(c("Matthijs", "S."), "Berends", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800"), email = "m.berends@certe.nl"),
person(c("Christian", "F."), "Luz", role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-5809-5995")),
person("Dennis", "Souverein", role = c("aut", "ctb"), comment = c(ORCID = "0000-0003-0455-0336")),
person(c("Erwin", "E.", "A."), "Hassing", role = c("aut", "ctb")),
person("Casper", "Albers", role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
person("Peter", "Dutey-Magni", role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
person("Judith", "Fonville", role = "ctb"),
person("Alex", "Friedrich", role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
person("Corinna", "Glasner", role = "ths", comment = c(ORCID = "0000-0003-1241-1328")),
person("Eric", "Hazenberg", role = "ctb"),
person("Gwen", "Knight", role = "ctb", comment = c(ORCID = "0000-0002-7263-9896")),
person("Annick", "Lenglet", role = "ctb", comment = c(ORCID = "0000-0003-2013-8405")),
person("Bart", "Meijer", role = "ctb"),
person("Anton", "Mymrikov", role = "ctb"),
person("Sofia", "Ny", role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
person("Rogier", "Schade", role = "ctb"),
person("Bhanu", "Sinha", role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
person("Anthony", "Underwood", role = "ctb", comment = c(ORCID = "0000-0002-8547-4277")))
person(family = "Berends", c("Matthijs", "S."), role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800"), email = "m.berends@certe.nl"),
person(family = "Luz", c("Christian", "F."), role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-5809-5995")),
person(family = "Souverein", c("Dennis"), role = c("aut", "ctb"), comment = c(ORCID = "0000-0003-0455-0336")),
person(family = "Hassing", c("Erwin", "E.", "A."), role = c("aut", "ctb")),
person(family = "Albers", c("Casper", "J."), role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
person(family = "Dutey-Magni", c("Peter"), role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
person(family = "Fonville", c("Judith", "M"), role = "ctb"),
person(family = "Friedrich", c("Alex", "W."), role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
person(family = "Glasner", c("Corinna"), role = "ths", comment = c(ORCID = "0000-0003-1241-1328")),
person(family = "Hazenberg", c("Eric", "H.", "L.", "C.", "M."), role = "ctb"),
person(family = "Knight", c("Gwen"), role = "ctb", comment = c(ORCID = "0000-0002-7263-9896")),
person(family = "Lenglet", c("Annick"), role = "ctb", comment = c(ORCID = "0000-0003-2013-8405")),
person(family = "Meijer", c("Bart", "C."), role = "ctb"),
person(family = "Mymrikov", c("Anton"), role = "ctb"),
person(family = "Ny", c("Sofia"), role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
person(family = "Schade", c("Rogier", "P."), role = "ctb"),
person(family = "Sinha", c("Bhanu", "N.", "M."), role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
person(family = "Underwood", c("Anthony"), role = "ctb", comment = c(ORCID = "0000-0002-8547-4277")))
Depends: R (>= 3.0.0)
Enhances:
cleaner,
skimr,
ggplot2,
tibble,
tidyselect
Suggests:
curl,
@ -41,7 +42,7 @@ Suggests:
rvest,
tinytest,
xml2
VignetteBuilder: knitr,rmarkdown
VignetteBuilder: knitr
URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR
BugReports: https://github.com/msberends/AMR/issues
License: GPL-2 | file LICENSE

19
NEWS.md
View File

@ -1,8 +1,10 @@
# AMR 1.8.1.9030
# AMR 1.8.1.9031
### New
* EUCAST 2022 and CLSI 2022 guidelines have been added for `as.rsi()`. EUCAST 2022 is now the new default guideline for all MIC and disks diffusion interpretations.
* Support for the following languages: Chinese, Greek, Japanese, Polish, Turkish and Ukrainian. The `AMR` package is now available in 16 languages.
* Support for `data.frame`-enhancing R packages, more specifically: `data.table`, `tibble`, and `tsibble`. AMR package functions that have a data set as output (such as `rsi_df()` and `bug_drug_combinations()`), will now return the same data type as the input. Furthermore, all our data sets are now in `tibble` format.
* Our data sets are now also continually exported to Apache Feather and Apache Parquet formats. You can find more info [in this article on our website](https://msberends.github.io/AMR/articles/datasets.html).
* Support for the following languages: Chinese, Greek, Japanese, Polish, Turkish and Ukrainian. We are very grateful for the valuable input by our colleagues from other countries. The `AMR` package is now available in 16 languages.
### Changed
* Fix for using `as.rsi()` on certain EUCAST breakpoints for MIC values
@ -16,11 +18,12 @@
* Changed value in column `prevalence` of the `microorganisms` data set from 3 to 2 for these genera: *Acholeplasma*, *Alistipes*, *Alloprevotella*, *Bergeyella*, *Borrelia*, *Brachyspira*, *Butyricimonas*, *Cetobacterium*, *Chlamydia*, *Chlamydophila*, *Deinococcus*, *Dysgonomonas*, *Elizabethkingia*, *Empedobacter*, *Haloarcula*, *Halobacterium*, *Halococcus*, *Myroides*, *Odoribacter*, *Ornithobacterium*, *Parabacteroides*, *Pedobacter*, *Phocaeicola*, *Porphyromonas*, *Riemerella*, *Sphingobacterium*, *Streptobacillus*, *Tenacibaculum*, *Terrimonas*, *Victivallis*, *Wautersiella*, *Weeksella*
* Fix for using the form `df[carbapenems() == "R", ]` using the latest `vctrs` package
* Fix for using `info = FALSE` in `mdro()`
* All data sets in this package are now exported as `tibble`, instead of base R `data.frame`s. Older R versions are still supported.
* Automatic language determination will give a note once a session
### Other
* New website to make use of the new Bootstrap 5 and pkgdown v2.0. The website now contains results for all examples and will be automatically regenerated with every change to our repository, using GitHub Actions
* Added Peter Dutey-Magni and Anton Mymrikov as contributors, to thank them for their valuable input
* Our data sets are now also continually exported to Apache Feather and Apache Parquet formats
* Set up Git Large File Storage (Git LFS) for the large SAS and SPSS file formats
@ -210,7 +213,7 @@
* Functions `oxazolidinones()` (an antibiotic selector function) and `filter_oxazolidinones()` (an antibiotic filter function) to select/filter on e.g. linezolid and tedizolid
```r
library(dplyr)
x <- example_isolates %>% select(date, hospital_id, oxazolidinones())
x <- example_isolates %>% select(date, ward, oxazolidinones())
#> Selecting oxazolidinones: column 'LNZ' (linezolid)
x <- example_isolates %>% filter_oxazolidinones()
@ -295,7 +298,7 @@
```r
library(dplyr)
example_isolates %>%
group_by(patient_id, hospital_id) %>%
group_by(patient_id, ward) %>%
filter(is_new_episode(date, episode_days = 60))
```
* Functions `mo_is_gram_negative()` and `mo_is_gram_positive()` as wrappers around `mo_gramstain()`. They always return `TRUE` or `FALSE` (except when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
@ -909,7 +912,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
boxplot()
# grouped boxplots:
septic_patients %>%
group_by(hospital_id) %>%
group_by(ward) %>%
freq(age) %>%
boxplot()
```
@ -1162,13 +1165,13 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
* Support for grouping variables, test with:
```r
septic_patients %>%
group_by(hospital_id) %>%
group_by(ward) %>%
freq(gender)
```
* Support for (un)selecting columns:
```r
septic_patients %>%
freq(hospital_id) %>%
freq(ward) %>%
select(-count, -cum_count) # only get item, percent, cum_percent
```
* Check for `hms::is.hms`

21
R/aa_helper_functions.R
View File

@ -565,7 +565,7 @@ return_after_integrity_check <- function(value, type, check_vector) {
value
}
# transforms data set to data.frame with only ASCII values, to comply with CRAN policies
# transforms data set to a tibble with only ASCII values, to comply with CRAN policies
dataset_UTF8_to_ASCII <- function(df) {
trans <- function(vect) {
iconv(vect, from = "UTF-8", to = "ASCII//TRANSLIT")
@ -587,7 +587,7 @@ dataset_UTF8_to_ASCII <- function(df) {
df[, i] <- col
}
}
df
tibble::as_tibble(df)
}
# for eucast_rules() and mdro(), creates markdown output with URLs and names
@ -711,7 +711,7 @@ meet_criteria <- function(object,
if (!is.null(pkg_env$meet_criteria_error_txt)) {
error_txt <- pkg_env$meet_criteria_error_txt
pkg_env$meet_criteria_error_txt <- NULL
stop(error_txt, call. = FALSE) # don't use stop_() here, pkg may not be loaded yet
stop(error_txt, call. = FALSE) # don't use stop_() here, our pkg may not be loaded yet
}
pkg_env$meet_criteria_error_txt <- NULL
@ -932,7 +932,7 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
#' @param entire_session show message once per session
message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
# 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())
# e.g. this would show a msg 4 times: example_isolates %>% group_by(ward) %>% filter(mo_is_gram_negative())
salt <- gsub("[^a-zA-Z0-9|_-]", "?", paste(c(...), sep = "|", collapse = "|"), perl = TRUE)
not_thrown_before <- is.null(pkg_env[[paste0("thrown_msg.", fn, ".", salt)]]) ||
!identical(pkg_env[[paste0("thrown_msg.", fn, ".", salt)]],
@ -1153,6 +1153,19 @@ create_pillar_column <- function(x, ...) {
new_pillar_shaft_simple(x, ...)
}
as_original_data_class <- function(df, old_class = NULL) {
if ("tbl_df" %in% old_class && pkg_is_available("tibble", also_load = FALSE)) {
fn <- import_fn("as_tibble", "tibble")
} else if ("tbl_ts" %in% old_class && pkg_is_available("tsibble", also_load = FALSE)) {
fn <- import_fn("as_tsibble", "tsibble")
} else if ("data.table" %in% old_class && pkg_is_available("data.table", also_load = FALSE)) {
fn <- import_fn("as.data.table", "data.table")
} else {
fn <- base::as.data.frame
}
fn(df)
}
# copied from vctrs::s3_register by their permission:
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
s3_register <- function(generic, class, method = NULL) {

4
R/ab.R
View File

@ -260,13 +260,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
}
# try if name starts with it
found <- antibiotics[which(AB_lookup$generalised_name %like% paste0("^", x_spelling)), ]$ab
found <- antibiotics[which(AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# try if name ends with it
found <- antibiotics[which(AB_lookup$generalised_name %like% paste0(x_spelling, "$")), ]$ab
found <- antibiotics[which(AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE]
if (nchar(x[i]) >= 4 & length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next

4
R/ab_property.R
View File

@ -429,10 +429,10 @@ ab_validate <- function(x, property, ...) {
} 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],
tryCatch(x[1L] %in% antibiotics[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE))
if (!all(x %in% AB_lookup[, property])) {
if (!all(x %in% AB_lookup[, property, drop = TRUE])) {
x <- as.ab(x, ...)
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE]
}

100
R/ab_selectors.R
View File

@ -49,115 +49,147 @@
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#' df <- example_isolates[ , c("hospital_id", "mo",
#' "AMP", "AMC", "TZP", "CXM", "CRO", "GEN",
#' "TOB", "COL", "IPM", "MEM", "TEC", "VAN")]
#' example_isolates
#'
#' # base R ------------------------------------------------------------------
#'
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
#' df[, carbapenems()]
#' example_isolates[, carbapenems()]
#'
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' df[, c("mo", aminoglycosides())]
#' example_isolates[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' df[, administrable_per_os()]
#' example_isolates[, administrable_per_os()]
#'
#' # filter using any() or all()
#' df[any(carbapenems() == "R"), ]
#' subset(df, any(carbapenems() == "R"))
#' example_isolates[any(carbapenems() == "R"), ]
#' subset(example_isolates, any(carbapenems() == "R"))
#'
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
#' df[any(carbapenems()), ]
#' df[all(carbapenems()), ]
#' example_isolates[any(carbapenems()), ]
#' example_isolates[all(carbapenems()), ]
#'
#' # filter with multiple antibiotic selectors using c()
#' df[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#'
#' # filter + select in one go: get penicillins in carbapenems-resistant strains
#' df[any(carbapenems() == "R"), penicillins()]
#' 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:
#' df[, penicillins() & administrable_per_os()]
#' example_isolates[, penicillins() & administrable_per_os()]
#'
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus very
#' # flexible. For instance, to select antibiotic columns with an oral DDD of at
#' # least 1 gram:
#' df[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#'
#' # dplyr -------------------------------------------------------------------
#' \donttest{
#' if (require("dplyr")) {
#'
#' # get AMR for all aminoglycosides e.g., per hospital:
#' df %>%
#' group_by(hospital_id) %>%
#' # get AMR for all aminoglycosides e.g., per ward:
#' example_isolates %>%
#' group_by(ward) %>%
#' summarise(across(aminoglycosides(), resistance))
#'
#' }
#' if (require("dplyr")) {
#'
#' # You can combine selectors with '&' to be more specific:
#' df %>%
#' example_isolates %>%
#' select(penicillins() & administrable_per_os())
#'
#' }
#' if (require("dplyr")) {
#'
#' # get AMR for only drugs that matter - no intrinsic resistance:
#' df %>%
#' example_isolates %>%
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(across(not_intrinsic_resistant(), resistance))
#'
#' }
#' if (require("dplyr")) {
#'
#' # get susceptibility for antibiotics whose name contains "trim":
#' df %>%
#' example_isolates %>%
#' filter(first_isolate()) %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
#'
#' }
#' if (require("dplyr")) {
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' df %>%
#' example_isolates %>%
#' select(carbapenems())
#'
#' }
#' if (require("dplyr")) {
#'
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
#' df %>%
#' example_isolates %>%
#' select(mo, aminoglycosides())
#'
#' }
#' if (require("dplyr")) {
#'
#' # any() and all() work in dplyr's filter() too:
#' df %>%
#' example_isolates %>%
#' filter(any(aminoglycosides() == "R"),
#' all(cephalosporins_2nd() == "R"))
#'
#' }
#' if (require("dplyr")) {
#'
#' # also works with c():
#' df %>%
#' example_isolates %>%
#' filter(any(c(carbapenems(), aminoglycosides()) == "R"))
#'
#' }
#' if (require("dplyr")) {
#'
#' # not setting any/all will automatically apply all():
#' df %>%
#' example_isolates %>%
#' filter(aminoglycosides() == "R")
#'
#' }
#' if (require("dplyr")) {
#'
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
#' df %>%
#' example_isolates %>%
#' select(mo, ab_class("mycobact"))
#'
#' }
#' if (require("dplyr")) {
#'
#' # get bug/drug combinations for only glycopeptides in Gram-positives:
#' df %>%
#' example_isolates %>%
#' filter(mo_is_gram_positive()) %>%
#' select(mo, glycopeptides()) %>%
#' bug_drug_combinations() %>%
#' format()
#'
#' }
#' if (require("dplyr")) {
#'
#' data.frame(some_column = "some_value",
#' J01CA01 = "S") %>% # ATC code of ampicillin
#' select(penicillins()) # only the 'J01CA01' column will be selected
#'
#' }
#' if (require("dplyr")) {
#'
#' # with recent versions of dplyr this is all equal:
#' x <- df[carbapenems() == "R", ]
#' y <- df %>% filter(carbapenems() == "R")
#' z <- df %>% filter(if_all(carbapenems(), ~.x == "R"))
#' identical(x, y)
#' identical(y, z)
#' x <- example_isolates[carbapenems() == "R", ]
#' y <- example_isolates %>% filter(carbapenems() == "R")
#' z <- example_isolates %>% filter(if_all(carbapenems(), ~.x == "R"))
#' identical(x, y) && identical(y, z)
#' }
#' }
ab_class <- function(ab_class,

2
R/age.R
View File

@ -160,7 +160,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter_first_isolate() %>%
#' filter(mo == as.mo("E. coli")) %>%
#' filter(mo == as.mo("Escherichia coli")) %>%
#' group_by(age_group = age_groups(age)) %>%
#' select(age_group, CIP) %>%
#' ggplot_rsi(x = "age_group",

8
R/amr.R
View File

@ -52,13 +52,11 @@
#' - Principal component analysis for AMR
#'
#' @section Reference Data Publicly Available:
#' All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this `AMR` package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find [all download links on our website](https://msberends.github.io/AMR/articles/datasets.html), which is automatically updated with every code change.
#' @section Read more on Our Website!:
#' On our website <https://msberends.github.io/AMR/> you can find [a comprehensive tutorial](https://msberends.github.io/AMR/articles/AMR.html) about how to conduct AMR data analysis, the [complete documentation of all functions](https://msberends.github.io/AMR/reference/) and [an example analysis using WHONET data](https://msberends.github.io/AMR/articles/WHONET.html).
#' All data sets in this `AMR` package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @section Contact Us:
#' For suggestions, comments or questions, please contact us at:
#' For suggestions, comments or questions, please contact us via:
#'
#' Matthijs S. Berends \cr
#' Dr. Matthijs S. Berends \cr
#' m.s.berends \[at\] umcg \[dot\] nl \cr
#' University of Groningen
#' Department of Medical Microbiology and Infection Prevention \cr

6
R/atc_online.R
View File

@ -180,15 +180,15 @@ atc_online_property <- function(atc_code,
if (property %in% c("atc", "name")) {
# ATC and name are only in first row
returnvalue[i] <- out[1, property]
returnvalue[i] <- out[1, property, drop = TRUE]
} else {
if (!"adm.r" %in% colnames(out) | is.na(out[1, "adm.r"])) {
if (!"adm.r" %in% colnames(out) | is.na(out[1, "adm.r", drop = TRUE])) {
returnvalue[i] <- NA
next
} else {
for (j in seq_len(nrow(out))) {
if (out[j, "adm.r"] == administration) {
returnvalue[i] <- out[j, property]
returnvalue[i] <- out[j, property, drop = TRUE]
}
}
}

6
R/availability.R
View File

@ -36,7 +36,7 @@
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo == as.mo("E. coli")) %>%
#' filter(mo == as.mo("Escherichia coli")) %>%
#' select_if(is.rsi) %>%
#' availability()
#' }
@ -45,6 +45,8 @@ availability <- function(tbl, width = NULL) {
meet_criteria(tbl, allow_class = "data.frame")
meet_criteria(width, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
tbl <- as.data.frame(tbl, stringsAsFactors = FALSE)
x <- vapply(FUN.VALUE = double(1), tbl, function(x) {
1 - sum(is.na(x)) / length(x)
})
@ -87,7 +89,7 @@ availability <- function(tbl, width = NULL) {
visual_resistance = vis_resistance,
stringsAsFactors = FALSE)
if (length(R[is.na(R)]) == ncol(tbl)) {
df[, 1:3]
df[, 1:3, drop = FALSE]
} else {
df
}

31
R/bug_drug_combinations.R
View File

@ -51,7 +51,7 @@
#' FUN = mo_gramstain)
#'
#' bug_drug_combinations(example_isolates,
#' FUN = function(x) ifelse(x == as.mo("E. coli"),
#' FUN = function(x) ifelse(x == as.mo("Escherichia coli"),
#' "E. coli",
#' "Others"))
#' }
@ -144,15 +144,12 @@ bug_drug_combinations <- function(x,
if (data_has_groups) {
out <- apply_group(x, "run_it", groups)
rownames(out) <- NULL
set_clean_class(out,
new_class = c("grouped", "bug_drug_combinations", "data.frame"))
} else {
out <- run_it(x)
rownames(out) <- NULL
set_clean_class(out,
new_class = c("bug_drug_combinations", "data.frame"))
}
rownames(out) <- NULL
out <- as_original_data_class(out, class(x.bak))
structure(out, class = c("bug_drug_combinations", ifelse(data_has_groups, "grouped", character(0)), class(out)))
}
#' @method format bug_drug_combinations
@ -180,18 +177,20 @@ format.bug_drug_combinations <- function(x,
meet_criteria(decimal.mark, allow_class = "character", has_length = 1)
meet_criteria(big.mark, allow_class = "character", has_length = 1)
x.bak <- x
if (inherits(x, "grouped")) {
# bug_drug_combinations() has been run on groups, so de-group here
warning_("in `format()`: formatting the output of `bug_drug_combinations()` does not support grouped variables, they were ignored")
x <- as.data.frame(x, stringsAsFactors = FALSE)
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
x <- data.frame(mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
S = sapply(idx, function(i) sum(y$S[i], na.rm = TRUE)),
I = sapply(idx, function(i) sum(y$I[i], na.rm = TRUE)),
R = sapply(idx, function(i) sum(y$R[i], na.rm = TRUE)),
total = sapply(idx, function(i) sum(y$S[i], na.rm = TRUE) +
sum(y$I[i], na.rm = TRUE) +
sum(y$R[i], na.rm = TRUE)),
S = sapply(idx, function(i) sum(x$S[i], na.rm = TRUE)),
I = sapply(idx, function(i) sum(x$I[i], na.rm = TRUE)),
R = sapply(idx, function(i) sum(x$R[i], na.rm = TRUE)),
total = sapply(idx, function(i) sum(x$S[i], na.rm = TRUE) +
sum(x$I[i], na.rm = TRUE) +
sum(x$R[i], na.rm = TRUE)),
stringsAsFactors = FALSE)
}
@ -256,7 +255,7 @@ format.bug_drug_combinations <- function(x,
# replace tidyr::pivot_wider() from here
for (i in unique(y$mo)) {
mo_group <- y[which(y$mo == i), c("ab", "txt")]
mo_group <- y[which(y$mo == i), c("ab", "txt"), drop = FALSE]
colnames(mo_group) <- c("ab", i)
rownames(mo_group) <- NULL
y <- y %pm>%
@ -269,7 +268,7 @@ format.bug_drug_combinations <- function(x,
remove_NAs()
select_ab_vars <- function(.data) {
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")])]
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")]), drop = FALSE]
}
y <- y %pm>%
@ -299,7 +298,7 @@ format.bug_drug_combinations <- function(x,
}
rownames(y) <- NULL
y
as_original_data_class(y, class(x.bak))
}
#' @method print bug_drug_combinations

14
R/catalogue_of_life.R
View File

@ -49,9 +49,9 @@ format_included_data_number <- function(data) {
#' [Click here][catalogue_of_life] for more information about the included taxa. Check which versions of the CoL and LPSN were included in this package with [catalogue_of_life_version()].
#' @section Included Taxa:
#' Included are:
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria", "Chromista", "Protozoa")), ])` (sub)species from the kingdoms of Archaea, Bacteria, Chromista and Protozoa
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), ])` (sub)species from these orders of the kingdom of Fungi: Eurotiales, Microascales, Mucorales, Onygenales, Pneumocystales, Saccharomycetales, Schizosaccharomycetales and Tremellales, as well as `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & !microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), ])` other fungal (sub)species. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package and including everything would tremendously slow down our algorithms too. By only including the aforementioned taxonomic orders, the most relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), ])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus"])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria", "Chromista", "Protozoa")), , drop = FALSE])` (sub)species from the kingdoms of Archaea, Bacteria, Chromista and Protozoa
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), , drop = FALSE])` (sub)species from these orders of the kingdom of Fungi: Eurotiales, Microascales, Mucorales, Onygenales, Pneumocystales, Saccharomycetales, Schizosaccharomycetales and Tremellales, as well as `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & !microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), ])` other fungal (sub)species. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package and including everything would tremendously slow down our algorithms too. By only including the aforementioned taxonomic orders, the most relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
#' - All `r format_included_data_number(microorganisms.old)` previously accepted names of all included (sub)species (these were taxonomically renamed)
#' - The complete taxonomic tree of all included (sub)species: from kingdom to subspecies
#' - The responsible author(s) and year of scientific publication
@ -72,13 +72,13 @@ format_included_data_number <- function(data) {
#' mo_shortname("Chlamydophila psittaci")
#'
#' # Get any property from the entire taxonomic tree for all included species
#' mo_class("E. coli")
#' mo_class("Escherichia coli")
#'
#' mo_family("E. coli")
#' mo_family("Escherichia coli")
#'
#' mo_gramstain("E. coli") # based on kingdom and phylum, see ?mo_gramstain
#' mo_gramstain("Escherichia coli") # based on kingdom and phylum, see ?mo_gramstain
#'
#' mo_ref("E. coli")
#' mo_ref("Escherichia coli")
#'
#' # Do not get mistaken - this package is about microorganisms
#' mo_kingdom("C. elegans")

8
R/count.R
View File

@ -75,7 +75,7 @@
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(R = count_R(CIP),
#' I = count_I(CIP),
#' S = count_S(CIP),
@ -86,7 +86,7 @@
#' # Number of available isolates for a whole antibiotic class
#' # (i.e., in this data set columns GEN, TOB, AMK, KAN)
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(across(aminoglycosides(), n_rsi))
#'
#' # Count co-resistance between amoxicillin/clav acid and gentamicin,
@ -108,8 +108,8 @@
#'
#' # It also supports grouping variables
#' example_isolates %>%
#' select(hospital_id, AMX, CIP) %>%
#' group_by(hospital_id) %>%
#' select(ward, AMX, CIP) %>%
#' group_by(ward) %>%
#' count_df(translate = FALSE)
#' }
#' }

2
R/custom_eucast_rules.R
View File

@ -26,7 +26,7 @@
#' Define Custom EUCAST Rules
#'
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
#' @param ... rules in [formula][`~`()] notation, see *Examples*
#' @param ... rules in [formula][base::tilde] notation, see *Examples*
#' @details
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
#' @section How it works:

116
R/data.R
View File

@ -27,7 +27,7 @@
#'
#' 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:
#' ## For the [antibiotics] data set: a [tibble[tibble::tibble] 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
#' - `cid`\cr Compound ID as found in PubChem
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
@ -43,7 +43,7 @@
#' - `iv_units`\cr Units of `iv_ddd`
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial agent. Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
#'
#' ## For the [antivirals] data set: a [data.frame] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
#' ## For the [antivirals] data set: a [tibble[tibble::tibble] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC
#' - `cid`\cr Compound ID as found in PubChem
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
@ -58,24 +58,15 @@
#' Synonyms (i.e. trade names) were derived from the Compound ID (`cid`) and consequently only available where a CID is available.
#'
#' ## Direct download
#' These data sets are available as 'flat files' for use even without \R - you can find the files here:
#'
#' * <https://github.com/msberends/AMR/raw/main/data-raw/antibiotics.txt>
#' * <https://github.com/msberends/AMR/raw/main/data-raw/antivirals.txt>
#'
#' Files in \R format (with preserved data structure) can be found here:
#'
#' * <https://github.com/msberends/AMR/raw/main/data/antibiotics.rda>
#' * <https://github.com/msberends/AMR/raw/main/data/antivirals.rda>
#' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @source World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
#'
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection WHOCC WHOCC
#' @seealso [microorganisms], [intrinsic_resistant]
#' @examples
#' head(antibiotics)
#' head(antivirals)
#' antibiotics
#' antivirals
"antibiotics"
#' @rdname antibiotics
@ -85,7 +76,7 @@
#'
#' A data set containing the full microbial taxonomy (**last updated: `r CATALOGUE_OF_LIFE$yearmonth_LPSN`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms from the Catalogue of Life (CoL) and the List of Prokaryotic names with Standing in Nomenclature (LPSN). MO codes can be looked up using [as.mo()].
#' @inheritSection catalogue_of_life Catalogue of Life
#' @format A [data.frame] with `r format(nrow(microorganisms), big.mark = ",")` observations and `r ncol(microorganisms)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(microorganisms), big.mark = ",")` observations and `r ncol(microorganisms)` variables:
#' - `mo`\cr ID of microorganism as used by this package
#' - `fullname`\cr Full name, like `"Escherichia coli"`
#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism
@ -114,10 +105,7 @@
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not (yet) in the Catalogue of Life
#'
#' ## Direct download
#' This data set is available as 'flat file' for use even without \R - you can find the file here: <https://github.com/msberends/AMR/raw/main/data-raw/microorganisms.txt>.
#'
#' The file in \R format (with preserved data structure) can be found here: <https://github.com/msberends/AMR/raw/main/data/microorganisms.rda>.
#'
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @section About the Records from LPSN (see *Source*):
#' The List of Prokaryotic names with Standing in Nomenclature (LPSN) provides comprehensive information on the nomenclature of prokaryotes. LPSN is a free to use service founded by Jean P. Euzeby in 1997 and later on maintained by Aidan C. Parte.
#'
@ -137,80 +125,80 @@
#' `r SNOMED_VERSION$current_source` as currently implemented in this `AMR` package:
#'
#' * Retrieved from the `r SNOMED_VERSION$title`, OID `r SNOMED_VERSION$current_oid`, version `r SNOMED_VERSION$current_version`; url: <`r SNOMED_VERSION$url`>
#' @inheritSection AMR Reference Data Publicly Available
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
#' @examples
#' head(microorganisms)
#' microorganisms
"microorganisms"
#' Data Set with Previously Accepted Taxonomic Names
#'
#' A data set containing old (previously valid or accepted) taxonomic names according to the Catalogue of Life. This data set is used internally by [as.mo()].
#' @inheritSection catalogue_of_life Catalogue of Life
#' @format A [data.frame] with `r format(nrow(microorganisms.old), big.mark = ",")` observations and `r ncol(microorganisms.old)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(microorganisms.old), big.mark = ",")` observations and `r ncol(microorganisms.old)` variables:
#' - `fullname`\cr Old full taxonomic name of the microorganism
#' - `fullname_new`\cr New full taxonomic name of the microorganism
#' - `ref`\cr Author(s) and year of concerning scientific publication
#' - `prevalence`\cr Prevalence of the microorganism, see [as.mo()]
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @source Catalogue of Life: Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org> (check included annual version with [catalogue_of_life_version()]).
#'
#' Parte, A.C. (2018). LPSN - List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#' @inheritSection AMR Reference Data Publicly Available
#' @seealso [as.mo()] [mo_property()] [microorganisms]
#' @examples
#' head(microorganisms.old)
#' microorganisms.old
"microorganisms.old"
#' Data Set with `r format(nrow(microorganisms.codes), big.mark = ",")` Common Microorganism Codes
#'
#' A data set containing commonly used codes for microorganisms, from laboratory systems and WHONET. Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
#' @format A [data.frame] with `r format(nrow(microorganisms.codes), big.mark = ",")` observations and `r ncol(microorganisms.codes)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(microorganisms.codes), big.mark = ",")` observations and `r ncol(microorganisms.codes)` variables:
#' - `code`\cr Commonly used code of a microorganism
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
#' @inheritSection AMR Reference Data Publicly Available
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @inheritSection catalogue_of_life Catalogue of Life
#' @seealso [as.mo()] [microorganisms]
#' @examples
#' head(microorganisms.codes)
#' microorganisms.codes
"microorganisms.codes"
#' Data Set with `r format(nrow(example_isolates), big.mark = ",")` Example Isolates
#'
#' A data set containing `r format(nrow(example_isolates), big.mark = ",")` microbial isolates with their full antibiograms. The data set reflects reality and can be used to practice AMR data analysis. For examples, please read [the tutorial on our website](https://msberends.github.io/AMR/articles/AMR.html).
#' @format A [data.frame] with `r format(nrow(example_isolates), big.mark = ",")` observations and `r ncol(example_isolates)` variables:
#' - `date`\cr date of receipt at the laboratory
#' - `hospital_id`\cr ID of the hospital, from A to D
#' - `ward_icu`\cr [logical] to determine if ward is an intensive care unit
#' - `ward_clinical`\cr [logical] to determine if ward is a regular clinical ward
#' - `ward_outpatient`\cr [logical] to determine if ward is an outpatient clinic
#' - `age`\cr age of the patient
#' - `gender`\cr gender of the patient
#' - `patient_id`\cr ID of the patient
#' - `mo`\cr ID of microorganism created with [as.mo()], see also [microorganisms]
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()]
#' @inheritSection AMR Reference Data Publicly Available
#' A data set containing `r format(nrow(example_isolates), big.mark = ",")` microbial isolates with their full antibiograms. This data set contains randomised fictitious data, but reflects reality and can be used to practise AMR data analysis. For examples, please read [the tutorial on our website](https://msberends.github.io/AMR/articles/AMR.html).
#' @format A [tibble[tibble::tibble] with `r format(nrow(example_isolates), big.mark = ",")` observations and `r ncol(example_isolates)` variables:
#' - `date`\cr Date of receipt at the laboratory
#' - `patient`\cr ID of the patient
#' - `age`\cr Age of the patient
#' - `gender`\cr Gender of the patient, either `r vector_or(example_isolates$gender)`
#' - `ward`\cr Ward type where the patient was admitted, either `r vector_or(example_isolates$ward)`
#' - `mo`\cr ID of microorganism created with [as.mo()], see also the [microorganisms] data set
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [set_ab_names()] or [ab_name()]
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @examples
#' head(example_isolates)
#' example_isolates
"example_isolates"
#' Data Set with Unclean Data
#'
#' A data set containing `r format(nrow(example_isolates_unclean), big.mark = ",")` microbial isolates that are not cleaned up and consequently not ready for AMR data analysis. This data set can be used for practice.
#' @format A [data.frame] with `r format(nrow(example_isolates_unclean), big.mark = ",")` observations and `r ncol(example_isolates_unclean)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(example_isolates_unclean), big.mark = ",")` observations and `r ncol(example_isolates_unclean)` variables:
#' - `patient_id`\cr ID of the patient
#' - `date`\cr date of receipt at the laboratory
#' - `hospital`\cr ID of the hospital, from A to C
#' - `bacteria`\cr info about microorganism that can be transformed with [as.mo()], see also [microorganisms]
#' - `AMX:GEN`\cr 4 different antibiotics that have to be transformed with [as.rsi()]
#' @inheritSection AMR Reference Data Publicly Available
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @examples
#' head(example_isolates_unclean)
#' example_isolates_unclean
"example_isolates_unclean"
#' Data Set with `r format(nrow(WHONET), big.mark = ",")` Isolates - WHONET Example
#'
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names are created using online surname generators and are only in place for practice purposes.
#' @format A [data.frame] with `r format(nrow(WHONET), big.mark = ",")` observations and `r ncol(WHONET)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(WHONET), big.mark = ",")` observations and `r ncol(WHONET)` variables:
#' - `Identification number`\cr ID of the sample
#' - `Specimen number`\cr ID of the specimen
#' - `Organism`\cr Name of the microorganism. Before analysis, you should transform this to a valid microbial class, using [as.mo()].
@ -237,15 +225,16 @@
#' - `Comment`\cr Other comments
#' - `Date of data entry`\cr [Date] this data was entered in WHONET
#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()].
#' @inheritSection AMR Reference Data Publicly Available
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @examples
#' head(WHONET)
#' WHONET
"WHONET"
#' Data Set for R/SI Interpretation
#'
#' Data set containing reference data to interpret MIC and disk diffusion to R/SI values, according to international guidelines. Currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
#' @format A [data.frame] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
#' - `guideline`\cr Name of the guideline
#' - `method`\cr Either `r vector_or(rsi_translation$method)`
#' - `site`\cr Body site, e.g. "Oral" or "Respiratory"
@ -258,31 +247,35 @@
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' @details
#' The repository of this `AMR` package contains a file comprising this exact data set: <https://github.com/msberends/AMR/blob/main/data-raw/rsi_translation.txt>. This file **allows for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. The file is updated automatically and the `mo` and `ab` columns have been transformed to contain the full official names instead of codes.
#' @inheritSection AMR Reference Data Publicly Available
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#'
#' They **allow for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI.
#' @seealso [intrinsic_resistant]
#' @examples
#' head(rsi_translation)
#' rsi_translation
"rsi_translation"
#' Data Set with Bacterial Intrinsic Resistance
#'
#' Data set containing defined intrinsic resistance by EUCAST of all bug-drug combinations.
#' @format A [data.frame] with `r format(nrow(intrinsic_resistant), big.mark = ",")` observations and `r ncol(intrinsic_resistant)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(intrinsic_resistant), big.mark = ",")` observations and `r ncol(intrinsic_resistant)` variables:
#' - `mo`\cr Microorganism ID
#' - `ab`\cr Antibiotic ID
#' @details The repository of this `AMR` package contains a file comprising this data set with full taxonomic and antibiotic names: <https://github.com/msberends/AMR/blob/main/data-raw/intrinsic_resistant.txt>. This file **allows for machine reading EUCAST guidelines about intrinsic resistance**, which is almost impossible with the Excel and PDF files distributed by EUCAST. The file is updated automatically.
#'
#' @details
#' This data set is based on `r format_eucast_version_nr(3.3)`.
#' @inheritSection AMR Reference Data Publicly Available
#'
#' ## Direct download
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#'
#' They **allow for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI.
#' @examples
#' head(intrinsic_resistant)
#' intrinsic_resistant
"intrinsic_resistant"
#' Data Set with Treatment Dosages as Defined by EUCAST
#'
#' EUCAST breakpoints used in this package are based on the dosages in this data set. They can be retrieved with [eucast_dosage()].
#' @format A [data.frame] with `r format(nrow(dosage), big.mark = ",")` observations and `r ncol(dosage)` variables:
#' @format A [tibble[tibble::tibble] with `r format(nrow(dosage), big.mark = ",")` observations and `r ncol(dosage)` 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
#' - `name`\cr Official name of the antimicrobial agent as used by WHONET/EARS-Net or the WHO
#' - `type`\cr Type of the dosage, either `r vector_or(dosage$type)`
@ -292,8 +285,11 @@
#' - `notes`\cr Additional dosage notes
#' - `original_txt`\cr Original text in the PDF file of EUCAST
#' - `eucast_version`\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply
#' @details `r format_eucast_version_nr(11.0)` are based on the dosages in this data set.
#' @inheritSection AMR Reference Data Publicly Available
#' @details
#' This data set is based on `r format_eucast_version_nr(11.0)`.
#'
#' ## Direct download
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @examples
#' head(dosage)
#' dosage
"dosage"

27
R/episode.R
View File

@ -63,26 +63,34 @@
#' # episodes based on any (combination of) grouping variables:
#' df %>%
#' mutate(condition = sample(x = c("A", "B", "C"),
#' size = 2000,
#' size = 200,
#' replace = TRUE)) %>%
#' group_by(condition) %>%
#' mutate(new_episode = is_new_episode(date, 365)) %>%
#' select(patient_id, date, condition, new_episode)
#' select(patient, date, condition, new_episode)
#'
#' }
#' if (require("dplyr")) {
#'
#' df %>%
#' group_by(hospital_id, patient_id) %>%
#' group_by(ward, patient) %>%
#' transmute(date,
#' patient_id,
#' patient,
#' new_index = get_episode(date, 60),
#' new_logical = is_new_episode(date, 60))
#'
#' }
#' if (require("dplyr")) {
#'
#' df %>%
#' group_by(hospital_id) %>%
#' summarise(n_patients = n_distinct(patient_id),
#' group_by(ward) %>%
#' summarise(n_patients = n_distinct(patient),
#' n_episodes_365 = sum(is_new_episode(date, episode_days = 365)),
#' n_episodes_60 = sum(is_new_episode(date, episode_days = 60)),
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30)))
#'
#' }
#' if (require("dplyr")) {
#'
#' # grouping on patients and microorganisms leads to the same
#' # results as first_isolate() when using 'episode-based':
@ -91,16 +99,19 @@
#' method = "episode-based")
#'
#' y <- df %>%
#' group_by(patient_id, mo) %>%
#' group_by(patient, mo) %>%
#' filter(is_new_episode(date, 365)) %>%
#' ungroup()
#'
#' identical(x, y)
#'
#' }
#' if (require("dplyr")) {
#'
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
#' # since you can now group on anything that seems relevant:
#' df %>%
#' group_by(patient_id, mo, hospital_id, ward_icu) %>%
#' group_by(patient, mo, ward) %>%
#' mutate(flag_episode = is_new_episode(date, 365)) %>%
#' select(group_vars(.), flag_episode)
#' }

22
R/eucast_rules.R
View File

@ -52,7 +52,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
#'
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
#' @param x data with antibiotic columns, such as `amox`, `AMX` and `AMC`
#' @param x a data set with antibiotic columns, such as `amox`, `AMX` and `AMC`
#' @param info a [logical] to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
@ -412,11 +412,11 @@ eucast_rules <- function(x,
}
if (any(x$genus == "Staphylococcus", na.rm = TRUE)) {
all_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), ]
all_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), , drop = FALSE]
all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL))
}
if (any(x$genus == "Streptococcus", na.rm = TRUE)) {
all_strep <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), ]
all_strep <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), , drop = FALSE]
all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL))
}
@ -432,7 +432,7 @@ eucast_rules <- function(x,
font_red(paste0("v", utils::packageDescription("AMR")$Version, ", ",
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"))), "), see ?eucast_rules\n"))))
}
ab_enzyme <- subset(antibiotics, name %like% "/")[, c("ab", "name")]
ab_enzyme <- subset(antibiotics, name %like% "/")[, c("ab", "name"), drop = FALSE]
colnames(ab_enzyme) <- c("enzyme_ab", "enzyme_name")
ab_enzyme$base_name <- gsub("^([a-zA-Z0-9]+).*", "\\1", ab_enzyme$enzyme_name)
ab_enzyme$base_ab <- antibiotics[match(ab_enzyme$base_name, antibiotics$name), "ab", drop = TRUE]
@ -446,7 +446,7 @@ eucast_rules <- function(x,
amox$base_name <- ab_name("AMX", language = NULL)
# merge and sort
ab_enzyme <- rbind(ab_enzyme, ampi, amox)
ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), ]
ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), , drop = FALSE]
for (i in seq_len(nrow(ab_enzyme))) {
# check if both base and base + enzyme inhibitor are part of the data set
@ -917,7 +917,7 @@ eucast_rules <- function(x,
# Return data set ---------------------------------------------------------
if (verbose == TRUE) {
verbose_info
as_original_data_class(verbose_info, old_attributes$class)
} else {
# x was analysed with only unique rows, so join everything together again
x <- x[, c(cols_ab, ".rowid"), drop = FALSE]
@ -925,7 +925,7 @@ eucast_rules <- function(x,
x.bak <- x.bak %pm>%
pm_left_join(x, by = ".rowid")
x.bak <- x.bak[, old_cols, drop = FALSE]
# reset original attributes
# reset original attributes, no need for as_original_data_class() here
attributes(x.bak) <- old_attributes
x.bak
}
@ -1060,15 +1060,19 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 11.0)
lst[[i]] <- list(ab = "",
name = "",
standard_dosage = ifelse("standard_dosage" %in% df$type,
df[which(df$type == "standard_dosage"), ]$original_txt,
df[which(df$type == "standard_dosage"), "original_txt", drop = TRUE],
NA_character_),
high_dosage = ifelse("high_dosage" %in% df$type,
df[which(df$type == "high_dosage"), ]$original_txt,
df[which(df$type == "high_dosage"), "original_txt", drop = TRUE],
NA_character_))
}
out <- do.call("rbind", lapply(lst, as.data.frame, stringsAsFactors = FALSE))
rownames(out) <- NULL
out$ab <- ab
out$name <- ab_name(ab, language = NULL)
if (pkg_is_available("tibble", also_load = FALSE)) {
import_fn("as_tibble", "tibble")(out)
} else {
out
}
}

49
R/first_isolate.R
View File

@ -32,7 +32,7 @@
#' @param col_mo column name of the IDs of the microorganisms (see [as.mo()]), defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
#' @param col_testcode column name of the test codes. Use `col_testcode = NULL` to **not** exclude certain test codes (such as test codes for screening). In that case `testcodes_exclude` will be ignored.
#' @param col_specimen column name of the specimen type or group
#' @param col_icu column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU)
#' @param col_icu column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU). This can also be a [logical] vector with the same length as rows in `x`.
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first isolates, see [key_antimicrobials()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see *Source*.
#' @param testcodes_exclude a [character] vector with test codes that should be excluded (case-insensitive)
@ -119,7 +119,7 @@
#' @rdname first_isolate
#' @seealso [key_antimicrobials()]
#' @export
#' @return A [`logical`] vector
#' @return A [logical] vector
#' @source Methodology of this function is strictly based on:
#'
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition**, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
@ -139,35 +139,21 @@
#' example_isolates %>%
#' filter(first_isolate())
#'
#' }
#' if (require("dplyr")) {
#'
#' # short-hand version:
#' example_isolates %>%
#' filter_first_isolate(info = FALSE)
#'
#' }
#' if (require("dplyr")) {
#'
#' # flag the first isolates per group:
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' mutate(first = first_isolate()) %>%
#' select(hospital_id, date, patient_id, mo, first)
#'
#' # now let's see if first isolates matter:
#' A <- example_isolates %>%
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' B <- example_isolates %>%
#' filter_first_isolate() %>% # the 1st isolate filter
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' # Have a look at A and B.
#' A
#' B
#'
#' # B is more reliable because every isolate is counted only once.
#' # Gentamicin resistance in hospital D appears to be 4.2% higher than
#' # when you (erroneously) would have used all isolates for analysis.
#' select(ward, date, patient, mo, first)
#' }
#' }
first_isolate <- function(x = NULL,
@ -217,7 +203,15 @@ first_isolate <- function(x = NULL,
col_specimen <- NULL
}
meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_icu, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
if (is.logical(col_icu)) {
meet_criteria(col_icu, allow_class = "logical", has_length = c(1, nrow(x)), allow_NULL = TRUE)
if (length(col_icu) == 1) {
col_icu <- rep(col_icu, nrow(x))
}
} else {
meet_criteria(col_icu, allow_class = c("character", "logical"), has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
col_icu <- x[, col_icu, drop = TRUE]
}
# method
method <- coerce_method(method)
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based"))
@ -343,7 +337,6 @@ first_isolate <- function(x = NULL,
check_columns_existance(col_patient_id)
check_columns_existance(col_mo)
check_columns_existance(col_testcode)
check_columns_existance(col_icu)
check_columns_existance(col_keyantimicrobials)
# convert dates to Date
@ -508,10 +501,10 @@ first_isolate <- function(x = NULL,
}
if (!is.null(col_icu)) {
if (icu_exclude == TRUE) {
message_("Excluding isolates from ICU.",
message_("Excluding ", format(sum(!col_icu, na.rm = TRUE), big.mark = ","), " isolates from ICU.",
add_fn = font_black,
as_note = FALSE)
x[which(as.logical(x[, col_icu, drop = TRUE])), "newvar_first_isolate"] <- FALSE
x[which(col_icu), "newvar_first_isolate"] <- FALSE
} else {
message_("Including isolates from ICU.",
add_fn = font_black,

42
R/ggplot_rsi.R
View File

@ -66,12 +66,15 @@
#' @export
#' @examples
#' \donttest{
#' if (require("ggplot2") & require("dplyr")) {
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # get antimicrobial results for drugs against a UTI:
#' ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) +
#' geom_rsi()
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # prettify the plot using some additional functions:
#' df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)
#' ggplot(df) +
@ -81,16 +84,25 @@
#' labels_rsi_count() +
#' theme_rsi()
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # or better yet, simplify this using the wrapper function - a single command:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%
#' ggplot_rsi()
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # get only proportions and no counts:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%
#' ggplot_rsi(datalabels = FALSE)
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # add other ggplot2 arguments as you like:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%
@ -100,11 +112,17 @@
#' linetype = 2,
#' alpha = 0.25)
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # you can alter the colours with colour names:
#' example_isolates %>%
#' select(AMX) %>%
#' ggplot_rsi(colours = c(SI = "yellow"))
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # but you can also use the built-in colour-blind friendly colours for
#' # your plots, where "S" is green, "I" is yellow and "R" is red:
#' data.frame(x = c("Value1", "Value2", "Value3"),
@ -114,33 +132,41 @@
#' geom_col(aes(x = x, y = y, fill = z)) +
#' scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R")
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # resistance of ciprofloxacine per age group
#' example_isolates %>%
#' mutate(first_isolate = first_isolate()) %>%
#' filter(first_isolate == TRUE,
#' mo == as.mo("E. coli")) %>%
#' mo == as.mo("Escherichia coli")) %>%
#' # age_groups() is also a function in this AMR package:
#' group_by(age_group = age_groups(age)) %>%
#' select(age_group, CIP) %>%
#' ggplot_rsi(x = "age_group")
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # a shorter version which also adjusts data label colours:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%
#' ggplot_rsi(colours = FALSE)
#'
#' }
#' if (require("ggplot2") && require("dplyr")) {
#'
#' # it also supports groups (don't forget to use the group var on `x` or `facet`):
#' example_isolates %>%
#' filter(mo_is_gram_negative()) %>%
#' filter(mo_is_gram_negative(), ward != "Outpatient") %>%
#' # select only UTI-specific drugs
#' select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>%
#' group_by(hospital_id) %>%
#' ggplot_rsi(x = "hospital_id",
#' select(ward, AMX, NIT, FOS, TMP, CIP) %>%
#' group_by(ward) %>%
#' ggplot_rsi(x = "ward",
#' facet = "antibiotic",
#' nrow = 1,
#' title = "AMR of Anti-UTI Drugs Per Hospital",
#' x.title = "Hospital",
#' title = "AMR of Anti-UTI Drugs Per Ward",
#' x.title = "Ward",
#' datalabels = FALSE)
#' }
#' }

20
R/join_microorganisms.R
View File

@ -42,12 +42,6 @@
#' left_join_microorganisms(as.mo("K. pneumoniae"))
#' left_join_microorganisms("B_KLBSL_PNMN")
#'
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' left_join_microorganisms() %>%
#' colnames()
#'
#' df <- data.frame(date = seq(from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
#' by = 1),
@ -55,8 +49,15 @@
#' "E. coli", "E. coli", "E. coli")),
#' stringsAsFactors = FALSE)
#' colnames(df)
#'
#' df_joined <- left_join_microorganisms(df, "bacteria")
#' colnames(df_joined)
#'
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' left_join_microorganisms() %>%
#' colnames()
#' }
#' }
inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
@ -119,9 +120,14 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
check_dataset_integrity()
if (!is.data.frame(x)) {
if (pkg_is_available("tibble", also_load = FALSE)) {
x <- import_fn("tibble", "tibble")(mo = x)
} else {
x <- data.frame(mo = x, stringsAsFactors = FALSE)
}
by <- "mo"
}
x.bak <- x
if (is.null(by)) {
by <- search_type_in_df(x, "mo", info = FALSE)
if (is.null(by) && NCOL(x) == 1) {
@ -171,5 +177,5 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
warning_("in `", type, "_join()`: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.")
}
joined
as_original_data_class(joined, class(x.bak))
}

6
R/like.R
View File

@ -59,11 +59,9 @@
#' a[1] %like% b
#' a %like% b[1]
#'
#' # get isolates whose name start with 'Ent' or 'ent'
#' example_isolates[which(mo_name(example_isolates$mo) %like% "^ent"), ]
#' \donttest{
#' # faster way, since mo_name() is context-aware:
#' example_isolates[which(mo_name() %like% "^ent"), ]
#' # get isolates whose name start with 'Entero' (case-insensitive)
#' example_isolates[which(mo_name() %like% "^entero"), ]
#'
#' if (require("dplyr")) {
#' example_isolates %>%

2
R/mdro.R
View File

@ -1740,7 +1740,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
}
columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df)] == "R"))
columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df), drop = FALSE] == "R"))
columns_nonsusceptible <- vapply(FUN.VALUE = character(1),
columns_nonsusceptible,
function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " "))

7
R/mic.R
View File

@ -120,9 +120,16 @@ valid_mic_levels <- c(c(t(vapply(FUN.VALUE = character(9), ops,
#' # plot MIC values, see ?plot
#' plot(mic_data)
#' plot(mic_data, mo = "E. coli", ab = "cipro")
#'
#' if (require("ggplot2")) {
#' autoplot(mic_data, mo = "E. coli", ab = "cipro")
#' }
#' if (require("ggplot2")) {
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
#' }
#' if (require("ggplot2")) {
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "uk") # Ukrainian
#' }
as.mic <- function(x, na.rm = FALSE) {
meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(na.rm, allow_class = "logical", has_length = 1)

295
R/mo.R
View File

@ -419,7 +419,7 @@ exec_as.mo <- function(x,
return(rep(NA_character_, length(x_input)))
}
} else if (all(x %in% reference_df[, 1][[1]])) {
} else if (all(x %in% reference_df[, 1, drop = TRUE][[1]])) {
# all in reference df
colnames(reference_df)[1] <- "x"
suppressWarnings(
@ -449,7 +449,7 @@ exec_as.mo <- function(x,
property,
drop = TRUE]
} else if (!all(x %in% microorganisms[, property])) {
} else if (!all(x %in% microorganisms[, property, drop = TRUE])) {
strip_whitespace <- function(x, dyslexia_mode) {
# all whitespaces (tab, new lines, etc.) should be one space
@ -669,7 +669,7 @@ exec_as.mo <- function(x,
FALSE
}))
if (sum(snomed_found, na.rm = TRUE) > 0) {
found <- reference_data_to_use[snomed_found == TRUE, property][[1]]
found <- reference_data_to_use[snomed_found == TRUE, property, drop = TRUE][[1]]
if (!is.na(found)) {
x[i] <- found[1L]
next
@ -694,9 +694,9 @@ exec_as.mo <- function(x,
# user-defined reference ----
if (!is.null(reference_df)) {
if (x_backup[i] %in% reference_df[, 1]) {
if (x_backup[i] %in% reference_df[, 1, drop = TRUE]) {
# already checked integrity of reference_df, all MOs are valid
ref_mo <- reference_df[reference_df[, 1] == x_backup[i], "mo"][[1L]]
ref_mo <- reference_df[reference_df[, 1, drop = TRUE] == x_backup[i], "mo", drop = TRUE][[1L]]
x[i] <- lookup(mo == ref_mo)
next
}
@ -1555,11 +1555,11 @@ exec_as.mo <- function(x,
# nolint start
# comment below code if all staphylococcal species are categorised as CoNS/CoPS
if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) {
if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property, drop = TRUE])) {
if (message_not_thrown_before("as.mo", "becker")) {
warning_("in `as.mo()`: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
font_italic(paste("S.",
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property, drop = TRUE]]))),
collapse = ", ")),
". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).",
immediate = TRUE)
@ -1820,7 +1820,7 @@ summary.mo <- function(object, ...) {
# unique and top 1-3
x <- as.mo(object) # force again, could be mo from older pkg version
top <- as.data.frame(table(x), responseName = "n", stringsAsFactors = FALSE)
top_3 <- top[order(-top$n), 1][1:3]
top_3 <- top[order(-top$n), 1, drop = TRUE][1:3]
value <- c("Class" = "mo",
"<NA>" = length(x[is.na(x)]),
"Unique" = pm_n_distinct(x[!is.na(x)]),
@ -2206,282 +2206,3 @@ strip_words <- function(text, n, side = "right") {
})
vapply(FUN.VALUE = character(1), out, paste, collapse = " ")
}
as.mo2 <- function(x,
Becker = FALSE,
Lancefield = FALSE,
allow_uncertain = TRUE,
reference_df = get_mo_source(),
info = interactive(),
property = "mo",
initial_search = TRUE,
dyslexia_mode = FALSE,
debug = FALSE,
ignore_pattern = getOption("AMR_ignore_pattern"),
reference_data_to_use = MO_lookup,
actual_uncertainty = 1,
actual_input = NULL,
language = get_AMR_locale()) {
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(allow_uncertain, allow_class = c("logical", "numeric", "integer"), has_length = 1)
meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE)
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms))
meet_criteria(initial_search, allow_class = "logical", has_length = 1)
meet_criteria(dyslexia_mode, allow_class = "logical", has_length = 1)
meet_criteria(debug, allow_class = "logical", has_length = 1)
meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(reference_data_to_use, allow_class = "data.frame")
meet_criteria(actual_uncertainty, allow_class = "numeric", has_length = 1)
meet_criteria(actual_input, allow_class = "character", allow_NULL = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
check_dataset_integrity()
if (isTRUE(debug) && initial_search == TRUE) {
time_start_tracking()
}
lookup <- function(needle,
column = property,
haystack = reference_data_to_use,
n = 1,
debug_mode = debug,
initial = initial_search,
uncertainty = actual_uncertainty,
input_actual = actual_input) {
if (!is.null(input_actual)) {
input <- input_actual
} else {
input <- tryCatch(x_backup[i], error = function(e) "")
}
# `column` can be NULL for all columns, or a selection
# returns a [character] (vector) - if `column` > length 1 then with columns as names
if (isTRUE(debug_mode)) {
cat(font_silver("Looking up: ", substitute(needle), collapse = ""),
"\n ", time_track())
}
if (length(column) == 1) {
res_df <- haystack[which(eval(substitute(needle), envir = haystack, enclos = parent.frame())), , drop = FALSE]
if (NROW(res_df) > 1 & uncertainty != -1) {
# sort the findings on matching score
scores <- mo_matching_score(x = input,
n = res_df[, "fullname", drop = TRUE])
res_df <- res_df[order(scores, decreasing = TRUE), , drop = FALSE]
}
res <- as.character(res_df[, column, drop = TRUE])
if (length(res) == 0) {
if (isTRUE(debug_mode)) {
cat(font_red(" (no match)\n"))
}
NA_character_
} else {
if (isTRUE(debug_mode)) {
cat(font_green(paste0(" MATCH (", NROW(res_df), " results)\n")))
}
if ((length(res) > n | uncertainty > 1) & uncertainty != -1) {
# save the other possible results as well, but not for forced certain results (then uncertainty == -1)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = uncertainty,
input = input,
result_mo = res_df[1, "mo", drop = TRUE],
candidates = as.character(res_df[, "fullname", drop = TRUE])),
stringsAsFactors = FALSE)
}
res[seq_len(min(n, length(res)))]
}
} else {
if (is.null(column)) {
column <- names(haystack)
}
res <- haystack[which(eval(substitute(needle), envir = haystack, enclos = parent.frame())), , drop = FALSE]
res <- res[seq_len(min(n, nrow(res))), column, drop = TRUE]
if (NROW(res) == 0) {
if (isTRUE(debug_mode)) {
cat(font_red(" (no rows)\n"))
}
res <- rep(NA_character_, length(column))
} else {
if (isTRUE(debug_mode)) {
cat(font_green(paste0(" MATCH (", NROW(res), " rows)\n")))
}
}
res <- as.character(res)
names(res) <- column
res
}
}
# start off with replaced language-specific non-ASCII characters with ASCII characters
x <- parse_and_convert(x)
# replace mo codes used in older package versions
x <- replace_old_mo_codes(x, property)
# ignore cases that match the ignore pattern
x <- replace_ignore_pattern(x, ignore_pattern)
# WHONET: xxx = no growth
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
# Laboratory systems: remove (translated) entries like "no growth", etc.
x[trimws2(x) %like% translate_into_language("no .*growth", language = language)] <- NA_character_
x[trimws2(x) %like% paste0("^(", translate_into_language("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()
pkg_env$mo_failures <- NULL
pkg_env$mo_uncertainties <- NULL
pkg_env$mo_renamed <- NULL
}
pkg_env$mo_renamed_last_run <- NULL
failures <- character(0)
uncertainty_level <- translate_allow_uncertain(allow_uncertain)
uncertainties <- data.frame(uncertainty = integer(0),
input = character(0),
fullname = character(0),
renamed_to = character(0),
mo = character(0),
candidates = character(0),
stringsAsFactors = FALSE)
x_input <- x
# already strip leading and trailing spaces
x <- trimws(x)
# only check the uniques, which is way faster
x <- unique(x)
# remove empty values (to later fill them in again with NAs)
# ("xxx" is WHONET code for 'no growth')
x <- x[!is.na(x)
& !is.null(x)
& !identical(x, "")
& !identical(x, "xxx")]
# defined df to check for
if (!is.null(reference_df)) {
check_validity_mo_source(reference_df)
reference_df <- repair_reference_df(reference_df)
}
# all empty
if (all(identical(trimws(x_input), "") | is.na(x_input) | length(x) == 0)) {
if (property == "mo") {
return(set_clean_class(rep(NA_character_, length(x_input)),
new_class = c("mo", "character")))
} else {
return(rep(NA_character_, length(x_input)))
}
} else if (all(x %in% reference_df[, 1][[1]])) {
# all in reference df
colnames(reference_df)[1] <- "x"
suppressWarnings(
x <- MO_lookup[match(reference_df[match(x, reference_df$x), "mo", drop = TRUE], MO_lookup$mo), property, drop = TRUE]
)
} else if (all(x %in% reference_data_to_use$mo)) {
x <- MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]
} else if (all(tolower(x) %in% reference_data_to_use$fullname_lower)) {
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
x <- MO_lookup[match(tolower(x), MO_lookup$fullname_lower), property, drop = TRUE]
} else if (all(x %in% reference_data_to_use$fullname)) {
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
x <- MO_lookup[match(x, MO_lookup$fullname), property, drop = TRUE]
} else if (all(toupper(x) %in% microorganisms.codes$code)) {
# commonly used MO codes
x <- MO_lookup[match(microorganisms.codes[match(toupper(x),
microorganisms.codes$code),
"mo",
drop = TRUE],
MO_lookup$mo),
property,
drop = TRUE]
} else if (!all(x %in% microorganisms[, property])) {
strip_whitespace <- function(x, dyslexia_mode) {
# all whitespaces (tab, new lines, etc.) should be one space
# and spaces before and after should be left blank
trimmed <- trimws2(x)
# also, make sure the trailing and leading characters are a-z or 0-9
# in case of non-regex
if (dyslexia_mode == FALSE) {
trimmed <- gsub("^[^a-zA-Z0-9)(]+", "", trimmed, perl = TRUE)
trimmed <- gsub("[^a-zA-Z0-9)(]+$", "", trimmed, perl = TRUE)
}
trimmed
}
x_backup_untouched <- x
x <- strip_whitespace(x, dyslexia_mode)
# translate 'unknown' names back to English
if (any(tolower(x) %like_case% "unbekannt|onbekend|desconocid|sconosciut|iconnu|desconhecid", na.rm = TRUE)) {
trns <- subset(TRANSLATIONS, pattern %like% "unknown")
langs <- LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]
for (l in langs) {
for (i in seq_len(nrow(trns))) {
if (!is.na(trns[i, l, drop = TRUE])) {
x <- gsub(pattern = trns[i, l, drop = TRUE],
replacement = trns$pattern[i],
x = x,
ignore.case = TRUE,
perl = TRUE)
}
}
}
}
# remove spp and species
x <- gsub("(^| )[ .]*(spp|ssp|ss|sp|subsp|subspecies|biovar|biotype|serovar|species)[ .]*( |$)", "", x, ignore.case = TRUE, perl = TRUE)
x <- strip_whitespace(x, dyslexia_mode)
x_backup <- x
# from here on case-insensitive
x <- tolower(x)
x_backup[x %like_case% "^(fungus|fungi)$"] <- "(unknown fungus)" # will otherwise become the kingdom
x_backup[x_backup_untouched == "Fungi"] <- "Fungi" # is literally the kingdom
# Fill in fullnames and MO codes directly
known_names <- tolower(x_backup) %in% MO_lookup$fullname_lower
x[known_names] <- MO_lookup[match(tolower(x_backup)[known_names], MO_lookup$fullname_lower), property, drop = TRUE]
known_codes_mo <- toupper(x_backup) %in% MO_lookup$mo
x[known_codes_mo] <- MO_lookup[match(toupper(x_backup)[known_codes_mo], MO_lookup$mo), property, drop = TRUE]
known_codes_lis <- toupper(x_backup) %in% microorganisms.codes$code
x[known_codes_lis] <- MO_lookup[match(microorganisms.codes[match(toupper(x_backup)[known_codes_lis],
microorganisms.codes$code), "mo", drop = TRUE],
MO_lookup$mo), property, drop = TRUE]
already_known <- known_names | known_codes_mo | known_codes_lis
# now only continue where the right taxonomic output is not already known
if (any(!already_known)) {
x_unknown <- x[!already_known]
x_unknown <- gsub(" ?[(].*[)] ?", "", x_unknown, perl = TRUE)
x_unknown <- gsub("[^a-z ]", " ", x_unknown, perl = TRUE)
x_unknown <- gsub(" +", " ", x_unknown, perl = TRUE)
print(x_unknown)
x_search <- gsub("([a-z])[a-z]*( ([a-z])[a-z]*)?( ([a-z])[a-z]*)?", "^\\1.* \\3.* \\5.*", x_unknown, perl = TRUE)
x_search <- gsub("( [.][*])+$", "", x_search, perl = TRUE)
print(x_search)
for (i in seq_len(length(x_unknown))) {
# search first, second and third part
mos_to_search <- MO_lookup[which(MO_lookup$fullname_lower %like_case% x_search[i]), "fullname", drop = TRUE]
score <- mo_matching_score(x_unknown[i], mos_to_search)
out <- mos_to_search[order(score, decreasing = TRUE)][1:25] # keep first 25
print(score[order(score, decreasing = TRUE)][1])
x[!already_known][i] <- MO_lookup$mo[match(out[1], MO_lookup$fullname)]
}
}
}
x
}

4
R/mo_property.R
View File

@ -601,7 +601,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
IDs <- mo_name(x = x, language = NULL)
syns <- lapply(IDs, function(newname) {
res <- sort(microorganisms.old[which(microorganisms.old$fullname_new == newname), "fullname"])
res <- sort(microorganisms.old[which(microorganisms.old$fullname_new == newname), "fullname", drop = TRUE])
if (length(res) == 0) {
NULL
} else {
@ -664,7 +664,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
x.mo <- as.mo(x = x, language = language, ... = ...)
metadata <- get_mo_failures_uncertainties_renamed()
df <- microorganisms[match(x.mo, microorganisms$mo), c("mo", "fullname", "source", "kingdom", "rank")]
df <- microorganisms[match(x.mo, microorganisms$mo), c("mo", "fullname", "source", "kingdom", "rank"), drop = FALSE]
df$url <- ifelse(df$source == "LPSN",
paste0(CATALOGUE_OF_LIFE$url_LPSN, "/species/", gsub(" ", "-", tolower(df$fullname), fixed = TRUE)),
paste0(CATALOGUE_OF_LIFE$url_CoL, "/data/search?type=EXACT&q=", gsub(" ", "%20", df$fullname, fixed = TRUE)))

4
R/pca.R
View File

@ -114,7 +114,7 @@ pca <- function(x,
error = function(e) warning("column names could not be set"))
# keep only numeric columns
x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y))]
x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y)), drop = FALSE]
# bind the data set with the non-numeric columns
x <- cbind(x.bak[, vapply(FUN.VALUE = logical(1), x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x)
}
@ -122,7 +122,7 @@ pca <- function(x,
x <- pm_ungroup(x) # would otherwise select the grouping vars
x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs
pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x)))]
pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x))), drop = FALSE]
message_("Columns selected for PCA: ", vector_and(font_bold(colnames(pca_data), collapse = NULL), quotes = TRUE),
". Total observations available: ", nrow(pca_data), ".")

10
R/proportion.R
View File

@ -106,12 +106,12 @@
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(r = resistance(CIP),
#' n = n_rsi(CIP)) # n_rsi works like n_distinct in dplyr, see ?n_rsi
#'
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(R = resistance(CIP, as_percent = TRUE),
#' SI = susceptibility(CIP, as_percent = TRUE),
#' n1 = count_all(CIP), # the actual total; sum of all three
@ -143,7 +143,7 @@
#'
#'
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' group_by(ward) %>%
#' summarise(cipro_p = susceptibility(CIP, as_percent = TRUE),
#' cipro_n = count_all(CIP),
#' genta_p = susceptibility(GEN, as_percent = TRUE),
@ -159,8 +159,8 @@
#' # It also supports grouping variables
#' # (use rsi_df to also include the count)
#' example_isolates %>%
#' select(hospital_id, AMX, CIP) %>%
#' group_by(hospital_id) %>%
#' select(ward, AMX, CIP) %>%
#' group_by(ward) %>%
#' rsi_df(translate = FALSE)
#' }
#' }

20
R/resistance_predict.R
View File

@ -80,7 +80,7 @@
#' filter_first_isolate() %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' resistance_predict("PEN", model = "binomial")
#' plot(x)
#' print(plot(x))
#'
#' # get the model from the object
#' mymodel <- attributes(x)$model
@ -88,7 +88,7 @@
#' }
#'
#' # create nice plots with ggplot2 yourself
#' if (require("dplyr") & require("ggplot2")) {
#' if (require("dplyr") && require("ggplot2")) {
#'
#' data <- example_isolates %>%
#' filter(mo == as.mo("E. coli")) %>%
@ -127,6 +127,9 @@ resistance_predict <- function(x,
stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
x.bak <- x
x <- as.data.frame(x, stringsAsFactors = FALSE)
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
@ -147,9 +150,6 @@ resistance_predict <- function(x,
stop_ifnot(col_date %in% colnames(x),
"column '", col_date, "' not found")
# no grouped tibbles
x <- as.data.frame(x, stringsAsFactors = FALSE)
year <- function(x) {
# don't depend on lubridate or so, would be overkill for only this function
if (all(grepl("^[0-9]{4}$", x))) {
@ -173,7 +173,7 @@ resistance_predict <- function(x,
# remove rows with NAs
df <- subset(df, !is.na(df[, col_ab, drop = TRUE]))
df$year <- year(df[, col_date, drop = TRUE])
df <- as.data.frame(rbind(table(df[, c("year", col_ab)])),
df <- as.data.frame(rbind(table(df[, c("year", col_ab), drop = FALSE])),
stringsAsFactors = FALSE)
df$year <- as.integer(rownames(df))
rownames(df) <- NULL
@ -275,11 +275,11 @@ resistance_predict <- function(x,
}
df_prediction$value <- ifelse(df_prediction$value > 1, 1, ifelse(df_prediction$value < 0, 0, df_prediction$value))
df_prediction <- df_prediction[order(df_prediction$year), ]
df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
structure(
.Data = df_prediction,
class = c("resistance_predict", "data.frame"),
out <- as_original_data_class(df_prediction, class(x.bak))
structure(out,
class = c("resistance_predict", class(out)),
I_as_S = I_as_S,
model_title = model,
model = model_lm,

11
R/rsi_calc.R
View File

@ -89,7 +89,7 @@ rsi_calc <- function(...,
x <- NULL
try(x <- as.data.frame(dots, stringsAsFactors = FALSE), silent = TRUE)
if (is.null(x)) {
# support for example_isolates %pm>% group_by(hospital_id) %pm>% summarise(amox = susceptibility(GEN, AMX))
# support for example_isolates %pm>% group_by(ward) %pm>% summarise(amox = susceptibility(GEN, AMX))
x <- as.data.frame(list(...), stringsAsFactors = FALSE)
}
}
@ -226,6 +226,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
translate_ab <- get_translate_ab(translate_ab)
data.bak <- data
# select only groups and antibiotics
if (is_null_or_grouped_tbl(data)) {
data_has_groups <- TRUE
@ -331,9 +332,9 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
if (data_has_groups) {
# ordering by the groups and two more: "antibiotic" and "interpretation"
out <- pm_ungroup(out[do.call("order", out[, seq_len(length(groups) + 2)]), ])
out <- pm_ungroup(out[do.call("order", out[, seq_len(length(groups) + 2), drop = FALSE]), , drop = FALSE])
} else {
out <- out[order(out$antibiotic, out$interpretation), ]
out <- out[order(out$antibiotic, out$interpretation), , drop = FALSE]
}
if (type == "proportion") {
@ -344,8 +345,8 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
}
rownames(out) <- NULL
class(out) <- c("rsi_df", class(out))
out
out <- as_original_data_class(out, class(data.bak))
structure(out, class = c("rsi_df", class(out)))
}
get_translate_ab <- function(translate_ab) {

BIN
R/sysdata.rda
View File

Binary file not shown.

25
R/translate.R
View File

@ -27,13 +27,13 @@
#'
#' For language-dependent output of AMR functions, like [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
#' @param x text to translate
#' @param lang language to choose. Use one of these supported language names or ISO-639-1 codes: `r paste0('"', sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), '" ("' , LANGUAGES_SUPPORTED, '")', collapse = ", ")`.
#' @param language language to choose. Use one of these supported language names or ISO-639-1 codes: `r paste0('"', sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), '" ("' , LANGUAGES_SUPPORTED, '")', collapse = ", ")`.
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_and(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#'
#' Please read about adding or updating a language in [our Wiki](https://github.com/msberends/AMR/wiki/).
#'
#' ## Changing the Default Language
#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [Sys.getlocale("LC_COLLATE")]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [`Sys.getlocale("LC_COLLATE")`][Sys.getlocale()]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
#'
#' 1. Setting the R option `AMR_locale`, either by using `set_AMR_locale()` or by running e.g. `options(AMR_locale = "de")`.
#'
@ -93,10 +93,10 @@ get_AMR_locale <- function() {
#' @rdname translate
#' @export
set_AMR_locale <- function(lang) {
lang <- validate_language(lang)
options(AMR_locale = lang)
message_("Using the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (", LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package for this session.")
set_AMR_locale <- function(language) {
language <- validate_language(language)
options(AMR_locale = language)
message_("Using the ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym, " language (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ") for the AMR package for this session.")
}
#' @rdname translate
@ -111,6 +111,7 @@ translate_AMR <- function(x, language = get_AMR_locale()) {
translate_into_language(x, language = language)
}
validate_language <- function(language, extra_txt = character(0)) {
if (trimws(tolower(language)) %in% c("en", "english", "", "false", NA)) {
return("en")
@ -124,8 +125,8 @@ validate_language <- function(language, extra_txt = character(0)) {
lang
}
find_language <- function(lang, fallback = TRUE) {
lang <- Map(function(l, n, check = lang) {
find_language <- function(language, fallback = TRUE) {
language <- Map(function(l, n, check = language) {
grepl(paste0("^(", l[1], "|", l[2], "|",
n, "(_|$)|", toupper(n), "(_|$))"),
check,
@ -136,12 +137,12 @@ find_language <- function(lang, fallback = TRUE) {
LANGUAGES_SUPPORTED_NAMES,
LANGUAGES_SUPPORTED,
USE.NAMES = TRUE)
lang <- names(which(lang == TRUE))
if (isTRUE(fallback) && length(lang) == 0) {
language <- names(which(language == TRUE))
if (isTRUE(fallback) && length(language) == 0) {
# other language -> set to English
lang <- "en"
language <- "en"
}
lang
language
}
# translate strings based on inst/translations.tsv

10
R/zzz.R
View File

@ -101,9 +101,13 @@ if (utf8_supported && !is_latex) {
}
}, silent = TRUE)
# be sure to print tibbles as tibbles
if (pkg_is_available("tibble", also_load = FALSE)) {
loadNamespace("tibble")
}
# reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed
# they cannott be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
# they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
assign(x = "AB_lookup", value = create_AB_lookup(), envir = asNamespace("AMR"))
assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR"))
assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR"))
@ -140,7 +144,7 @@ create_MO_lookup <- function() {
MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower, perl = TRUE)
# so arrange data on prevalence first, then kingdom, then full name
MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), ]
MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), , drop = FALSE]
}
create_MO.old_lookup <- function() {
@ -151,7 +155,7 @@ create_MO.old_lookup <- function() {
MO.old_lookup$g_species <- trimws(gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO.old_lookup$fullname_lower))
# so arrange data on prevalence first, then full name
MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), ]
MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), , drop = FALSE]
}
create_intr_resistance <- function() {

BIN
data-raw/AMR_latest.tar.gz
View File

Binary file not shown.

2
data-raw/Loinc.csv
View File

@ -71673,7 +71673,7 @@
"7553-1","Origanum vulgare Ab.IgG","ACnc","Pt","Ser","Qn","","ALLERGY","2.27","MIN","","ACTIVE","","1","","","","","","Y","","ABS; Aby; Allergen; Allergens; ALLERGY TESTING; Antby; Anti; Antibodies; Antibody; Arbitrary concentration; Autoantibodies; Autoantibody; f283; Immune globulin G; Immunoglobulin G; Oregano; Oreganum; Point in time; QNT; Quan; Quant; Quantitative; Random; Rf283; Serum; SR","Oregano IgG Qn","Both","","","","","Oregano IgG Ab [Units/volume] in Serum","","","","","","","0","0","0","","","","","","1.0h(2)","","Oregano IgG Qn (S)"
"75531-4","Enrollment basis","Type","Pt","^Patient","Nom","","SURVEY.PCORNET","2.50","MIN","","ACTIVE","","4","","","","","","","","Nominal; Point in time; Random; Survey; SURVEY.PCORNET; Typ","Enrollment basis","Observation","","","","","Enrollment basis","","","","","","","0","0","0","","","","","","2.50","",""
"75532-2","Applicable accrediting agency for unit","Type","Pt","{Nursing unit}","Nom","NMMDS","SURVEY.NMMDS","2.50","MIN","Types of accreditation that are appropriate or applicable to a unit or service. The unit may or may not have received the accreditation.","ACTIVE","","4","","","","","","","","Nominal; Nursing Management Minimum Data Set; Point in time; Random; Survey; SURVEY.NMMDS; Typ","","Observation","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","Applicable accrediting agency for unit [NMMDS]","","","","","","","0","0","0","","NMMDS","","","","2.50","",""
"75533-0","Accreditation, certification, & licensure panel","-","Pt","{Nursing unit}","-","NMMDS","PANEL.SURVEY.NMMDS","2.52","MIN","The set of terms in this panel are used to indicate quality assurance organizations of the nursing delivery unit/service by 3 different quality measure categories: accreditation, certification and licensure. Accreditation is a seal of approval given by private, nationally recognized groups that check on the quality of care at health care facilities and organizations. Health care organizations must meet certain quality standards in order to be accredited. Certification is the formal recognition of the knowledge, skills, and experience demonstrated by the achievement of standards that are identified by the profession² (ANA, 2009). Licensure is the granting of authority to practice² (ANA, 2009). State agencies determine the requirements for licensure and examine the competency necessary to meet quality standards.","ACTIVE","","4","","","","","","","","Nursing Management Minimum Data Set; Pan; PANEL.SURVEY.NMMDS; Panl; Pnl; Point in time; Random; Survey; SURVEY.NMMDS","","","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","NMMDS accreditation, certification, and licensure panel [NMMDS]","","","","","","","0","0","0","","NMMDS","Panel","","","2.50","",""
"75533-0","Accreditation, certification, & licensure panel","-","Pt","{Nursing unit}","-","NMMDS","PANEL.SURVEY.NMMDS","2.52","MIN","The set of terms in this panel are used to indicate quality assurance organizations of the nursing delivery unit/service by 3 different quality measure categories: accreditation, certification and licensure. Accreditation is a seal of approval given by private, nationally recognized groups that check on the quality of care at health care facilities and organizations. Health care organizations must meet certain quality standards in order to be accredited. Certification is the formal recognition of the knowledge, skills, and experience demonstrated by the achievement of standards that are identified by the profession² (ANA, 2009). Licensure is the granting of authority to practise² (ANA, 2009). State agencies determine the requirements for licensure and examine the competency necessary to meet quality standards.","ACTIVE","","4","","","","","","","","Nursing Management Minimum Data Set; Pan; PANEL.SURVEY.NMMDS; Panl; Pnl; Point in time; Random; Survey; SURVEY.NMMDS","","","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","NMMDS accreditation, certification, and licensure panel [NMMDS]","","","","","","","0","0","0","","NMMDS","Panel","","","2.50","",""
"75534-8","Accreditation received","Type","Pt","{Nursing unit}","Nom","NMMDS","SURVEY.NMMDS","2.50","MIN","Types of accreditation obtained by a unit to demonstrate quality of care. Accreditation is a seal of approval given by private, nationally recognized groups that check on the quality of care at health care facilities and organizations. Health care organizations must meet certain quality standards in order to be accredited.","ACTIVE","","4","","","","","","","","Nominal; Nursing Management Minimum Data Set; Point in time; Random; Survey; SURVEY.NMMDS; Typ","","Observation","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","Accreditation received [NMMDS]","","","","","","","0","0","0","","NMMDS","","","","2.50","",""
"75535-5","Certification received","Type","Pt","{Nursing unit}","Nom","NMMDS","SURVEY.NMMDS","2.50","MIN","Types of certification obtained by a unit to demonstrate quality care.","ACTIVE","","4","","","","","","","","Nominal; Nursing Management Minimum Data Set; Point in time; Random; Survey; SURVEY.NMMDS; Typ","","Observation","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","Certification received [NMMDS]","","","","","","","0","0","0","","NMMDS","","","","2.50","",""
"75536-3","Applicable certification agency for unit","Type","Pt","{Nursing unit}","Nom","NMMDS","SURVEY.NMMDS","2.50","MIN","Types of certification that are appropriate or applicable to a unit or service. The unit may or may not have received the certification.","ACTIVE","","4","","","","","","","","Nominal; Nursing Management Minimum Data Set; Point in time; Random; Survey; SURVEY.NMMDS; Typ","","Observation","","","Copyright © 2006 Diane Huber and Connie Delaney. Used with permission.","","Applicable certification agency for unit [NMMDS]","","","","","","","0","0","0","","NMMDS","","","","2.50","",""

Can't render this file because it is too large.

2
data-raw/_language_update.R
View File

@ -55,7 +55,7 @@ lang_env$TRANSLATIONS <- utils::read.delim(file = "data-raw/translations.tsv",
quote = "")
lang_env$LANGUAGES_SUPPORTED_NAMES <- c(list(en = list(exonym = "English", endonym = "English")),
lapply(lang_env$TRANSLATIONS[, which(nchar(colnames(lang_env$TRANSLATIONS)) == 2)],
lapply(lang_env$TRANSLATIONS[, which(nchar(colnames(lang_env$TRANSLATIONS)) == 2), drop = FALSE],
function(x) list(exonym = x[1], endonym = x[2])))
lang_env$LANGUAGES_SUPPORTED <- names(lang_env$LANGUAGES_SUPPORTED_NAMES)

BIN
data-raw/data_dsmz.rds
View File

Binary file not shown.

BIN
data-raw/download_buttons.psd
View File

Binary file not shown.

BIN
data-raw/download_dta.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 35 KiB

BIN
data-raw/download_r.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 48 KiB

BIN
data-raw/download_sas.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 43 KiB

BIN
data-raw/download_sav.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 36 KiB

BIN
data-raw/download_txt.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 19 KiB

BIN
data-raw/download_xlsx.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 40 KiB

13
data-raw/ex2.R
View File

@ -1,13 +0,0 @@
ex2 <- example_isolates
for (extra_id in seq_len(50)) {
ex2 <- ex2 %>%
bind_rows(example_isolates %>% mutate(patient_id = paste0(patient_id, extra_id)))
}
# randomly clear antibibiograms of 2%
clr <- sort(sample(x = seq_len(nrow(ex2)),
size = nrow(ex2) * 0.02))
for (row in which(is.rsi(ex2))) {
ex2[clr, row] <- NA_rsi_
}

BIN
data-raw/ex2.rds
View File

Binary file not shown.

BIN
data-raw/example_isolates.rds
View File

Binary file not shown.

28
data-raw/exploratory_data_analysis_test.R
View File

@ -1,28 +0,0 @@
library(dplyr)
example_isolates %>%
select(mo, where(is.rsi)) %>%
tidyr::pivot_longer(cols = where(is.rsi)) %>%
# remove intrisic R
filter(!paste(mo, name) %in% AMR:::INTRINSIC_R) %>%
mutate(name = as.ab(name),
value = ifelse(value == "R", 1, 0),
class = ab_group(name)) %>%
group_by(mo, class) %>%
summarise(n = n(),
res = mean(value, na.rm = TRUE)) %>%
filter(n > 30, !is.na(res))
df <- example_isolates
search_mo <- "B_ESCHR_COLI"
intrinsic_res <- INTRINSIC_R[INTRINSIC_R %like% search_mo]
intrinsic_res <- gsub(".* (.*)", "\\1", intrinsic_res)
x <- df %>%
select(mo, where(is.rsi)) %>%
filter(mo == search_mo) %>%
# at least 30 results available
select(function(x) sum(!is.na(x)) >= 30) %>%
# remove intrisic R
select(!matches(paste(intrinsic_res, collapse = "|")))

BIN
data-raw/github_preview.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 87 KiB

BIN
data-raw/github_preview.psd
View File

Binary file not shown.

27
data-raw/pre-commit-hook.R
View File

@ -29,7 +29,7 @@
library(dplyr, warn.conflicts = FALSE)
devtools::load_all(quiet = TRUE)
set_AMR_locale("en")
suppressMessages(set_AMR_locale("en"))
old_globalenv <- ls(envir = globalenv())
@ -69,7 +69,7 @@ TRANSLATIONS <- utils::read.delim(file = "data-raw/translations.tsv",
quote = "")
LANGUAGES_SUPPORTED_NAMES <- c(list(en = list(exonym = "English", endonym = "English")),
lapply(TRANSLATIONS[, which(nchar(colnames(TRANSLATIONS)) == 2)],
lapply(TRANSLATIONS[, which(nchar(colnames(TRANSLATIONS)) == 2), drop = FALSE],
function(x) list(exonym = x[1], endonym = x[2])))
LANGUAGES_SUPPORTED <- names(LANGUAGES_SUPPORTED_NAMES)
@ -122,7 +122,7 @@ create_MO_fullname_lower <- function() {
MO_lookup$species,
MO_lookup$subspecies)))
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname"])
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE])
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
MO_lookup$fullname_lower
}
@ -208,7 +208,8 @@ create_AB_lookup <- function() {
AB_LOOKUP <- create_AB_lookup()
# Export to package as internal data ----
usethis::use_data(EUCAST_RULES_DF,
usethis::ui_info(paste0("Saving {usethis::ui_value('sysdata.rda')} to {usethis::ui_value('R/')}"))
suppressMessages(usethis::use_data(EUCAST_RULES_DF,
TRANSLATIONS,
LANGUAGES_SUPPORTED_NAMES,
LANGUAGES_SUPPORTED,
@ -250,7 +251,7 @@ usethis::use_data(EUCAST_RULES_DF,
internal = TRUE,
overwrite = TRUE,
version = 2,
compress = "xz")
compress = "xz"))
# Export data sets to the repository in different formats -----------------
@ -285,7 +286,7 @@ rsi <- rsi_translation %>%
mutate(mo_name = mo_name(mo, language = NULL), .after = mo) %>%
mutate(ab_name = ab_name(ab, language = NULL), .after = ab)
if (changed_md5(rsi)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('rsi_translation')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('rsi_translation')} to {usethis::ui_value('data-raw/')}"))
write_md5(rsi)
try(saveRDS(rsi, "data-raw/rsi_translation.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(rsi, "data-raw/rsi_translation.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -298,7 +299,7 @@ if (changed_md5(rsi)) {
}
if (changed_md5(microorganisms)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('data-raw/')}"))
write_md5(microorganisms)
try(saveRDS(microorganisms, "data-raw/microorganisms.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(mo, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -315,7 +316,7 @@ if (changed_md5(microorganisms)) {
}
if (changed_md5(microorganisms.old)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms.old')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms.old')} to {usethis::ui_value('data-raw/')}"))
write_md5(microorganisms.old)
try(saveRDS(microorganisms.old, "data-raw/microorganisms.old.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(microorganisms.old, "data-raw/microorganisms.old.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -329,7 +330,7 @@ if (changed_md5(microorganisms.old)) {
ab <- dplyr::mutate_if(antibiotics, ~!is.numeric(.), as.character)
if (changed_md5(ab)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('antibiotics')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('antibiotics')} to {usethis::ui_value('data-raw/')}"))
write_md5(ab)
try(saveRDS(antibiotics, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(antibiotics, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -343,7 +344,7 @@ if (changed_md5(ab)) {
av <- dplyr::mutate_if(antivirals, ~!is.numeric(.), as.character)
if (changed_md5(av)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('antivirals')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('antivirals')} to {usethis::ui_value('data-raw/')}"))
write_md5(av)
try(saveRDS(antivirals, "data-raw/antivirals.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(av, "data-raw/antivirals.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -360,7 +361,7 @@ intrinsicR <- data.frame(microorganism = mo_name(intrinsic_resistant$mo, languag
antibiotic = ab_name(intrinsic_resistant$ab, language = NULL),
stringsAsFactors = FALSE)
if (changed_md5(intrinsicR)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('intrinsic_resistant')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('intrinsic_resistant')} to {usethis::ui_value('data-raw/')}"))
write_md5(intrinsicR)
try(saveRDS(intrinsicR, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(intrinsicR, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -373,7 +374,7 @@ if (changed_md5(intrinsicR)) {
}
if (changed_md5(dosage)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('dosage')} to {usethis::ui_value('/data-raw/')}"))
usethis::ui_info(paste0("Saving {usethis::ui_value('dosage')} to {usethis::ui_value('data-raw/')}"))
write_md5(dosage)
try(saveRDS(dosage, "data-raw/dosage.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(dosage, "data-raw/dosage.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
@ -385,7 +386,7 @@ if (changed_md5(dosage)) {
try(arrow::write_parquet(dosage, "data-raw/dosage.parquet"), silent = TRUE)
}
reset_AMR_locale()
suppressMessages(reset_AMR_locale())
# remove leftovers from global env
current_globalenv <- ls(envir = globalenv())

4
data-raw/reproduction_of_antibiotics.R
View File

@ -138,7 +138,7 @@ abx2 <- abx2 %>% arrange(ab)
seqnr <- 0
# add follow up nrs
for (i in 2:nrow(abx2)) {
if (abx2[i, "ab"] == abx2[i - 1, "ab"]) {
if (abx2[i, "ab", drop = TRUE] == abx2[i - 1, "ab", drop = TRUE]) {
seqnr <- seqnr + 1
abx2[i, "seqnr"] <- seqnr
} else {
@ -147,7 +147,7 @@ for (i in 2:nrow(abx2)) {
}
for (i in 2:nrow(abx2)) {
if (!is.na(abx2[i, "seqnr"])) {
abx2[i, "ab"] <- paste0(abx2[i, "ab"], abx2[i, "seqnr"])
abx2[i, "ab"] <- paste0(abx2[i, "ab", drop = TRUE], abx2[i, "seqnr", drop = TRUE])
}
}
abx2 <- abx2 %>% select(-seqnr) %>% arrange(name)

6
data-raw/reproduction_of_example_isolates_unclean.R
View File

@ -92,7 +92,7 @@ example_isolates_unclean <- data_a %>%
example_isolates_unclean$patient_id <- sample(patients, size = nrow(example_isolates_unclean), replace = TRUE)
example_isolates_unclean <- example_isolates_unclean %>%
select(patient_id, hospital, date, bacteria, everything())
usethis::use_data(example_isolates_unclean, overwrite = TRUE)
select(patient_id, hospital, date, bacteria, everything()) %>%
dataset_UTF8_to_ASCII()
usethis::use_data(example_isolates_unclean, overwrite = TRUE, internal = FALSE, version = 2, compress = "xz")

2
data-raw/reproduction_of_intrinsic_resistant.R
View File

@ -36,7 +36,7 @@ int_resis <- eucast_rules(int_resis,
is.na(have_these_values) & reference.version == 3.3),
info = FALSE)
int_resis2 <- int_resis[, sapply(int_resis, function(x) any(!is.rsi(x) | x == "R"))] %>%
int_resis2 <- int_resis[, sapply(int_resis, function(x) any(!is.rsi(x) | x == "R")), drop = FALSE] %>%
tidyr::pivot_longer(-mo) %>%
filter(value == "R") %>%
select(mo, ab = name)

BIN
data-raw/tinytest_1.2.4.10.tar.gz
View File

Binary file not shown.

BIN
data/WHONET.rda
View File

Binary file not shown.

BIN
data/antibiotics.rda
View File

Binary file not shown.

BIN
data/antivirals.rda
View File

Binary file not shown.

BIN
data/dosage.rda
View File

Binary file not shown.

BIN
data/example_isolates.rda
View File

Binary file not shown.

BIN
data/example_isolates_unclean.rda
View File

Binary file not shown.

BIN
data/intrinsic_resistant.rda
View File

Binary file not shown.

BIN
data/microorganisms.codes.rda
View File

Binary file not shown.

BIN
data/microorganisms.rda
View File

Binary file not shown.

BIN
data/rsi_translation.rda
View File

Binary file not shown.

37
index.md
View File

@ -65,8 +65,8 @@ library(AMR)
library(dplyr)
out <- example_isolates %>%
# group by hospital code:
group_by(hospital_id) %>%
# group by ward:
group_by(ward) %>%
# calculate AMR using resistance(), over all aminoglycosides
# and polymyxins:
summarise(across(c(aminoglycosides(), polymyxins()),
@ -74,36 +74,33 @@ out <- example_isolates %>%
out
```
| hospital_id | GEN | TOB | AMK | KAN | COL |
|:------------|:-----:|:-----:|:-----:|:-----:|:-----:|
| A | 0.203 | 0.328 | 0.657 | 1 | 0.853 |
| B | 0.274 | 0.367 | 0.645 | 1 | 0.845 |
| C | 0.212 | 0.342 | 0.582 | 1 | 0.865 |
| D | 0.251 | 0.332 | 0.642 | 1 | 0.745 |
| ward | GEN | TOB | AMK | KAN | COL |
|:-----------|------:|------:|------:|------:|------:|
| Clinical | 0.229 | 0.315 | 0.626 | 1 | 0.780 |
| ICU | 0.290 | 0.400 | 0.662 | 1 | 0.857 |
| Outpatient | 0.200 | 0.368 | 0.605 | NA | 0.889 |
```r
# transform the antibiotic columns to names:
out %>% set_ab_names()
```
| hospital_id | gentamicin | tobramycin | amikacin | kanamycin | colistin |
|:------------|:----------:|:----------:|:---------|:---------:|:---------:|
| A | 0.203 | 0.328 | 0.657 | 1 | 0.853 |
| B | 0.274 | 0.367 | 0.645 | 1 | 0.845 |
| C | 0.212 | 0.342 | 0.582 | 1 | 0.865 |
| D | 0.251 | 0.332 | 0.642 | 1 | 0.745 |
| ward | gentamicin | tobramycin | amikacin | kanamycin | colistin |
|:-----------|-----------:|-----------:|----------|----------:|----------:|
| Clinical | 0.229 | 0.315 | 0.626 | 1 | 0.780 |
| ICU | 0.290 | 0.400 | 0.662 | 1 | 0.857 |
| Outpatient | 0.200 | 0.368 | 0.605 | NA | 0.889 |
```r
# transform the antibiotic column to ATC codes:
out %>% set_ab_names(property = "atc")
```
| hospital_id | J01GB03 | J01GB01 | J01GB06 | J01GB04 | J01XB01 |
|:------------|:----------:|:----------:|:---------|:---------:|:---------:|
| A | 0.203 | 0.328 | 0.657 | 1 | 0.853 |
| B | 0.274 | 0.367 | 0.645 | 1 | 0.845 |
| C | 0.212 | 0.342 | 0.582 | 1 | 0.865 |
| D | 0.251 | 0.332 | 0.642 | 1 | 0.745 |
| ward | J01GB03 | J01GB01 | J01GB06 | J01GB04 | J01XB01 |
|:-----------|-----------:|-----------:|----------|----------:|----------:|
| Clinical | 0.229 | 0.315 | 0.626 | 1 | 0.780 |
| ICU | 0.290 | 0.400 | 0.662 | 1 | 0.857 |
| Outpatient | 0.200 | 0.368 | 0.605 | NA | 0.889 |
### What else can you do with this package?

2
inst/tinytest/test-_misc.R
View File

@ -49,5 +49,5 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this:
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(ward)))
}

2
inst/tinytest/test-bug_drug_combinations.R
View File

@ -30,7 +30,7 @@ expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE)))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_true(example_isolates %>%
group_by(hospital_id) %>%
group_by(ward) %>%
bug_drug_combinations(FUN = mo_gramstain) %>%
is.data.frame())
}

10
inst/tinytest/test-count.R
View File

@ -49,7 +49,7 @@ expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
expect_error(count_df(example_isolates[, "date", drop = TRUE]))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_equal(example_isolates %>% count_susceptible(AMC), 1433)
@ -63,7 +63,7 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
group_by(ward) %>%
summarise(cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)) %>%
@ -89,9 +89,9 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
)
# grouping in rsi_calc_df() (= backbone of rsi_df())
expect_true("hospital_id" %in% (example_isolates %>%
group_by(hospital_id) %>%
select(hospital_id, AMX, CIP, gender) %>%
expect_true("ward" %in% (example_isolates %>%
group_by(ward) %>%
select(ward, AMX, CIP, gender) %>%
rsi_df() %>%
colnames()))
}

14
inst/tinytest/test-data.R
View File

@ -45,16 +45,16 @@ expect_false(any(is.na(microorganisms.codes$mo)))
expect_true(all(dosage$ab %in% antibiotics$ab))
expect_true(all(dosage$name %in% antibiotics$name))
# check valid disks/MICs
expect_false(any(is.na(as.mic(rsi_translation[which(rsi_translation$method == "MIC"), "breakpoint_S"]))))
expect_false(any(is.na(as.mic(rsi_translation[which(rsi_translation$method == "MIC"), "breakpoint_R"]))))
expect_false(any(is.na(as.disk(rsi_translation[which(rsi_translation$method == "DISK"), "breakpoint_S"]))))
expect_false(any(is.na(as.disk(rsi_translation[which(rsi_translation$method == "DISK"), "breakpoint_R"]))))
expect_false(any(is.na(as.mic(rsi_translation[which(rsi_translation$method == "MIC"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.mic(rsi_translation[which(rsi_translation$method == "MIC"), "breakpoint_R", drop = TRUE]))))
expect_false(any(is.na(as.disk(rsi_translation[which(rsi_translation$method == "DISK"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.disk(rsi_translation[which(rsi_translation$method == "DISK"), "breakpoint_R", drop = TRUE]))))
# antibiotic names must always be coercible to their original AB code
expect_identical(as.ab(antibiotics$name), antibiotics$ab)
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(class(dataset), "data.frame")
@ -62,8 +62,8 @@ for (i in seq_len(length(datasets))) {
}
df <- AMR:::MO_lookup
expect_true(nrow(df[which(df$prevalence == 1), ]) < nrow(df[which(df$prevalence == 2), ]))
expect_true(nrow(df[which(df$prevalence == 2), ]) < nrow(df[which(df$prevalence == 3), ]))
expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE]))
expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE]))
expect_true(all(c("mo", "fullname",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"rank", "ref", "species_id", "source", "prevalence", "snomed",

2
inst/tinytest/test-episode.R
View File

@ -49,7 +49,7 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient_id, mo) %>%
group_by(patient, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))

26
inst/tinytest/test-first_isolate.R
View File

@ -52,8 +52,8 @@ expect_equal(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient_id",
col_icu = "ward_icu",
col_patient_id = "patient",
col_icu = example_isolates$ward == "ICU",
info = TRUE,
icu_exclude = TRUE),
na.rm = TRUE),
@ -67,7 +67,7 @@ x[random_rows, "specimen"] <- "Urine"
expect_true(
sum(first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
@ -76,11 +76,11 @@ expect_true(
expect_true(
sum(first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
col_icu = "ward_icu",
col_icu = x$ward == "ICU",
icu_exclude = TRUE,
info = TRUE), na.rm = TRUE) < 1501)
@ -89,7 +89,7 @@ test_iso <- example_isolates
test_iso$specimen <- "test"
expect_message(first_isolate(test_iso,
"date",
"patient_id",
"patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "something_unexisting",
@ -99,13 +99,13 @@ expect_message(first_isolate(test_iso,
expect_message(first_isolate(example_isolates,
col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
col_patient_id = "patient",
col_testcode = "gender",
testcodes_exclude = "M",
info = TRUE))
# errors
expect_error(first_isolate("date", "patient_id", col_mo = "mo"))
expect_error(first_isolate("date", "patient", col_mo = "mo"))
expect_error(first_isolate(example_isolates,
col_date = "non-existing col",
col_mo = "mo"))
@ -116,12 +116,12 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
mutate(mo = as.character(mo)) %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
col_patient_id = "patient",
info = FALSE),
example_isolates %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
col_patient_id = "patient",
info = FALSE))
# support for WHONET
@ -133,8 +133,8 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
first_isolate(info = TRUE))
# groups
x <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate())
y <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate(.))
x <- example_isolates %>% group_by(ward) %>% mutate(first = first_isolate())
y <- example_isolates %>% group_by(ward) %>% mutate(first = first_isolate(.))
expect_identical(x, y)
}
@ -146,7 +146,7 @@ expect_equal(
sum(
first_isolate(x = df,
col_date = "date",
col_patient_id = "patient_id",
col_patient_id = "patient",
col_mo = "mo",
info = TRUE),
na.rm = TRUE),

2
inst/tinytest/test-key_antimicrobials.R
View File

@ -33,4 +33,4 @@ expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyant
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ]))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), , drop = FALSE]))

4
inst/tinytest/test-mdro.R
View File

@ -235,6 +235,6 @@ expect_warning(mdro(example_isolates,
# print groups
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE))
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), info = TRUE))
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), guideline = custom, info = TRUE))
}

9
inst/tinytest/test-mo.R
View File

@ -147,7 +147,8 @@ expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_S
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# select with one column
expect_identical(
example_isolates[1:10, ] %>%
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus) %>%
as.mo() %>%
@ -157,9 +158,11 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# select with two columns
expect_identical(
example_isolates[1:10, ] %>%
example_isolates %>%
slice(1:10) %>%
pull(mo),
example_isolates[1:10, ] %>%
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo())

6
inst/tinytest/test-proportion.R
View File

@ -48,7 +48,7 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# percentages
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
group_by(ward) %>%
summarise(R = proportion_R(CIP, as_percent = TRUE),
I = proportion_I(CIP, as_percent = TRUE),
S = proportion_S(CIP, as_percent = TRUE),
@ -60,7 +60,7 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
group_by(ward) %>%
summarise(cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_rsi(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
@ -122,4 +122,4 @@ expect_warning(proportion_R(as.character(example_isolates$GEN)))
expect_warning(proportion_I(as.character(example_isolates$GEN)))
expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date"]))
expect_error(proportion_df(example_isolates[, "date", drop = TRUE]))

11
man/AMR.Rd
View File

@ -35,19 +35,14 @@ This package can be used for:
}
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
}
\section{Read more on Our Website!}{
On our website \url{https://msberends.github.io/AMR/} you can find \href{https://msberends.github.io/AMR/articles/AMR.html}{a comprehensive tutorial} about how to conduct AMR data analysis, the \href{https://msberends.github.io/AMR/reference/}{complete documentation of all functions} and \href{https://msberends.github.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\section{Contact Us}{
For suggestions, comments or questions, please contact us at:
For suggestions, comments or questions, please contact us via:
Matthijs S. Berends \cr
Dr. Matthijs S. Berends \cr
m.s.berends [at] umcg [dot] nl \cr
University of Groningen
Department of Medical Microbiology and Infection Prevention \cr

10
man/WHONET.Rd
View File

@ -5,7 +5,7 @@
\alias{WHONET}
\title{Data Set with 500 Isolates - WHONET Example}
\format{
A \link{data.frame} with 500 observations and 53 variables:
A [tibble\link[tibble:tibble]{tibble::tibble} with 500 observations and 53 variables:
\itemize{
\item \verb{Identification number}\cr ID of the sample
\item \verb{Specimen number}\cr ID of the specimen
@ -41,12 +41,10 @@ WHONET
\description{
This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our \link{example_isolates} data set. All patient names are created using online surname generators and are only in place for practice purposes.
}
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
\details{
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{
head(WHONET)
WHONET
}
\keyword{datasets}

2
man/ab_property.Rd
View File

@ -104,7 +104,7 @@ European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{htt
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{

2
man/age_groups.Rd
View File

@ -59,7 +59,7 @@ age_groups(ages, "children")
if (require("dplyr")) {
example_isolates \%>\%
filter_first_isolate() \%>\%
filter(mo == as.mo("E. coli")) \%>\%
filter(mo == as.mo("Escherichia coli")) \%>\%
group_by(age_group = age_groups(age)) \%>\%
select(age_group, CIP) \%>\%
ggplot_rsi(x = "age_group",

102
man/antibiotic_class_selectors.Rd
View File

@ -166,121 +166,153 @@ The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function c
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{
# `example_isolates` is a data set available in the AMR package.
# See ?example_isolates.
df <- example_isolates[ , c("hospital_id", "mo",
"AMP", "AMC", "TZP", "CXM", "CRO", "GEN",
"TOB", "COL", "IPM", "MEM", "TEC", "VAN")]
example_isolates
# base R ------------------------------------------------------------------
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
df[, carbapenems()]
example_isolates[, carbapenems()]
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
df[, c("mo", aminoglycosides())]
example_isolates[, c("mo", aminoglycosides())]
# select only antibiotic columns with DDDs for oral treatment
df[, administrable_per_os()]
example_isolates[, administrable_per_os()]
# filter using any() or all()
df[any(carbapenems() == "R"), ]
subset(df, any(carbapenems() == "R"))
example_isolates[any(carbapenems() == "R"), ]
subset(example_isolates, any(carbapenems() == "R"))
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
df[any(carbapenems()), ]
df[all(carbapenems()), ]
example_isolates[any(carbapenems()), ]
example_isolates[all(carbapenems()), ]
# filter with multiple antibiotic selectors using c()
df[all(c(carbapenems(), aminoglycosides()) == "R"), ]
example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
# filter + select in one go: get penicillins in carbapenems-resistant strains
df[any(carbapenems() == "R"), penicillins()]
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:
df[, penicillins() & administrable_per_os()]
example_isolates[, penicillins() & administrable_per_os()]
# ab_selector() applies a filter in the `antibiotics` data set and is thus very
# flexible. For instance, to select antibiotic columns with an oral DDD of at
# least 1 gram:
df[, ab_selector(oral_ddd > 1 & oral_units == "g")]
example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
# dplyr -------------------------------------------------------------------
\donttest{
if (require("dplyr")) {
# get AMR for all aminoglycosides e.g., per hospital:
df \%>\%
group_by(hospital_id) \%>\%
# get AMR for all aminoglycosides e.g., per ward:
example_isolates \%>\%
group_by(ward) \%>\%
summarise(across(aminoglycosides(), resistance))
}
if (require("dplyr")) {
# You can combine selectors with '&' to be more specific:
df \%>\%
example_isolates \%>\%
select(penicillins() & administrable_per_os())
}
if (require("dplyr")) {
# get AMR for only drugs that matter - no intrinsic resistance:
df \%>\%
example_isolates \%>\%
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
group_by(hospital_id) \%>\%
group_by(ward) \%>\%
summarise(across(not_intrinsic_resistant(), resistance))
}
if (require("dplyr")) {
# get susceptibility for antibiotics whose name contains "trim":
df \%>\%
example_isolates \%>\%
filter(first_isolate()) \%>\%
group_by(hospital_id) \%>\%
group_by(ward) \%>\%
summarise(across(ab_selector(name \%like\% "trim"), susceptibility))
}
if (require("dplyr")) {
# this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
df \%>\%
example_isolates \%>\%
select(carbapenems())
}
if (require("dplyr")) {
# this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
df \%>\%
example_isolates \%>\%
select(mo, aminoglycosides())
}
if (require("dplyr")) {
# any() and all() work in dplyr's filter() too:
df \%>\%
example_isolates \%>\%
filter(any(aminoglycosides() == "R"),
all(cephalosporins_2nd() == "R"))
}
if (require("dplyr")) {
# also works with c():
df \%>\%
example_isolates \%>\%
filter(any(c(carbapenems(), aminoglycosides()) == "R"))
}
if (require("dplyr")) {
# not setting any/all will automatically apply all():
df \%>\%
example_isolates \%>\%
filter(aminoglycosides() == "R")
}
if (require("dplyr")) {
# this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
df \%>\%
example_isolates \%>\%
select(mo, ab_class("mycobact"))
}
if (require("dplyr")) {
# get bug/drug combinations for only glycopeptides in Gram-positives:
df \%>\%
example_isolates \%>\%
filter(mo_is_gram_positive()) \%>\%
select(mo, glycopeptides()) \%>\%
bug_drug_combinations() \%>\%
format()
}
if (require("dplyr")) {
data.frame(some_column = "some_value",
J01CA01 = "S") \%>\% # ATC code of ampicillin
select(penicillins()) # only the 'J01CA01' column will be selected
}
if (require("dplyr")) {
# with recent versions of dplyr this is all equal:
x <- df[carbapenems() == "R", ]
y <- df \%>\% filter(carbapenems() == "R")
z <- df \%>\% filter(if_all(carbapenems(), ~.x == "R"))
identical(x, y)
identical(y, z)
x <- example_isolates[carbapenems() == "R", ]
y <- example_isolates \%>\% filter(carbapenems() == "R")
z <- example_isolates \%>\% filter(if_all(carbapenems(), ~.x == "R"))
identical(x, y) && identical(y, z)
}
}
}

27
man/antibiotics.Rd
View File

@ -6,7 +6,7 @@
\alias{antivirals}
\title{Data Sets with 566 Antimicrobial Drugs}
\format{
\subsection{For the \link{antibiotics} data set: a \link{data.frame} with 464 observations and 14 variables:}{
\subsection{For the \link{antibiotics} data set: a [tibble\link[tibble:tibble]{tibble::tibble} with 464 observations and 14 variables:}{
\itemize{
\item \code{ab}\cr Antibiotic ID as used in this package (such as \code{AMC}), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
\item \code{cid}\cr Compound ID as found in PubChem
@ -25,7 +25,7 @@
}
}
\subsection{For the \link{antivirals} data set: a \link{data.frame} with 102 observations and 9 variables:}{
\subsection{For the \link{antivirals} data set: a [tibble\link[tibble:tibble]{tibble::tibble} with 102 observations and 9 variables:}{
\itemize{
\item \code{atc}\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC
\item \code{cid}\cr Compound ID as found in PubChem
@ -39,7 +39,7 @@
}
}
An object of class \code{data.frame} with 102 rows and 9 columns.
An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 102 rows and 9 columns.
}
\source{
World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): \url{https://www.whocc.no/atc_ddd_index/}
@ -60,24 +60,9 @@ Properties that are based on an ATC code are only available when an ATC is avail
Synonyms (i.e. trade names) were derived from the Compound ID (\code{cid}) and consequently only available where a CID is available.
\subsection{Direct download}{
These data sets are available as 'flat files' for use even without \R - you can find the files here:
\itemize{
\item \url{https://github.com/msberends/AMR/raw/main/data-raw/antibiotics.txt}
\item \url{https://github.com/msberends/AMR/raw/main/data-raw/antivirals.txt}
}
Files in \R format (with preserved data structure) can be found here:
\itemize{
\item \url{https://github.com/msberends/AMR/raw/main/data/antibiotics.rda}
\item \url{https://github.com/msberends/AMR/raw/main/data/antivirals.rda}
Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
}
}
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
}
\section{WHOCC}{
\if{html}{\figure{logo_who.png}{options: height="60" style=margin-bottom:"5"} \cr}
@ -91,8 +76,8 @@ The WHOCC is located in Oslo at the Norwegian Institute of Public Health and fun
}
\examples{
head(antibiotics)
head(antivirals)
antibiotics
antivirals
}
\seealso{
\link{microorganisms}, \link{intrinsic_resistant}

2
man/as.ab.Rd
View File

@ -61,7 +61,7 @@ The WHOCC is located in Oslo at the Norwegian Institute of Public Health and fun
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{

13
man/as.mic.Rd
View File

@ -103,9 +103,16 @@ as.rsi(x = as.mic(c(0.01, 2, 4, 8)),
# plot MIC values, see ?plot
plot(mic_data)
plot(mic_data, mo = "E. coli", ab = "cipro")
autoplot(mic_data, mo = "E. coli", ab = "cipro")
autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "uk") # Ukrainian
if (require("ggplot2")) {
autoplot(mic_data, mo = "E. coli", ab = "cipro")
}
if (require("ggplot2")) {
autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
}
if (require("ggplot2")) {
autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "uk") # Ukrainian
}
}
\seealso{
\code{\link[=as.rsi]{as.rsi()}}

2
man/as.mo.Rd
View File

@ -173,7 +173,7 @@ This package contains the complete taxonomic tree of almost all microorganisms (
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{

2
man/as.rsi.Rd
View File

@ -156,7 +156,7 @@ This AMR package honours this (new) insight. Use \code{\link[=susceptibility]{su
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{

2
man/availability.Rd
View File

@ -25,7 +25,7 @@ availability(example_isolates)
\donttest{
if (require("dplyr")) {
example_isolates \%>\%
filter(mo == as.mo("E. coli")) \%>\%
filter(mo == as.mo("Escherichia coli")) \%>\%
select_if(is.rsi) \%>\%
availability()
}

4
man/bug_drug_combinations.Rd
View File

@ -25,7 +25,7 @@ bug_drug_combinations(x, col_mo = NULL, FUN = mo_shortname, ...)
)
}
\arguments{
\item{x}{data with antibiotic columns, such as \code{amox}, \code{AMX} and \code{AMC}}
\item{x}{a data set with antibiotic columns, such as \code{amox}, \code{AMX} and \code{AMC}}
\item{col_mo}{column name of the IDs of the microorganisms (see \code{\link[=as.mo]{as.mo()}}), defaults to the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.}
@ -74,7 +74,7 @@ bug_drug_combinations(example_isolates,
FUN = mo_gramstain)
bug_drug_combinations(example_isolates,
FUN = function(x) ifelse(x == as.mo("E. coli"),
FUN = function(x) ifelse(x == as.mo("Escherichia coli"),
"E. coli",
"Others"))
}

8
man/catalogue_of_life.Rd
View File

@ -40,13 +40,13 @@ catalogue_of_life_version()
mo_shortname("Chlamydophila psittaci")
# Get any property from the entire taxonomic tree for all included species
mo_class("E. coli")
mo_class("Escherichia coli")
mo_family("E. coli")
mo_family("Escherichia coli")
mo_gramstain("E. coli") # based on kingdom and phylum, see ?mo_gramstain
mo_gramstain("Escherichia coli") # based on kingdom and phylum, see ?mo_gramstain
mo_ref("E. coli")
mo_ref("Escherichia coli")
# Do not get mistaken - this package is about microorganisms
mo_kingdom("C. elegans")

8
man/count.Rd
View File

@ -155,7 +155,7 @@ susceptibility(example_isolates$AMX) * n_rsi(example_isolates$AMX)
\donttest{
if (require("dplyr")) {
example_isolates \%>\%
group_by(hospital_id) \%>\%
group_by(ward) \%>\%
summarise(R = count_R(CIP),
I = count_I(CIP),
S = count_S(CIP),
@ -166,7 +166,7 @@ if (require("dplyr")) {
# Number of available isolates for a whole antibiotic class
# (i.e., in this data set columns GEN, TOB, AMK, KAN)
example_isolates \%>\%
group_by(hospital_id) \%>\%
group_by(ward) \%>\%
summarise(across(aminoglycosides(), n_rsi))
# Count co-resistance between amoxicillin/clav acid and gentamicin,
@ -188,8 +188,8 @@ if (require("dplyr")) {
# It also supports grouping variables
example_isolates \%>\%
select(hospital_id, AMX, CIP) \%>\%
group_by(hospital_id) \%>\%
select(ward, AMX, CIP) \%>\%
group_by(ward) \%>\%
count_df(translate = FALSE)
}
}

2
man/custom_eucast_rules.Rd
View File

@ -7,7 +7,7 @@
custom_eucast_rules(...)
}
\arguments{
\item{...}{rules in \link[=`~`]{formula} notation, see \emph{Examples}}
\item{...}{rules in \link[base:tilde]{formula} notation, see \emph{Examples}}
}
\value{
A \link{list} containing the custom rules

13
man/dosage.Rd
View File

@ -5,7 +5,7 @@
\alias{dosage}
\title{Data Set with Treatment Dosages as Defined by EUCAST}
\format{
A \link{data.frame} with 169 observations and 9 variables:
A [tibble\link[tibble:tibble]{tibble::tibble} with 169 observations and 9 variables:
\itemize{
\item \code{ab}\cr Antibiotic ID as used in this package (such as \code{AMC}), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
\item \code{name}\cr Official name of the antimicrobial agent as used by WHONET/EARS-Net or the WHO
@ -25,14 +25,13 @@ dosage
EUCAST breakpoints used in this package are based on the dosages in this data set. They can be retrieved with \code{\link[=eucast_dosage]{eucast_dosage()}}.
}
\details{
\href{https://www.eucast.org/clinical_breakpoints/}{'EUCAST Clinical Breakpoint Tables' v11.0} (2021) are based on the dosages in this data set.
}
\section{Reference Data Publicly Available}{
This data set is based on \href{https://www.eucast.org/clinical_breakpoints/}{'EUCAST Clinical Breakpoint Tables' v11.0} (2021).
\subsection{Direct download}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
}
\examples{
head(dosage)
dosage
}
\keyword{datasets}

44
man/eucast_rules.Rd
View File

@ -36,7 +36,7 @@ eucast_rules(
eucast_dosage(ab, administration = "iv", version_breakpoints = 11)
}
\arguments{
\item{x}{data with antibiotic columns, such as \code{amox}, \code{AMX} and \code{AMC}}
\item{x}{a data set with antibiotic columns, such as \code{amox}, \code{AMX} and \code{AMC}}
\item{col_mo}{column name of the IDs of the microorganisms (see \code{\link[=as.mo]{as.mo()}}), defaults to the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.}
@ -83,26 +83,26 @@ Custom rules can be created using \code{\link[=custom_eucast_rules]{custom_eucas
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
eucast_rules(example_isolates, rules = "custom", custom_rules = x, info = FALSE)
#> # A tibble: 2,000 x 49
#> date hospit~1 ward_~2 ward_~3 ward_~4 age gender patie~5 mo
#> * <date> <fct> <lgl> <lgl> <lgl> <dbl> <chr> <chr> <mo>
#> 1 2002-01-02 D FALSE TRUE FALSE 65 F A77334 B_ESCHR_COLI
#> 2 2002-01-03 D FALSE TRUE FALSE 65 F A77334 B_ESCHR_COLI
#> 3 2002-01-07 B TRUE FALSE FALSE 45 F 067927 B_STPHY_EPDR
#> 4 2002-01-07 B TRUE FALSE FALSE 45 F 067927 B_STPHY_EPDR
#> 5 2002-01-13 B TRUE FALSE FALSE 45 F 067927 B_STPHY_EPDR
#> 6 2002-01-13 B TRUE FALSE FALSE 45 F 067927 B_STPHY_EPDR
#> 7 2002-01-14 D FALSE TRUE FALSE 78 M 462729 B_STPHY_AURS
#> 8 2002-01-14 D FALSE TRUE FALSE 78 M 462729 B_STPHY_AURS
#> 9 2002-01-16 B TRUE FALSE FALSE 45 F 067927 B_STPHY_EPDR
#> 10 2002-01-17 B TRUE FALSE FALSE 79 F 858515 B_STPHY_EPDR
#> # ... with 1,990 more rows, 40 more variables: PEN <rsi>, OXA <rsi>, FLC <rsi>,
#> # AMX <rsi>, AMC <rsi>, AMP <rsi>, TZP <rsi>, CZO <rsi>, FEP <rsi>,
#> # CXM <rsi>, FOX <rsi>, CTX <rsi>, CAZ <rsi>, CRO <rsi>, GEN <rsi>,
#> # TOB <rsi>, AMK <rsi>, KAN <rsi>, TMP <rsi>, SXT <rsi>, NIT <rsi>,
#> # FOS <rsi>, LNZ <rsi>, CIP <rsi>, MFX <rsi>, VAN <rsi>, TEC <rsi>,
#> # TCY <rsi>, TGC <rsi>, DOX <rsi>, ERY <rsi>, CLI <rsi>, AZM <rsi>,
#> # IPM <rsi>, MEM <rsi>, MTR <rsi>, CHL <rsi>, COL <rsi>, MUP <rsi>, ...
#> # A tibble: 2,000 x 46
#> date patient age gender ward mo PEN OXA FLC AMX
#> * <date> <chr> <dbl> <chr> <chr> <mo> <rsi> <rsi> <rsi> <rsi>
#> 1 2002-01-02 A77334 65 F Clinical B_ESCHR_COLI R NA NA NA
#> 2 2002-01-03 A77334 65 F Clinical B_ESCHR_COLI R NA NA NA
#> 3 2002-01-07 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 4 2002-01-07 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 5 2002-01-13 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 6 2002-01-13 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 7 2002-01-14 462729 78 M Clinical B_STPHY_AURS R NA S R
#> 8 2002-01-14 462729 78 M Clinical B_STPHY_AURS R NA S R
#> 9 2002-01-16 067927 45 F ICU B_STPHY_EPDR R NA R NA
#> 10 2002-01-17 858515 79 F ICU B_STPHY_EPDR R NA S NA
#> # ... with 1,990 more rows, and 36 more variables: AMC <rsi>, AMP <rsi>,
#> # TZP <rsi>, CZO <rsi>, FEP <rsi>, CXM <rsi>, FOX <rsi>, CTX <rsi>,
#> # CAZ <rsi>, CRO <rsi>, GEN <rsi>, TOB <rsi>, AMK <rsi>, KAN <rsi>,
#> # TMP <rsi>, SXT <rsi>, NIT <rsi>, FOS <rsi>, LNZ <rsi>, CIP <rsi>,
#> # MFX <rsi>, VAN <rsi>, TEC <rsi>, TCY <rsi>, TGC <rsi>, DOX <rsi>,
#> # ERY <rsi>, CLI <rsi>, AZM <rsi>, IPM <rsi>, MEM <rsi>, MTR <rsi>,
#> # CHL <rsi>, COL <rsi>, MUP <rsi>, RIF <rsi>
#> # i Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names
}\if{html}{\out{</div>}}
}
@ -131,7 +131,7 @@ Amikacin (\code{AMK}, \href{https://www.whocc.no/atc_ddd_index/?code=J01GB06&sho
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
All data sets in this \code{AMR} package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{

29
man/example_isolates.Rd
View File

@ -5,32 +5,27 @@
\alias{example_isolates}
\title{Data Set with 2,000 Example Isolates}
\format{
A \link{data.frame} with 2,000 observations and 49 variables:
A [tibble\link[tibble:tibble]{tibble::tibble} with 2,000 observations and 46 variables:
\itemize{
\item \code{date}\cr date of receipt at the laboratory
\item \code{hospital_id}\cr ID of the hospital, from A to D
\item \code{ward_icu}\cr \link{logical} to determine if ward is an intensive care unit
\item \code{ward_clinical}\cr \link{logical} to determine if ward is a regular clinical ward
\item \code{ward_outpatient}\cr \link{logical} to determine if ward is an outpatient clinic
\item \code{age}\cr age of the patient
\item \code{gender}\cr gender of the patient
\item \code{patient_id}\cr ID of the patient
\item \code{mo}\cr ID of microorganism created with \code{\link[=as.mo]{as.mo()}}, see also \link{microorganisms}
\item \code{PEN:RIF}\cr 40 different antibiotics with class \code{\link{rsi}} (see \code{\link[=as.rsi]{as.rsi()}}); these column names occur in the \link{antibiotics} data set and can be translated with \code{\link[=ab_name]{ab_name()}}
\item \code{date}\cr Date of receipt at the laboratory
\item \code{patient}\cr ID of the patient
\item \code{age}\cr Age of the patient
\item \code{gender}\cr Gender of the patient, either "F" or "M"
\item \code{ward}\cr Ward type where the patient was admitted, either "Clinical", "ICU" or "Outpatient"
\item \code{mo}\cr ID of microorganism created with \code{\link[=as.mo]{as.mo()}}, see also the \link{microorganisms} data set
\item \code{PEN:RIF}\cr 40 different antibiotics with class \code{\link{rsi}} (see \code{\link[=as.rsi]{as.rsi()}}); these column names occur in the \link{antibiotics} data set and can be translated with \code{\link[=set_ab_names]{set_ab_names()}} or \code{\link[=ab_name]{ab_name()}}
}
}
\usage{
example_isolates
}
\description{
A data set containing 2,000 microbial isolates with their full antibiograms. The data set reflects reality and can be used to practice AMR data analysis. For examples, please read \href{https://msberends.github.io/AMR/articles/AMR.html}{the tutorial on our website}.
A data set containing 2,000 microbial isolates with their full antibiograms. This data set contains randomised fictitious data, but reflects reality and can be used to practise AMR data analysis. For examples, please read \href{https://msberends.github.io/AMR/articles/AMR.html}{the tutorial on our website}.
}
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
\details{
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{
head(example_isolates)
example_isolates
}
\keyword{datasets}

10
man/example_isolates_unclean.Rd
View File

@ -5,7 +5,7 @@
\alias{example_isolates_unclean}
\title{Data Set with Unclean Data}
\format{
A \link{data.frame} with 3,000 observations and 8 variables:
A [tibble\link[tibble:tibble]{tibble::tibble} with 3,000 observations and 8 variables:
\itemize{
\item \code{patient_id}\cr ID of the patient
\item \code{date}\cr date of receipt at the laboratory
@ -20,12 +20,10 @@ example_isolates_unclean
\description{
A data set containing 3,000 microbial isolates that are not cleaned up and consequently not ready for AMR data analysis. This data set can be used for practice.
}
\section{Reference Data Publicly Available}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
\details{
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
}
\examples{
head(example_isolates_unclean)
example_isolates_unclean
}
\keyword{datasets}

34
man/first_isolate.Rd
View File

@ -58,7 +58,7 @@ filter_first_isolate(
\item{col_specimen}{column name of the specimen type or group}
\item{col_icu}{column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU)}
\item{col_icu}{column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU). This can also be a \link{logical} vector with the same length as rows in \code{x}.}
\item{col_keyantimicrobials}{(only useful when \code{method = "phenotype-based"}) column name of the key antimicrobials to determine first isolates, see \code{\link[=key_antimicrobials]{key_antimicrobials()}}. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use \code{col_keyantimicrobials = FALSE} to prevent this. Can also be the output of \code{\link[=key_antimicrobials]{key_antimicrobials()}}.}
@ -87,7 +87,7 @@ filter_first_isolate(
\item{...}{arguments passed on to \code{\link[=first_isolate]{first_isolate()}} when using \code{\link[=filter_first_isolate]{filter_first_isolate()}}, otherwise arguments passed on to \code{\link[=key_antimicrobials]{key_antimicrobials()}} (such as \code{universal}, \code{gram_negative}, \code{gram_positive})}
}
\value{
A \code{\link{logical}} vector
A \link{logical} vector
}
\description{
Determine first isolates of all microorganisms of every patient per episode and (if needed) per specimen type. These functions support all four methods as summarised by Hindler \emph{et al.} in 2007 (\doi{10.1086/511864}). To determine patient episodes not necessarily based on microorganisms, use \code{\link[=is_new_episode]{is_new_episode()}} that also supports grouping with the \code{dplyr} package.
@ -178,35 +178,21 @@ if (require("dplyr")) {
example_isolates \%>\%
filter(first_isolate())
}
if (require("dplyr")) {
# short-hand version:
example_isolates \%>\%
filter_first_isolate(info = FALSE)
}
if (require("dplyr")) {
# flag the first isolates per group:
example_isolates \%>\%
group_by(hospital_id) \%>\%
group_by(ward) \%>\%
mutate(first = first_isolate()) \%>\%
select(hospital_id, date, patient_id, mo, first)
# now let's see if first isolates matter:
A <- example_isolates \%>\%
group_by(hospital_id) \%>\%
summarise(count = n_rsi(GEN), # gentamicin availability
resistance = resistance(GEN)) # gentamicin resistance
B <- example_isolates \%>\%
filter_first_isolate() \%>\% # the 1st isolate filter
group_by(hospital_id) \%>\%
summarise(count = n_rsi(GEN), # gentamicin availability
resistance = resistance(GEN)) # gentamicin resistance
# Have a look at A and B.
A
B
# B is more reliable because every isolate is counted only once.
# Gentamicin resistance in hospital D appears to be 4.2\% higher than
# when you (erroneously) would have used all isolates for analysis.
select(ward, date, patient, mo, first)
}
}
}

27
man/get_episode.Rd
View File

@ -54,26 +54,34 @@ if (require("dplyr")) {
# episodes based on any (combination of) grouping variables:
df \%>\%
mutate(condition = sample(x = c("A", "B", "C"),
size = 2000,
size = 200,
replace = TRUE)) \%>\%
group_by(condition) \%>\%
mutate(new_episode = is_new_episode(date, 365)) \%>\%
select(patient_id, date, condition, new_episode)
select(patient, date, condition, new_episode)
}
if (require("dplyr")) {
df \%>\%
group_by(hospital_id, patient_id) \%>\%
group_by(ward, patient) \%>\%
transmute(date,
patient_id,
patient,
new_index = get_episode(date, 60),
new_logical = is_new_episode(date, 60))
}
if (require("dplyr")) {
df \%>\%
group_by(hospital_id) \%>\%
summarise(n_patients = n_distinct(patient_id),
group_by(ward) \%>\%
summarise(n_patients = n_distinct(patient),
n_episodes_365 = sum(is_new_episode(date, episode_days = 365)),
n_episodes_60 = sum(is_new_episode(date, episode_days = 60)),
n_episodes_30 = sum(is_new_episode(date, episode_days = 30)))
}
if (require("dplyr")) {
# grouping on patients and microorganisms leads to the same
# results as first_isolate() when using 'episode-based':
@ -82,16 +90,19 @@ if (require("dplyr")) {
method = "episode-based")
y <- df \%>\%
group_by(patient_id, mo) \%>\%
group_by(patient, mo) \%>\%
filter(is_new_episode(date, 365)) \%>\%
ungroup()
identical(x, y)
}
if (require("dplyr")) {
# but is_new_episode() has a lot more flexibility than first_isolate(),
# since you can now group on anything that seems relevant:
df \%>\%
group_by(patient_id, mo, hospital_id, ward_icu) \%>\%
group_by(patient, mo, ward) \%>\%
mutate(flag_episode = is_new_episode(date, 365)) \%>\%
select(group_vars(.), flag_episode)
}

42
man/ggplot_rsi.Rd
View File

@ -142,12 +142,15 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin
}
\examples{
\donttest{
if (require("ggplot2") & require("dplyr")) {
if (require("ggplot2") && require("dplyr")) {
# get antimicrobial results for drugs against a UTI:
ggplot(example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)) +
geom_rsi()
}
if (require("ggplot2") && require("dplyr")) {
# prettify the plot using some additional functions:
df <- example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)
ggplot(df) +
@ -157,16 +160,25 @@ if (require("ggplot2") & require("dplyr")) {
labels_rsi_count() +
theme_rsi()
}
if (require("ggplot2") && require("dplyr")) {
# or better yet, simplify this using the wrapper function - a single command:
example_isolates \%>\%
select(AMX, NIT, FOS, TMP, CIP) \%>\%
ggplot_rsi()
}
if (require("ggplot2") && require("dplyr")) {
# get only proportions and no counts:
example_isolates \%>\%
select(AMX, NIT, FOS, TMP, CIP) \%>\%
ggplot_rsi(datalabels = FALSE)
}
if (require("ggplot2") && require("dplyr")) {
# add other ggplot2 arguments as you like:
example_isolates \%>\%
select(AMX, NIT, FOS, TMP, CIP) \%>\%
@ -176,11 +188,17 @@ if (require("ggplot2") & require("dplyr")) {
linetype = 2,
alpha = 0.25)
}
if (require("ggplot2") && require("dplyr")) {
# you can alter the colours with colour names:
example_isolates \%>\%
select(AMX) \%>\%
ggplot_rsi(colours = c(SI = "yellow"))
}
if (require("ggplot2") && require("dplyr")) {
# but you can also use the built-in colour-blind friendly colours for
# your plots, where "S" is green, "I" is yellow and "R" is red:
data.frame(x = c("Value1", "Value2", "Value3"),
@ -190,33 +208,41 @@ if (require("ggplot2") & require("dplyr")) {
geom_col(aes(x = x, y = y, fill = z)) +
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R")
}
if (require("ggplot2") && require("dplyr")) {
# resistance of ciprofloxacine per age group
example_isolates \%>\%
mutate(first_isolate = first_isolate()) \%>\%
filter(first_isolate == TRUE,
mo == as.mo("E. coli")) \%>\%
mo == as.mo("Escherichia coli")) \%>\%
# age_groups() is also a function in this AMR package:
group_by(age_group = age_groups(age)) \%>\%
select(age_group, CIP) \%>\%
ggplot_rsi(x = "age_group")
}
if (require("ggplot2") && require("dplyr")) {
# a shorter version which also adjusts data label colours:
example_isolates \%>\%
select(AMX, NIT, FOS, TMP, CIP) \%>\%
ggplot_rsi(colours = FALSE)
}
if (require("ggplot2") && require("dplyr")) {
# it also supports groups (don't forget to use the group var on `x` or `facet`):
example_isolates \%>\%
filter(mo_is_gram_negative()) \%>\%
filter(mo_is_gram_negative(), ward != "Outpatient") \%>\%
# select only UTI-specific drugs
select(hospital_id, AMX, NIT, FOS, TMP, CIP) \%>\%
group_by(hospital_id) \%>\%
ggplot_rsi(x = "hospital_id",
select(ward, AMX, NIT, FOS, TMP, CIP) \%>\%
group_by(ward) \%>\%
ggplot_rsi(x = "ward",
facet = "antibiotic",
nrow = 1,
title = "AMR of Anti-UTI Drugs Per Hospital",
x.title = "Hospital",
title = "AMR of Anti-UTI Drugs Per Ward",
x.title = "Ward",
datalabels = FALSE)
}
}

15
man/intrinsic_resistant.Rd
View File

@ -5,7 +5,7 @@
\alias{intrinsic_resistant}
\title{Data Set with Bacterial Intrinsic Resistance}
\format{
A \link{data.frame} with 134,956 observations and 2 variables:
A [tibble\link[tibble:tibble]{tibble::tibble} with 134,956 observations and 2 variables:
\itemize{
\item \code{mo}\cr Microorganism ID
\item \code{ab}\cr Antibiotic ID
@ -18,16 +18,15 @@ intrinsic_resistant
Data set containing defined intrinsic resistance by EUCAST of all bug-drug combinations.
}
\details{
The repository of this \code{AMR} package contains a file comprising this data set with full taxonomic and antibiotic names: \url{https://github.com/msberends/AMR/blob/main/data-raw/intrinsic_resistant.txt}. This file \strong{allows for machine reading EUCAST guidelines about intrinsic resistance}, which is almost impossible with the Excel and PDF files distributed by EUCAST. The file is updated automatically.
This data set is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).
}
\section{Reference Data Publicly Available}{
\subsection{Direct download}{
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this \code{AMR} package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find \href{https://msberends.github.io/AMR/articles/datasets.html}{all download links on our website}, which is automatically updated with every code change.
}
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
They \strong{allow for machine reading EUCAST and CLSI guidelines}, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI.
}
}
\examples{
head(intrinsic_resistant)
intrinsic_resistant
}
\keyword{datasets}

Some files were not shown because too many files have changed in this diff Show More