diff --git a/.Rbuildignore b/.Rbuildignore index 6fd7fa1c6..aa62a5704 100755 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -16,6 +16,7 @@ ^docs$ ^git_.*\.sh$ ^index\.md$ +^index\.Rmd$ ^installed_deps$ ^Meta$ ^pkgdown$ @@ -37,3 +38,4 @@ ^logo.svg$ ^CRAN-SUBMISSION$ ^PythonPackage$ +^README\.Rmd$ diff --git a/.gitignore b/.gitignore index 54dfafbd4..7f5190bc7 100755 --- a/.gitignore +++ b/.gitignore @@ -12,6 +12,8 @@ inst/doc /src/*.d /src/*.so _noinclude +index.html +README.html *.dll vignettes/*.R .DS_Store diff --git a/DESCRIPTION b/DESCRIPTION index 62a3a0a3f..d01daf993 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9249 -Date: 2025-04-20 +Version: 2.1.1.9250 +Date: 2025-04-21 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 diff --git a/NEWS.md b/NEWS.md index 8d8a2a35e..630dd4b12 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 2.1.1.9249 +# AMR 2.1.1.9250 *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)* diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 5fd034dc8..1017f5d37 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -72,7 +72,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @param administration Route of administration, either `r vector_or(dosage$administration)`. #' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`). #' @param custom_rules Custom rules to apply, created with [custom_eucast_rules()]. -#' @param overwrite A [logical] indicating whether to overwrite non-`NA` values (default: `FALSE`). When `FALSE`, only `NA` values are modified. To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant.". +#' @param overwrite A [logical] indicating whether to overwrite non-`NA` values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant". #' @inheritParams first_isolate #' @details #' **Note:** This function does not translate MIC values to SIR values. Use [as.sir()] for that. \cr @@ -1248,7 +1248,7 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 15) { meet_criteria(version_breakpoints, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_BREAKPOINTS))) # show used version_breakpoints number once per session (AMR_env will reload every session) - if (message_not_thrown_before("eucast_dosage", "v", gsub("[^0-9]", "", version_breakpoints), entire_session = TRUE)) { + if (missing(version_breakpoints) && message_not_thrown_before("eucast_dosage", "v", gsub("[^0-9]", "", version_breakpoints), entire_session = TRUE)) { message_( "Dosages for antimicrobial drugs, as meant for ", format_eucast_version_nr(version_breakpoints, markdown = FALSE), ". ", @@ -1259,18 +1259,19 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 15) { ab <- as.ab(ab) lst <- vector("list", length = length(ab)) for (i in seq_len(length(ab))) { - df <- AMR::dosage[which(AMR::dosage$ab == ab[i] & AMR::dosage$administration == administration), , drop = FALSE] + df <- AMR::dosage[which(AMR::dosage$eucast_version == version_breakpoints & AMR::dosage$ab == ab[i] & AMR::dosage$administration == administration), , drop = FALSE] lst[[i]] <- list( ab = "", name = "", standard_dosage = ifelse("standard_dosage" %in% df$type, - df[which(df$type == "standard_dosage"), "original_txt", drop = TRUE], + trimws2(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", drop = TRUE], + trimws2(df[which(df$type == "high_dosage"), "original_txt", drop = TRUE]), NA_character_ - ) + ), + eucast_version = df$eucast_version[1] ) } out <- do.call(rbind_AMR, lapply(lst, as.data.frame, stringsAsFactors = FALSE)) diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 000000000..0253e7f7d --- /dev/null +++ b/README.Rmd @@ -0,0 +1,60 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + # fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# The `AMR` Package for R + +Please visit our comprehensive package website to read more about this package, including many examples and tutorials. + +Overview: + +* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach +* Peer-reviewed, used in over 175 countries, available in 20 languages +* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA +* Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs +* Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation +* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class +* Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, **SNOMED CT**, and **NCBI** +* 100% free of costs and dependencies, highly suitable for places with **limited resources** + +---- + +The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. + +The `AMR` package supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl). + +---- + +### How to get this package + +To install the latest 'release' version from CRAN: + +```{r, eval = FALSE} +install.packages("AMR") +``` + +To install the latest 'beta' version: + +```{r, eval = FALSE} +install.packages("AMR", repos = "beta.amr-for-r.org") + +# if this does not work, try to install directly from GitHub using the 'remotes' package: +remotes::install_github("msberends/AMR") +``` + +---- + + +This AMR package for R is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](https://amr-for-r.org/LICENSE-text.html). These requirements are consequently legally binding: modifications must be released under the same license when distributing the package, changes made to the code must be documented, source code must be made available when the package is distributed, and a copy of the license and copyright notice must be included with the package. + diff --git a/README.md b/README.md index 74dd801fd..1c93c8e7f 100755 --- a/README.md +++ b/README.md @@ -1,43 +1,75 @@ + + + # The `AMR` Package for R -Please visit our comprehensive package website to read more about this package, including many examples and tutorials. - ----- - -The `AMR` package is a free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. +Please visit our comprehensive package website +to read more about this package, including many examples and tutorials. Overview: -* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach -* Peer-reviewed, used in over 175 countries, available in 20 languages -* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA -* Provides the **full microbiological taxonomy** and extensive info on **all antimicrobial drugs** -* Applies all recent **CLSI** and **EUCAST** clinical and veterinary breakpoints for MICs, disk zones and ECOFFs -* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class -* Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, **SNOMED CT**, and **NCBI** -* 100% free of costs and dependencies, highly suitable for places with **limited resources** +- Provides an **all-in-one solution** for antimicrobial resistance (AMR) + data analysis in a One Health approach +- Peer-reviewed, used in over 175 countries, available in 20 languages +- Generates **antibiograms** - traditional, combined, syndromic, and + even WISCA +- Provides the **full microbiological taxonomy** of ~79 000 distinct + species and extensive info of ~620 antimicrobial drugs +- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and + veterinary breakpoints, and ECOFFs, for MIC and disk zone + interpretation +- Corrects for duplicate isolates, **calculates** and **predicts** AMR + per antimicrobial class +- Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, + **SNOMED CT**, and **NCBI** +- 100% free of costs and dependencies, highly suitable for places with + **limited resources** ----- +------------------------------------------------------------------------ + +The `AMR` package is a peer-reviewed, free and open-source R package +with zero dependencies to simplify the analysis and prediction of +Antimicrobial Resistance (AMR) and to work with microbial and +antimicrobial data and properties, by using evidence-based methods. +**Our aim is to provide a standard** for clean and reproducible AMR data +analysis, that can therefore empower epidemiological analyses to +continuously enable surveillance and treatment evaluation in any +setting. + +The `AMR` package supports and can read any data format, including +WHONET data. This package works on Windows, macOS and Linux with all +versions of R since R-3.0 (April 2013). **It was designed to work in any +setting, including those with very limited resources**. It was created +for both routine data analysis and academic research at the Faculty of +Medical Sciences of the [University of Groningen](https://www.rug.nl) +and the [University Medical Center Groningen](https://www.umcg.nl). + +------------------------------------------------------------------------ ### How to get this package -To install the latest 'release' version from CRAN: +To install the latest ‘release’ version from CRAN: -```r +``` r install.packages("AMR") ``` -To install the latest 'beta' version: +To install the latest ‘beta’ version: -```r +``` r install.packages("AMR", repos = "beta.amr-for-r.org") # if this does not work, try to install directly from GitHub using the 'remotes' package: remotes::install_github("msberends/AMR") ``` ----- +------------------------------------------------------------------------ - -This AMR package for R is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](https://amr-for-r.org/LICENSE-text.html). These requirements are consequently legally binding: modifications must be released under the same license when distributing the package, changes made to the code must be documented, source code must be made available when the package is distributed, and a copy of the license and copyright notice must be included with the package. - + This AMR package for R is free, open-source software and +licensed under the [GNU General Public License v2.0 +(GPL-2)](https://amr-for-r.org/LICENSE-text.html). These requirements +are consequently legally binding: modifications must be released under +the same license when distributing the package, changes made to the code +must be documented, source code must be made available when the package +is distributed, and a copy of the license and copyright notice must be +included with the package. diff --git a/data-raw/_pre_commit_checks.R b/data-raw/_pre_commit_checks.R index 51b209096..1ac1950c6 100644 --- a/data-raw/_pre_commit_checks.R +++ b/data-raw/_pre_commit_checks.R @@ -656,6 +656,13 @@ if (files_changed()) { suppressMessages(devtools::document(quiet = TRUE)) } +# Update index.md and README.md ------------------------------------------- +if (files_changed("man/microorganisms.Rd") | files_changed("man/antimicrobials.Rd") | files_changed("man/clinical_breakpoints.Rd") | files_changed("man/antibiogram.Rd")) { + usethis::ui_info("Update index.md") + suppressWarnings(rmarkdown::render("index.Rmd", quiet = TRUE)) + suppressWarnings(rmarkdown::render("README.Rmd", quiet = TRUE)) +} + # Finished ---------------------------------------------------------------- usethis::ui_done("All done") suppressMessages(reset_AMR_locale()) diff --git a/index.Rmd b/index.Rmd new file mode 100644 index 000000000..83a765f73 --- /dev/null +++ b/index.Rmd @@ -0,0 +1,278 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "pkgdown/assets/", + out.width = "100%" +) +``` + +# The `AMR` Package for R + +* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach +* Peer-reviewed, used in over 175 countries, available in 20 languages +* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA +* Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs +* Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation +* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class +* Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, **SNOMED CT**, and **NCBI** +* 100% free of costs and dependencies, highly suitable for places with **limited resources** + +> Now available for Python too! [Click here](./articles/AMR_for_Python.html) to read more. + +
+

https://amr-for-r.org

+

https://doi.org/10.18637/jss.v104.i03

+
+ + + +---- + +### Introduction + +The `AMR` package is a peer-reviewed, [free and open-source](#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. We are a team of [many different researchers](./authors.html) from around the globe to make this a successful and durable project! + +This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)). + +After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](./reference/microorganisms.html) (updated June 2024) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](./reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl). + +##### Used in over 175 countries, available in 20 languages + + + +Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names. + +With the help of contributors from all corners of the world, the `AMR` package is available in English, Czech, Chinese, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swedish, Turkish, and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages. + +### Practical examples + +#### Filtering and selecting data + +One of the most powerful functions of this package, aside from calculating and plotting AMR, is selecting and filtering based on antimicrobial columns. This can be done using the so-called [antimicrobial selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html), which work in base R, `dplyr` and `data.table`. + +```{r} +# AMR works great with dplyr, but it's not required or neccesary +library(AMR) +library(dplyr, warn.conflicts = FALSE) + +example_isolates %>% + mutate(bacteria = mo_fullname()) %>% + # filtering functions for microorganisms: + filter(mo_is_gram_negative(), + mo_is_intrinsic_resistant(ab = "cefotax")) %>% + # antimicrobial selectors: + select(bacteria, + aminoglycosides(), + carbapenems()) +``` + +With only having defined a row filter on Gram-negative bacteria with intrinsic resistance to cefotaxime (`mo_is_gram_negative()` and `mo_is_intrinsic_resistant()`) and a column selection on two antibiotic groups (`aminoglycosides()` and `carbapenems()`), the reference data about [all microorganisms](./reference/microorganisms.html) and [all antimicrobials](./reference/antimicrobials.html) in the `AMR` package make sure you get what you meant. + +#### Generating antibiograms + +The `AMR` package supports generating traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA). + +If used inside [R Markdown](https://rmarkdown.rstudio.com) or [Quarto](https://quarto.org), the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.). + +```{r} +antibiogram(example_isolates, + antimicrobials = c(aminoglycosides(), carbapenems())) +``` + +In combination antibiograms, it is clear that combined antimicrobials yield higher empiric coverage: + +```{r} +antibiogram(example_isolates, + antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"), + mo_transform = "gramstain") +``` + +Like many other functions in this package, `antibiogram()` comes with support for 20 languages that are often detected automatically based on system language: + +```{r} +antibiogram(example_isolates, + antimicrobials = c("cipro", "tobra", "genta"), # any arbitrary name or code will work + mo_transform = "gramstain", + ab_transform = "name", + language = "uk") # Ukrainian +``` + +#### Interpreting and plotting MIC and SIR values + +The `AMR` package allows interpretation of MIC and disk diffusion values based on CLSI and EUCAST. Moreover, the `ggplot2` package is extended with new scale functions, to allow plotting of log2-distributed MIC values and SIR values. + +```{r, eval = FALSE} +library(ggplot2) +library(AMR) + +# generate some random values +some_mic_values <- random_mic(size = 100) +some_groups <- sample(LETTERS[1:5], 20, replace = TRUE) +interpretation <- as.sir(some_mic_values, + guideline = "EUCAST 2024", + mo = "E. coli", # or any code or name resembling a known species + ab = "Cipro") # or any code or name resembling an antibiotic + +# create the plot +ggplot(data.frame(mic = some_mic_values, + group = some_groups, + sir = interpretation), + aes(x = group, y = mic, colour = sir)) + + theme_minimal() + + geom_boxplot(fill = NA, colour = "grey") + + geom_jitter(width = 0.25) + + + # NEW scale function: plot MIC values to x, y, colour or fill + scale_y_mic() + + + # NEW scale function: write out S/I/R in any of the 20 supported languages + # and set colourblind-friendly colours + scale_colour_sir() +``` + + + + + +#### Calculating resistance per group + +For a manual approach, you can use the `resistance` or `susceptibility()` function: + +```{r} +example_isolates %>% + # group by ward: + group_by(ward) %>% + # calculate AMR using resistance() for gentamicin and tobramycin + # and get their 95% confidence intervals using sir_confidence_interval(): + summarise(across(c(GEN, TOB), + list(total_R = resistance, + conf_int = function(x) sir_confidence_interval(x, collapse = "-")))) +``` + +Or use [antimicrobial selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html) to select a series of antibiotic columns: + +```{r} +library(AMR) +library(dplyr) + +out <- example_isolates %>% + # group by ward: + group_by(ward) %>% + # calculate AMR using resistance(), over all aminoglycosides and polymyxins: + summarise(across(c(aminoglycosides(), polymyxins()), + resistance)) +out +``` + +```{r} +# transform the antibiotic columns to names: +out %>% set_ab_names() +``` + +```{r} +# transform the antibiotic column to ATC codes: +out %>% set_ab_names(property = "atc") +``` + +### What else can you do with this package? + +This package was intended as a comprehensive toolbox for integrated AMR data analysis. This package can be used for: + + * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](./reference/mo_property.html)) + * Interpreting raw MIC and disk diffusion values, based on any CLSI or EUCAST guideline ([manual](./reference/as.sir.html)) + * Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records ([manual](./reference/ab_from_text.html)) + * Determining first isolates to be used for AMR data analysis ([manual](./reference/first_isolate.html)) + * Calculating antimicrobial resistance ([tutorial](./articles/AMR.html)) + * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](./articles/MDR.html)) + * Calculating (empirical) susceptibility of both mono therapy and combination therapies ([tutorial](./articles/AMR.html)) + * Apply AMR function in predictive modelling ([tutorial](./articles/AMR_with_tidymodels.html)) + * Getting properties for any microorganism (like Gram stain, species, genus or family) ([manual](./reference/mo_property.html)) + * Getting properties for any antimicrobial (like name, code of EARS-Net/ATC/LOINC/PubChem, defined daily dose or trade name) ([manual](./reference/ab_property.html)) + * Plotting antimicrobial resistance ([tutorial](./articles/AMR.html)) + * Applying EUCAST expert rules ([manual](./reference/eucast_rules.html)) + * Getting SNOMED codes of a microorganism, or getting properties of a microorganism based on a SNOMED code ([manual](./reference/mo_property.html)) + * Getting LOINC codes of an antibiotic, or getting properties of an antibiotic based on a LOINC code ([manual](./reference/ab_property.html)) + * Machine reading the EUCAST and CLSI guidelines from 2011-2021 to translate MIC values and disk diffusion diameters to SIR ([link](./articles/datasets.html)) + * Principal component analysis for AMR ([tutorial](./articles/PCA.html)) + +### Get this package + +#### Latest official version + +[![CRAN](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.r-project.org/package=AMR) +[![CRANlogs](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.r-project.org/package=AMR) + +This package is available [here on the official R network (CRAN)](https://cran.r-project.org/package=AMR). Install this package in R from CRAN by using the command: + +```{r, eval = FALSE} +install.packages("AMR") +``` + +It will be downloaded and installed automatically. For RStudio, click on the menu *Tools* > *Install Packages...* and then type in "AMR" and press Install. + +**Note:** Not all functions on this website may be available in this latest release. To use all functions and data sets mentioned on this website, install the latest beta version. + +#### Latest beta version + +[![check-old](https://github.com/msberends/AMR/actions/workflows/check-old-tinytest.yaml/badge.svg?branch=main)](https://github.com/msberends/AMR/actions/workflows/check-old-tinytest.yaml) +[![check-recent](https://github.com/msberends/AMR/actions/workflows/check-current-testthat.yaml/badge.svg?branch=main)](https://github.com/msberends/AMR/actions/workflows/check-current-testthat.yaml) +[![CodeFactor](https://www.codefactor.io/repository/github/msberends/amr/badge)](https://www.codefactor.io/repository/github/msberends/amr) +[![Codecov](https://codecov.io/gh/msberends/AMR/branch/main/graph/badge.svg)](https://codecov.io/gh/msberends/AMR?branch=main) + +Please read our [Developer Guideline here](https://github.com/msberends/AMR/wiki/Developer-Guideline). + +To install the latest and unpublished beta version: + +```{r, eval = FALSE} +install.packages("AMR", repos = "beta.amr-for-r.org") + +# if this does not work, try to install directly from GitHub using the 'remotes' package: +remotes::install_github("msberends/AMR") +``` + +### Get started + +To find out how to conduct AMR data analysis, please [continue reading here to get started](./articles/AMR.html) or click a link in the ['How to' menu](./articles/). + +### Partners + +The initial development of this package was part of, related to, or made possible by the following non-profit organisations and initiatives: + +
+ + + + + +
+ +### Copyright + +This R package is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](./LICENSE-text.html). In a nutshell, this means that this package: + +- May be used for commercial purposes + +- May be used for private purposes + +- May **not** be used for patent purposes + +- May be modified, although: + + - Modifications **must** be released under the same license when distributing the package + - Changes made to the code **must** be documented + +- May be distributed, although: + + - Source code **must** be made available when the package is distributed + - A copy of the license and copyright notice **must** be included with the package. + +- Comes with a LIMITATION of liability + +- Comes with NO warranty diff --git a/index.md b/index.md index 88eb9a342..29c72243f 100644 --- a/index.md +++ b/index.md @@ -1,51 +1,147 @@ + + + # The `AMR` Package for R -* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach -* Peer-reviewed, used in over 175 countries, available in 20 languages -* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA -* Provides the **full microbiological taxonomy** and extensive info on **all antimicrobial drugs** -* Applies all recent **CLSI** and **EUCAST** clinical and veterinary breakpoints for MICs, disk zones and ECOFFs -* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class -* Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, **SNOMED CT**, and **NCBI** -* 100% free of costs and dependencies, highly suitable for places with **limited resources** +- Provides an **all-in-one solution** for antimicrobial resistance (AMR) + data analysis in a One Health approach +- Peer-reviewed, used in over 175 countries, available in 20 languages +- Generates **antibiograms** - traditional, combined, syndromic, and + even WISCA +- Provides the **full microbiological taxonomy** of ~79 000 distinct + species and extensive info of ~620 antimicrobial drugs +- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and + veterinary breakpoints, and ECOFFs, for MIC and disk zone + interpretation +- Corrects for duplicate isolates, **calculates** and **predicts** AMR + per antimicrobial class +- Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, + **SNOMED CT**, and **NCBI** +- 100% free of costs and dependencies, highly suitable for places with + **limited resources** -> Now available for Python too! [Click here](./articles/AMR_for_Python.html) to read more. +> Now available for Python too! [Click +> here](./articles/AMR_for_Python.html) to read more.
-

https://amr-for-r.org

-

https://doi.org/10.18637/jss.v104.i03

+ +

+https://amr-for-r.org +

+

+https://doi.org/10.18637/jss.v104.i03 +

+
----- +------------------------------------------------------------------------ ### Introduction -The `AMR` package is a peer-reviewed, [free and open-source](#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. We are a team of [many different researchers](./authors.html) from around the globe to make this a successful and durable project! +The `AMR` package is a peer-reviewed, [free and open-source](#copyright) +R package with [zero +dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify +the analysis and prediction of Antimicrobial Resistance (AMR) and to +work with microbial and antimicrobial data and properties, by using +evidence-based methods. **Our aim is to provide a standard** for clean +and reproducible AMR data analysis, that can therefore empower +epidemiological analyses to continuously enable surveillance and +treatment evaluation in any setting. We are a team of [many different +researchers](./authors.html) from around the globe to make this a +successful and durable project! -This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)). +This work was published in the Journal of Statistical Software (Volume +104(3); [DOI +10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and +formed the basis of two PhD theses ([DOI +10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and +[DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)). -After installing this package, R knows [**~79,000 distinct microbial species**](./reference/microorganisms.html) (updated June 2024) and all [**~620 antimicrobial and antiviral drugs**](./reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI and EUCAST are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl). +After installing this package, R knows [**~79 000 distinct microbial +species**](./reference/microorganisms.html) (updated June 2024) and all +[**~620 antimicrobial and antiviral +drugs**](./reference/antimicrobials.html) by name and code (including +ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all +about valid SIR and MIC values. The integral clinical breakpoint +guidelines from CLSI 2011-2025 and EUCAST 2011-2025 are included, even +with epidemiological cut-off (ECOFF) values. It supports and can read +any data format, including WHONET data. This package works on Windows, +macOS and Linux with all versions of R since R-3.0 (April 2013). **It +was designed to work in any setting, including those with very limited +resources**. It was created for both routine data analysis and academic +research at the Faculty of Medical Sciences of the [University of +Groningen](https://www.rug.nl) and the [University Medical Center +Groningen](https://www.umcg.nl). ##### Used in over 175 countries, available in 20 languages -Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names. +Since its first public release in early 2018, this R package has been +used in almost all countries in the world. Click the map to enlarge and +to see the country names. -With the help of contributors from all corners of the world, the `AMR` package is available in English, Czech, Chinese, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swedish, Turkish, and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages. +With the help of contributors from all corners of the world, the `AMR` +package is available in + +English, + +Czech, + +Chinese, + +Danish, + +Dutch, + +Finnish, + +French, + +German, + +Greek, + +Italian, + +Japanese, + +Norwegian, + +Polish, + +Portuguese, + +Romanian, + +Russian, + +Spanish, + +Swedish, + +Turkish, and + +Ukrainian. Antimicrobial drug (group) names and colloquial microorganism +names are provided in these languages. ### Practical examples #### Filtering and selecting data -One of the most powerful functions of this package, aside from calculating and plotting AMR, is selecting and filtering based on antimicrobial columns. This can be done using the so-called [antimicrobial selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html), which work in base R, `dplyr` and `data.table`. +One of the most powerful functions of this package, aside from +calculating and plotting AMR, is selecting and filtering based on +antimicrobial columns. This can be done using the so-called +[antimicrobial +selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html), +which work in base R, `dplyr` and `data.table`. -```r +``` r # AMR works great with dplyr, but it's not required or neccesary library(AMR) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) example_isolates %>% mutate(bacteria = mo_fullname()) %>% @@ -56,83 +152,106 @@ example_isolates %>% select(bacteria, aminoglycosides(), carbapenems()) +#> ℹ Using column 'mo' as input for mo_fullname() +#> ℹ Using column 'mo' as input for mo_is_gram_negative() +#> ℹ Using column 'mo' as input for mo_is_intrinsic_resistant() +#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB' (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin) +#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem) +#> # A tibble: 35 × 7 +#> bacteria GEN TOB AMK KAN IPM MEM +#> +#> 1 Pseudomonas aeruginosa  I   S   NA  R   S   NA +#> 2 Pseudomonas aeruginosa  I   S   NA  R   S   NA +#> 3 Pseudomonas aeruginosa  I   S   NA  R   S   NA +#> 4 Pseudomonas aeruginosa  S   S   S   R   NA  S  +#> 5 Pseudomonas aeruginosa  S   S   S   R   S   S  +#> 6 Pseudomonas aeruginosa  S   S   S   R   S   S  +#> 7 Stenotrophomonas maltophilia  R   R   R   R   R   R  +#> 8 Pseudomonas aeruginosa  S   S   S   R   NA  S  +#> 9 Pseudomonas aeruginosa  S   S   S   R   NA  S  +#> 10 Pseudomonas aeruginosa  S   S   S   R   S   S  +#> # ℹ 25 more rows ``` -With only having defined a row filter on Gram-negative bacteria with intrinsic resistance to cefotaxime (`mo_is_gram_negative()` and `mo_is_intrinsic_resistant()`) and a column selection on two antibiotic groups (`aminoglycosides()` and `carbapenems()`), the reference data about [all microorganisms](./reference/microorganisms.html) and [all antimicrobials](./reference/antimicrobials.html) in the `AMR` package make sure you get what you meant: - -|bacteria | GEN | TOB | AMK | KAN | IPM | MEM | -|:------------------------------|:---:|:---:|:---:|:---:|:---:|:---:| -|*Pseudomonas aeruginosa* | I | S | | R | S | | -|*Pseudomonas aeruginosa* | I | S | | R | S | | -|*Pseudomonas aeruginosa* | I | S | | R | S | | -|*Pseudomonas aeruginosa* | S | S | S | R | | S | -|*Pseudomonas aeruginosa* | S | S | S | R | S | S | -|*Pseudomonas aeruginosa* | S | S | S | R | S | S | -|*Stenotrophomonas maltophilia* | R | R | R | R | R | R | -|*Pseudomonas aeruginosa* | S | S | S | R | | S | -|*Pseudomonas aeruginosa* | S | S | S | R | | S | -|*Pseudomonas aeruginosa* | S | S | S | R | S | S | +With only having defined a row filter on Gram-negative bacteria with +intrinsic resistance to cefotaxime (`mo_is_gram_negative()` and +`mo_is_intrinsic_resistant()`) and a column selection on two antibiotic +groups (`aminoglycosides()` and `carbapenems()`), the reference data +about [all microorganisms](./reference/microorganisms.html) and [all +antimicrobials](./reference/antimicrobials.html) in the `AMR` package +make sure you get what you meant. #### Generating antibiograms -The `AMR` package supports generating traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA). +The `AMR` package supports generating traditional, combined, syndromic, +and even weighted-incidence syndromic combination antibiograms (WISCA). -If used inside [R Markdown](https://rmarkdown.rstudio.com) or [Quarto](https://quarto.org), the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.). +If used inside [R Markdown](https://rmarkdown.rstudio.com) or +[Quarto](https://quarto.org), the table will be printed in the right +output format automatically (such as markdown, LaTeX, HTML, etc.). -```r +``` r antibiogram(example_isolates, - antimicrobials = c(aminoglycosides(), carbapenems()), - formatting_type = 14) + antimicrobials = c(aminoglycosides(), carbapenems())) +#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB' (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin) +#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem) +#> ℹ 502 combinations had less than minimum = 30 results and were ignored ``` -| Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin | -|:-----------------|:--------------:|:--------------:|:--------------:|:----------:|:--------------:|:--------------:| -| CoNS | 0% (0-8%) | 86% (82-90%) | 52% (37-67%) | 0% (0-8%) | 52% (37-67%) | 22% (12-35%) | -| *E. coli* | 100% (98-100%) | 98% (96-99%) | 100% (99-100%) | | 100% (99-100%) | 97% (96-99%) | -| *E. faecalis* | 0% (0-9%) | 0% (0-9%) | 100% (91-100%) | 0% (0-9%) | | 0% (0-9%) | -| *K. pneumoniae* | | 90% (79-96%) | 100% (93-100%) | | 100% (93-100%) | 90% (79-96%) | -| *P. aeruginosa* | | 100% (88-100%) | | 0% (0-12%) | | 100% (88-100%) | -| *P. mirabilis* | | 94% (80-99%) | 94% (79-99%) | | | 94% (80-99%) | -| *S. aureus* | | 99% (97-100%) | | | | 98% (92-100%) | -| *S. epidermidis* | 0% (0-8%) | 79% (71-85%) | | 0% (0-8%) | | 51% (40-61%) | -| *S. hominis* | | 92% (84-97%) | | | | 85% (74-93%) | -| *S. pneumoniae* | 0% (0-3%) | 0% (0-3%) | | 0% (0-3%) | | 0% (0-3%) | +| Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin | +|:---|:---|:---|:---|:---|:---|:---| +| CoNS | 0% (0-8%,N=43) | 86% (82-90%,N=309) | 52% (37-67%,N=48) | 0% (0-8%,N=43) | 52% (37-67%,N=48) | 22% (12-35%,N=55) | +| E. coli | 100% (98-100%,N=171) | 98% (96-99%,N=460) | 100% (99-100%,N=422) | | 100% (99-100%,N=418) | 97% (96-99%,N=462) | +| E. faecalis | 0% (0-9%,N=39) | 0% (0-9%,N=39) | 100% (91-100%,N=38) | 0% (0-9%,N=39) | | 0% (0-9%,N=39) | +| K. pneumoniae | | 90% (79-96%,N=58) | 100% (93-100%,N=51) | | 100% (93-100%,N=53) | 90% (79-96%,N=58) | +| P. aeruginosa | | 100% (88-100%,N=30) | | 0% (0-12%,N=30) | | 100% (88-100%,N=30) | +| P. mirabilis | | 94% (80-99%,N=34) | 94% (79-99%,N=32) | | | 94% (80-99%,N=34) | +| S. aureus | | 99% (97-100%,N=233) | | | | 98% (92-100%,N=86) | +| S. epidermidis | 0% (0-8%,N=44) | 79% (71-85%,N=163) | | 0% (0-8%,N=44) | | 51% (40-61%,N=89) | +| S. hominis | | 92% (84-97%,N=80) | | | | 85% (74-93%,N=62) | +| S. pneumoniae | 0% (0-3%,N=117) | 0% (0-3%,N=117) | | 0% (0-3%,N=117) | | 0% (0-3%,N=117) | -In combination antibiograms, it is clear that combined antimicrobials yield higher empiric coverage: +In combination antibiograms, it is clear that combined antimicrobials +yield higher empiric coverage: -```r +``` r antibiogram(example_isolates, antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"), - mo_transform = "gramstain", - formatting_type = 14) + mo_transform = "gramstain") +#> ℹ 3 combinations had less than minimum = 30 results and were ignored ``` -|Pathogen | Piperacillin/tazobactam | Piperacillin/tazobactam + Gentamicin | Piperacillin/tazobactam + Tobramycin | -|:-------------|:-----------------------:|:------------------------------------:|:------------------------------------:| -|Gram-negative | 88% (85-91%) | 99% (97-99%) | 98% (97-99%) | -|Gram-positive | 86% (82-89%) | 98% (96-98%) | 95% (93-97%) | +| Pathogen | Piperacillin/tazobactam | Piperacillin/tazobactam + Gentamicin | Piperacillin/tazobactam + Tobramycin | +|:---|:---|:---|:---| +| Gram-negative | 88% (85-91%,N=641) | 99% (97-99%,N=691) | 98% (97-99%,N=693) | +| Gram-positive | 86% (82-89%,N=345) | 98% (96-98%,N=1044) | 95% (93-97%,N=550) | -Like many other functions in this package, `antibiogram()` comes with support for 20 languages that are often detected automatically based on system language: +Like many other functions in this package, `antibiogram()` comes with +support for 20 languages that are often detected automatically based on +system language: -```r +``` r antibiogram(example_isolates, antimicrobials = c("cipro", "tobra", "genta"), # any arbitrary name or code will work mo_transform = "gramstain", ab_transform = "name", - formatting_type = 14, language = "uk") # Ukrainian +#> ℹ 3 combinations had less than minimum = 30 results and were ignored ``` -|Збудник | Гентаміцин | Тобраміцин | Ципрофлоксацин | -|:-------------|:------------:|:------------:|:--------------:| -|Грамнегативні | 96% (95-98%) | 96% (94-97%) | 91% (88-93%) | -|Грампозитивні | 63% (60-66%) | 34% (31-38%) | 77% (74-80%) | +| Збудник | Гентаміцин | Тобраміцин | Ципрофлоксацин | +|:--------------|:--------------------|:-------------------|:-------------------| +| Грамнегативні | 96% (95-98%,N=684) | 96% (94-97%,N=686) | 91% (88-93%,N=684) | +| Грампозитивні | 63% (60-66%,N=1170) | 34% (31-38%,N=665) | 77% (74-80%,N=724) | #### Interpreting and plotting MIC and SIR values -The `AMR` package allows interpretation of MIC and disk diffusion values based on CLSI and EUCAST. Moreover, the `ggplot2` package is extended with new scale functions, to allow plotting of log2-distributed MIC values and SIR values. +The `AMR` package allows interpretation of MIC and disk diffusion values +based on CLSI and EUCAST. Moreover, the `ggplot2` package is extended +with new scale functions, to allow plotting of log2-distributed MIC +values and SIR values. -```r +``` r library(ggplot2) library(AMR) @@ -162,14 +281,15 @@ ggplot(data.frame(mic = some_mic_values, ``` - + #### Calculating resistance per group -For a manual approach, you can use the `resistance` or `susceptibility()` function: +For a manual approach, you can use the `resistance` or +`susceptibility()` function: -```r +``` r example_isolates %>% # group by ward: group_by(ward) %>% @@ -178,17 +298,19 @@ example_isolates %>% summarise(across(c(GEN, TOB), list(total_R = resistance, conf_int = function(x) sir_confidence_interval(x, collapse = "-")))) +#> # A tibble: 3 × 5 +#> ward GEN_total_R GEN_conf_int TOB_total_R TOB_conf_int +#> +#> 1 Clinical 0.2289362 0.205-0.254 0.3147503 0.284-0.347 +#> 2 ICU 0.2902655 0.253-0.33 0.4004739 0.353-0.449 +#> 3 Outpatient 0.2 0.131-0.285 0.3676471 0.254-0.493 ``` -|ward | GEN_total_R | GEN_conf_int | TOB_total_R | TOB_conf_int | -|:----------|:-----------:|:------------:|:-----------:|:------------:| -|Clinical | 0.2289362 | 0.205-0.254 | 0.3147503 | 0.284-0.347 | -|ICU | 0.2902655 | 0.253-0.33 | 0.4004739 | 0.353-0.449 | -|Outpatient | 0.2000000 | 0.131-0.285 | 0.3676471 | 0.254-0.493 | +Or use [antimicrobial +selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html) +to select a series of antibiotic columns: -Or use [antimicrobial selectors](https://amr-for-r.org/reference/antimicrobial_selectors.html) to select a series of antibiotic columns: - -```r +``` r library(AMR) library(dplyr) @@ -198,57 +320,86 @@ out <- example_isolates %>% # calculate AMR using resistance(), over all aminoglycosides and polymyxins: summarise(across(c(aminoglycosides(), polymyxins()), resistance)) +#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB' (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin) +#> ℹ For polymyxins() using column 'COL' (colistin) +#> Warning: There was 1 warning in `summarise()`. +#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`. +#> ℹ In group 3: `ward = "Outpatient"`. +#> Caused by warning: +#> ! Introducing NA: only 23 results available for KAN in group: ward = "Outpatient" (minimum = 30). out +#> # A tibble: 3 × 6 +#> ward GEN TOB AMK KAN COL +#> +#> 1 Clinical 0.2289362 0.3147503 0.6258993 1 0.7802956 +#> 2 ICU 0.2902655 0.4004739 0.6624473 1 0.8574144 +#> 3 Outpatient 0.2 0.3676471 0.6052632 NA 0.8888889 ``` -| 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 | | 0.889 | - -```r +``` r # transform the antibiotic columns to names: out %>% set_ab_names() +#> # A tibble: 3 × 6 +#> ward gentamicin tobramycin amikacin kanamycin colistin +#> +#> 1 Clinical 0.2289362 0.3147503 0.6258993 1 0.7802956 +#> 2 ICU 0.2902655 0.4004739 0.6624473 1 0.8574144 +#> 3 Outpatient 0.2 0.3676471 0.6052632 NA 0.8888889 ``` -| 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 | | 0.889 | - -```r +``` r # transform the antibiotic column to ATC codes: out %>% set_ab_names(property = "atc") +#> # A tibble: 3 × 6 +#> ward J01GB03 J01GB01 J01GB06 J01GB04 J01XB01 +#> +#> 1 Clinical 0.2289362 0.3147503 0.6258993 1 0.7802956 +#> 2 ICU 0.2902655 0.4004739 0.6624473 1 0.8574144 +#> 3 Outpatient 0.2 0.3676471 0.6052632 NA 0.8888889 ``` -| 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 | | 0.889 | - ### What else can you do with this package? -This package was intended as a comprehensive toolbox for integrated AMR data analysis. This package can be used for: +This package was intended as a comprehensive toolbox for integrated AMR +data analysis. This package can be used for: - * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](./reference/mo_property.html)) - * Interpreting raw MIC and disk diffusion values, based on any CLSI or EUCAST guideline ([manual](./reference/as.sir.html)) - * Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records ([manual](./reference/ab_from_text.html)) - * Determining first isolates to be used for AMR data analysis ([manual](./reference/first_isolate.html)) - * Calculating antimicrobial resistance ([tutorial](./articles/AMR.html)) - * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](./articles/MDR.html)) - * Calculating (empirical) susceptibility of both mono therapy and combination therapies ([tutorial](./articles/AMR.html)) - * Apply AMR function in predictive modelling ([tutorial](./articles/AMR_with_tidymodels.html)) - * Getting properties for any microorganism (like Gram stain, species, genus or family) ([manual](./reference/mo_property.html)) - * Getting properties for any antimicrobial (like name, code of EARS-Net/ATC/LOINC/PubChem, defined daily dose or trade name) ([manual](./reference/ab_property.html)) - * Plotting antimicrobial resistance ([tutorial](./articles/AMR.html)) - * Applying EUCAST expert rules ([manual](./reference/eucast_rules.html)) - * Getting SNOMED codes of a microorganism, or getting properties of a microorganism based on a SNOMED code ([manual](./reference/mo_property.html)) - * Getting LOINC codes of an antibiotic, or getting properties of an antibiotic based on a LOINC code ([manual](./reference/ab_property.html)) - * Machine reading the EUCAST and CLSI guidelines from 2011-2021 to translate MIC values and disk diffusion diameters to SIR ([link](./articles/datasets.html)) - * Principal component analysis for AMR ([tutorial](./articles/PCA.html)) +- Reference for the taxonomy of microorganisms, since the package + contains all microbial (sub)species from the List of Prokaryotic names + with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the + Global Biodiversity Information Facility + ([GBIF](https://www.gbif.org)) + ([manual](./reference/mo_property.html)) +- Interpreting raw MIC and disk diffusion values, based on any CLSI or + EUCAST guideline ([manual](./reference/as.sir.html)) +- Retrieving antimicrobial drug names, doses and forms of administration + from clinical health care records + ([manual](./reference/ab_from_text.html)) +- Determining first isolates to be used for AMR data analysis + ([manual](./reference/first_isolate.html)) +- Calculating antimicrobial resistance ([tutorial](./articles/AMR.html)) +- Determining multi-drug resistance (MDR) / multi-drug resistant + organisms (MDRO) ([tutorial](./articles/MDR.html)) +- Calculating (empirical) susceptibility of both mono therapy and + combination therapies ([tutorial](./articles/AMR.html)) +- Apply AMR function in predictive modelling + ([tutorial](./articles/AMR_with_tidymodels.html)) +- Getting properties for any microorganism (like Gram stain, species, + genus or family) ([manual](./reference/mo_property.html)) +- Getting properties for any antimicrobial (like name, code of + EARS-Net/ATC/LOINC/PubChem, defined daily dose or trade name) + ([manual](./reference/ab_property.html)) +- Plotting antimicrobial resistance ([tutorial](./articles/AMR.html)) +- Applying EUCAST expert rules ([manual](./reference/eucast_rules.html)) +- Getting SNOMED codes of a microorganism, or getting properties of a + microorganism based on a SNOMED code + ([manual](./reference/mo_property.html)) +- Getting LOINC codes of an antibiotic, or getting properties of an + antibiotic based on a LOINC code + ([manual](./reference/ab_property.html)) +- Machine reading the EUCAST and CLSI guidelines from 2011-2021 to + translate MIC values and disk diffusion diameters to SIR + ([link](./articles/datasets.html)) +- Principal component analysis for AMR ([tutorial](./articles/PCA.html)) ### Get this package @@ -257,15 +408,21 @@ This package was intended as a comprehensive toolbox for integrated AMR data ana [![CRAN](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.r-project.org/package=AMR) [![CRANlogs](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.r-project.org/package=AMR) -This package is available [here on the official R network (CRAN)](https://cran.r-project.org/package=AMR). Install this package in R from CRAN by using the command: +This package is available [here on the official R network +(CRAN)](https://cran.r-project.org/package=AMR). Install this package in +R from CRAN by using the command: -```r +``` r install.packages("AMR") ``` -It will be downloaded and installed automatically. For RStudio, click on the menu *Tools* > *Install Packages...* and then type in "AMR" and press Install. +It will be downloaded and installed automatically. For RStudio, click on +the menu *Tools* \> *Install Packages…* and then type in “AMR” and press +Install. -**Note:** Not all functions on this website may be available in this latest release. To use all functions and data sets mentioned on this website, install the latest beta version. +**Note:** Not all functions on this website may be available in this +latest release. To use all functions and data sets mentioned on this +website, install the latest beta version. #### Latest beta version @@ -274,11 +431,12 @@ It will be downloaded and installed automatically. For RStudio, click on the men [![CodeFactor](https://www.codefactor.io/repository/github/msberends/amr/badge)](https://www.codefactor.io/repository/github/msberends/amr) [![Codecov](https://codecov.io/gh/msberends/AMR/branch/main/graph/badge.svg)](https://codecov.io/gh/msberends/AMR?branch=main) -Please read our [Developer Guideline here](https://github.com/msberends/AMR/wiki/Developer-Guideline). +Please read our [Developer Guideline +here](https://github.com/msberends/AMR/wiki/Developer-Guideline). To install the latest and unpublished beta version: -```r +``` r install.packages("AMR", repos = "beta.amr-for-r.org") # if this does not work, try to install directly from GitHub using the 'remotes' package: @@ -287,23 +445,30 @@ remotes::install_github("msberends/AMR") ### Get started -To find out how to conduct AMR data analysis, please [continue reading here to get started](./articles/AMR.html) or click a link in the ['How to' menu](./articles/). +To find out how to conduct AMR data analysis, please [continue reading +here to get started](./articles/AMR.html) or click a link in the [‘How +to’ menu](./articles/). ### Partners -The development of this package is part of, related to, or made possible by the following non-profit organisations and initiatives: +The initial development of this package was part of, related to, or made +possible by the following non-profit organisations and initiatives:
- - - - - + + + + + + +
### Copyright -This R package is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](./LICENSE-text.html). In a nutshell, this means that this package: +This R package is free, open-source software and licensed under the [GNU +General Public License v2.0 (GPL-2)](./LICENSE-text.html). In a +nutshell, this means that this package: - May be used for commercial purposes @@ -313,13 +478,16 @@ This R package is free, open-source software and licensed under the [GNU General - May be modified, although: - - Modifications **must** be released under the same license when distributing the package + - Modifications **must** be released under the same license when + distributing the package - Changes made to the code **must** be documented - May be distributed, although: - - Source code **must** be made available when the package is distributed - - A copy of the license and copyright notice **must** be included with the package. + - Source code **must** be made available when the package is + distributed + - A copy of the license and copyright notice **must** be included with + the package. - Comes with a LIMITATION of liability diff --git a/man/eucast_rules.Rd b/man/eucast_rules.Rd index 5b3bb2791..f65f5577b 100644 --- a/man/eucast_rules.Rd +++ b/man/eucast_rules.Rd @@ -51,7 +51,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15) \item{custom_rules}{Custom rules to apply, created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}.} -\item{overwrite}{A \link{logical} indicating whether to overwrite non-\code{NA} values (default: \code{FALSE}). When \code{FALSE}, only \code{NA} values are modified. To ensure compliance with EUCAST guidelines, \strong{this should remain} \code{FALSE}, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant.".} +\item{overwrite}{A \link{logical} indicating whether to overwrite non-\code{NA} values (default: \code{FALSE}). When \code{FALSE}, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, \strong{this should remain} \code{FALSE}, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".} \item{...}{Column name of an antimicrobial, see section \emph{Antimicrobials} below.}