mirror of
https://github.com/msberends/AMR.git
synced 2026-09-21 13:10:52 +02:00
Compare commits
77
Commits
v1.5.0
..
0ce9fb4da2
+1
-2
@@ -1,3 +1,4 @@
|
||||
^.*\.RData$
|
||||
^.*\.Rproj$
|
||||
^\.Renviron$
|
||||
^\.Rprofile$
|
||||
@@ -22,10 +23,8 @@
|
||||
^data-raw$
|
||||
^\.lintr$
|
||||
^tests/testthat/_snaps$
|
||||
^vignettes/AMR.Rmd$
|
||||
^vignettes/benchmarks.Rmd$
|
||||
^vignettes/EUCAST.Rmd$
|
||||
^vignettes/MDR.Rmd$
|
||||
^vignettes/PCA.Rmd$
|
||||
^vignettes/resistance_predict.Rmd$
|
||||
^vignettes/SPSS.Rmd$
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
@@ -50,18 +50,26 @@ jobs:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
config:
|
||||
- {os: macOS-latest, r: 'devel', allowfail: false}
|
||||
- {os: macOS-latest, r: 'devel', allowfail: true}
|
||||
- {os: macOS-latest, r: 'release', allowfail: false}
|
||||
- {os: macOS-latest, r: 'oldrel', allowfail: false}
|
||||
|
||||
- {os: windows-latest, r: 'devel', allowfail: false}
|
||||
- {os: windows-latest, r: 'release', allowfail: false}
|
||||
- {os: windows-latest, r: 'oldrel', allowfail: false}
|
||||
- {os: ubuntu-20.04, r: 'devel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: 'release', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: 'oldrel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
|
||||
- {os: ubuntu-20.04, r: 'devel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: 'release', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: 'oldrel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '4.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.6', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.5', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.4', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.3', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.0', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
- {os: ubuntu-20.04, r: '3.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
|
||||
|
||||
- {os: ubuntu-16.04, r: 'devel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
- {os: ubuntu-16.04, r: 'release', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
- {os: ubuntu-16.04, r: 'oldrel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
@@ -73,7 +81,7 @@ jobs:
|
||||
- {os: ubuntu-16.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
- {os: ubuntu-16.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
- {os: ubuntu-16.04, r: '3.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
|
||||
|
||||
|
||||
env:
|
||||
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
|
||||
RSPM: ${{ matrix.config.rspm }}
|
||||
@@ -85,52 +93,34 @@ jobs:
|
||||
with:
|
||||
r-version: ${{ matrix.config.r }}
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@master
|
||||
|
||||
- name: Query dependencies
|
||||
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
|
||||
run: |
|
||||
install.packages('remotes')
|
||||
saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Cache R packages
|
||||
if: runner.os != 'Windows' && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
|
||||
uses: actions/cache@v1
|
||||
with:
|
||||
path: ${{ env.R_LIBS_USER }}
|
||||
key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('.github/depends.Rds') }}
|
||||
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-
|
||||
# - uses: r-lib/actions/setup-pandoc@master
|
||||
|
||||
# - name: Query dependencies
|
||||
# if: matrix.config.r != '3.0'
|
||||
# run: |
|
||||
# saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
|
||||
# shell: Rscript {0}
|
||||
|
||||
- name: Install Linux dependencies
|
||||
if: runner.os == 'Linux' && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
|
||||
env:
|
||||
RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
|
||||
run: |
|
||||
Rscript -e "remotes::install_github('r-hub/sysreqs')"
|
||||
sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
|
||||
sudo -s eval "$sysreqs"
|
||||
|
||||
- name: Install Linux dependencies on old R versions
|
||||
if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
|
||||
env:
|
||||
RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
|
||||
if: runner.os == 'Linux'
|
||||
# update the below with sysreqs::sysreqs("DESCRIPTION") and check the "DEB" entries (for Ubuntu).
|
||||
# we don't want to depend on the sysreqs pkg here, as it requires a quite new R version
|
||||
run: |
|
||||
sudo apt install -y libssl-dev pandoc pandoc-citeproc libxml2-dev libicu-dev libcurl4-openssl-dev
|
||||
|
||||
- name: Install macOS dependencies
|
||||
if: matrix.config.os == 'macOS-latest' && matrix.config.r == 'devel'
|
||||
- name: Update package dependencies
|
||||
run: |
|
||||
brew install mariadb-connector-c
|
||||
|
||||
- name: Install package dependencies
|
||||
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
|
||||
run: |
|
||||
remotes::install_deps(dependencies = TRUE)
|
||||
remotes::install_cran("rcmdcheck")
|
||||
install.packages("data-raw/AMR_latest.tar.gz")
|
||||
source("data-raw/_install_deps.R")
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Cache R packages
|
||||
# if: runner.os != 'Windows'
|
||||
uses: actions/cache@v1
|
||||
with:
|
||||
path: ${{ env.R_LIBS_USER }}
|
||||
key: ${{ matrix.config.os }}-r-${{ matrix.config.r }} # -${{ hashFiles('.github/depends.Rds') }}
|
||||
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}
|
||||
|
||||
- name: Session info
|
||||
run: |
|
||||
@@ -139,26 +129,42 @@ jobs:
|
||||
as.data.frame(utils::installed.packages())[, "Version", drop = FALSE]
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Run R CMD check
|
||||
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
|
||||
env:
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Run R CMD check on older R versions
|
||||
if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
|
||||
- name: Run R CMD check on Windows
|
||||
if: runner.os == 'Windows'
|
||||
env:
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
_R_CHECK_FORCE_SUGGESTS_: false
|
||||
_R_CHECK_DEPENDS_ONLY_: true
|
||||
_R_CHECK_LENGTH_1_CONDITION_: verbose
|
||||
_R_CHECK_LENGTH_1_LOGIC2_: verbose
|
||||
R_LIBS_USER: ${{ env.R_LIBS_USER }}
|
||||
R_TINYTEST: true
|
||||
run: |
|
||||
R CMD check data-raw/AMR_*.tar.gz --no-manual --no-build-vignettes
|
||||
tar -xf data-raw/AMR_latest.tar.gz
|
||||
rm -rf AMR/vignettes
|
||||
R CMD check AMR
|
||||
shell: bash
|
||||
|
||||
- name: Run R CMD check on Linux and macOS
|
||||
if: runner.os != 'Windows'
|
||||
env:
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
_R_CHECK_FORCE_SUGGESTS_: false
|
||||
_R_CHECK_DEPENDS_ONLY_: true
|
||||
_R_CHECK_LENGTH_1_CONDITION_: verbose
|
||||
_R_CHECK_LENGTH_1_LOGIC2_: verbose
|
||||
R_LIBS_USER: ${{ env.R_LIBS_USER }}
|
||||
R_TINYTEST: true
|
||||
run: |
|
||||
tar -xf data-raw/AMR_latest.tar.gz
|
||||
rm -rf AMR/vignettes
|
||||
R CMD check AMR --no-manual --no-vignettes
|
||||
shell: bash
|
||||
|
||||
- name: Show testthat output
|
||||
if: always()
|
||||
run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
|
||||
run: |
|
||||
find . -name 'testthat.Rout*' -exec cat '{}' \; || true
|
||||
shell: bash
|
||||
|
||||
- name: Upload check results
|
||||
@@ -166,4 +172,4 @@ jobs:
|
||||
uses: actions/upload-artifact@master
|
||||
with:
|
||||
name: ${{ matrix.config.os }}-r${{ matrix.config.r }}-results
|
||||
path: check
|
||||
path: AMR.Rcheck
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
@@ -31,10 +31,10 @@ on:
|
||||
branches:
|
||||
- master
|
||||
|
||||
name: code-tested
|
||||
name: code-coverage
|
||||
|
||||
jobs:
|
||||
code-tested:
|
||||
code-coverage:
|
||||
runs-on: macOS-latest
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
|
||||
+10
-10
@@ -1,7 +1,7 @@
|
||||
Package: AMR
|
||||
Version: 1.5.0
|
||||
Date: 2021-01-05
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Version: 1.6.0.9032
|
||||
Date: 2021-05-15
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Authors@R: c(
|
||||
person(role = c("aut", "cre"),
|
||||
family = "Berends", given = c("Matthijs", "S."), email = "m.s.berends@umcg.nl", comment = c(ORCID = "0000-0001-7620-1800")),
|
||||
@@ -35,11 +35,10 @@ Authors@R: c(
|
||||
family = "Souverein", given = "Dennis", email = "d.souvereing@streeklabhaarlem.nl"),
|
||||
person(role = "ctb",
|
||||
family = "Underwood", given = "Anthony", email = "au3@sanger.ac.uk"))
|
||||
Description: Functions to simplify the analysis and prediction of Antimicrobial
|
||||
Resistance (AMR) and to work with microbial and antimicrobial properties by
|
||||
using evidence-based methods, like those defined by Leclercq et al. (2013)
|
||||
<doi:10.1111/j.1469-0691.2011.03703.x> and the Clinical and Laboratory
|
||||
Standards Institute (2014) <isbn: 1-56238-899-1>.
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
data analysis and to work with microbial and antimicrobial properties by
|
||||
using evidence-based methods and reliable reference data such as LPSN
|
||||
<doi:10.1099/ijsem.0.004332>.
|
||||
Depends:
|
||||
R (>= 3.0.0)
|
||||
Suggests:
|
||||
@@ -47,6 +46,7 @@ Suggests:
|
||||
curl,
|
||||
dplyr,
|
||||
ggplot2,
|
||||
ggtext,
|
||||
knitr,
|
||||
microbenchmark,
|
||||
pillar,
|
||||
@@ -55,9 +55,9 @@ Suggests:
|
||||
rstudioapi,
|
||||
rvest,
|
||||
skimr,
|
||||
testthat,
|
||||
tidyr,
|
||||
xml2
|
||||
tinytest,
|
||||
xml2,
|
||||
VignetteBuilder: knitr,rmarkdown
|
||||
URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
|
||||
@@ -1,5 +1,19 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
S3method("!",mic)
|
||||
S3method("!=",mic)
|
||||
S3method("%%",mic)
|
||||
S3method("%/%",mic)
|
||||
S3method("&",mic)
|
||||
S3method("*",mic)
|
||||
S3method("+",mic)
|
||||
S3method("-",mic)
|
||||
S3method("/",mic)
|
||||
S3method("<",mic)
|
||||
S3method("<=",mic)
|
||||
S3method("==",mic)
|
||||
S3method(">",mic)
|
||||
S3method(">=",mic)
|
||||
S3method("[",ab)
|
||||
S3method("[",disk)
|
||||
S3method("[",mic)
|
||||
@@ -18,28 +32,68 @@ S3method("[[<-",disk)
|
||||
S3method("[[<-",mic)
|
||||
S3method("[[<-",mo)
|
||||
S3method("[[<-",rsi)
|
||||
S3method("^",mic)
|
||||
S3method("|",mic)
|
||||
S3method(abs,mic)
|
||||
S3method(acos,mic)
|
||||
S3method(acosh,mic)
|
||||
S3method(all,mic)
|
||||
S3method(any,mic)
|
||||
S3method(as.data.frame,ab)
|
||||
S3method(as.data.frame,mo)
|
||||
S3method(as.double,mic)
|
||||
S3method(as.integer,mic)
|
||||
S3method(as.list,custom_eucast_rules)
|
||||
S3method(as.list,custom_mdro_guideline)
|
||||
S3method(as.matrix,mic)
|
||||
S3method(as.numeric,mic)
|
||||
S3method(as.rsi,data.frame)
|
||||
S3method(as.rsi,default)
|
||||
S3method(as.rsi,disk)
|
||||
S3method(as.rsi,mic)
|
||||
S3method(asin,mic)
|
||||
S3method(asinh,mic)
|
||||
S3method(atan,mic)
|
||||
S3method(atanh,mic)
|
||||
S3method(barplot,disk)
|
||||
S3method(barplot,mic)
|
||||
S3method(barplot,rsi)
|
||||
S3method(c,ab)
|
||||
S3method(c,custom_eucast_rules)
|
||||
S3method(c,custom_mdro_guideline)
|
||||
S3method(c,disk)
|
||||
S3method(c,mic)
|
||||
S3method(c,mo)
|
||||
S3method(c,rsi)
|
||||
S3method(ceiling,mic)
|
||||
S3method(cos,mic)
|
||||
S3method(cosh,mic)
|
||||
S3method(cospi,mic)
|
||||
S3method(cummax,mic)
|
||||
S3method(cummin,mic)
|
||||
S3method(cumprod,mic)
|
||||
S3method(cumsum,mic)
|
||||
S3method(digamma,mic)
|
||||
S3method(droplevels,mic)
|
||||
S3method(droplevels,rsi)
|
||||
S3method(exp,mic)
|
||||
S3method(expm1,mic)
|
||||
S3method(floor,mic)
|
||||
S3method(format,bug_drug_combinations)
|
||||
S3method(gamma,mic)
|
||||
S3method(hist,mic)
|
||||
S3method(kurtosis,data.frame)
|
||||
S3method(kurtosis,default)
|
||||
S3method(kurtosis,matrix)
|
||||
S3method(lgamma,mic)
|
||||
S3method(log,mic)
|
||||
S3method(log10,mic)
|
||||
S3method(log1p,mic)
|
||||
S3method(log2,mic)
|
||||
S3method(max,mic)
|
||||
S3method(mean,mic)
|
||||
S3method(median,mic)
|
||||
S3method(min,mic)
|
||||
S3method(plot,disk)
|
||||
S3method(plot,mic)
|
||||
S3method(plot,resistance_predict)
|
||||
@@ -47,18 +101,40 @@ S3method(plot,rsi)
|
||||
S3method(print,ab)
|
||||
S3method(print,bug_drug_combinations)
|
||||
S3method(print,catalogue_of_life_version)
|
||||
S3method(print,custom_eucast_rules)
|
||||
S3method(print,custom_mdro_guideline)
|
||||
S3method(print,disk)
|
||||
S3method(print,mic)
|
||||
S3method(print,mo)
|
||||
S3method(print,mo_renamed)
|
||||
S3method(print,mo_uncertainties)
|
||||
S3method(print,pca)
|
||||
S3method(print,rsi)
|
||||
S3method(prod,mic)
|
||||
S3method(quantile,mic)
|
||||
S3method(range,mic)
|
||||
S3method(rep,mo)
|
||||
S3method(round,mic)
|
||||
S3method(sign,mic)
|
||||
S3method(signif,mic)
|
||||
S3method(sin,mic)
|
||||
S3method(sinh,mic)
|
||||
S3method(sinpi,mic)
|
||||
S3method(skewness,data.frame)
|
||||
S3method(skewness,default)
|
||||
S3method(skewness,matrix)
|
||||
S3method(sort,mic)
|
||||
S3method(sqrt,mic)
|
||||
S3method(sum,mic)
|
||||
S3method(summary,mic)
|
||||
S3method(summary,mo)
|
||||
S3method(summary,pca)
|
||||
S3method(summary,rsi)
|
||||
S3method(tan,mic)
|
||||
S3method(tanh,mic)
|
||||
S3method(tanpi,mic)
|
||||
S3method(trigamma,mic)
|
||||
S3method(trunc,mic)
|
||||
S3method(unique,ab)
|
||||
S3method(unique,disk)
|
||||
S3method(unique,mic)
|
||||
@@ -66,6 +142,8 @@ S3method(unique,mo)
|
||||
S3method(unique,rsi)
|
||||
export("%like%")
|
||||
export("%like_case%")
|
||||
export("%unlike%")
|
||||
export("%unlike_case%")
|
||||
export(ab_atc)
|
||||
export(ab_atc_group1)
|
||||
export(ab_atc_group2)
|
||||
@@ -83,8 +161,10 @@ export(ab_tradenames)
|
||||
export(ab_url)
|
||||
export(age)
|
||||
export(age_groups)
|
||||
export(all_antimicrobials)
|
||||
export(aminoglycosides)
|
||||
export(anti_join_microorganisms)
|
||||
export(antimicrobials_equal)
|
||||
export(as.ab)
|
||||
export(as.disk)
|
||||
export(as.mic)
|
||||
@@ -113,6 +193,9 @@ export(count_all)
|
||||
export(count_df)
|
||||
export(count_resistant)
|
||||
export(count_susceptible)
|
||||
export(custom_eucast_rules)
|
||||
export(custom_mdro_guideline)
|
||||
export(eucast_dosage)
|
||||
export(eucast_exceptional_phenotypes)
|
||||
export(eucast_rules)
|
||||
export(facet_rsi)
|
||||
@@ -130,6 +213,7 @@ export(filter_first_weighted_isolate)
|
||||
export(filter_fluoroquinolones)
|
||||
export(filter_glycopeptides)
|
||||
export(filter_macrolides)
|
||||
export(filter_oxazolidinones)
|
||||
export(filter_penicillins)
|
||||
export(filter_tetracyclines)
|
||||
export(first_isolate)
|
||||
@@ -153,8 +237,11 @@ export(is.mo)
|
||||
export(is.rsi)
|
||||
export(is.rsi.eligible)
|
||||
export(is_new_episode)
|
||||
export(italicise_taxonomy)
|
||||
export(italicize_taxonomy)
|
||||
export(key_antibiotics)
|
||||
export(key_antibiotics_equal)
|
||||
export(key_antimicrobials)
|
||||
export(kurtosis)
|
||||
export(labels_rsi_count)
|
||||
export(left_join_microorganisms)
|
||||
@@ -175,6 +262,7 @@ export(mo_info)
|
||||
export(mo_is_gram_negative)
|
||||
export(mo_is_gram_positive)
|
||||
export(mo_is_intrinsic_resistant)
|
||||
export(mo_is_yeast)
|
||||
export(mo_kingdom)
|
||||
export(mo_matching_score)
|
||||
export(mo_name)
|
||||
@@ -196,6 +284,7 @@ export(mo_url)
|
||||
export(mo_year)
|
||||
export(mrgn)
|
||||
export(n_rsi)
|
||||
export(oxazolidinones)
|
||||
export(p_symbol)
|
||||
export(pca)
|
||||
export(penicillins)
|
||||
@@ -224,15 +313,19 @@ export(theme_rsi)
|
||||
importFrom(graphics,arrows)
|
||||
importFrom(graphics,axis)
|
||||
importFrom(graphics,barplot)
|
||||
importFrom(graphics,par)
|
||||
importFrom(graphics,hist)
|
||||
importFrom(graphics,legend)
|
||||
importFrom(graphics,mtext)
|
||||
importFrom(graphics,plot)
|
||||
importFrom(graphics,points)
|
||||
importFrom(graphics,text)
|
||||
importFrom(stats,complete.cases)
|
||||
importFrom(stats,glm)
|
||||
importFrom(stats,lm)
|
||||
importFrom(stats,median)
|
||||
importFrom(stats,pchisq)
|
||||
importFrom(stats,prcomp)
|
||||
importFrom(stats,predict)
|
||||
importFrom(stats,qchisq)
|
||||
importFrom(stats,quantile)
|
||||
importFrom(stats,var)
|
||||
|
||||
@@ -1,6 +1,146 @@
|
||||
# AMR 1.5.0
|
||||
# `AMR` 1.6.0.9032
|
||||
## <small>Last updated: 15 May 2021</small>
|
||||
|
||||
*Note: the rules of 'EUCAST Clinical Breakpoints v11.0 (2021)' will be added in the next release, to be expected in February/March 2021.*
|
||||
### New
|
||||
* Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()`
|
||||
* Function `italicise_taxonomy()` to make taxonomic names within a string italic, with support for markdown and ANSI
|
||||
* Support for all four methods to determine first isolates as summarised by Hindler *et al.* (doi: [10.1086/511864](https://doi.org/10.1086/511864)): isolate-based, patient-based, episode-based and phenotype-based. The last method is now the default.
|
||||
* The `first_isolate()` function gained the argument `method` that has to be "phenotype-based", "episode-based", "patient-based", or "isolate-based". The old behaviour is equal to "episode-based". The new default is "phenotype-based" if antimicrobial test results are available, and "episode-based" otherwise. This new default will yield slightly more isolates for selection (which is a good thing).
|
||||
* Since fungal isolates can also be selected, the functions `key_antibiotics()` and `key_antibiotics_equal()` are now deprecated in favour of the `key_antimicrobials()` and `antimicrobial_equal()` functions. Also, the new `all_antimicrobials()` function works like the old `key_antibiotics()` function, but includes any column with antimicrobial test results. Using `key_antimicrobials()` still only selects six preferred antibiotics for Gram-negatives, six for Gram-positives, and six universal antibiotics. It has a new `antifungal` argument to set antifungal agents (antimycotics).
|
||||
* Using `type == "points"` in the `first_isolate()` function for phenotype-based selection will now consider all antimicrobial drugs in the data set, using the new `all_antimicrobials()`
|
||||
* The `first_isolate()` function can now take a vector of values for `col_keyantibiotics` and can have an episode length of `Inf`
|
||||
* Since the phenotype-based method is the new default, `filter_first_isolate()` renders the `filter_first_weighted_isolate()` function redundant. For this reason, `filter_first_weighted_isolate()` is now deprecated.
|
||||
* The documentation of the `first_isolate()` and `key_antimicrobials()` functions has been completely rewritten.
|
||||
* Added `ggplot()` method for `resistance_predict()`
|
||||
|
||||
### Changed
|
||||
* Custom MDRO guidelines (`mdro()`, `custom_mdro_guideline()`):
|
||||
* Custom MDRO guidelines can now be combined with other custom MDRO guidelines using `c()`
|
||||
* Fix for applying the rules; in previous versions, rows were interpreted according to the last matched rule. Now, rows are interpreted according to the first matched rule
|
||||
* Fix for `age_groups()` for persons aged zero
|
||||
* The `example_isolates` data set now contains some (fictitious) zero-year old patients
|
||||
* Fix for minor translation errors
|
||||
* Printing of microbial codes in a `data.frame` or `tibble` now gives a warning if the data contains old microbial codes (from a previous AMR package version)
|
||||
* Extended the `like()` functions:
|
||||
* Now checks if `pattern` is a *valid* regular expression
|
||||
* Added `%unlike%` and `%unlike_case%` (as negations of the existing `%like%` and `%like_case%`). This greatly improves readability:
|
||||
```r
|
||||
if (!grepl("EUCAST", guideline)) ...
|
||||
# same:
|
||||
if (guideline %unlike% "EUCAST") ...
|
||||
```
|
||||
* Altered the RStudio addin, so it now iterates over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%` if you keep pressing your keyboard shortcut
|
||||
* Fixed an installation error on R-3.0
|
||||
* Added `info` argument to `as.mo()` to turn on/off the progress bar
|
||||
* Fixed a bug where `col_mo` in some functions (esp. `eucast_rules()` and `mdro()`) could not be a column name of the `microorganisms` data set as it would throw an error
|
||||
* Fix for transforming numeric values to RSI (`as.rsi()`) when the `vctrs` package is loaded (i.e., when using tidyverse)
|
||||
* Colour fix for using `barplot()` on an RSI class
|
||||
* Added 25 common system codes for bacteria to the `microorganisms.codes` data set
|
||||
* Added 16 common system codes for antimicrobial agents to the `antibiotics` data set
|
||||
* Fix for using `skimr::skim()` on classes `mo`, `mic` and `disk` when using the just released `dplyr` v1.0.6
|
||||
* Updated `skimr::skim()` usage for MIC values to also include 25th and 75th percentiles
|
||||
* Fix for plotting missing MIC/disk diffusion values
|
||||
* Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables
|
||||
|
||||
### Other
|
||||
* All unit tests are now processed by the `tinytest` package, instead of the `testthat` package. The `testthat` package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the `tinytest` package is very lightweight and dependency-free.
|
||||
|
||||
|
||||
# `AMR` 1.6.0
|
||||
|
||||
### New
|
||||
* Support for EUCAST Clinical Breakpoints v11.0 (2021), effective in the `eucast_rules()` function and in `as.rsi()` to interpret MIC and disk diffusion values. This is now the default guideline in this package.
|
||||
* Added function `eucast_dosage()` to get a `data.frame` with advised dosages of a certain bug-drug combination, which is based on the new `dosage` data set
|
||||
* Added data set `dosage` to fuel the new `eucast_dosage()` function and to make this data available in a structured way
|
||||
* Existing data set `example_isolates` now reflects the latest EUCAST rules
|
||||
* Added argument `only_rsi_columns` for some functions, which defaults to `FALSE`, to indicate if the functions must only be applied to columns that are of class `<rsi>` (i.e., transformed with `as.rsi()`). This increases speed since automatic determination of antibiotic columns is not needed anymore. Affected functions are:
|
||||
* All antibiotic selector functions (`ab_class()` and its wrappers, such as `aminoglycosides()`, `carbapenems()`, `penicillins()`)
|
||||
* All antibiotic filter functions (`filter_ab_class()` and its wrappers, such as `filter_aminoglycosides()`, `filter_carbapenems()`, `filter_penicillins()`)
|
||||
* `eucast_rules()`
|
||||
* `mdro()` (including wrappers such as `brmo()`, `mrgn()` and `eucast_exceptional_phenotypes()`)
|
||||
* `guess_ab_col()`
|
||||
* 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())
|
||||
#> Selecting oxazolidinones: column 'LNZ' (linezolid)
|
||||
|
||||
x <- example_isolates %>% filter_oxazolidinones()
|
||||
#> Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"
|
||||
```
|
||||
* Support for custom MDRO guidelines, using the new `custom_mdro_guideline()` function, please see `mdro()` for additional info
|
||||
* `ggplot()` generics for classes `<mic>` and `<disk>`
|
||||
* Function `mo_is_yeast()`, which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:
|
||||
```r
|
||||
mo_kingdom(c("Aspergillus", "Candida"))
|
||||
#> [1] "Fungi" "Fungi"
|
||||
|
||||
mo_is_yeast(c("Aspergillus", "Candida"))
|
||||
#> [1] FALSE TRUE
|
||||
|
||||
# usage for filtering data:
|
||||
example_isolates[which(mo_is_yeast()), ] # base R
|
||||
example_isolates %>% filter(mo_is_yeast()) # dplyr
|
||||
```
|
||||
The `mo_type()` function has also been updated to reflect this change:
|
||||
```r
|
||||
mo_type(c("Aspergillus", "Candida"))
|
||||
# [1] "Fungi" "Yeasts"
|
||||
mo_type(c("Aspergillus", "Candida"), language = "es") # also supported: de, nl, fr, it, pt
|
||||
#> [1] "Hongos" "Levaduras"
|
||||
```
|
||||
* Added Pretomanid (PMD, J04AK08) to the `antibiotics` data set
|
||||
* MIC values (see `as.mic()`) can now be used in any mathematical processing, such as usage inside functions `min()`, `max()`, `range()`, and with binary operators (`+`, `-`, etc.). This allows for easy distribution analysis and fast filtering on MIC values:
|
||||
```r
|
||||
x <- random_mic(10)
|
||||
x
|
||||
#> Class <mic>
|
||||
#> [1] 128 0.5 2 0.125 64 0.25 >=256 8 16 4
|
||||
x[x > 4]
|
||||
#> Class <mic>
|
||||
#> [1] 128 64 >=256 8 16
|
||||
range(x)
|
||||
#> [1] 0.125 256.000
|
||||
range(log2(x))
|
||||
#> [1] -3 8
|
||||
```
|
||||
|
||||
### Changed
|
||||
* Updated the bacterial taxonomy to 3 March 2021 (using [LPSN](https://lpsn.dsmz.de))
|
||||
* Added 3,372 new species and 1,523 existing species became synomyms
|
||||
* The URL of a bacterial species (`mo_url()`) will now lead to https://lpsn.dsmz.de
|
||||
* Big update for plotting classes `rsi`, `<mic>`, and `<disk>`:
|
||||
* Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent
|
||||
* All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)
|
||||
* Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see `translate`)
|
||||
* Plotting is now possible with base R using `plot()` and with ggplot2 using `ggplot()` on any vector of MIC and disk diffusion values
|
||||
* Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the `microorganisms` data set
|
||||
* `is.rsi()` and `is.rsi.eligible()` now return a vector of `TRUE`/`FALSE` when the input is a data set, by iterating over all columns
|
||||
* Using functions without setting a data set (e.g., `mo_is_gram_negative()`, `mo_is_gram_positive()`, `mo_is_intrinsic_resistant()`, `first_isolate()`, `mdro()`) now work with `dplyr`s `group_by()` again
|
||||
* `first_isolate()` can be used with `group_by()` (also when using a dot `.` as input for the data) and now returns the names of the groups
|
||||
* Updated the data set `microorganisms.codes` (which contains popular LIS and WHONET codes for microorganisms) for some species of *Mycobacterium* that previously incorrectly returned *M. africanum*
|
||||
* WHONET code `"PNV"` will now correctly be interpreted as `PHN`, the antibiotic code for phenoxymethylpenicillin ('peni V')
|
||||
* Fix for verbose output of `mdro(..., verbose = TRUE)` for German guideline (3MGRN and 4MGRN) and Dutch guideline (BRMO, only *P. aeruginosa*)
|
||||
* `is.rsi.eligible()` now detects if the column name resembles an antibiotic name or code and now returns `TRUE` immediately if the input contains any of the values "R", "S" or "I". This drastically improves speed, also for a lot of other functions that rely on automatic determination of antibiotic columns.
|
||||
* Functions `get_episode()` and `is_new_episode()` now support less than a day as value for argument `episode_days` (e.g., to include one patient/test per hour)
|
||||
* Argument `ampc_cephalosporin_resistance` in `eucast_rules()` now also applies to value "I" (not only "S")
|
||||
* Functions `print()` and `summary()` on a Principal Components Analysis object (`pca()`) now print additional group info if the original data was grouped using `dplyr::group_by()`
|
||||
* Improved speed and reliability of `guess_ab_col()`. As this also internally improves the reliability of `first_isolate()` and `mdro()`, this might have a slight impact on the results of those functions.
|
||||
* Fix for `mo_name()` when used in other languages than English
|
||||
* The `like()` function (and its fast alias `%like%`) now always use Perl compatibility, improving speed for many functions in this package (e.g., `as.mo()` is now up to 4 times faster)
|
||||
* *Staphylococcus cornubiensis* is now correctly categorised as coagulase-positive
|
||||
* `random_disk()` and `random_mic()` now have an expanded range in their randomisation
|
||||
* Support for GISA (glycopeptide-intermediate *S. aureus*), so e.g. `mo_genus("GISA")` will return `"Staphylococcus"`
|
||||
* Added translations of German and Spanish for more than 200 antimicrobial drugs
|
||||
* Speed improvement for `as.ab()` when the input is an official name or ATC code
|
||||
* Added argument `include_untested_rsi` to the `first_isolate()` functions (defaults to `TRUE` to keep existing behaviour), to be able to exclude rows where all R/SI values (class `<rsi>`, see `as.rsi()`) are empty
|
||||
|
||||
### Other
|
||||
* Big documentation updates
|
||||
* Loading the package (i.e., `library(AMR)`) now is ~50 times faster than before, in costs of package size (which increased by ~3 MB)
|
||||
|
||||
|
||||
# `AMR` 1.5.0
|
||||
|
||||
### New
|
||||
* Functions `get_episode()` and `is_new_episode()` to determine (patient) episodes which are not necessarily based on microorganisms. The `get_episode()` function returns the index number of the episode per group, while the `is_new_episode()` function returns values `TRUE`/`FALSE` to indicate whether an item in a vector is the start of a new episode. They also support `dplyr`s grouping (i.e. using `group_by()`):
|
||||
@@ -77,7 +217,7 @@
|
||||
* Added CodeFactor as a continuous code review to this package: <https://www.codefactor.io/repository/github/msberends/amr/>
|
||||
* Added Dr. Rogier Schade as contributor
|
||||
|
||||
# AMR 1.4.0
|
||||
# `AMR` 1.4.0
|
||||
|
||||
### New
|
||||
* Support for 'EUCAST Expert Rules' / 'EUCAST Intrinsic Resistance and Unusual Phenotypes' version 3.2 of May 2020. With this addition to the previously implemented version 3.1 of 2016, the `eucast_rules()` function can now correct for more than 180 different antibiotics and the `mdro()` function can determine multidrug resistance based on more than 150 different antibiotics. All previously implemented versions of the EUCAST rules are now maintained and kept available in this package. The `eucast_rules()` function consequently gained the arguments `version_breakpoints` (at the moment defaults to v10.0, 2020) and `version_expertrules` (at the moment defaults to v3.2, 2020). The `example_isolates` data set now also reflects the change from v3.1 to v3.2. The `mdro()` function now accepts `guideline == "EUCAST3.1"` and `guideline == "EUCAST3.2"`.
|
||||
@@ -149,7 +289,7 @@
|
||||
* Removed unnecessary references to the `base` package
|
||||
* Added packages that could be useful for some functions to the `Suggests` field of the `DESCRIPTION` file
|
||||
|
||||
# AMR 1.3.0
|
||||
# `AMR` 1.3.0
|
||||
|
||||
### New
|
||||
* Function `ab_from_text()` to retrieve antimicrobial drug names, doses and forms of administration from clinical texts in e.g. health care records, which also corrects for misspelling since it uses `as.ab()` internally
|
||||
@@ -202,7 +342,7 @@
|
||||
### Other
|
||||
* Moved primary location of this project from GitLab to [GitHub](https://github.com/msberends/AMR), giving us native support for automated syntax checking without being dependent on external services such as AppVeyor and Travis CI.
|
||||
|
||||
# AMR 1.2.0
|
||||
# `AMR` 1.2.0
|
||||
|
||||
### Breaking
|
||||
* Removed code dependency on all other R packages, making this package fully independent of the development process of others. This is a major code change, but will probably not be noticeable by most users.
|
||||
@@ -240,7 +380,7 @@
|
||||
* Removed previously deprecated function `p.symbol()` - it was replaced with `p_symbol()`
|
||||
* Removed function `read.4d()`, that was only useful for reading data from an old test database.
|
||||
|
||||
# AMR 1.1.0
|
||||
# `AMR` 1.1.0
|
||||
|
||||
### New
|
||||
* Support for easy principal component analysis for AMR, using the new `pca()` function
|
||||
@@ -262,7 +402,7 @@
|
||||
* Support for the upcoming `dplyr` version 1.0.0
|
||||
* More robust assigning for classes `rsi` and `mic`
|
||||
|
||||
# AMR 1.0.1
|
||||
# `AMR` 1.0.1
|
||||
|
||||
### Changed
|
||||
* Fixed important floating point error for some MIC comparisons in EUCAST 2020 guideline
|
||||
@@ -278,7 +418,7 @@
|
||||
* Added `uti` (as abbreviation of urinary tract infections) as argument to `as.rsi()`, so interpretation of MIC values and disk zones can be made dependent on isolates specifically from UTIs
|
||||
* Info printing in functions `eucast_rules()`, `first_isolate()`, `mdro()` and `resistance_predict()` will now at default only print when R is in an interactive mode (i.e. not in RMarkdown)
|
||||
|
||||
# AMR 1.0.0
|
||||
# `AMR` 1.0.0
|
||||
|
||||
This software is now out of beta and considered stable. Nonetheless, this package will be developed continually.
|
||||
|
||||
@@ -314,7 +454,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
* Speed improvements, especially for the *G. species* format (G for genus), like *E. coli* and *K pneumoniae*
|
||||
* Support for more common codes used in laboratory information systems
|
||||
* Input values for `as.disk()` limited to a maximum of 50 millimeters
|
||||
* Added a lifecycle state to every function, following [the lifecycle circle of the `tidyverse`](https://www.tidyverse.org/lifecycle)
|
||||
* Added a lifecycle state to every function, following the lifecycle circle of the `tidyverse`
|
||||
* For in `as.ab()`: support for drugs starting with "co-" like co-amoxiclav, co-trimoxazole, co-trimazine and co-trimazole (thanks to Peter Dutey)
|
||||
* Changes to the `antibiotics` data set (thanks to Peter Dutey):
|
||||
* Added more synonyms to colistin, imipenem and piperacillin/tazobactam
|
||||
@@ -326,7 +466,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
* Full support for the upcoming R 4.0
|
||||
* Removed unnecessary `AMR::` calls
|
||||
|
||||
# AMR 0.9.0
|
||||
# `AMR` 0.9.0
|
||||
|
||||
### Breaking
|
||||
* Adopted Adeolu *et al.* (2016), [PMID 27620848](https:/pubmed.ncbi.nlm.nih.gov/27620848/) for the `microorganisms` data set, which means that the new order Enterobacterales now consists of a part of the existing family Enterobacteriaceae, but that this family has been split into other families as well (like *Morganellaceae* and *Yersiniaceae*). Although published in 2016, this information is not yet in the Catalogue of Life version of 2019. All MDRO determinations with `mdro()` will now use the Enterobacterales order for all guidelines before 2016 that were dependent on the Enterobacteriaceae family.
|
||||
@@ -392,7 +532,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
* Change dependency on `clean` to `cleaner`, as this package was renamed accordingly upon CRAN request
|
||||
* Added Dr. Sofia Ny as contributor
|
||||
|
||||
# AMR 0.8.0
|
||||
# `AMR` 0.8.0
|
||||
|
||||
### Breaking
|
||||
* Determination of first isolates now **excludes** all 'unknown' microorganisms at default, i.e. microbial code `"UNKNOWN"`. They can be included with the new argument `include_unknown`:
|
||||
@@ -521,7 +661,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
* Added Prof. Dr. Casper Albers as doctoral advisor and added Dr. Judith Fonville, Eric Hazenberg, Dr. Bart Meijer, Dr. Dennis Souverein and Annick Lenglet as contributors
|
||||
* Cleaned the coding style of every single syntax line in this package with the help of the `lintr` package
|
||||
|
||||
# AMR 0.7.1
|
||||
# `AMR` 0.7.1
|
||||
|
||||
#### New
|
||||
* Function `rsi_df()` to transform a `data.frame` to a data set containing only the microbial interpretation (S, I, R), the antibiotic, the percentage of S/I/R and the number of available isolates. This is a convenient combination of the existing functions `count_df()` and `portion_df()` to immediately show resistance percentages and number of available isolates:
|
||||
@@ -582,7 +722,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
#### Other
|
||||
* Fixed a note thrown by CRAN tests
|
||||
|
||||
# AMR 0.7.0
|
||||
# `AMR` 0.7.0
|
||||
|
||||
#### New
|
||||
* Support for translation of disk diffusion and MIC values to RSI values (i.e. antimicrobial interpretations). Supported guidelines are EUCAST (2011 to 2019) and CLSI (2011 to 2019). Use `as.rsi()` on an MIC value (created with `as.mic()`), a disk diffusion value (created with the new `as.disk()`) or on a complete date set containing columns with MIC or disk diffusion values.
|
||||
@@ -600,7 +740,7 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
* Based on the Compound ID, almost 5,000 official brand names have been added from many different countries
|
||||
* All references to antibiotics in our package now use EARS-Net codes, like `AMX` for amoxicillin
|
||||
* Functions `atc_certe`, `ab_umcg` and `atc_trivial_nl` have been removed
|
||||
* All `atc_*` functions are superceded by `ab_*` functions
|
||||
* All `atc_*` functions are superseded by `ab_*` functions
|
||||
* All output will be translated by using an included translation file which [can be viewed here](https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv)
|
||||
* Improvements to plotting AMR results with `ggplot_rsi()`:
|
||||
* New argument `colours` to set the bar colours
|
||||
@@ -640,20 +780,20 @@ This software is now out of beta and considered stable. Nonetheless, this packag
|
||||
#### Other
|
||||
* Support for R 3.6.0 and later by providing support for [staged install](https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html)
|
||||
|
||||
# AMR 0.6.1
|
||||
# `AMR` 0.6.1
|
||||
|
||||
#### Changed
|
||||
* Fixed a critical bug when using `eucast_rules()` with `verbose = TRUE`
|
||||
* Coercion of microbial IDs are now written to the package namespace instead of the user's home folder, to comply with the CRAN policy
|
||||
|
||||
# AMR 0.6.0
|
||||
# `AMR` 0.6.0
|
||||
|
||||
**New website!**
|
||||
|
||||
We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.gitlab.io/AMR/) (built with the great [`pkgdown`](https://pkgdown.r-lib.org/))
|
||||
|
||||
* Contains the complete manual of this package and all of its functions with an explanation of their arguments
|
||||
* Contains a comprehensive tutorial about how to conduct antimicrobial resistance analysis, import data from WHONET or SPSS and many more.
|
||||
* Contains a comprehensive tutorial about how to conduct AMR data analysis, import data from WHONET or SPSS and many more.
|
||||
|
||||
#### New
|
||||
* **BREAKING**: removed deprecated functions, arguments and references to 'bactid'. Use `as.mo()` to identify an MO code.
|
||||
@@ -712,7 +852,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
* New function `mo_uncertainties()` to review values that could be coerced to a valid MO code using `as.mo()`, but with uncertainty.
|
||||
* New function `mo_renamed()` to get a list of all returned values from `as.mo()` that have had taxonomic renaming
|
||||
* New function `age()` to calculate the (patients) age in years
|
||||
* New function `age_groups()` to split ages into custom or predefined groups (like children or elderly). This allows for easier demographic antimicrobial resistance analysis per age group.
|
||||
* New function `age_groups()` to split ages into custom or predefined groups (like children or elderly). This allows for easier demographic AMR data analysis per age group.
|
||||
* New function `ggplot_rsi_predict()` as well as the base R `plot()` function can now be used for resistance prediction calculated with `resistance_predict()`:
|
||||
```r
|
||||
x <- resistance_predict(septic_patients, col_ab = "amox")
|
||||
@@ -839,7 +979,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
#### Other
|
||||
* Updated licence text to emphasise GPL 2.0 and that this is an R package.
|
||||
|
||||
# AMR 0.5.0
|
||||
# `AMR` 0.5.0
|
||||
|
||||
#### New
|
||||
* Repository moved to GitLab
|
||||
@@ -922,7 +1062,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
* Updated vignettes to comply with README
|
||||
|
||||
|
||||
# AMR 0.4.0
|
||||
# `AMR` 0.4.0
|
||||
|
||||
#### New
|
||||
* The data set `microorganisms` now contains **all microbial taxonomic data from ITIS** (kingdoms Bacteria, Fungi and Protozoa), the Integrated Taxonomy Information System, available via https://itis.gov. The data set now contains more than 18,000 microorganisms with all known bacteria, fungi and protozoa according ITIS with genus, species, subspecies, family, order, class, phylum and subkingdom. The new data set `microorganisms.old` contains all previously known taxonomic names from those kingdoms.
|
||||
@@ -1033,7 +1173,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
#### Other
|
||||
* More unit tests to ensure better integrity of functions
|
||||
|
||||
# AMR 0.3.0
|
||||
# `AMR` 0.3.0
|
||||
|
||||
#### New
|
||||
* **BREAKING**: `rsi_df` was removed in favour of new functions `portion_R`, `portion_IR`, `portion_I`, `portion_SI` and `portion_S` to selectively calculate resistance or susceptibility. These functions are 20 to 30 times faster than the old `rsi` function. The old function still works, but is deprecated.
|
||||
@@ -1103,7 +1243,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
* Windows: https://ci.appveyor.com/project/msberends/amr
|
||||
* Added thesis advisors to DESCRIPTION file
|
||||
|
||||
# AMR 0.2.0
|
||||
# `AMR` 0.2.0
|
||||
|
||||
#### New
|
||||
* Full support for Windows, Linux and macOS
|
||||
@@ -1138,7 +1278,7 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
* Added build tests for Linux and macOS using Travis CI (https://travis-ci.org/msberends/AMR)
|
||||
* Added line coverage checking using CodeCov (https://codecov.io/gh/msberends/AMR/tree/master/R)
|
||||
|
||||
# AMR 0.1.1
|
||||
# `AMR` 0.1.1
|
||||
|
||||
* `EUCAST_rules` applies for amoxicillin even if ampicillin is missing
|
||||
* Edited column names to comply with GLIMS, the laboratory information system
|
||||
@@ -1146,6 +1286,6 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git
|
||||
* Renamed 'Daily Defined Dose' to 'Defined Daily Dose'
|
||||
* Added barplots for `rsi` and `mic` classes
|
||||
|
||||
# AMR 0.1.0
|
||||
# `AMR` 0.1.0
|
||||
|
||||
* First submission to CRAN.
|
||||
|
||||
+319
-67
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# faster implementation of left_join than using merge() by poorman - we use match():
|
||||
@@ -71,7 +71,49 @@ addin_insert_in <- function() {
|
||||
|
||||
# No export, no Rd
|
||||
addin_insert_like <- function() {
|
||||
import_fn("insertText", "rstudioapi")(" %like% ")
|
||||
# we want Shift + Ctrl/Cmd + L to iterate over %like%, %unlike%, %like_case%, and %unlike_case%
|
||||
|
||||
getActiveDocumentContext <- import_fn("getActiveDocumentContext", "rstudioapi")
|
||||
insertText <- import_fn("insertText", "rstudioapi")
|
||||
modifyRange <- import_fn("modifyRange", "rstudioapi")
|
||||
document_range <- import_fn("document_range", "rstudioapi")
|
||||
document_position <- import_fn("document_position", "rstudioapi")
|
||||
|
||||
context <- getActiveDocumentContext()
|
||||
current_row <- context$selection[[1]]$range$end[1]
|
||||
current_col <- context$selection[[1]]$range$end[2]
|
||||
current_row_txt <- context$contents[current_row]
|
||||
if (is.null(current_row) || current_row_txt %unlike% "%(un)?like") {
|
||||
insertText(" %like% ")
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
pos_preceded_by <- function(txt) {
|
||||
if (tryCatch(substr(current_row_txt, current_col - nchar(trimws(txt, which = "right")), current_col) == trimws(txt, which = "right"),
|
||||
error = function(e) FALSE)) {
|
||||
return(TRUE)
|
||||
}
|
||||
tryCatch(substr(current_row_txt, current_col - nchar(txt), current_col) %like% paste0("^", txt),
|
||||
error = function(e) FALSE)
|
||||
}
|
||||
replace_pos <- function(old, with) {
|
||||
modifyRange(document_range(document_position(current_row, current_col - nchar(old)),
|
||||
document_position(current_row, current_col)),
|
||||
text = with,
|
||||
id = context$id)
|
||||
}
|
||||
|
||||
if (pos_preceded_by(" %like% ")) {
|
||||
replace_pos(" %like% ", with = " %unlike% ")
|
||||
} else if (pos_preceded_by(" %unlike% ")) {
|
||||
replace_pos(" %unlike% ", with = " %like_case% ")
|
||||
} else if (pos_preceded_by(" %like_case% ")) {
|
||||
replace_pos(" %like_case% ", with = " %unlike_case% ")
|
||||
} else if (pos_preceded_by(" %unlike_case% ")) {
|
||||
replace_pos(" %unlike_case% ", with = " %like% ")
|
||||
} else {
|
||||
insertText(" %like% ")
|
||||
}
|
||||
}
|
||||
|
||||
check_dataset_integrity <- function() {
|
||||
@@ -81,18 +123,31 @@ check_dataset_integrity <- function() {
|
||||
overwritten <- data_in_pkg[data_in_pkg %in% data_in_globalenv]
|
||||
# exception for example_isolates
|
||||
overwritten <- overwritten[overwritten != "example_isolates"]
|
||||
stop_if(length(overwritten) > 0,
|
||||
"the following data set is overwritten by your global environment and prevents the AMR package from working correctly:\n",
|
||||
paste0("'", overwritten, "'", collapse = ", "),
|
||||
".\nPlease rename your object before using this function.", call = FALSE)
|
||||
if (length(overwritten) > 0) {
|
||||
if (length(overwritten) > 1) {
|
||||
plural <- c("s are", "", "s")
|
||||
} else {
|
||||
plural <- c(" is", "s", "")
|
||||
}
|
||||
if (message_not_thrown_before("dataset_overwritten")) {
|
||||
warning_("The following data set", plural[1],
|
||||
" overwritten by your global environment and prevent", plural[2],
|
||||
" the AMR package from working correctly: ",
|
||||
vector_and(overwritten, quotes = "'"),
|
||||
".\nPlease rename your object", plural[3], ".", call = FALSE)
|
||||
remember_thrown_message("dataset_overwritten")
|
||||
}
|
||||
}
|
||||
# check if other packages did not overwrite our data sets
|
||||
valid_microorganisms <- TRUE
|
||||
valid_antibiotics <- TRUE
|
||||
tryCatch({
|
||||
check_microorganisms <- all(c("mo", "fullname", "kingdom", "phylum",
|
||||
valid_microorganisms <- all(c("mo", "fullname", "kingdom", "phylum",
|
||||
"class", "order", "family", "genus",
|
||||
"species", "subspecies", "rank",
|
||||
"species_id", "source", "ref", "prevalence") %in% colnames(microorganisms),
|
||||
na.rm = TRUE)
|
||||
check_antibiotics <- all(c("ab", "atc", "cid", "name", "group",
|
||||
valid_antibiotics <- all(c("ab", "atc", "cid", "name", "group",
|
||||
"atc_group1", "atc_group2", "abbreviations",
|
||||
"synonyms", "oral_ddd", "oral_units",
|
||||
"iv_ddd", "iv_units", "loinc") %in% colnames(antibiotics),
|
||||
@@ -101,8 +156,8 @@ check_dataset_integrity <- function() {
|
||||
# package not yet loaded
|
||||
require("AMR")
|
||||
})
|
||||
stop_if(!check_microorganisms | !check_antibiotics,
|
||||
"the data set `microorganisms` or `antibiotics` was overwritten in your environment because another package with the same object names was loaded _after_ the AMR package, preventing the AMR package from working correctly. Please load the AMR package last.")
|
||||
stop_if(!valid_microorganisms | !valid_antibiotics,
|
||||
"the data set `microorganisms` or `antibiotics` was overwritten in your environment because another package with the same object name(s) was loaded _after_ the AMR package, preventing the AMR package from working correctly. Please load the AMR package last.")
|
||||
invisible(TRUE)
|
||||
}
|
||||
|
||||
@@ -138,8 +193,8 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
}
|
||||
# -- key antibiotics
|
||||
if (type == "keyantibiotics") {
|
||||
if (any(colnames(x) %like% "^key.*(ab|antibiotics)")) {
|
||||
found <- sort(colnames(x)[colnames(x) %like% "^key.*(ab|antibiotics)"])[1]
|
||||
if (any(colnames(x) %like% "^key.*(ab|antibiotics|antimicrobials)")) {
|
||||
found <- sort(colnames(x)[colnames(x) %like% "^key.*(ab|antibiotics|antimicrobials)"])[1]
|
||||
}
|
||||
}
|
||||
# -- date
|
||||
@@ -201,10 +256,21 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
found
|
||||
}
|
||||
|
||||
is_possibly_regex <- function(x) {
|
||||
tryCatch(vapply(FUN.VALUE = character(1), strsplit(x, ""),
|
||||
function(y) any(y %in% c("$", "(", ")", "*", "+", "-", ".", "?", "[", "]", "^", "{", "|", "}", "\\"), na.rm = TRUE)),
|
||||
error = function(e) rep(TRUE, length(x)))
|
||||
is_valid_regex <- function(x) {
|
||||
regex_at_all <- tryCatch(vapply(FUN.VALUE = logical(1),
|
||||
X = strsplit(x, ""),
|
||||
FUN = function(y) any(y %in% c("$", "(", ")", "*", "+", "-",
|
||||
".", "?", "[", "]", "^", "{",
|
||||
"|", "}", "\\"),
|
||||
na.rm = TRUE),
|
||||
USE.NAMES = FALSE),
|
||||
error = function(e) rep(TRUE, length(x)))
|
||||
regex_valid <- vapply(FUN.VALUE = logical(1),
|
||||
X = x,
|
||||
FUN = function(y) !"try-error" %in% class(try(grepl(y, "", perl = TRUE),
|
||||
silent = TRUE)),
|
||||
USE.NAMES = FALSE)
|
||||
regex_at_all & regex_valid
|
||||
}
|
||||
|
||||
stop_ifnot_installed <- function(package) {
|
||||
@@ -213,8 +279,8 @@ stop_ifnot_installed <- function(package) {
|
||||
vapply(FUN.VALUE = character(1), package, function(pkg)
|
||||
tryCatch(get(".packageName", envir = asNamespace(pkg)),
|
||||
error = function(e) {
|
||||
if (package == "rstudioapi") {
|
||||
stop("This function only works in RStudio.", call. = FALSE)
|
||||
if (pkg == "rstudioapi") {
|
||||
stop("This function only works in RStudio when using R >= 3.2.", call. = FALSE)
|
||||
} else if (pkg != "base") {
|
||||
stop("This requires the '", pkg, "' package.",
|
||||
"\nTry to install it with: install.packages(\"", pkg, "\")",
|
||||
@@ -255,7 +321,7 @@ word_wrap <- function(...,
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
|
||||
if (isTRUE(as_note)) {
|
||||
msg <- paste0("NOTE: ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
|
||||
msg <- paste0(pkg_env$info_icon, " ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
|
||||
}
|
||||
|
||||
if (msg %like% "\n") {
|
||||
@@ -289,8 +355,8 @@ word_wrap <- function(...,
|
||||
msg <- paste0(msg, collapse = " ")
|
||||
msg <- gsub("\n ", "\n", msg, fixed = TRUE)
|
||||
|
||||
if (msg_stripped %like% "^NOTE: ") {
|
||||
indentation <- 6 + extra_indent
|
||||
if (msg_stripped %like% "\u2139 ") {
|
||||
indentation <- 2 + extra_indent
|
||||
} else if (msg_stripped %like% "^=> ") {
|
||||
indentation <- 3 + extra_indent
|
||||
} else {
|
||||
@@ -393,7 +459,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
|
||||
ifelse(!is.na(y), y, NA))
|
||||
}
|
||||
|
||||
class_integrity_check <- function(value, type, check_vector) {
|
||||
return_after_integrity_check <- function(value, type, check_vector) {
|
||||
if (!all(value[!is.na(value)] %in% check_vector)) {
|
||||
warning_(paste0("invalid ", type, ", NA generated"), call = FALSE)
|
||||
value[!value %in% check_vector] <- NA
|
||||
@@ -439,12 +505,79 @@ create_ab_documentation <- function(ab) {
|
||||
out
|
||||
}
|
||||
|
||||
vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, last_sep = " or ") {
|
||||
# makes unique and sorts, and this also removed NAs
|
||||
v <- unique(v)
|
||||
if (isTRUE(sort)) {
|
||||
v <- sort(v)
|
||||
}
|
||||
if (isTRUE(reverse)) {
|
||||
v <- rev(v)
|
||||
}
|
||||
if (isTRUE(quotes)) {
|
||||
quotes <- '"'
|
||||
} else if (isFALSE(quotes)) {
|
||||
quotes <- ""
|
||||
} else {
|
||||
quotes <- quotes[1L]
|
||||
}
|
||||
if (length(v) == 1) {
|
||||
return(paste0(quotes, v, quotes))
|
||||
}
|
||||
if (identical(v, c("I", "R", "S"))) {
|
||||
# class <rsi> should be sorted like this
|
||||
v <- c("R", "S", "I")
|
||||
}
|
||||
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
|
||||
paste0(paste0(quotes, v[seq_len(length(v) - 1)], quotes, collapse = ", "),
|
||||
last_sep, paste0(quotes, v[length(v)], quotes))
|
||||
}
|
||||
|
||||
vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE) {
|
||||
vector_or(v = v, quotes = quotes, reverse = reverse, sort = sort, last_sep = " and ")
|
||||
}
|
||||
|
||||
format_class <- function(class, plural = FALSE) {
|
||||
class.bak <- class
|
||||
class[class == "numeric"] <- "number"
|
||||
class[class == "integer"] <- "whole number"
|
||||
if (all(c("numeric", "integer") %in% class.bak, na.rm = TRUE)) {
|
||||
class[class %in% c("number", "whole number")] <- "(whole) number"
|
||||
}
|
||||
class[class == "character"] <- "text string"
|
||||
class[class %in% c("Date", "POSIXt")] <- "date"
|
||||
class[class != class.bak] <- paste0(ifelse(plural, "", "a "),
|
||||
class[class != class.bak],
|
||||
ifelse(plural, "s", ""))
|
||||
# exceptions
|
||||
class[class == "logical"] <- ifelse(plural, "a vector of `TRUE`/`FALSE`", "`TRUE` or `FALSE`")
|
||||
class[class == "data.frame"] <- "a data set"
|
||||
if ("list" %in% class) {
|
||||
class <- "a list"
|
||||
}
|
||||
if ("matrix" %in% class) {
|
||||
class <- "a matrix"
|
||||
}
|
||||
if ("custom_eucast_rules" %in% class) {
|
||||
class <- "input created with `custom_eucast_rules()`"
|
||||
}
|
||||
if (any(c("mo", "ab", "rsi") %in% class)) {
|
||||
class <- paste0("of class <", class[1L], ">")
|
||||
}
|
||||
class[class == class.bak] <- paste0("of class <", class[class == class.bak], ">")
|
||||
# output
|
||||
vector_or(class, quotes = FALSE, sort = FALSE)
|
||||
}
|
||||
|
||||
# a check for every single argument in all functions
|
||||
meet_criteria <- function(object,
|
||||
allow_class = NULL,
|
||||
has_length = NULL,
|
||||
looks_like = NULL,
|
||||
is_in = NULL,
|
||||
is_positive = NULL,
|
||||
is_positive_or_zero = NULL,
|
||||
is_finite = NULL,
|
||||
contains_column_class = NULL,
|
||||
allow_NULL = FALSE,
|
||||
allow_NA = FALSE,
|
||||
@@ -453,6 +586,16 @@ meet_criteria <- function(object,
|
||||
|
||||
obj_name <- deparse(substitute(object))
|
||||
call_depth <- -2 - abs(.call_depth)
|
||||
|
||||
# if object is missing, or another error:
|
||||
tryCatch(invisible(object),
|
||||
error = function(e) pkg_env$meet_criteria_error_txt <- e$message)
|
||||
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
|
||||
}
|
||||
pkg_env$meet_criteria_error_txt <- NULL
|
||||
|
||||
if (is.null(object)) {
|
||||
stop_if(allow_NULL == FALSE, "argument `", obj_name, "` must not be NULL", call = call_depth)
|
||||
@@ -463,20 +606,10 @@ meet_criteria <- function(object,
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
vector_or <- function(v, quotes) {
|
||||
if (length(v) == 1) {
|
||||
return(paste0(ifelse(quotes, '"', ""), v, ifelse(quotes, '"', "")))
|
||||
}
|
||||
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
|
||||
paste0(paste0(ifelse(quotes, '"', ""), v[seq_len(length(v) - 1)], ifelse(quotes, '"', ""), collapse = ", "),
|
||||
" or ", paste0(ifelse(quotes, '"', ""), v[length(v)], ifelse(quotes, '"', "")))
|
||||
}
|
||||
|
||||
if (!is.null(allow_class)) {
|
||||
stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
|
||||
"` must ", # ifelse(allow_NULL, "be NULL or must ", ""),
|
||||
"be of class ", vector_or(allow_class, quotes = TRUE),
|
||||
", not \"", paste(class(object), collapse = "/"), "\"",
|
||||
"` must be ", format_class(allow_class, plural = isTRUE(has_length > 1)),
|
||||
", i.e. not be ", format_class(class(object), plural = isTRUE(has_length > 1)),
|
||||
call = call_depth)
|
||||
# check data.frames for data
|
||||
if (inherits(object, "data.frame")) {
|
||||
@@ -507,11 +640,36 @@ meet_criteria <- function(object,
|
||||
}
|
||||
stop_ifnot(all(object %in% is_in, na.rm = TRUE), "argument `", obj_name,
|
||||
"` must be ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, "one of: ", ""),
|
||||
vector_or(is_in, quotes = TRUE),
|
||||
", not ", paste0("\"", object, "\"", collapse = "/"), "",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, "either ", ""),
|
||||
vector_or(is_in, quotes = !isTRUE(any(c("double", "numeric", "integer") %in% allow_class))),
|
||||
ifelse(allow_NA == TRUE, ", or NA", ""),
|
||||
call = call_depth)
|
||||
}
|
||||
if (isTRUE(is_positive)) {
|
||||
stop_if(is.numeric(object) && !all(object > 0, na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be a number higher than zero",
|
||||
"all be numbers higher than zero"),
|
||||
call = call_depth)
|
||||
}
|
||||
if (isTRUE(is_positive_or_zero)) {
|
||||
stop_if(is.numeric(object) && !all(object >= 0, na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be zero or a positive number",
|
||||
"all be zero or numbers higher than zero"),
|
||||
call = call_depth)
|
||||
}
|
||||
if (isTRUE(is_finite)) {
|
||||
stop_if(is.numeric(object) && !all(is.finite(object[!is.na(object)]), na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be a finite number",
|
||||
"all be finite numbers"),
|
||||
" (i.e., not be infinite)",
|
||||
call = call_depth)
|
||||
}
|
||||
if (!is.null(contains_column_class)) {
|
||||
stop_ifnot(any(vapply(FUN.VALUE = logical(1),
|
||||
object,
|
||||
@@ -527,11 +685,25 @@ meet_criteria <- function(object,
|
||||
}
|
||||
|
||||
get_current_data <- function(arg_name, call) {
|
||||
# try dplyr::cur_data_all() first to support dplyr groups
|
||||
# only useful for e.g. dplyr::filter(), dplyr::mutate() and dplyr::summarise()
|
||||
# not useful (throws error) with e.g. dplyr::select() - but that will be caught later in this function
|
||||
cur_data_all <- import_fn("cur_data_all", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_data_all)) {
|
||||
out <- tryCatch(cur_data_all(), error = function(e) NULL)
|
||||
if (is.data.frame(out)) {
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
|
||||
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2) {
|
||||
# R-3.0 and R-3.1 do not have an `x` element in the call stack, rendering this function useless
|
||||
if (is.na(arg_name)) {
|
||||
# like in carbapenems() etc.
|
||||
warning_("this function can only be used in R >= 3.2", call = call)
|
||||
return(data.frame())
|
||||
} else {
|
||||
# mimic a default R error, e.g. for example_isolates[which(mo_name() %like% "^ent"), ]
|
||||
stop_("argument `", arg_name, "` is missing with no default", call = call)
|
||||
}
|
||||
}
|
||||
@@ -539,13 +711,19 @@ get_current_data <- function(arg_name, call) {
|
||||
# try a (base R) method, by going over the complete system call stack with sys.frames()
|
||||
not_set <- TRUE
|
||||
frms <- lapply(sys.frames(), function(el) {
|
||||
if (".Generic" %in% names(el)) {
|
||||
if (tryCatch(not_set == TRUE && ".data" %in% names(el) && is.data.frame(el$`.data`), error = function(e) FALSE)) {
|
||||
# dplyr? - an element `.data` will be in the system call stack
|
||||
if (not_set == TRUE && ".Generic" %in% names(el)) {
|
||||
if (tryCatch(".data" %in% names(el) && is.data.frame(el$`.data`), error = function(e) FALSE)) {
|
||||
# - - - -
|
||||
# dplyr
|
||||
# - - - -
|
||||
# an element `.data` will be in the system call stack when using dplyr::select()
|
||||
# [but not when using dplyr::filter(), dplyr::mutate() or dplyr::summarise()]
|
||||
not_set <<- FALSE
|
||||
el$`.data`
|
||||
} else if (tryCatch(not_set == TRUE && any(c("x", "xx") %in% names(el)), error = function(e) FALSE)) {
|
||||
# otherwise try base R:
|
||||
} else if (tryCatch(any(c("x", "xx") %in% names(el)), error = function(e) FALSE)) {
|
||||
# - - - -
|
||||
# base R
|
||||
# - - - -
|
||||
# an element `x` will be in this environment for only cols, e.g. `example_isolates[, carbapenems()]`
|
||||
# an element `xx` will be in this environment for rows + cols, e.g. `example_isolates[c(1:3), carbapenems()]`
|
||||
if (tryCatch(is.data.frame(el$xx), error = function(e) FALSE)) {
|
||||
@@ -564,6 +742,8 @@ get_current_data <- function(arg_name, call) {
|
||||
NULL
|
||||
}
|
||||
})
|
||||
|
||||
# lookup the matched frame and return its value: a data.frame
|
||||
vars_df <- tryCatch(frms[[which(!vapply(FUN.VALUE = logical(1), frms, is.null))]], error = function(e) NULL)
|
||||
if (is.data.frame(vars_df)) {
|
||||
return(vars_df)
|
||||
@@ -571,15 +751,68 @@ get_current_data <- function(arg_name, call) {
|
||||
|
||||
# nothing worked, so:
|
||||
if (is.na(arg_name)) {
|
||||
stop_("this function must be used inside valid dplyr selection verbs or inside a data.frame call",
|
||||
if (isTRUE(is.numeric(call))) {
|
||||
fn <- as.character(sys.call(call + 1)[1])
|
||||
examples <- paste0(", e.g.:\n",
|
||||
" your_data %>% select(", fn, "())\n",
|
||||
" your_data %>% select(column_a, column_b, ", fn, "())\n",
|
||||
" your_data[, ", fn, "()]\n",
|
||||
' your_data[, c("column_a", "column_b", ', fn, "())]")
|
||||
} else {
|
||||
examples <- ""
|
||||
}
|
||||
stop_("this function must be used inside valid dplyr selection verbs or inside a data.frame call",
|
||||
examples,
|
||||
call = call)
|
||||
} else {
|
||||
stop_("argument `", arg_name, "` is missing with no default ",
|
||||
"or function not used inside a valid dplyr verb",
|
||||
call = call)
|
||||
stop_("argument `", arg_name, "` is missing with no default", call = call)
|
||||
}
|
||||
}
|
||||
|
||||
get_current_column <- function() {
|
||||
# try dplyr::cur_columns() first
|
||||
cur_column <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_column)) {
|
||||
out <- tryCatch(cur_column(), error = function(e) NULL)
|
||||
if (!is.null(out)) {
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
|
||||
# cur_column() doesn't always work (only allowed for conditions set by dplyr), but it's probably still possible:
|
||||
frms <- lapply(sys.frames(), function(el) {
|
||||
if ("i" %in% names(el)) {
|
||||
if ("tibble_vars" %in% names(el)) {
|
||||
# for mutate_if()
|
||||
el$tibble_vars[el$i]
|
||||
} else {
|
||||
# for mutate(across())
|
||||
df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL)
|
||||
if (is.data.frame(df)) {
|
||||
colnames(df)[el$i]
|
||||
} else {
|
||||
el$i
|
||||
}
|
||||
}
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
})
|
||||
|
||||
vars <- unlist(frms)
|
||||
if (length(vars) > 0) {
|
||||
vars[length(vars)]
|
||||
} else {
|
||||
# not found, so:
|
||||
NULL
|
||||
}
|
||||
}
|
||||
|
||||
is_null_or_grouped_tbl <- function(x) {
|
||||
# attribute "grouped_df" might change at one point, so only set in one place; here.
|
||||
is.null(x) || inherits(x, "grouped_df")
|
||||
}
|
||||
|
||||
unique_call_id <- function(entire_session = FALSE) {
|
||||
if (entire_session == TRUE) {
|
||||
c(envir = "session",
|
||||
@@ -595,19 +828,20 @@ unique_call_id <- function(entire_session = FALSE) {
|
||||
remember_thrown_message <- function(fn, entire_session = FALSE) {
|
||||
# this is to prevent that messages/notes will be printed for every dplyr group
|
||||
# e.g. this would show a msg 4 times: example_isolates %>% group_by(hospital_id) %>% filter(mo_is_gram_negative())
|
||||
assign(x = paste0("thrown_msg_", fn),
|
||||
assign(x = paste0("thrown_msg.", fn),
|
||||
value = unique_call_id(entire_session = entire_session),
|
||||
envir = pkg_env)
|
||||
}
|
||||
|
||||
message_not_thrown_before <- function(fn, entire_session = FALSE) {
|
||||
is.null(pkg_env[[paste0("thrown_msg_", fn)]]) || !identical(pkg_env[[paste0("thrown_msg_", fn)]], unique_call_id(entire_session))
|
||||
is.null(pkg_env[[paste0("thrown_msg.", fn)]]) || !identical(pkg_env[[paste0("thrown_msg.", fn)]], unique_call_id(entire_session))
|
||||
}
|
||||
|
||||
reset_all_thrown_messages <- function() {
|
||||
# for unit tests, where the environment and highest system call do not change
|
||||
# can be found in tests/testthat/*.R
|
||||
pkg_env_contents <- ls(envir = pkg_env)
|
||||
rm(list = pkg_env_contents[pkg_env_contents %like% "^thrown_msg_"],
|
||||
rm(list = pkg_env_contents[pkg_env_contents %like% "^thrown_msg."],
|
||||
envir = pkg_env)
|
||||
}
|
||||
|
||||
@@ -703,19 +937,28 @@ font_grey <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[38;5;249m", after = "\033[39m", collapse = collapse)
|
||||
}
|
||||
font_grey_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[48;5;254m", after = "\033[49m", collapse = collapse)
|
||||
if (tryCatch(rstudioapi::getThemeInfo()$dark == TRUE, error = function(e) FALSE)) {
|
||||
# similar to HTML #444444
|
||||
try_colour(..., before = "\033[48;5;238m", after = "\033[49m", collapse = collapse)
|
||||
} else {
|
||||
# similar to HTML #eeeeee
|
||||
try_colour(..., before = "\033[48;5;254m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
}
|
||||
font_green_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[42m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_rsi_R_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[48;5;202m", after = "\033[49m", collapse = collapse)
|
||||
#ED553B
|
||||
try_colour(..., before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_rsi_S_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[48;5;76m", after = "\033[49m", collapse = collapse)
|
||||
#3CAEA3
|
||||
try_colour(..., before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_rsi_I_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[48;5;148m", after = "\033[49m", collapse = collapse)
|
||||
#F6D55C
|
||||
try_colour(..., before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_red_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[41m", after = "\033[49m", collapse = collapse)
|
||||
@@ -740,8 +983,8 @@ font_stripstyle <- function(x) {
|
||||
gsub("(?:(?:\\x{001b}\\[)|\\x{009b})(?:(?:[0-9]{1,3})?(?:(?:;[0-9]{0,3})*)?[A-M|f-m])|\\x{001b}[A-M]", "", x, perl = TRUE)
|
||||
}
|
||||
|
||||
progress_ticker <- function(n = 1, n_min = 0, ...) {
|
||||
if (!interactive() || n < n_min) {
|
||||
progress_ticker <- function(n = 1, n_min = 0, print = TRUE, ...) {
|
||||
if (print == FALSE || n < n_min) {
|
||||
pb <- list()
|
||||
pb$tick <- function() {
|
||||
invisible()
|
||||
@@ -788,15 +1031,8 @@ formatted_filesize <- function(...) {
|
||||
}
|
||||
|
||||
create_pillar_column <- function(x, ...) {
|
||||
new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE)
|
||||
if (!is.null(new_pillar_shaft_simple)) {
|
||||
new_pillar_shaft_simple(x, ...)
|
||||
} else {
|
||||
# does not exist in package 'pillar' anymore
|
||||
structure(list(x),
|
||||
class = "pillar_shaft_simple",
|
||||
...)
|
||||
}
|
||||
new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar")
|
||||
new_pillar_shaft_simple(x, ...)
|
||||
}
|
||||
|
||||
# copied from vctrs::s3_register by their permission:
|
||||
@@ -913,8 +1149,16 @@ percentage <- function(x, digits = NULL, ...) {
|
||||
digits = digits, ...)
|
||||
}
|
||||
|
||||
# prevent dependency on package 'backports'
|
||||
# these functions were not available in previous versions of R (last checked: R 4.0.3)
|
||||
time_start_tracking <- function() {
|
||||
pkg_env$time_start <- round(as.numeric(Sys.time()) * 1000)
|
||||
}
|
||||
|
||||
time_track <- function(name = NULL) {
|
||||
paste("(until now:", trimws(round(as.numeric(Sys.time()) * 1000) - pkg_env$time_start), "ms)")
|
||||
}
|
||||
|
||||
# prevent dependency on package 'backports' ----
|
||||
# these functions were not available in previous versions of R (last checked: R 4.0.5)
|
||||
# see here for the full list: https://github.com/r-lib/backports
|
||||
strrep <- function(x, times) {
|
||||
x <- as.character(x)
|
||||
@@ -961,3 +1205,11 @@ isNamespaceLoaded <- function(pkg) {
|
||||
lengths <- function(x, use.names = TRUE) {
|
||||
vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names)
|
||||
}
|
||||
|
||||
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.1) {
|
||||
# R-3.0 does not contain these functions, set them here to prevent installation failure
|
||||
# (required for extension of the <mic> class)
|
||||
cospi <- function(...) 1
|
||||
sinpi <- function(...) 1
|
||||
tanpi <- function(...) 1
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# ------------------------------------------------
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,16 +20,16 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform input to an antibiotic ID
|
||||
#' Transform Input to an Antibiotic ID
|
||||
#'
|
||||
#' Use this function to determine the antibiotic code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x character vector to determine to antibiotic ID
|
||||
#' @param flag_multiple_results logical to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
|
||||
#' @param info logical to indicate whether a progress bar should be printed
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [character] vector to determine to antibiotic ID
|
||||
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to internal functions
|
||||
#' @rdname as.ab
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
@@ -42,7 +42,7 @@
|
||||
#' * Switching two characters (such as "mreopenem", often the case in clinical data, when doctors typed too fast)
|
||||
#' * Digitalised paper records, leaving artefacts like 0/o/O (zero and O's), B/8, n/r, etc.
|
||||
#'
|
||||
#' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see Examples.
|
||||
#' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see *Examples*.
|
||||
#'
|
||||
#' Note: the [as.ab()] and [`ab_*`][ab_property()] functions may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
|
||||
#' @section Source:
|
||||
@@ -56,8 +56,8 @@
|
||||
#' @seealso
|
||||
#' * [antibiotics] for the [data.frame] that is being used to determine ATCs
|
||||
#' * [ab_from_text()] for a function to retrieve antimicrobial drugs from clinical text (from health care records)
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # these examples all return "ERY", the ID of erythromycin:
|
||||
@@ -82,7 +82,15 @@
|
||||
#' # they use as.ab() internally:
|
||||
#' ab_name("J01FA01") # "Erythromycin"
|
||||
#' ab_name("eryt") # "Erythromycin"
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' # you can quickly rename <rsi> columns using dplyr >= 1.0.0:
|
||||
#' example_isolates %>%
|
||||
#' rename_with(as.ab, where(is.rsi))
|
||||
#'
|
||||
#' }
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
meet_criteria(x, allow_class = c("character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
@@ -95,19 +103,34 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
|
||||
initial_search <- is.null(list(...)$initial_search)
|
||||
already_regex <- isTRUE(list(...)$already_regex)
|
||||
|
||||
if (all(toupper(x) %in% antibiotics$ab)) {
|
||||
# valid AB code, but not yet right class
|
||||
return(set_clean_class(toupper(x),
|
||||
new_class = c("ab", "character")))
|
||||
}
|
||||
fast_mode <- isTRUE(list(...)$fast_mode)
|
||||
|
||||
x_bak <- x
|
||||
x <- toupper(x)
|
||||
x_nonNA <- x[!is.na(x)]
|
||||
|
||||
if (all(x_nonNA %in% antibiotics$ab, na.rm = TRUE)) {
|
||||
# all valid AB codes, but not yet right class
|
||||
return(set_clean_class(x,
|
||||
new_class = c("ab", "character")))
|
||||
}
|
||||
if (all(x_nonNA %in% toupper(antibiotics$name), na.rm = TRUE)) {
|
||||
# all valid AB names
|
||||
out <- antibiotics$ab[match(x, toupper(antibiotics$name))]
|
||||
out[is.na(x)] <- NA_character_
|
||||
return(out)
|
||||
}
|
||||
if (all(x_nonNA %in% antibiotics$atc, na.rm = TRUE)) {
|
||||
# all valid ATC codes
|
||||
out <- antibiotics$ab[match(x, antibiotics$atc)]
|
||||
out[is.na(x)] <- NA_character_
|
||||
return(out)
|
||||
}
|
||||
|
||||
# remove diacritics
|
||||
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
|
||||
x <- gsub('"', "", x, fixed = TRUE)
|
||||
x <- gsub("(specimen|specimen date|specimen_date|spec_date)", "", x, ignore.case = TRUE, perl = TRUE)
|
||||
x <- gsub("(specimen|specimen date|specimen_date|spec_date|^dates?$)", "", x, ignore.case = TRUE, perl = TRUE)
|
||||
x_bak_clean <- x
|
||||
if (already_regex == FALSE) {
|
||||
x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
|
||||
@@ -125,18 +148,19 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
}
|
||||
if (length(abnames) > 1) {
|
||||
message_("More than one result was found for item ", index, ": ",
|
||||
paste0(abnames, collapse = ", "))
|
||||
vector_and(abnames, quotes = FALSE))
|
||||
}
|
||||
}
|
||||
found[1L]
|
||||
}
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
progress <- progress_ticker(n = length(x), n_min = ifelse(isTRUE(info), 25, length(x) + 1)) # start if n >= 25
|
||||
progress <- progress_ticker(n = length(x), n_min = 25, print = info) # start if n >= 25
|
||||
on.exit(close(progress))
|
||||
}
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
progress$tick()
|
||||
}
|
||||
@@ -145,21 +169,25 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
next
|
||||
}
|
||||
if (identical(x[i], "") |
|
||||
# no short names:
|
||||
nchar(x[i]) <= 2 |
|
||||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it:
|
||||
identical(tolower(x[i]), "bacteria")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
|
||||
if (isTRUE(flag_multiple_results) & x[i] %like% "[ ]") {
|
||||
if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") {
|
||||
from_text <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]]),
|
||||
error = function(e) character(0))
|
||||
} else {
|
||||
from_text <- character(0)
|
||||
}
|
||||
|
||||
# old code for phenoxymethylpenicillin (Peni V)
|
||||
if (x[i] == "PNV") {
|
||||
x_new[i] <- "PHN"
|
||||
next
|
||||
}
|
||||
|
||||
# exact name
|
||||
found <- antibiotics[which(AB_lookup$generalised_name == x[i]), ]$ab
|
||||
if (length(found) > 0) {
|
||||
@@ -208,7 +236,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
|
||||
# exact abbreviation
|
||||
abbr_found <- unlist(lapply(AB_lookup$generalised_abbreviations,
|
||||
function(s) x[i] %in% s))
|
||||
# require at least 2 characters for abbreviations
|
||||
function(s) x[i] %in% s & nchar(x[i]) >= 2))
|
||||
found <- antibiotics$ab[abbr_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
@@ -268,8 +297,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
}
|
||||
|
||||
# INITIAL SEARCH - More uncertain results ----
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
|
||||
if (initial_search == TRUE && fast_mode == FALSE) {
|
||||
# only run on first try
|
||||
|
||||
# try by removing all spaces
|
||||
@@ -294,10 +323,12 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
x_translated <- paste(lapply(strsplit(x[i], "[^A-Z0-9]"),
|
||||
function(y) {
|
||||
for (i in seq_len(length(y))) {
|
||||
y[i] <- ifelse(tolower(y[i]) %in% tolower(translations_file$replacement),
|
||||
translations_file[which(tolower(translations_file$replacement) == tolower(y[i]) &
|
||||
!isFALSE(translations_file$fixed)), "pattern"],
|
||||
y[i])
|
||||
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
||||
y[i] <- ifelse(tolower(y[i]) %in% tolower(translations_file[, lang, drop = TRUE]),
|
||||
translations_file[which(tolower(translations_file[, lang, drop = TRUE]) == tolower(y[i]) &
|
||||
!isFALSE(translations_file$fixed)), "pattern"],
|
||||
y[i])
|
||||
}
|
||||
}
|
||||
generalise_antibiotic_name(y)
|
||||
})[[1]],
|
||||
@@ -344,7 +375,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
|
||||
# try from a bigger text, like from a health care record, see ?ab_from_text
|
||||
# already calculated above if flag_multiple_results = TRUE
|
||||
if (isTRUE(flag_multiple_results)) {
|
||||
if (flag_multiple_results == TRUE) {
|
||||
found <- from_text[1L]
|
||||
} else {
|
||||
found <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]][1L]),
|
||||
@@ -357,7 +388,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
|
||||
# first 5 except for cephalosporins, then first 7 (those cephalosporins all start quite the same!)
|
||||
found <- suppressWarnings(as.ab(substr(x[i], 1, 5), initial_search = FALSE))
|
||||
if (!is.na(found) && !ab_group(found, initial_search = FALSE) %like% "cephalosporins") {
|
||||
if (!is.na(found) && ab_group(found, initial_search = FALSE) %unlike% "cephalosporins") {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
@@ -438,21 +469,19 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||
if (length(x_unknown_ATCs) > 0) {
|
||||
warning_("These ATC codes are not (yet) in the antibiotics data set: ",
|
||||
paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
vector_and(x_unknown_ATCs), ".",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
if (length(x_unknown) > 0) {
|
||||
if (length(x_unknown) > 0 & fast_mode == FALSE) {
|
||||
warning_("These values could not be coerced to a valid antimicrobial ID: ",
|
||||
paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "),
|
||||
".",
|
||||
vector_and(x_unknown), ".",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %pm>%
|
||||
pm_left_join(data.frame(x = x, x_new = x_new, stringsAsFactors = FALSE), by = "x") %pm>%
|
||||
pm_pull(x_new)
|
||||
pm_pull(x_new)
|
||||
|
||||
if (length(x_result) == 0) {
|
||||
x_result <- NA_character_
|
||||
@@ -521,7 +550,7 @@ as.data.frame.ab <- function(x, ...) {
|
||||
"[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
#' @method [[<- ab
|
||||
#' @export
|
||||
@@ -529,15 +558,16 @@ as.data.frame.ab <- function(x, ...) {
|
||||
"[[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
#' @method c ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.ab <- function(x, ...) {
|
||||
c.ab <- function(...) {
|
||||
x <- list(...)[[1L]]
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
|
||||
}
|
||||
|
||||
#' @method unique ab
|
||||
|
||||
+68
-45
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,12 +20,14 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Antibiotic class selectors
|
||||
#' Antibiotic Class Selectors
|
||||
#'
|
||||
#' These functions help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations.
|
||||
#' These functions help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
|
||||
#' @inheritParams filter_ab_class
|
||||
#' @details \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
|
||||
#'
|
||||
@@ -34,14 +36,14 @@
|
||||
#' @seealso [filter_ab_class()] for the `filter()` equivalent.
|
||||
#' @name antibiotic_class_selectors
|
||||
#' @export
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
|
||||
#' example_isolates[, c(carbapenems())]
|
||||
#' example_isolates[, carbapenems()]
|
||||
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
|
||||
#' example_isolates[, c("mo", aminoglycosides())]
|
||||
#'
|
||||
@@ -78,91 +80,101 @@
|
||||
#' example_isolates %>% filter_carbapenems("R", "all")
|
||||
#' example_isolates %>% filter(across(carbapenems(), ~. == "R"))
|
||||
#' }
|
||||
ab_class <- function(ab_class) {
|
||||
ab_selector(ab_class, function_name = "ab_class")
|
||||
ab_class <- function(ab_class,
|
||||
only_rsi_columns = FALSE) {
|
||||
ab_selector(ab_class, function_name = "ab_class", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
aminoglycosides <- function() {
|
||||
ab_selector("aminoglycoside", function_name = "aminoglycosides")
|
||||
aminoglycosides <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("aminoglycoside", function_name = "aminoglycosides", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
carbapenems <- function() {
|
||||
ab_selector("carbapenem", function_name = "carbapenems")
|
||||
carbapenems <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("carbapenem", function_name = "carbapenems", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins <- function() {
|
||||
ab_selector("cephalosporin", function_name = "cephalosporins")
|
||||
cephalosporins <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporin", function_name = "cephalosporins", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins_1st <- function() {
|
||||
ab_selector("cephalosporins.*1", function_name = "cephalosporins_1st")
|
||||
cephalosporins_1st <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporins.*1", function_name = "cephalosporins_1st", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins_2nd <- function() {
|
||||
ab_selector("cephalosporins.*2", function_name = "cephalosporins_2nd")
|
||||
cephalosporins_2nd <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporins.*2", function_name = "cephalosporins_2nd", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins_3rd <- function() {
|
||||
ab_selector("cephalosporins.*3", function_name = "cephalosporins_3rd")
|
||||
cephalosporins_3rd <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporins.*3", function_name = "cephalosporins_3rd", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins_4th <- function() {
|
||||
ab_selector("cephalosporins.*4", function_name = "cephalosporins_4th")
|
||||
cephalosporins_4th <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporins.*4", function_name = "cephalosporins_4th", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
cephalosporins_5th <- function() {
|
||||
ab_selector("cephalosporins.*5", function_name = "cephalosporins_5th")
|
||||
cephalosporins_5th <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("cephalosporins.*5", function_name = "cephalosporins_5th", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
fluoroquinolones <- function() {
|
||||
ab_selector("fluoroquinolone", function_name = "fluoroquinolones")
|
||||
fluoroquinolones <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("fluoroquinolone", function_name = "fluoroquinolones", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
glycopeptides <- function() {
|
||||
ab_selector("glycopeptide", function_name = "glycopeptides")
|
||||
glycopeptides <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("glycopeptide", function_name = "glycopeptides", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
macrolides <- function() {
|
||||
ab_selector("macrolide", function_name = "macrolides")
|
||||
macrolides <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("macrolide", function_name = "macrolides", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
penicillins <- function() {
|
||||
ab_selector("penicillin", function_name = "penicillins")
|
||||
oxazolidinones <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("oxazolidinone", function_name = "oxazolidinones", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
tetracyclines <- function() {
|
||||
ab_selector("tetracycline", function_name = "tetracyclines")
|
||||
penicillins <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("penicillin", function_name = "penicillins", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
ab_selector <- function(ab_class, function_name) {
|
||||
#' @rdname antibiotic_class_selectors
|
||||
#' @export
|
||||
tetracyclines <- function(only_rsi_columns = FALSE) {
|
||||
ab_selector("tetracycline", function_name = "tetracyclines", only_rsi_columns = only_rsi_columns)
|
||||
}
|
||||
|
||||
ab_selector <- function(ab_class,
|
||||
function_name,
|
||||
only_rsi_columns) {
|
||||
meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(function_name, allow_class = "character", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
|
||||
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2) {
|
||||
warning_("antibiotic class selectors such as ", function_name,
|
||||
@@ -172,7 +184,15 @@ ab_selector <- function(ab_class, function_name) {
|
||||
}
|
||||
|
||||
vars_df <- get_current_data(arg_name = NA, call = -3)
|
||||
ab_in_data <- get_column_abx(vars_df, info = FALSE)
|
||||
|
||||
# improve speed here so it will only run once when e.g. in one select call
|
||||
if (!identical(pkg_env$ab_selector, unique_call_id())) {
|
||||
ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns)
|
||||
pkg_env$ab_selector <- unique_call_id()
|
||||
pkg_env$ab_selector_cols <- ab_in_data
|
||||
} else {
|
||||
ab_in_data <- pkg_env$ab_selector_cols
|
||||
}
|
||||
|
||||
if (length(ab_in_data) == 0) {
|
||||
message_("No antimicrobial agents found.")
|
||||
@@ -196,15 +216,18 @@ ab_selector <- function(ab_class, function_name) {
|
||||
if (length(agents) == 0) {
|
||||
message_("No antimicrobial agents of class ", ab_group, " found", examples, ".")
|
||||
} else {
|
||||
agents_formatted <- paste0("column '", font_bold(agents, collapse = NULL), "'")
|
||||
agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'")
|
||||
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
|
||||
agents_formatted[agents != agents_names] <- paste0(agents_formatted[agents != agents_names],
|
||||
" (", agents_names[agents != agents_names], ")")
|
||||
message_("Selecting ", ab_group, ": ", paste(agents_formatted, collapse = ", "),
|
||||
need_name <- tolower(gsub("[^a-zA-Z]", "", agents)) != tolower(gsub("[^a-zA-Z]", "", agents_names))
|
||||
agents_formatted[need_name] <- paste0(agents_formatted[need_name],
|
||||
" (", agents_names[need_name], ")")
|
||||
message_("Selecting ", ab_group, ": ",
|
||||
ifelse(length(agents) == 1, "column ", "columns "),
|
||||
vector_and(agents_formatted, quotes = FALSE),
|
||||
as_note = FALSE,
|
||||
extra_indent = nchar(paste0("Selecting ", ab_group, ": ")))
|
||||
extra_indent = 6)
|
||||
}
|
||||
remember_thrown_message(function_name)
|
||||
}
|
||||
remember_thrown_message(function_name)
|
||||
}
|
||||
unname(agents)
|
||||
}
|
||||
|
||||
+12
-9
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,25 +20,26 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Retrieve antimicrobial drug names and doses from clinical text
|
||||
#' Retrieve Antimicrobial Drug Names and Doses from Clinical Text
|
||||
#'
|
||||
#' Use this function on e.g. clinical texts from health care records. It returns a [list] with all antimicrobial drugs, doses and forms of administration found in the texts.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param text text to analyse
|
||||
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
|
||||
#' @param collapse character to pass on to `paste(..., collapse = ...)` to only return one character per element of `text`, see *Examples*
|
||||
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search logical to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to [as.ab()]
|
||||
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.ab()] function may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
|
||||
#'
|
||||
#' ## Argument `type`
|
||||
#' At default, the function will search for antimicrobial drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.ab()] internally, it will correct for misspelling.
|
||||
#'
|
||||
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for numeric values that are higher than 100 and do not resemble years. The output will be numeric. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
|
||||
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for [numeric] values that are higher than 100 and do not resemble years. The output will be [numeric]. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
@@ -52,7 +53,7 @@
|
||||
#' `df %>% mutate(abx = ab_from_text(clinical_text, collapse = "|"))`
|
||||
#' @export
|
||||
#' @return A [list], or a [character] if `collapse` is not `NULL`
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # mind the bad spelling of amoxicillin in this line,
|
||||
#' # straight from a true health care record:
|
||||
@@ -92,6 +93,7 @@ ab_from_text <- function(text,
|
||||
collapse = NULL,
|
||||
translate_ab = FALSE,
|
||||
thorough_search = NULL,
|
||||
info = interactive(),
|
||||
...) {
|
||||
if (missing(type)) {
|
||||
type <- type[1L]
|
||||
@@ -102,12 +104,13 @@ ab_from_text <- function(text,
|
||||
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(translate_ab, allow_NULL = FALSE) # get_translate_ab() will be more informative about what's allowed
|
||||
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
type <- tolower(trimws(type))
|
||||
|
||||
text <- tolower(as.character(text))
|
||||
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5)
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
||||
on.exit(close(progress))
|
||||
|
||||
if (type %like% "(drug|ab|anti)") {
|
||||
|
||||
+10
-10
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,22 +20,22 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get properties of an antibiotic
|
||||
#' Get Properties of an Antibiotic
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antibiotic from the [antibiotics] data set. All input values will be evaluated internally with [as.ab()].
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param tolower logical to indicate whether the first character of every output should be transformed to a lower case character. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param property one of the column names of one of the [antibiotics] data set
|
||||
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param units a logical to indicate whether the units instead of the DDDs itself must be returned, see Examples
|
||||
#' @param units a [logical] to indicate whether the units instead of the DDDs itself must be returned, see *Examples*
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... other arguments passed on to [as.ab()]
|
||||
#' @details All output will be [translate]d where possible.
|
||||
#' @details All output [will be translated][translate] where possible.
|
||||
#'
|
||||
#' The function [ab_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
|
||||
#' @inheritSection as.ab Source
|
||||
@@ -48,8 +48,8 @@
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso [antibiotics]
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # all properties:
|
||||
#' ab_name("AMX") # "Amoxicillin"
|
||||
@@ -225,7 +225,7 @@ ab_url <- function(x, open = FALSE, ...) {
|
||||
|
||||
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(ab_atc(ab))]
|
||||
if (length(NAs) > 0) {
|
||||
warning_("No ATC code available for ", paste0(NAs, collapse = ", "), ".")
|
||||
warning_("No ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
}
|
||||
|
||||
if (open == TRUE) {
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,22 +20,22 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Age in years of individuals
|
||||
#' Age in Years of Individuals
|
||||
#'
|
||||
#' Calculates age in years based on a reference date, which is the sytem date at default.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x date(s), will be coerced with [as.POSIXlt()]
|
||||
#' @param reference reference date(s) (defaults to today), will be coerced with [as.POSIXlt()]
|
||||
#' @param exact a logical to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
|
||||
#' @param na.rm a logical to indicate whether missing values should be removed
|
||||
#' @param exact a [logical] to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
|
||||
#' @param na.rm a [logical] to indicate whether missing values should be removed
|
||||
#' @param ... arguments passed on to [as.POSIXlt()], such as `origin`
|
||||
#' @details Ages below 0 will be returned as `NA` with a warning. Ages above 120 will only give a warning.
|
||||
#' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise
|
||||
#' @seealso To split ages into groups, use the [age_groups()] function.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # 10 random birth dates
|
||||
@@ -96,16 +96,16 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
ages
|
||||
}
|
||||
|
||||
#' Split ages into age groups
|
||||
#' Split Ages into Age Groups
|
||||
#'
|
||||
#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x age, e.g. calculated with [age()]
|
||||
#' @param split_at values to split `x` at, defaults to age groups 0-11, 12-24, 25-54, 55-74 and 75+. See Details.
|
||||
#' @param split_at values to split `x` at, defaults to age groups 0-11, 12-24, 25-54, 55-74 and 75+. See *Details*.
|
||||
#' @param na.rm a [logical] to indicate whether missing values should be removed
|
||||
#' @details To split ages, the input for the `split_at` argument can be:
|
||||
#'
|
||||
#' * A numeric vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
|
||||
#' * A [numeric] vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
|
||||
#' The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+).
|
||||
#' * A character:
|
||||
#' - `"children"` or `"kids"`, equivalent of: `c(0, 1, 2, 4, 6, 13, 18)`. This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+.
|
||||
@@ -115,7 +115,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
#' @return Ordered [factor]
|
||||
#' @seealso To determine ages, based on one or more reference dates, use the [age()] function.
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
|
||||
#'
|
||||
@@ -149,8 +149,8 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
#' }
|
||||
#' }
|
||||
age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
|
||||
meet_criteria(x, allow_class = c("numeric", "integer"))
|
||||
meet_criteria(split_at, allow_class = c("numeric", "integer", "character"))
|
||||
meet_criteria(x, allow_class = c("numeric", "integer"), is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(split_at, allow_class = c("numeric", "integer", "character"), is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (any(x < 0, na.rm = TRUE)) {
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' The `AMR` Package
|
||||
@@ -29,7 +29,7 @@
|
||||
#' @details
|
||||
#' `AMR` is a free, open-source and independent \R package 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 antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
||||
#'
|
||||
#' After installing this package, \R knows ~70,000 distinct microbial species and all ~550 antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
|
||||
#' After installing this package, \R knows `r format_included_data_number(microorganisms)` distinct microbial species and all `r format_included_data_number(rbind(antibiotics[, "atc", drop = FALSE], antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
|
||||
#'
|
||||
#' This package is fully independent of any other \R package and works on Windows, macOS and Linux with all versions of \R since R-3.0.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, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This \R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
|
||||
#'
|
||||
@@ -37,7 +37,7 @@
|
||||
#' - Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the Catalogue of Life and List of Prokaryotic names with Standing in Nomenclature
|
||||
#' - Interpreting raw MIC and disk diffusion values, based on the latest CLSI or EUCAST guidelines
|
||||
#' - Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records
|
||||
#' - Determining first isolates to be used for AMR analysis
|
||||
#' - Determining first isolates to be used for AMR data analysis
|
||||
#' - Calculating antimicrobial resistance
|
||||
#' - Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO)
|
||||
#' - Calculating (empirical) susceptibility of both mono therapy and combination therapies
|
||||
@@ -51,10 +51,10 @@
|
||||
#' - Machine reading the EUCAST and CLSI guidelines from 2011-2020 to translate MIC values and disk diffusion diameters to R/SI
|
||||
#' - Principal component analysis for AMR
|
||||
#'
|
||||
#' @section Reference data publicly available:
|
||||
#' @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 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). As we would like to better understand the backgrounds and needs of our users, please [participate in our survey](https://msberends.github.io/AMR/survey.html)!
|
||||
#' @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). As we would like to better understand the backgrounds and needs of our users, please [participate in our survey](https://msberends.github.io/AMR/survey.html)!
|
||||
#' @section Contact Us:
|
||||
#' For suggestions, comments or questions, please contact us at:
|
||||
#'
|
||||
@@ -73,16 +73,3 @@
|
||||
#' @name AMR
|
||||
#' @rdname AMR
|
||||
NULL
|
||||
|
||||
#' Plotting for classes `rsi`, `mic` and `disk`
|
||||
#'
|
||||
#' Functions to print classes of the `AMR` package.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @param ... Arguments passed on to functions
|
||||
#' @inheritParams base::plot
|
||||
#' @inheritParams graphics::barplot
|
||||
#' @name plot
|
||||
#' @rdname plot
|
||||
#' @keywords internal
|
||||
NULL
|
||||
|
||||
+8
-8
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,16 +20,16 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get ATC properties from WHOCC website
|
||||
#' Get ATC Properties from WHOCC Website
|
||||
#'
|
||||
#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic), such as the name, defined daily dose (DDD) or standard unit.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
|
||||
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.
|
||||
#' @param administration type of administration when using `property = "Adm.R"`, see Details
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param atc_code a [character] or [character] vector with ATC code(s) of antibiotic(s)
|
||||
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see *Examples*.
|
||||
#' @param administration type of administration when using `property = "Adm.R"`, see *Details*
|
||||
#' @param url url of website of the WHOCC. The sign `%s` can be used as a placeholder for ATC codes.
|
||||
#' @param url_vet url of website of the WHOCC for veterinary medicine. The sign `%s` can be used as a placeholder for ATC_vet codes (that all start with "Q").
|
||||
#' @param ... arguments to pass on to `atc_property`
|
||||
@@ -61,7 +61,7 @@
|
||||
#' **N.B. This function requires an internet connection and only works if the following packages are installed: `curl`, `rvest`, `xml2`.**
|
||||
#' @export
|
||||
#' @rdname atc_online
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @source <https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
|
||||
+6
-6
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,18 +20,18 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Check availability of columns
|
||||
#' Check Availability of Columns
|
||||
#'
|
||||
#' Easy check for data availability of all columns in a data set. This makes it easy to get an idea of which antimicrobial combinations can be used for calculation with e.g. [susceptibility()] and [resistance()].
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param tbl a [data.frame] or [list]
|
||||
#' @param width number of characters to present the visual availability, defaults to filling the width of the console
|
||||
#' @details The function returns a [data.frame] with columns `"resistant"` and `"visual_resistance"`. The values in that columns are calculated with [resistance()].
|
||||
#' @return [data.frame] with column names of `tbl` as row names
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' availability(example_isolates)
|
||||
@@ -44,7 +44,7 @@
|
||||
#' }
|
||||
availability <- function(tbl, width = NULL) {
|
||||
meet_criteria(tbl, allow_class = "data.frame")
|
||||
meet_criteria(width, allow_class = "numeric", allow_NULL = TRUE)
|
||||
meet_criteria(width, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
x <- vapply(FUN.VALUE = double(1), tbl, function(x) {
|
||||
1 - sum(is.na(x)) / length(x)
|
||||
|
||||
+15
-13
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,19 +20,19 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine bug-drug combinations
|
||||
#' Determine Bug-Drug Combinations
|
||||
#'
|
||||
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publicable/printable format, see Examples.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publicable/printable format, see *Examples*.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param combine_IR logical to indicate whether values R and I should be summed
|
||||
#' @param add_ab_group logical to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant logical to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
|
||||
#' @param translate_ab character of length 1 containing column names of the [antibiotics] data set
|
||||
#' @param combine_IR a [logical] to indicate whether values R and I should be summed
|
||||
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
|
||||
#' @param translate_ab a [character] of length 1 containing column names of the [antibiotics] data set
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams rsi_df
|
||||
#' @inheritParams base::formatC
|
||||
@@ -41,7 +41,7 @@
|
||||
#' @rdname bug_drug_combinations
|
||||
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
|
||||
#' @source \strong{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/>.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' x <- bug_drug_combinations(example_isolates)
|
||||
@@ -69,8 +69,10 @@ bug_drug_combinations <- function(x,
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
} else {
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
}
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
|
||||
x_class <- class(x)
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
@@ -127,7 +129,7 @@ format.bug_drug_combinations <- function(x,
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(add_ab_group, allow_class = "logical", has_length = 1)
|
||||
|
||||
+27
-28
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
format_included_data_number <- function(data) {
|
||||
@@ -44,10 +44,10 @@ format_included_data_number <- function(data) {
|
||||
#' This package contains the complete taxonomic tree of almost all microorganisms from the authoritative and comprehensive Catalogue of Life.
|
||||
#' @section Catalogue of Life:
|
||||
#' \if{html}{\figure{logo_col.png}{options: height=40px style=margin-bottom:5px} \cr}
|
||||
#' This package contains the complete taxonomic tree of almost all microorganisms (~70,000 species) from the authoritative and comprehensive Catalogue of Life (CoL, <http://www.catalogueoflife.org>). The CoL is the most comprehensive and authoritative global index of species currently available. Nonetheless, we supplemented the CoL data with data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, [lpsn.dsmz.de](https://lpsn.dsmz.de)). This supplementation is needed until the [CoL+ project](https://github.com/CatalogueOfLife/general) is finished, which we await.
|
||||
#' This package contains the complete taxonomic tree of almost all microorganisms (`r format_included_data_number(microorganisms)` species) from the authoritative and comprehensive Catalogue of Life (CoL, <http://www.catalogueoflife.org>). The CoL is the most comprehensive and authoritative global index of species currently available. Nonetheless, we supplemented the CoL data with data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, [lpsn.dsmz.de](https://lpsn.dsmz.de)). This supplementation is needed until the [CoL+ project](https://github.com/CatalogueOfLife/general) is finished, which we await.
|
||||
#'
|
||||
#' [Click here][catalogue_of_life] for more information about the included taxa. Check which versions of the CoL and LSPN were included in this package with [catalogue_of_life_version()].
|
||||
#' @section Included taxa:
|
||||
#' [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*).
|
||||
@@ -59,7 +59,7 @@ format_included_data_number <- function(data) {
|
||||
#' The Catalogue of Life (<http://www.catalogueoflife.org>) is the most comprehensive and authoritative global index of species currently available. It holds essential information on the names, relationships and distributions of over 1.9 million species. The Catalogue of Life is used to support the major biodiversity and conservation information services such as the Global Biodiversity Information Facility (GBIF), Encyclopedia of Life (EoL) and the International Union for Conservation of Nature Red List. It is recognised by the Convention on Biological Diversity as a significant component of the Global Taxonomy Initiative and a contribution to Target 1 of the Global Strategy for Plant Conservation.
|
||||
#'
|
||||
#' The syntax used to transform the original data to a cleansed \R format, can be found here: <https://github.com/msberends/AMR/blob/master/data-raw/reproduction_of_microorganisms.R>.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @name catalogue_of_life
|
||||
#' @rdname catalogue_of_life
|
||||
#' @seealso Data set [microorganisms] for the actual data. \cr
|
||||
@@ -99,25 +99,25 @@ NULL
|
||||
#'
|
||||
#' This function returns information about the included data from the Catalogue of Life.
|
||||
#' @seealso [microorganisms]
|
||||
#' @details For DSMZ, see [microorganisms].
|
||||
#' @details For LPSN, see [microorganisms].
|
||||
#' @return a [list], which prints in pretty format
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
catalogue_of_life_version <- function() {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# see the `catalogue_of_life` list in R/data.R
|
||||
lst <- list(catalogue_of_life =
|
||||
list(version = gsub("{year}", catalogue_of_life$year, catalogue_of_life$version, fixed = TRUE),
|
||||
url = gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE),
|
||||
# see the `CATALOGUE_OF_LIFE` list in R/globals.R
|
||||
lst <- list(CoL =
|
||||
list(version = gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$version, fixed = TRUE),
|
||||
url = gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$url_CoL, fixed = TRUE),
|
||||
n = nrow(pm_filter(microorganisms, source == "CoL"))),
|
||||
deutsche_sammlung_von_mikroorganismen_und_zellkulturen =
|
||||
list(version = "Prokaryotic Nomenclature Up-to-Date from DSMZ",
|
||||
url = catalogue_of_life$url_DSMZ,
|
||||
yearmonth = catalogue_of_life$yearmonth_DSMZ,
|
||||
n = nrow(pm_filter(microorganisms, source == "DSMZ"))),
|
||||
LPSN =
|
||||
list(version = "List of Prokaryotic names with Standing in Nomenclature",
|
||||
url = CATALOGUE_OF_LIFE$url_LPSN,
|
||||
yearmonth = CATALOGUE_OF_LIFE$yearmonth_LPSN,
|
||||
n = nrow(pm_filter(microorganisms, source == "LPSN"))),
|
||||
total_included =
|
||||
list(
|
||||
n_total_species = nrow(microorganisms),
|
||||
@@ -131,16 +131,15 @@ catalogue_of_life_version <- function() {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.catalogue_of_life_version <- function(x, ...) {
|
||||
lst <- x
|
||||
cat(paste0(font_bold("Included in this AMR package are:\n\n"),
|
||||
font_underline(lst$catalogue_of_life$version), "\n",
|
||||
" Available at: ", lst$catalogue_of_life$url, "\n",
|
||||
" Number of included species: ", format(lst$catalogue_of_life$n, big.mark = ","), "\n",
|
||||
font_underline(paste0(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$version, " (",
|
||||
lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
|
||||
" Available at: ", lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$url, "\n",
|
||||
" Number of included species: ", format(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$n, big.mark = ","), "\n\n",
|
||||
"=> Total number of species included: ", format(lst$total_included$n_total_species, big.mark = ","), "\n",
|
||||
"=> Total number of synonyms included: ", format(lst$total_included$n_total_synonyms, big.mark = ","), "\n\n",
|
||||
cat(paste0(font_bold("Included in this AMR package (v", utils::packageDescription("AMR")$Version, ") are:\n\n", collapse = ""),
|
||||
font_underline(x$CoL$version), "\n",
|
||||
" Available at: ", font_blue(x$CoL$url), "\n",
|
||||
" Number of included microbial species: ", format(x$CoL$n, big.mark = ","), "\n",
|
||||
font_underline(paste0(x$LPSN$version, " (",
|
||||
x$LPSN$yearmonth, ")")), "\n",
|
||||
" Available at: ", font_blue(x$LPSN$url), "\n",
|
||||
" Number of included bacterial species: ", format(x$LPSN$n, big.mark = ","), "\n\n",
|
||||
"=> Total number of species included: ", format(x$total_included$n_total_species, big.mark = ","), "\n",
|
||||
"=> Total number of synonyms included: ", format(x$total_included$n_total_synonyms, big.mark = ","), "\n\n",
|
||||
"See for more info ?microorganisms and ?catalogue_of_life.\n"))
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,15 +20,15 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Count available isolates
|
||||
#' Count Available Isolates
|
||||
#'
|
||||
#' @description These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, please see *Examples*.
|
||||
#' @description These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
|
||||
#'
|
||||
#' [count_resistant()] should be used to count resistant isolates, [count_susceptible()] should be used to count susceptible isolates.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed.
|
||||
#' @inheritParams proportion
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
@@ -39,13 +39,13 @@
|
||||
#' The function [n_rsi()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antibiotics have an available result (S, I or R). Their use is equal to `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`.
|
||||
#'
|
||||
#' The function [count_df()] takes any variable from `data` that has an [`rsi`] class (created with [as.rsi()]) and counts the number of S's, I's and R's. It also supports grouped variables. The function [rsi_df()] works exactly like [count_df()], but adds the percentage of S, I and R.
|
||||
#' @inheritSection proportion Combination therapy
|
||||
#' @inheritSection proportion Combination Therapy
|
||||
#' @seealso [`proportion_*`][proportion] to calculate microbial resistance and susceptibility.
|
||||
#' @return An [integer]
|
||||
#' @rdname count
|
||||
#' @name count
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' ?example_isolates
|
||||
|
||||
@@ -0,0 +1,254 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Define Custom EUCAST Rules
|
||||
#'
|
||||
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
|
||||
#' @inheritSection lifecycle Maturing Lifecycle
|
||||
#' @param ... rules in formula 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:
|
||||
#'
|
||||
#' ### Basics
|
||||
#'
|
||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" ~ aminopenicillins == "R")
|
||||
#' ```
|
||||
#'
|
||||
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
|
||||
#'
|
||||
#' ```
|
||||
#' x
|
||||
#' #> A set of custom EUCAST rules:
|
||||
#' #>
|
||||
#' #> 1. If TZP is S then set to S:
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' #>
|
||||
#' #> 2. If TZP is R then set to R:
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' ```
|
||||
#'
|
||||
#' The rules (the part *before* the tilde, in above example `TZP == "S"` and `TZP == "R"`) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column `TZP` must exist. We will create a sample data set and test the rules set:
|
||||
#'
|
||||
#' ```
|
||||
#' df <- data.frame(mo = c("E. coli", "K. pneumoniae"),
|
||||
#' TZP = "R",
|
||||
#' amox = "",
|
||||
#' AMP = "")
|
||||
#' df
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R
|
||||
#' #> 2 K. pneumoniae R
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = x)
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R R R
|
||||
#' #> 2 K. pneumoniae R R R
|
||||
#' ```
|
||||
#'
|
||||
#' ### Using taxonomic properties in rules
|
||||
#'
|
||||
#' There is one exception in variables used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), quote = "``", sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#'
|
||||
#' ```
|
||||
#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = y)
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R
|
||||
#' #> 2 K. pneumoniae R R R
|
||||
#' ```
|
||||
#'
|
||||
#' ### Usage of antibiotic group names
|
||||
#'
|
||||
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the antibiotic agents that will be matched when running the rule.
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("``", tolower(x), "``\\cr(", paste0(sort(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE)), collapse = ", "), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' @returns A [list] containing the custom rules
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
|
||||
#' eucast_rules(example_isolates,
|
||||
#' rules = "custom",
|
||||
#' custom_rules = x,
|
||||
#' info = FALSE)
|
||||
#'
|
||||
#' # combine rule sets
|
||||
#' x2 <- c(x,
|
||||
#' custom_eucast_rules(TZP == "R" ~ carbapenems == "R"))
|
||||
#' x2
|
||||
custom_eucast_rules <- function(...) {
|
||||
|
||||
dots <- tryCatch(list(...),
|
||||
error = function(e) "error")
|
||||
stop_if(identical(dots, "error"),
|
||||
"rules must be a valid formula inputs (e.g., using '~'), see `?custom_eucast_rules`")
|
||||
n_dots <- length(dots)
|
||||
stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?custom_eucast_rules`.")
|
||||
out <- vector("list", n_dots)
|
||||
for (i in seq_len(n_dots)) {
|
||||
stop_ifnot(inherits(dots[[i]], "formula"),
|
||||
"rule ", i, " must be a valid formula input (e.g., using '~'), see `?custom_eucast_rules`")
|
||||
|
||||
# Query
|
||||
qry <- dots[[i]][[2]]
|
||||
if (inherits(qry, "call")) {
|
||||
qry <- as.expression(qry)
|
||||
}
|
||||
qry <- as.character(qry)
|
||||
# these will prevent vectorisation, so replace them:
|
||||
qry <- gsub("&&", "&", qry, fixed = TRUE)
|
||||
qry <- gsub("||", "|", qry, fixed = TRUE)
|
||||
# format nicely, setting spaces around operators
|
||||
qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
|
||||
qry <- gsub(" ?, ?", ", ", qry)
|
||||
qry <- gsub("'", "\"", qry, fixed = TRUE)
|
||||
out[[i]]$query <- as.expression(qry)
|
||||
|
||||
# Resulting rule
|
||||
result <- dots[[i]][[3]]
|
||||
stop_ifnot(deparse(result) %like% "==",
|
||||
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`")
|
||||
result_group <- as.character(result)[[2]]
|
||||
if (paste0(toupper(result_group), "S") %in% DEFINED_AB_GROUPS) {
|
||||
# support for e.g. 'aminopenicillin' if user meant 'aminopenicillins'
|
||||
result_group <- paste0(result_group, "s")
|
||||
}
|
||||
if (toupper(result_group) %in% DEFINED_AB_GROUPS) {
|
||||
result_group <- eval(parse(text = toupper(result_group)), envir = asNamespace("AMR"))
|
||||
} else {
|
||||
result_group <- tryCatch(
|
||||
suppressWarnings(as.ab(result_group,
|
||||
fast_mode = TRUE,
|
||||
info = FALSE,
|
||||
flag_multiple_results = FALSE)),
|
||||
error = function(e) NA_character_)
|
||||
}
|
||||
|
||||
stop_if(any(is.na(result_group)),
|
||||
"this result of rule ", i, " could not be translated to a single antimicrobial agent/group: \"",
|
||||
as.character(result)[[2]], "\".\n\nThe input can be a name or code of an antimicrobial agent, or be one of: ",
|
||||
vector_or(tolower(DEFINED_AB_GROUPS), quotes = FALSE), ".")
|
||||
result_value <- as.character(result)[[3]]
|
||||
result_value[result_value == "NA"] <- NA
|
||||
stop_ifnot(result_value %in% c("R", "S", "I", NA),
|
||||
"the resulting value of rule ", i, " must be either \"R\", \"S\", \"I\" or NA")
|
||||
result_value <- as.rsi(result_value)
|
||||
|
||||
out[[i]]$result_group <- result_group
|
||||
out[[i]]$result_value <- result_value
|
||||
}
|
||||
|
||||
names(out) <- paste0("rule", seq_len(n_dots))
|
||||
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||
}
|
||||
|
||||
#' @method c custom_eucast_rules
|
||||
#' @noRd
|
||||
#' @export
|
||||
c.custom_eucast_rules <- function(x, ...) {
|
||||
if (length(list(...)) == 0) {
|
||||
return(x)
|
||||
}
|
||||
out <- unclass(x)
|
||||
for (e in list(...)) {
|
||||
out <- c(out, unclass(e))
|
||||
}
|
||||
names(out) <- paste0("rule", seq_len(length(out)))
|
||||
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||
}
|
||||
|
||||
#' @method as.list custom_eucast_rules
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.list.custom_eucast_rules <- function(x, ...) {
|
||||
c(x, ...)
|
||||
}
|
||||
|
||||
#' @method print custom_eucast_rules
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.custom_eucast_rules <- function(x, ...) {
|
||||
cat("A set of custom EUCAST rules:\n")
|
||||
for (i in seq_len(length(x))) {
|
||||
rule <- x[[i]]
|
||||
rule$query <- format_custom_query_rule(rule$query)
|
||||
if (rule$result_value == "R") {
|
||||
val <- font_rsi_R_bg(font_black(" R "))
|
||||
} else if (rule$result_value == "S") {
|
||||
val <- font_rsi_S_bg(font_black(" S "))
|
||||
} else {
|
||||
val <- font_rsi_I_bg(font_black(" I "))
|
||||
}
|
||||
agents <- paste0(font_blue(ab_name(rule$result_group, language = NULL, tolower = TRUE),
|
||||
collapse = NULL),
|
||||
" (", rule$result_group, ")")
|
||||
agents <- sort(agents)
|
||||
rule_if <- word_wrap(paste0(i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
||||
"set to {result}:"),
|
||||
extra_indent = 5)
|
||||
rule_if <- gsub("{result}", val, rule_if, fixed = TRUE)
|
||||
rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5))
|
||||
cat("\n ", rule_if, "\n", rule_then, "\n", sep = "")
|
||||
}
|
||||
}
|
||||
|
||||
format_custom_query_rule <- function(query, colours = has_colour()) {
|
||||
query <- gsub(" & ", font_black(font_bold(" and ")), query, fixed = TRUE)
|
||||
query <- gsub(" | ", font_black(" or "), query, fixed = TRUE)
|
||||
query <- gsub(" + ", font_black(" plus "), query, fixed = TRUE)
|
||||
query <- gsub(" - ", font_black(" minus "), query, fixed = TRUE)
|
||||
query <- gsub(" / ", font_black(" divided by "), query, fixed = TRUE)
|
||||
query <- gsub(" * ", font_black(" times "), query, fixed = TRUE)
|
||||
query <- gsub(" == ", font_black(" is "), query, fixed = TRUE)
|
||||
query <- gsub(" > ", font_black(" is higher than "), query, fixed = TRUE)
|
||||
query <- gsub(" < ", font_black(" is lower than "), query, fixed = TRUE)
|
||||
query <- gsub(" >= ", font_black(" is higher than or equal to "), query, fixed = TRUE)
|
||||
query <- gsub(" <= ", font_black(" is lower than or equal to "), query, fixed = TRUE)
|
||||
query <- gsub(" ^ ", font_black(" to the power of "), query, fixed = TRUE)
|
||||
query <- gsub(" %in% ", font_black(" is one of "), query, fixed = TRUE)
|
||||
query <- gsub(" %like% ", font_black(" resembles "), query, fixed = TRUE)
|
||||
if (colours == TRUE) {
|
||||
query <- gsub('"R"', font_rsi_R_bg(font_black(" R ")), query, fixed = TRUE)
|
||||
query <- gsub('"S"', font_rsi_S_bg(font_black(" S ")), query, fixed = TRUE)
|
||||
query <- gsub('"I"', font_rsi_I_bg(font_black(" I ")), query, fixed = TRUE)
|
||||
}
|
||||
# replace the black colour 'stops' with blue colour 'starts'
|
||||
query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE)
|
||||
# start with blue
|
||||
query <- paste0("\033[34m", query)
|
||||
if (colours == FALSE) {
|
||||
query <- font_stripstyle(query)
|
||||
}
|
||||
query
|
||||
}
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,14 +20,14 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Data sets with `r format(nrow(antibiotics) + nrow(antivirals), big.mark = ",")` antimicrobials
|
||||
#' Data Sets with `r format(nrow(antibiotics) + nrow(antivirals), big.mark = ",")` Antimicrobials
|
||||
#'
|
||||
#' Two data sets containing all antibiotics/antimycotics and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antibiotics] data set. Three identifiers are included in this data set: an antibiotic ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes.
|
||||
#' @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 [data.frame] with `r nrow(antibiotics)` observations and `r ncol(antibiotics)` variables:
|
||||
#' - `ab`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
#' - `atc`\cr ATC code (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02`
|
||||
#' - `cid`\cr Compound ID as found in PubChem
|
||||
@@ -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 [data.frame] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
|
||||
#' - `atc`\cr ATC code (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
|
||||
@@ -57,7 +57,7 @@
|
||||
#'
|
||||
#' Synonyms (i.e. trade names) are derived from the Compound ID (`cid`) and consequently only available where a CID is available.
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' ## 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/master/data-raw/antibiotics.txt>
|
||||
@@ -72,18 +72,18 @@
|
||||
#' WHONET 2019 software: <http://www.whonet.org/software.html>
|
||||
#'
|
||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <http://ec.europa.eu/health/documents/community-register/html/atc.htm>
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @seealso [microorganisms], [intrinsic_resistant]
|
||||
"antibiotics"
|
||||
|
||||
#' @rdname antibiotics
|
||||
"antivirals"
|
||||
|
||||
#' Data set with `r format(nrow(microorganisms), big.mark = ",")` microorganisms
|
||||
#' Data Set with `r format(nrow(microorganisms), big.mark = ",")` Microorganisms
|
||||
#'
|
||||
#' A data set containing the microbial taxonomy of six kingdoms from the Catalogue of Life. MO codes can be looked up using [as.mo()].
|
||||
#' A data set containing the microbial taxonomy, last updated in `r CATALOGUE_OF_LIFE$yearmonth_LPSN`, of six 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:
|
||||
#' - `mo`\cr ID of microorganism as used by this package
|
||||
@@ -92,10 +92,17 @@
|
||||
#' - `rank`\cr Text of the taxonomic rank of the microorganism, like `"species"` or `"genus"`
|
||||
#' - `ref`\cr Author(s) and year of concerning scientific publication
|
||||
#' - `species_id`\cr ID of the species as used by the Catalogue of Life
|
||||
#' - `source`\cr Either "CoL", "DSMZ" (see Source) or "manually added"
|
||||
#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
|
||||
#' - `prevalence`\cr Prevalence of the microorganism, see [as.mo()]
|
||||
#' - `snomed`\cr SNOMED code of the microorganism. Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
|
||||
#' @details Manually added were:
|
||||
#' - `snomed`\cr Systematized Nomenclature of Medicine (SNOMED) code of the microorganism, according to the `r SNOMED_VERSION$current_source` (see *Source*). Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
|
||||
#' @details
|
||||
#' Please note that entries are only based on the Catalogue of Life and the LPSN (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
|
||||
#'
|
||||
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the `AMR` package returns 2007 for `mo_year("S. pettenkoferi")`.
|
||||
#'
|
||||
#' ## Manual additions
|
||||
#' For convenience, some entries were added manually:
|
||||
#'
|
||||
#' - 11 entries of *Streptococcus* (beta-haemolytic: groups A, B, C, D, F, G, H, K and unspecified; other: viridans, milleri)
|
||||
#' - 2 entries of *Staphylococcus* (coagulase-negative (CoNS) and coagulase-positive (CoPS))
|
||||
#' - 3 entries of *Trichomonas* (*Trichomonas vaginalis*, and its family and genus)
|
||||
@@ -103,9 +110,8 @@
|
||||
#' - 1 entry of *Blastocystis* (*Blastocystis hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
|
||||
#' - 5 other 'undefined' entries (unknown, unknown Gram negatives, unknown Gram positives, unknown yeast and unknown fungus)
|
||||
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not (yet) in the Catalogue of Life
|
||||
#' - `r format(nrow(subset(microorganisms, source == "DSMZ")), big.mark = ",")` species from the DSMZ (Deutsche Sammlung von Mikroorganismen und Zellkulturen) since the DSMZ contain the latest taxonomic information based on recent publications
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' ## 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/master/data-raw/microorganisms.txt>
|
||||
@@ -113,30 +119,31 @@
|
||||
#' The file in \R format (with preserved data structure) can be found here:
|
||||
#'
|
||||
#' * <https://github.com/msberends/AMR/raw/master/data/microorganisms.rda>
|
||||
#' @section About the records from DSMZ (see source):
|
||||
#' Names of prokaryotes are defined as being validly published by the International Code of Nomenclature of Bacteria. Validly published are all names which are included in the Approved Lists of Bacterial Names and the names subsequently published in the International Journal of Systematic Bacteriology (IJSB) and, from January 2000, in the International Journal of Systematic and Evolutionary Microbiology (IJSEM) as original articles or in the validation lists.
|
||||
#' *(from <https://www.dsmz.de/services/online-tools/prokaryotic-nomenclature-up-to-date>)*
|
||||
#' @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.
|
||||
#'
|
||||
#' In February 2020, the DSMZ records were merged with the List of Prokaryotic names with Standing in Nomenclature (LPSN).
|
||||
#' @source Catalogue of Life: Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org> (check included annual version with [catalogue_of_life_version()]).
|
||||
#' As of February 2020, the regularly augmented LPSN database at DSMZ is the basis of the new LPSN service. The new database was implemented for the Type-Strain Genome Server and augmented in 2018 to store all kinds of nomenclatural information. Data from the previous version of LPSN and from the Prokaryotic Nomenclature Up-to-date (PNU) service were imported into the new system. PNU had been established in 1993 as a service of the Leibniz Institute DSMZ, and was curated by Norbert Weiss, Manfred Kracht and Dorothea Gleim.
|
||||
#' @source
|
||||
#' `r gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$version, fixed = TRUE)` as currently implemented in this `AMR` package:
|
||||
#'
|
||||
#' 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}
|
||||
#'
|
||||
#' Leibniz Institute DSMZ-German Collection of Microorganisms and Cell Cultures, Germany, Prokaryotic Nomenclature Up-to-Date, <https://www.dsmz.de/services/online-tools/prokaryotic-nomenclature-up-to-date> and <https://lpsn.dsmz.de> (check included version with [catalogue_of_life_version()]).
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' * Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org>
|
||||
#'
|
||||
#' List of Prokaryotic names with Standing in Nomenclature (`r CATALOGUE_OF_LIFE$yearmonth_LPSN`) as currently implemented in this `AMR` package:
|
||||
#'
|
||||
#' * Parte, A.C., Sarda Carbasse, J., Meier-Kolthoff, J.P., Reimer, L.C. and Goker, M. (2020). List of Prokaryotic names with Standing in Nomenclature (LPSN) moves to the DSMZ. International Journal of Systematic and Evolutionary Microbiology, 70, 5607-5612; \doi{10.1099/ijsem.0.004332}
|
||||
#' * 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}
|
||||
#' * Parte, A.C. (2014). LPSN — List of Prokaryotic names with Standing in Nomenclature. Nucleic Acids Research, 42, Issue D1, D613–D616; \doi{10.1093/nar/gkt1111}
|
||||
#' * Euzeby, J.P. (1997). List of Bacterial Names with Standing in Nomenclature: a Folder Available on the Internet. International Journal of Systematic Bacteriology, 47, 590-592; \doi{10.1099/00207713-47-2-590}
|
||||
#'
|
||||
#' `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
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
|
||||
"microorganisms"
|
||||
|
||||
catalogue_of_life <- list(
|
||||
year = 2019,
|
||||
version = "Catalogue of Life: {year} Annual Checklist",
|
||||
url_CoL = "http://www.catalogueoflife.org/col/",
|
||||
url_DSMZ = "https://lpsn.dsmz.de",
|
||||
yearmonth_DSMZ = "May 2020"
|
||||
)
|
||||
|
||||
#' Data set with previously accepted taxonomic names
|
||||
#' 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
|
||||
@@ -148,55 +155,55 @@ catalogue_of_life <- list(
|
||||
#' @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
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @seealso [as.mo()] [mo_property()] [microorganisms]
|
||||
"microorganisms.old"
|
||||
|
||||
#' Data set with `r format(nrow(microorganisms.codes), big.mark = ",")` common microorganism codes
|
||||
#' 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:
|
||||
#' - `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
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @seealso [as.mo()] [microorganisms]
|
||||
"microorganisms.codes"
|
||||
|
||||
#' Data set with `r format(nrow(example_isolates), big.mark = ",")` example isolates
|
||||
#' 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 analysis. For examples, please read [the tutorial on our website](https://msberends.github.io/AMR/articles/AMR.html).
|
||||
#' 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
|
||||
#' - `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
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
"example_isolates"
|
||||
|
||||
#' Data set with unclean data
|
||||
#' 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 analysis. This data set can be used for practice.
|
||||
#' 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:
|
||||
#' - `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
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
"example_isolates_unclean"
|
||||
|
||||
#' Data set with `r format(nrow(WHONET), big.mark = ",")` isolates - WHONET example
|
||||
#' 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:
|
||||
@@ -210,8 +217,8 @@ catalogue_of_life <- list(
|
||||
#' - `Sex`\cr Fictitious gender of patient
|
||||
#' - `Age`\cr Fictitious age of patient
|
||||
#' - `Age category`\cr Age group, can also be looked up using [age_groups()]
|
||||
#' - `Date of admission`\cr Date of hospital admission
|
||||
#' - `Specimen date`\cr Date when specimen was received at laboratory
|
||||
#' - `Date of admission`\cr [Date] of hospital admission
|
||||
#' - `Specimen date`\cr [Date] when specimen was received at laboratory
|
||||
#' - `Specimen type`\cr Specimen type or group
|
||||
#' - `Specimen type (Numeric)`\cr Translation of `"Specimen type"`
|
||||
#' - `Reason`\cr Reason of request with Differential Diagnosis
|
||||
@@ -224,18 +231,18 @@ catalogue_of_life <- list(
|
||||
#' - `MRSA screening test`\cr Microorganism is possible MRSA?
|
||||
#' - `Inducible clindamycin resistance`\cr Clindamycin can be induced?
|
||||
#' - `Comment`\cr Other comments
|
||||
#' - `Date of data entry`\cr Date this data was entered in WHONET
|
||||
#' - `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
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
"WHONET"
|
||||
|
||||
#' Data set for R/SI interpretation
|
||||
#' Data Set for R/SI Interpretation
|
||||
#'
|
||||
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are 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)))`) and 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)))`). 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:
|
||||
#' - `guideline`\cr Name of the guideline
|
||||
#' - `method`\cr Either "MIC" or "DISK"
|
||||
#' - `method`\cr Either `r vector_or(rsi_translation$method)`
|
||||
#' - `site`\cr Body site, e.g. "Oral" or "Respiratory"
|
||||
#' - `mo`\cr Microbial ID, see [as.mo()]
|
||||
#' - `ab`\cr Antibiotic ID, see [as.ab()]
|
||||
@@ -243,14 +250,14 @@ catalogue_of_life <- list(
|
||||
#' - `disk_dose`\cr Dose of the used disk diffusion method
|
||||
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
|
||||
#' - `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)
|
||||
#' - `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/master/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.
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @seealso [intrinsic_resistant]
|
||||
"rsi_translation"
|
||||
|
||||
#' Data set with bacterial intrinsic resistance
|
||||
#' 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:
|
||||
@@ -259,8 +266,8 @@ catalogue_of_life <- list(
|
||||
#' @details The repository of this `AMR` package contains a file comprising this exact data set: <https://github.com/msberends/AMR/blob/master/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.
|
||||
#'
|
||||
#' This data set is based on `r format_eucast_version_nr(3.2)`.
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' if (require("dplyr")) {
|
||||
#' intrinsic_resistant %>%
|
||||
@@ -269,3 +276,21 @@ catalogue_of_life <- list(
|
||||
#' # [1] "Enterococcus casseliflavus" "Enterococcus gallinarum"
|
||||
#' }
|
||||
"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:
|
||||
#' - `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)`
|
||||
#' - `dose`\cr Dose, such as "2 g" or "25 mg/kg"
|
||||
#' - `dose_times`\cr Number of times a dose must be administered
|
||||
#' - `administration`\cr Route of administration, either `r vector_or(dosage$administration)`
|
||||
#' - `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
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
"dosage"
|
||||
|
||||
+98
-5
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,14 +20,14 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Deprecated functions
|
||||
#' Deprecated Functions
|
||||
#'
|
||||
#' These functions are so-called '[Deprecated]'. They will be removed in a future release. Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
|
||||
#' @inheritSection lifecycle Retired lifecycle
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection lifecycle Retired Lifecycle
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @keywords internal
|
||||
#' @name AMR-deprecated
|
||||
#' @export
|
||||
@@ -45,3 +45,96 @@ p_symbol <- function(p, emptychar = " ") {
|
||||
|
||||
s
|
||||
}
|
||||
|
||||
#' @name AMR-deprecated
|
||||
#' @export
|
||||
filter_first_weighted_isolate <- function(x = NULL,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
...) {
|
||||
|
||||
.Deprecated(old = "filter_first_weighted_isolate()",
|
||||
new = "filter_first_isolate()",
|
||||
package = "AMR")
|
||||
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
|
||||
filter_first_isolate(x = x, col_date = col_date, col_patient_id = col_patient_id, col_mo = col_mo, ...)
|
||||
}
|
||||
|
||||
#' @name AMR-deprecated
|
||||
#' @export
|
||||
key_antibiotics <- function(x = NULL,
|
||||
col_mo = NULL,
|
||||
universal_1 = guess_ab_col(x, "amoxicillin"),
|
||||
universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
|
||||
universal_3 = guess_ab_col(x, "cefuroxime"),
|
||||
universal_4 = guess_ab_col(x, "piperacillin/tazobactam"),
|
||||
universal_5 = guess_ab_col(x, "ciprofloxacin"),
|
||||
universal_6 = guess_ab_col(x, "trimethoprim/sulfamethoxazole"),
|
||||
GramPos_1 = guess_ab_col(x, "vancomycin"),
|
||||
GramPos_2 = guess_ab_col(x, "teicoplanin"),
|
||||
GramPos_3 = guess_ab_col(x, "tetracycline"),
|
||||
GramPos_4 = guess_ab_col(x, "erythromycin"),
|
||||
GramPos_5 = guess_ab_col(x, "oxacillin"),
|
||||
GramPos_6 = guess_ab_col(x, "rifampin"),
|
||||
GramNeg_1 = guess_ab_col(x, "gentamicin"),
|
||||
GramNeg_2 = guess_ab_col(x, "tobramycin"),
|
||||
GramNeg_3 = guess_ab_col(x, "colistin"),
|
||||
GramNeg_4 = guess_ab_col(x, "cefotaxime"),
|
||||
GramNeg_5 = guess_ab_col(x, "ceftazidime"),
|
||||
GramNeg_6 = guess_ab_col(x, "meropenem"),
|
||||
warnings = TRUE,
|
||||
...) {
|
||||
|
||||
.Deprecated(old = "key_antibiotics()",
|
||||
new = "key_antimicrobials()",
|
||||
package = "AMR")
|
||||
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
|
||||
key_antimicrobials(x = x,
|
||||
col_mo = col_mo,
|
||||
universal = c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6),
|
||||
gram_negative = c(GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6),
|
||||
gram_positive = c(GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6),
|
||||
antifungal = NULL,
|
||||
only_rsi_columns = FALSE,
|
||||
...)
|
||||
}
|
||||
|
||||
#' @name AMR-deprecated
|
||||
#' @export
|
||||
key_antibiotics_equal <- function(y,
|
||||
z,
|
||||
type = "keyantimicrobials",
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = FALSE,
|
||||
na.rm = TRUE,
|
||||
...) {
|
||||
|
||||
.Deprecated(old = "key_antibiotics_equal()",
|
||||
new = "antimicrobials_equal()",
|
||||
package = "AMR")
|
||||
|
||||
antimicrobials_equal(y = y,
|
||||
z = z,
|
||||
type = type,
|
||||
ignore_I = ignore_I,
|
||||
points_threshold = points_threshold,
|
||||
info = info)
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,22 +20,22 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform input to disk diffusion diameters
|
||||
#' Transform Input to Disk Diffusion Diameters
|
||||
#'
|
||||
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @rdname as.disk
|
||||
#' @param x vector
|
||||
#' @param na.rm a logical indicating whether missing values should be removed
|
||||
#' @param na.rm a [logical] indicating whether missing values should be removed
|
||||
#' @details Interpret disk values as RSI values with [as.rsi()]. It supports guidelines from EUCAST and CLSI.
|
||||
#' @return An [integer] with additional class [`disk`]
|
||||
#' @aliases disk
|
||||
#' @export
|
||||
#' @seealso [as.rsi()]
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' # transform existing disk zones to the `disk` class
|
||||
@@ -61,7 +61,7 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (!is.disk(x)) {
|
||||
x <- x %pm>% unlist()
|
||||
x <- unlist(x)
|
||||
if (na.rm == TRUE) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
@@ -98,8 +98,8 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak)] %pm>%
|
||||
unique() %pm>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
@@ -145,30 +145,6 @@ print.disk <- function(x, ...) {
|
||||
print(as.integer(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @method plot disk
|
||||
#' @export
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @rdname plot
|
||||
plot.disk <- function(x,
|
||||
main = paste("Disk zones values of", deparse(substitute(x))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion (mm)",
|
||||
axes = FALSE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(axes, allow_class = "logical", has_length = 1)
|
||||
|
||||
barplot(table(x),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
axes = axes,
|
||||
main = main,
|
||||
...)
|
||||
axis(2, seq(0, max(table(x))))
|
||||
}
|
||||
|
||||
#' @method [ disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
@@ -206,11 +182,8 @@ plot.disk <- function(x,
|
||||
#' @method c disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.disk <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
y <- as.disk(y)
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
c.disk <- function(...) {
|
||||
as.disk(unlist(lapply(list(...), as.character)))
|
||||
}
|
||||
|
||||
#' @method unique disk
|
||||
@@ -229,7 +202,7 @@ get_skimmers.disk <- function(column) {
|
||||
min = ~min(as.double(.), na.rm = TRUE),
|
||||
max = ~max(as.double(.), na.rm = TRUE),
|
||||
median = ~stats::median(as.double(.), na.rm = TRUE),
|
||||
n_unique = ~pm_n_distinct(., na.rm = TRUE),
|
||||
n_unique = ~length(unique(stats::na.omit(.))),
|
||||
hist = ~skimr::inline_hist(stats::na.omit(as.double(.)))
|
||||
)
|
||||
}
|
||||
|
||||
+31
-22
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,39 +20,44 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine (new) episodes for patients
|
||||
#' Determine (New) Episodes for Patients
|
||||
#'
|
||||
#' These functions determine which items in a vector can be considered (the start of) a new episode, based on the argument `episode_days`. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns values `TRUE`/`FALSE` to indicate whether an item in a vector is the start of a new episode.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x vector of dates (class `Date` or `POSIXt`)
|
||||
#' @param episode_days length of the required episode in days, please see *Details*
|
||||
#' @param ... arguments passed on to [as.Date()]
|
||||
#' @param episode_days required episode length in days, can also be less than a day or `Inf`, see *Details*
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
#' Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least `episode_days` days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least `episode_days` days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names.
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
|
||||
#'
|
||||
#' The `dplyr` package is not required for these functions to work, but these functions support [variable grouping][dplyr::group_by()] and work conveniently inside `dplyr` verbs such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()].
|
||||
#' The `dplyr` package is not required for these functions to work, but these functions do support [variable grouping][dplyr::group_by()] and work conveniently inside `dplyr` verbs such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()].
|
||||
#' @return
|
||||
#' * [get_episode()]: a [double] vector
|
||||
#' * [is_new_episode()]: a [logical] vector
|
||||
#' @seealso [first_isolate()]
|
||||
#' @rdname get_episode
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' get_episode(example_isolates$date, episode_days = 60)
|
||||
#' is_new_episode(example_isolates$date, episode_days = 60)
|
||||
#' get_episode(example_isolates$date, episode_days = 60) # indices
|
||||
#' is_new_episode(example_isolates$date, episode_days = 60) # TRUE/FALSE
|
||||
#'
|
||||
#' # filter on results from the third 60-day episode only, using base R
|
||||
#' example_isolates[which(get_episode(example_isolates$date, 60) == 3), ]
|
||||
#'
|
||||
#' # the functions also work for less than a day, e.g. to include one per hour:
|
||||
#' get_episode(c(Sys.time(),
|
||||
#' Sys.time() + 60 * 60),
|
||||
#' episode_days = 1/24)
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # is_new_episode() can also be used in dplyr verbs to determine patient
|
||||
@@ -80,10 +85,11 @@
|
||||
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30)))
|
||||
#'
|
||||
#'
|
||||
#' # grouping on patients and microorganisms leads to the same results
|
||||
#' # as first_isolate():
|
||||
#' # grouping on patients and microorganisms leads to the same
|
||||
#' # results as first_isolate() when using 'episode-based':
|
||||
#' x <- example_isolates %>%
|
||||
#' filter(first_isolate(., include_unknown = TRUE))
|
||||
#' filter_first_isolate(include_unknown = TRUE,
|
||||
#' method = "episode-based")
|
||||
#'
|
||||
#' y <- example_isolates %>%
|
||||
#' group_by(patient_id, mo) %>%
|
||||
@@ -100,7 +106,7 @@
|
||||
#' }
|
||||
get_episode <- function(x, episode_days, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "double", "integer"), has_length = 1)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
|
||||
exec_episode(type = "sequential",
|
||||
x = x,
|
||||
@@ -112,7 +118,7 @@ get_episode <- function(x, episode_days, ...) {
|
||||
#' @export
|
||||
is_new_episode <- function(x, episode_days, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "double", "integer"), has_length = 1)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
|
||||
exec_episode(type = "logical",
|
||||
x = x,
|
||||
@@ -121,7 +127,10 @@ is_new_episode <- function(x, episode_days, ...) {
|
||||
}
|
||||
|
||||
exec_episode <- function(type, x, episode_days, ...) {
|
||||
x <- as.double(as.Date(x, ...)) # as.Date() for POSIX classes
|
||||
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
|
||||
# since x is now in seconds, get seconds from episode_days as well
|
||||
episode_seconds <- episode_days * 60 * 60 * 24
|
||||
|
||||
if (length(x) == 1) {
|
||||
if (type == "logical") {
|
||||
return(TRUE)
|
||||
@@ -129,7 +138,7 @@ exec_episode <- function(type, x, episode_days, ...) {
|
||||
return(1)
|
||||
}
|
||||
} else if (length(x) == 2) {
|
||||
if (max(x) - min(x) >= episode_days) {
|
||||
if (max(x) - min(x) >= episode_seconds) {
|
||||
if (type == "logical") {
|
||||
return(c(TRUE, TRUE))
|
||||
} else if (type == "sequential") {
|
||||
@@ -146,13 +155,13 @@ exec_episode <- function(type, x, episode_days, ...) {
|
||||
|
||||
# I asked on StackOverflow:
|
||||
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
|
||||
exec <- function(x, episode_days) {
|
||||
exec <- function(x, episode_seconds) {
|
||||
indices <- integer()
|
||||
start <- x[1]
|
||||
ind <- 1
|
||||
indices[1] <- 1
|
||||
for (i in 2:length(x)) {
|
||||
if (isTRUE((x[i] - start) >= episode_days)) {
|
||||
if (isTRUE((x[i] - start) >= episode_seconds)) {
|
||||
ind <- ind + 1
|
||||
if (type == "logical") {
|
||||
indices[ind] <- i
|
||||
@@ -175,7 +184,7 @@ exec_episode <- function(type, x, episode_days, ...) {
|
||||
df <- data.frame(x = x,
|
||||
y = seq_len(length(x))) %pm>%
|
||||
pm_arrange(x)
|
||||
df$new <- exec(df$x, episode_days)
|
||||
df$new <- exec(df$x, episode_seconds)
|
||||
df %pm>%
|
||||
pm_arrange(y) %pm>%
|
||||
pm_pull(new)
|
||||
|
||||
+307
-383
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,61 +20,67 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv"
|
||||
# (running "data-raw/internals.R" will process that TSV file)
|
||||
EUCAST_VERSION_BREAKPOINTS <- list("10.0" = list(version_txt = "v10.0",
|
||||
year = 2020,
|
||||
title = "'EUCAST Clinical Breakpoints'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"))
|
||||
EUCAST_VERSION_EXPERT_RULES <- list("3.1" = list(version_txt = "v3.1",
|
||||
year = 2016,
|
||||
title = "'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"),
|
||||
"3.2" = list(version_txt = "v3.2",
|
||||
year = 2020,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"))
|
||||
|
||||
format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
# for documentation - adds title, version number, year and url in markdown language
|
||||
lst <- c(EUCAST_VERSION_BREAKPOINTS, EUCAST_VERSION_EXPERT_RULES)
|
||||
version <- format(version, nsmall = 1)
|
||||
if (markdown == TRUE) {
|
||||
paste0("[", lst[[version]]$title, " ", lst[[version]]$version_txt, "](", lst[[version]]$url, ")",
|
||||
" from ", lst[[version]]$year)
|
||||
} else {
|
||||
paste0(lst[[version]]$title, " ", lst[[version]]$version_txt,
|
||||
" from ", lst[[version]]$year)
|
||||
version <- format(unique(version), nsmall = 1)
|
||||
txt <- character(0)
|
||||
for (i in seq_len(length(version))) {
|
||||
v <- version[i]
|
||||
if (markdown == TRUE) {
|
||||
txt <- c(txt, paste0("[", lst[[v]]$title, " ", lst[[v]]$version_txt, "](", lst[[v]]$url, ")",
|
||||
" (", lst[[v]]$year, ")"))
|
||||
} else {
|
||||
txt <- c(txt, paste0(lst[[version]]$title, " ", lst[[v]]$version_txt,
|
||||
" (", lst[[v]]$year, ")"))
|
||||
}
|
||||
}
|
||||
|
||||
vector_and(txt, quotes = FALSE)
|
||||
}
|
||||
|
||||
#' Apply EUCAST rules
|
||||
#' Apply EUCAST Rules
|
||||
#'
|
||||
#' @description
|
||||
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://eucast.org>), see *Source*.
|
||||
#' 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.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x data 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"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`.
|
||||
#' @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.
|
||||
#' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Currently supported: `r paste0(names(EUCAST_VERSION_BREAKPOINTS), collapse = ", ")`.
|
||||
#' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Currently supported: `r paste0(names(EUCAST_VERSION_EXPERT_RULES), collapse = ", ")`.
|
||||
#' @param ampc_cephalosporin_resistance a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of `NA` for this argument will remove results for these agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: *`r gsub("[)(^]", "", gsub("|", ", ", eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1], fixed = TRUE))`*.
|
||||
#'
|
||||
#' @param ... column name of an antibiotic, please see section *Antibiotics* below
|
||||
#' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Can be either `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), reverse = TRUE)`.
|
||||
#' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`.
|
||||
#' @param ampc_cephalosporin_resistance a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three agents. A value of `NA` (the default) for this argument will remove results for these three agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` or `FALSE` to not alter results for these three agents of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
||||
#' @param ... column name of an antibiotic, see section *Antibiotics* below
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param administration route of administration, either `r vector_or(dosage$administration)`
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()]
|
||||
#' @inheritParams first_isolate
|
||||
#' @details
|
||||
#' **Note:** This function does not translate MIC values to RSI values. Use [as.rsi()] for that. \cr
|
||||
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance.
|
||||
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
||||
#'
|
||||
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv>.
|
||||
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The file used as input for this `AMR` package contains the taxonomy updated until [`r CATALOGUE_OF_LIFE$yearmonth_LPSN`][catalogue_of_life()].
|
||||
#'
|
||||
#' ## 'Other' rules
|
||||
#' ## Custom Rules
|
||||
#'
|
||||
#' Custom rules can be created using [custom_eucast_rules()], e.g.:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
|
||||
#'
|
||||
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x)
|
||||
#' ```
|
||||
#'
|
||||
#'
|
||||
#' ## 'Other' Rules
|
||||
#'
|
||||
#' Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are:
|
||||
#'
|
||||
@@ -89,7 +95,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#'
|
||||
#' The following antibiotics are used for the functions [eucast_rules()] and [mdro()]. These are shown below in the format 'name (`antimicrobial ID`, [ATC code](https://www.whocc.no/atc/structure_and_principles/))', sorted alphabetically:
|
||||
#'
|
||||
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "ATM", "AVO", "AZL", "AZM", "BAM", "BPR", "CAC", "CAT", "CAZ", "CCP", "CCV", "CCX", "CDC", "CDR", "CDZ", "CEC", "CED", "CEI", "CEM", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CFZ", "CHE", "CHL", "CID", "CIP", "CLI", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPI", "CPL", "CPM", "CPO", "CPR", "CPT", "CPX", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTC", "CTF", "CTL", "CTS", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZA", "CZD", "CZO", "CZP", "CZX", "DAL", "DAP", "DIR", "DIT", "DIX", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERY", "ETP", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOV", "FOX", "FOX1", "FUS", "GAT", "GEM", "GEN", "GRX", "HAP", "HET", "IPM", "ISE", "JOS", "KAN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHN", "PIP", "PLB", "PME", "PRI", "PRL", "PRU", "PVM", "QDA", "RAM", "RFL", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SMX", "SPI", "SPX", "STR", "STR1", "SUD", "SUT", "SXT", "SZO", "TAL", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TIO", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
|
||||
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "APL", "APX", "ATM", "AVB", "AVO", "AZD", "AZL", "AZM", "BAM", "BPR", "CAC", "CAT", "CAZ", "CCP", "CCV", "CCX", "CDC", "CDR", "CDZ", "CEC", "CED", "CEI", "CEM", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CFZ", "CHE", "CHL", "CIC", "CID", "CIP", "CLI", "CLM", "CLO", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPI", "CPL", "CPM", "CPO", "CPR", "CPT", "CPX", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTC", "CTF", "CTL", "CTS", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZA", "CZD", "CZO", "CZP", "CZX", "DAL", "DAP", "DIC", "DIR", "DIT", "DIX", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERY", "ETP", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOV", "FOX", "FOX1", "FUS", "GAT", "GEM", "GEN", "GRX", "HAP", "HET", "IPM", "ISE", "JOS", "KAN", "LEN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MET", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "NAC", "NAF", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHE", "PHN", "PIP", "PLB", "PME", "PNM", "PRC", "PRI", "PRL", "PRP", "PRU", "PVM", "QDA", "RAM", "RFL", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SLT6", "SMX", "SPI", "SPX", "SRX", "STR", "STR1", "SUD", "SUL", "SUT", "SXT", "SZO", "TAL", "TAZ", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TIO", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
|
||||
#' @aliases EUCAST
|
||||
#' @rdname eucast_rules
|
||||
#' @export
|
||||
@@ -101,8 +107,9 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf)
|
||||
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx)
|
||||
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx)
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' a <- data.frame(mo = c("Staphylococcus aureus",
|
||||
@@ -144,37 +151,50 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' # containing all details about the transformations:
|
||||
#' c <- eucast_rules(a, verbose = TRUE)
|
||||
#' }
|
||||
#'
|
||||
#' eucast_dosage(c("tobra", "genta", "cipro"), "iv")
|
||||
eucast_rules <- function(x,
|
||||
col_mo = NULL,
|
||||
info = interactive(),
|
||||
rules = getOption("AMR_eucastrules", default = c("breakpoints", "expert")),
|
||||
verbose = FALSE,
|
||||
version_breakpoints = 10.0,
|
||||
version_breakpoints = 11.0,
|
||||
version_expertrules = 3.2,
|
||||
ampc_cephalosporin_resistance = NA,
|
||||
only_rsi_columns = FALSE,
|
||||
custom_rules = NULL,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4), is_in = c("breakpoints", "expert", "other", "all"))
|
||||
meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4, 5), is_in = c("breakpoints", "expert", "other", "all", "custom"))
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(version_breakpoints, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(version_expertrules, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("rsi", "character"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE, is_in = c("R", "S", "I"))
|
||||
meet_criteria(version_breakpoints, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_BREAKPOINTS)))
|
||||
meet_criteria(version_expertrules, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_EXPERT_RULES)))
|
||||
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "rsi"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
||||
|
||||
if ("custom" %in% rules & is.null(custom_rules)) {
|
||||
warning_("No custom rules were set with the `custom_rules` argument",
|
||||
call = FALSE,
|
||||
immediate = TRUE)
|
||||
rules <- rules[rules != "custom"]
|
||||
if (length(rules) == 0) {
|
||||
if (info == TRUE) {
|
||||
message_("No other rules were set, returning original data", add_fn = font_red, as_note = FALSE)
|
||||
}
|
||||
return(x)
|
||||
}
|
||||
}
|
||||
|
||||
x_deparsed <- deparse(substitute(x))
|
||||
if (length(x_deparsed) > 1 || !all(x_deparsed %like% "[a-z]+")) {
|
||||
if (length(x_deparsed) > 1 || any(x_deparsed %unlike% "[a-z]+")) {
|
||||
x_deparsed <- "your_data"
|
||||
}
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
version_breakpoints <- as.double(gsub("[^0-9.]+", "", version_breakpoints))
|
||||
version_expertrules <- as.double(gsub("[^0-9.]+", "", version_expertrules))
|
||||
stop_ifnot(version_breakpoints %in% as.double(names(EUCAST_VERSION_BREAKPOINTS)),
|
||||
"EUCAST version ", version_breakpoints, " for clinical breakpoints not found")
|
||||
stop_ifnot(version_expertrules %in% as.double(names(EUCAST_VERSION_EXPERT_RULES)),
|
||||
"EUCAST version ", version_expertrules, " for expert rules/intrinsic resistance not found")
|
||||
breakpoints_info <- EUCAST_VERSION_BREAKPOINTS[[which(as.double(names(EUCAST_VERSION_BREAKPOINTS)) == version_breakpoints)]]
|
||||
expertrules_info <- EUCAST_VERSION_EXPERT_RULES[[which(as.double(names(EUCAST_VERSION_EXPERT_RULES)) == version_expertrules)]]
|
||||
|
||||
@@ -203,8 +223,8 @@ eucast_rules <- function(x,
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
}
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
|
||||
decimal.mark <- getOption("OutDec")
|
||||
big.mark <- ifelse(decimal.mark != ",", ",", ".")
|
||||
@@ -220,7 +240,13 @@ eucast_rules <- function(x,
|
||||
cat(font_subtle(" (no changes)\n"))
|
||||
} else {
|
||||
# opening
|
||||
cat(font_grey(" ("))
|
||||
if (n_added > 0 & n_changed == 0) {
|
||||
cat(font_green(" ("))
|
||||
} else if (n_added == 0 & n_changed > 0) {
|
||||
cat(font_blue(" ("))
|
||||
} else {
|
||||
cat(font_grey(" ("))
|
||||
}
|
||||
# additions
|
||||
if (n_added > 0) {
|
||||
if (n_added == 1) {
|
||||
@@ -242,7 +268,13 @@ eucast_rules <- function(x,
|
||||
}
|
||||
}
|
||||
# closing
|
||||
cat(font_grey(")\n"))
|
||||
if (n_added > 0 & n_changed == 0) {
|
||||
cat(font_green(")\n"))
|
||||
} else if (n_added == 0 & n_changed > 0) {
|
||||
cat(font_blue(")\n"))
|
||||
} else {
|
||||
cat(font_grey(")\n"))
|
||||
}
|
||||
}
|
||||
warned <<- FALSE
|
||||
}
|
||||
@@ -267,219 +299,15 @@ eucast_rules <- function(x,
|
||||
hard_dependencies = NULL,
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
|
||||
AMC <- cols_ab["AMC"]
|
||||
AMK <- cols_ab["AMK"]
|
||||
AMP <- cols_ab["AMP"]
|
||||
AMX <- cols_ab["AMX"]
|
||||
ATM <- cols_ab["ATM"]
|
||||
AVO <- cols_ab["AVO"]
|
||||
AZL <- cols_ab["AZL"]
|
||||
AZM <- cols_ab["AZM"]
|
||||
BAM <- cols_ab["BAM"]
|
||||
BPR <- cols_ab["BPR"]
|
||||
CAC <- cols_ab["CAC"]
|
||||
CAT <- cols_ab["CAT"]
|
||||
CAZ <- cols_ab["CAZ"]
|
||||
CCP <- cols_ab["CCP"]
|
||||
CCV <- cols_ab["CCV"]
|
||||
CCX <- cols_ab["CCX"]
|
||||
CDC <- cols_ab["CDC"]
|
||||
CDR <- cols_ab["CDR"]
|
||||
CDZ <- cols_ab["CDZ"]
|
||||
CEC <- cols_ab["CEC"]
|
||||
CED <- cols_ab["CED"]
|
||||
CEI <- cols_ab["CEI"]
|
||||
CEM <- cols_ab["CEM"]
|
||||
CEP <- cols_ab["CEP"]
|
||||
CFM <- cols_ab["CFM"]
|
||||
CFM1 <- cols_ab["CFM1"]
|
||||
CFP <- cols_ab["CFP"]
|
||||
CFR <- cols_ab["CFR"]
|
||||
CFS <- cols_ab["CFS"]
|
||||
CFZ <- cols_ab["CFZ"]
|
||||
CHE <- cols_ab["CHE"]
|
||||
CHL <- cols_ab["CHL"]
|
||||
CID <- cols_ab["CID"]
|
||||
CIP <- cols_ab["CIP"]
|
||||
CLI <- cols_ab["CLI"]
|
||||
CLR <- cols_ab["CLR"]
|
||||
CMX <- cols_ab["CMX"]
|
||||
CMZ <- cols_ab["CMZ"]
|
||||
CND <- cols_ab["CND"]
|
||||
COL <- cols_ab["COL"]
|
||||
CPD <- cols_ab["CPD"]
|
||||
CPI <- cols_ab["CPI"]
|
||||
CPL <- cols_ab["CPL"]
|
||||
CPM <- cols_ab["CPM"]
|
||||
CPO <- cols_ab["CPO"]
|
||||
CPR <- cols_ab["CPR"]
|
||||
CPT <- cols_ab["CPT"]
|
||||
CPX <- cols_ab["CPX"]
|
||||
CRB <- cols_ab["CRB"]
|
||||
CRD <- cols_ab["CRD"]
|
||||
CRN <- cols_ab["CRN"]
|
||||
CRO <- cols_ab["CRO"]
|
||||
CSL <- cols_ab["CSL"]
|
||||
CTB <- cols_ab["CTB"]
|
||||
CTC <- cols_ab["CTC"]
|
||||
CTF <- cols_ab["CTF"]
|
||||
CTL <- cols_ab["CTL"]
|
||||
CTS <- cols_ab["CTS"]
|
||||
CTT <- cols_ab["CTT"]
|
||||
CTX <- cols_ab["CTX"]
|
||||
CTZ <- cols_ab["CTZ"]
|
||||
CXM <- cols_ab["CXM"]
|
||||
CYC <- cols_ab["CYC"]
|
||||
CZA <- cols_ab["CZA"]
|
||||
CZD <- cols_ab["CZD"]
|
||||
CZO <- cols_ab["CZO"]
|
||||
CZP <- cols_ab["CZP"]
|
||||
CZX <- cols_ab["CZX"]
|
||||
DAL <- cols_ab["DAL"]
|
||||
DAP <- cols_ab["DAP"]
|
||||
DIR <- cols_ab["DIR"]
|
||||
DIT <- cols_ab["DIT"]
|
||||
DIX <- cols_ab["DIX"]
|
||||
DIZ <- cols_ab["DIZ"]
|
||||
DKB <- cols_ab["DKB"]
|
||||
DOR <- cols_ab["DOR"]
|
||||
DOX <- cols_ab["DOX"]
|
||||
ENX <- cols_ab["ENX"]
|
||||
EPC <- cols_ab["EPC"]
|
||||
ERY <- cols_ab["ERY"]
|
||||
ETP <- cols_ab["ETP"]
|
||||
FEP <- cols_ab["FEP"]
|
||||
FLC <- cols_ab["FLC"]
|
||||
FLE <- cols_ab["FLE"]
|
||||
FLR1 <- cols_ab["FLR1"]
|
||||
FOS <- cols_ab["FOS"]
|
||||
FOV <- cols_ab["FOV"]
|
||||
FOX <- cols_ab["FOX"]
|
||||
FOX1 <- cols_ab["FOX1"]
|
||||
FUS <- cols_ab["FUS"]
|
||||
GAT <- cols_ab["GAT"]
|
||||
GEM <- cols_ab["GEM"]
|
||||
GEN <- cols_ab["GEN"]
|
||||
GRX <- cols_ab["GRX"]
|
||||
HAP <- cols_ab["HAP"]
|
||||
HET <- cols_ab["HET"]
|
||||
IPM <- cols_ab["IPM"]
|
||||
ISE <- cols_ab["ISE"]
|
||||
JOS <- cols_ab["JOS"]
|
||||
KAN <- cols_ab["KAN"]
|
||||
LEX <- cols_ab["LEX"]
|
||||
LIN <- cols_ab["LIN"]
|
||||
LNZ <- cols_ab["LNZ"]
|
||||
LOM <- cols_ab["LOM"]
|
||||
LOR <- cols_ab["LOR"]
|
||||
LTM <- cols_ab["LTM"]
|
||||
LVX <- cols_ab["LVX"]
|
||||
MAN <- cols_ab["MAN"]
|
||||
MCM <- cols_ab["MCM"]
|
||||
MEC <- cols_ab["MEC"]
|
||||
MEM <- cols_ab["MEM"]
|
||||
MEV <- cols_ab["MEV"]
|
||||
MEZ <- cols_ab["MEZ"]
|
||||
MFX <- cols_ab["MFX"]
|
||||
MID <- cols_ab["MID"]
|
||||
MNO <- cols_ab["MNO"]
|
||||
MTM <- cols_ab["MTM"]
|
||||
NAL <- cols_ab["NAL"]
|
||||
NEO <- cols_ab["NEO"]
|
||||
NET <- cols_ab["NET"]
|
||||
NIT <- cols_ab["NIT"]
|
||||
NOR <- cols_ab["NOR"]
|
||||
NOV <- cols_ab["NOV"]
|
||||
NVA <- cols_ab["NVA"]
|
||||
OFX <- cols_ab["OFX"]
|
||||
OLE <- cols_ab["OLE"]
|
||||
ORI <- cols_ab["ORI"]
|
||||
OXA <- cols_ab["OXA"]
|
||||
PAZ <- cols_ab["PAZ"]
|
||||
PEF <- cols_ab["PEF"]
|
||||
PEN <- cols_ab["PEN"]
|
||||
PHN <- cols_ab["PHN"]
|
||||
PIP <- cols_ab["PIP"]
|
||||
PLB <- cols_ab["PLB"]
|
||||
PME <- cols_ab["PME"]
|
||||
PRI <- cols_ab["PRI"]
|
||||
PRL <- cols_ab["PRL"]
|
||||
PRU <- cols_ab["PRU"]
|
||||
PVM <- cols_ab["PVM"]
|
||||
QDA <- cols_ab["QDA"]
|
||||
RAM <- cols_ab["RAM"]
|
||||
RFL <- cols_ab["RFL"]
|
||||
RID <- cols_ab["RID"]
|
||||
RIF <- cols_ab["RIF"]
|
||||
ROK <- cols_ab["ROK"]
|
||||
RST <- cols_ab["RST"]
|
||||
RXT <- cols_ab["RXT"]
|
||||
SAM <- cols_ab["SAM"]
|
||||
SBC <- cols_ab["SBC"]
|
||||
SDI <- cols_ab["SDI"]
|
||||
SDM <- cols_ab["SDM"]
|
||||
SIS <- cols_ab["SIS"]
|
||||
SLF <- cols_ab["SLF"]
|
||||
SLF1 <- cols_ab["SLF1"]
|
||||
SLF10 <- cols_ab["SLF10"]
|
||||
SLF11 <- cols_ab["SLF11"]
|
||||
SLF12 <- cols_ab["SLF12"]
|
||||
SLF13 <- cols_ab["SLF13"]
|
||||
SLF2 <- cols_ab["SLF2"]
|
||||
SLF3 <- cols_ab["SLF3"]
|
||||
SLF4 <- cols_ab["SLF4"]
|
||||
SLF5 <- cols_ab["SLF5"]
|
||||
SLF6 <- cols_ab["SLF6"]
|
||||
SLF7 <- cols_ab["SLF7"]
|
||||
SLF8 <- cols_ab["SLF8"]
|
||||
SLF9 <- cols_ab["SLF9"]
|
||||
SLT1 <- cols_ab["SLT1"]
|
||||
SLT2 <- cols_ab["SLT2"]
|
||||
SLT3 <- cols_ab["SLT3"]
|
||||
SLT4 <- cols_ab["SLT4"]
|
||||
SLT5 <- cols_ab["SLT5"]
|
||||
SMX <- cols_ab["SMX"]
|
||||
SPI <- cols_ab["SPI"]
|
||||
SPX <- cols_ab["SPX"]
|
||||
STR <- cols_ab["STR"]
|
||||
STR1 <- cols_ab["STR1"]
|
||||
SUD <- cols_ab["SUD"]
|
||||
SUT <- cols_ab["SUT"]
|
||||
SXT <- cols_ab["SXT"]
|
||||
SZO <- cols_ab["SZO"]
|
||||
TAL <- cols_ab["TAL"]
|
||||
TCC <- cols_ab["TCC"]
|
||||
TCM <- cols_ab["TCM"]
|
||||
TCY <- cols_ab["TCY"]
|
||||
TEC <- cols_ab["TEC"]
|
||||
TEM <- cols_ab["TEM"]
|
||||
TGC <- cols_ab["TGC"]
|
||||
THA <- cols_ab["THA"]
|
||||
TIC <- cols_ab["TIC"]
|
||||
TIO <- cols_ab["TIO"]
|
||||
TLT <- cols_ab["TLT"]
|
||||
TLV <- cols_ab["TLV"]
|
||||
TMP <- cols_ab["TMP"]
|
||||
TMX <- cols_ab["TMX"]
|
||||
TOB <- cols_ab["TOB"]
|
||||
TRL <- cols_ab["TRL"]
|
||||
TVA <- cols_ab["TVA"]
|
||||
TZD <- cols_ab["TZD"]
|
||||
TZP <- cols_ab["TZP"]
|
||||
VAN <- cols_ab["VAN"]
|
||||
|
||||
ab_missing <- function(ab) {
|
||||
all(ab %in% c(NULL, NA))
|
||||
}
|
||||
|
||||
if (ab_missing(AMP) & !ab_missing(AMX)) {
|
||||
if (!"AMP" %in% names(cols_ab) & "AMX" %in% names(cols_ab)) {
|
||||
# ampicillin column is missing, but amoxicillin is available
|
||||
if (info == TRUE) {
|
||||
message_("Using column '", font_bold(AMX), "' as input for ampicillin since many EUCAST rules depend on it.")
|
||||
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
|
||||
}
|
||||
AMP <- AMX
|
||||
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
||||
}
|
||||
|
||||
# data preparation ----
|
||||
@@ -487,62 +315,35 @@ eucast_rules <- function(x,
|
||||
message_("Preparing data...", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
|
||||
# nolint start
|
||||
# antibiotic classes ----
|
||||
aminoglycosides <- c(AMK, DKB, GEN, ISE, KAN, NEO, NET, RST, SIS, STR, STR1, TOB)
|
||||
aminopenicillins <- c(AMP, AMX)
|
||||
carbapenems <- c(DOR, ETP, IPM, MEM, MEV)
|
||||
cephalosporins <- c(CDZ, CCP, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
|
||||
cephalosporins_1st <- c(CAC, CFR, RID, CTZ, CZD, CZO, CRD, CTL, LEX, CEP, HAP, CED)
|
||||
cephalosporins_2nd <- c(CEC, MAN, CMZ, CID, CND, CTT, CTF, FOX, CPR, CXM, LOR)
|
||||
cephalosporins_3rd <- c(CDZ, CCP, CCX, CDR, DIT, DIX, CAT, CPI, CFM, CMX, DIZ, CFP, CSL, CTX, CTC, CTS, CHE, FOV, CFZ, CPM, CPD, CPX, CDC, CFS, CAZ, CZA, CCV, CEM, CPL, CTB, TIO, CZX, CZP, CRO, LTM)
|
||||
cephalosporins_except_CAZ <- cephalosporins[cephalosporins != ifelse(is.null(CAZ), "", CAZ)]
|
||||
fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
|
||||
glycopeptides <- c(AVO, NVA, RAM, TEC, TCM, VAN) # dalba/orita/tela are in lipoglycopeptides
|
||||
lincosamides <- c(CLI, LIN, PRL)
|
||||
lipoglycopeptides <- c(DAL, ORI, TLV)
|
||||
macrolides <- c(AZM, CLR, DIR, ERY, FLR1, JOS, MID, MCM, OLE, ROK, RXT, SPI, TLT, TRL)
|
||||
oxazolidinones <- c(CYC, LNZ, THA, TZD)
|
||||
polymyxins <- c(PLB, COL)
|
||||
streptogramins <- c(QDA, PRI)
|
||||
tetracyclines <- c(DOX, MNO, TCY) # since EUCAST v3.1 tigecycline (TGC) is set apart
|
||||
ureidopenicillins <- c(PIP, TZP, AZL, MEZ)
|
||||
all_betalactams <- c(aminopenicillins, cephalosporins, carbapenems, ureidopenicillins, AMC, OXA, FLC, PEN)
|
||||
# nolint end
|
||||
|
||||
# Some helper functions ---------------------------------------------------
|
||||
get_antibiotic_columns <- function(x, df) {
|
||||
x <- trimws(unlist(strsplit(x, ",", fixed = TRUE)))
|
||||
y <- character(0)
|
||||
for (i in seq_len(length(x))) {
|
||||
if (is.function(get(x[i]))) {
|
||||
stop("Column ", x[i], " is also a function. Please create an issue on github.com/msberends/AMR/issues.")
|
||||
get_antibiotic_columns <- function(x, cols_ab) {
|
||||
x <- strsplit(x, ", *")[[1]]
|
||||
x_new <- character()
|
||||
for (val in x) {
|
||||
if (toupper(val) %in% ls(envir = asNamespace("AMR"))) {
|
||||
# antibiotic group names, as defined in data-raw/_internals.R, such as `CARBAPENEMS`
|
||||
val <- eval(parse(text = toupper(val)), envir = asNamespace("AMR"))
|
||||
} else if (toupper(val) %in% AB_lookup$ab) {
|
||||
# separate drugs, such as `AMX`
|
||||
val <- as.ab(val)
|
||||
} else {
|
||||
stop_("antimicrobial agent (group) not found in EUCAST rules file: ", val, call = FALSE)
|
||||
}
|
||||
y <- c(y, tryCatch(get(x[i]), error = function(e) ""))
|
||||
x_new <- c(x_new, val)
|
||||
}
|
||||
y[y != "" & y %in% colnames(df)]
|
||||
}
|
||||
markup_italics_where_needed <- function(x) {
|
||||
# returns names found in family, genus or species as italics
|
||||
if (!has_colour()) {
|
||||
return(x)
|
||||
}
|
||||
x <- unlist(strsplit(x, " "))
|
||||
ind <- gsub("[)(:]", "", x) %in% c(MO_lookup[which(MO_lookup$rank %in% c("family", "genus")), ]$fullname,
|
||||
MO_lookup[which(MO_lookup$rank == "species"), ]$species)
|
||||
x[ind] <- font_italic(x[ind], collapse = NULL)
|
||||
paste(x, collapse = " ")
|
||||
cols_ab[match(x_new, names(cols_ab))]
|
||||
}
|
||||
get_antibiotic_names <- function(x) {
|
||||
x <- x %pm>%
|
||||
strsplit(",") %pm>%
|
||||
unlist() %pm>%
|
||||
trimws() %pm>%
|
||||
vapply(FUN.VALUE = character(1), function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %pm>%
|
||||
vapply(FUN.VALUE = character(1), function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE, fast_mode = TRUE) else x) %pm>%
|
||||
sort() %pm>%
|
||||
paste(collapse = ", ")
|
||||
x <- gsub("_", " ", x, fixed = TRUE)
|
||||
x <- gsub("except CAZ", paste("except", ab_name("CAZ", language = NULL, tolower = TRUE)), x, fixed = TRUE)
|
||||
x <- gsub("except TGC", paste("except", ab_name("TGC", language = NULL, tolower = TRUE)), x, fixed = TRUE)
|
||||
x <- gsub("cephalosporins (1st|2nd|3rd|4th|5th)", "cephalosporins (\\1 gen.)", x)
|
||||
x
|
||||
}
|
||||
@@ -618,10 +419,13 @@ eucast_rules <- function(x,
|
||||
pm_distinct(`.rowid`, .keep_all = TRUE) %pm>%
|
||||
as.data.frame(stringsAsFactors = FALSE)
|
||||
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
|
||||
x <- x %pm>%
|
||||
left_join_microorganisms(by = col_mo, suffix = c("_oldcols", ""))
|
||||
# rename col_mo to prevent interference with joined columns
|
||||
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
|
||||
col_mo <- ".col_mo"
|
||||
# join to microorganisms data set
|
||||
x <- left_join_microorganisms(x, by = col_mo, suffix = c("_oldcols", ""))
|
||||
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
|
||||
x$genus_species <- paste(x$genus, x$species)
|
||||
x$genus_species <- trimws(paste(x$genus, x$species))
|
||||
if (info == TRUE & NROW(x) > 10000) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
}
|
||||
@@ -647,33 +451,47 @@ 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$base_name <- gsub("^([a-zA-Z0-9]+).*", "\\1", ab_enzyme$name)
|
||||
ab_enzyme$base_ab <- as.ab(ab_enzyme$base_name)
|
||||
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]
|
||||
ab_enzyme <- subset(ab_enzyme, !is.na(base_ab))
|
||||
# make ampicillin and amoxicillin interchangable
|
||||
ampi <- subset(ab_enzyme, base_ab == "AMX")
|
||||
ampi$base_ab <- "AMP"
|
||||
ampi$base_name <- ab_name("AMP", language = NULL)
|
||||
amox <- subset(ab_enzyme, base_ab == "AMP")
|
||||
amox$base_ab <- "AMX"
|
||||
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), ]
|
||||
|
||||
for (i in seq_len(nrow(ab_enzyme))) {
|
||||
if (all(c(ab_enzyme[i, ]$ab, ab_enzyme[i, ]$base_ab) %in% names(cols_ab), na.rm = TRUE)) {
|
||||
ab_name_base <- ab_name(cols_ab[ab_enzyme[i, ]$base_ab], language = NULL, tolower = TRUE)
|
||||
ab_name_enzyme <- ab_name(cols_ab[ab_enzyme[i, ]$ab], language = NULL, tolower = TRUE)
|
||||
# check if both base and base + enzyme inhibitor are part of the data set
|
||||
if (all(c(ab_enzyme$base_ab[i], ab_enzyme$enzyme_ab[i]) %in% names(cols_ab), na.rm = TRUE)) {
|
||||
col_base <- unname(cols_ab[ab_enzyme$base_ab[i]])
|
||||
col_enzyme <- unname(cols_ab[ab_enzyme$enzyme_ab[i]])
|
||||
|
||||
# Set base to R where base + enzyme inhibitor is R ----
|
||||
rule_current <- paste0("Set ", ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = R where ",
|
||||
ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = R")
|
||||
rule_current <- paste0(ab_enzyme$base_name[i], " ('", font_bold(col_base), "') = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " ('", font_bold(col_enzyme), "') = R")
|
||||
if (info == TRUE) {
|
||||
cat(word_wrap(rule_current))
|
||||
cat("\n")
|
||||
cat(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6))
|
||||
}
|
||||
run_changes <- edit_rsi(x = x,
|
||||
col_mo = col_mo,
|
||||
to = "R",
|
||||
rule = c(rule_current, "Other rules", "",
|
||||
paste0("Non-EUCAST: AMR package v", utils::packageDescription("AMR")$Version)),
|
||||
rows = which(as.rsi_no_warning(x[, cols_ab[ab_enzyme[i, ]$ab]]) == "R"),
|
||||
cols = cols_ab[ab_enzyme[i, ]$base_ab],
|
||||
rows = which(as.rsi_no_warning(x[, col_enzyme, drop = TRUE]) == "R"),
|
||||
cols = col_base,
|
||||
last_verbose_info = verbose_info,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info)
|
||||
info = info,
|
||||
verbose = verbose)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
@@ -689,23 +507,25 @@ eucast_rules <- function(x,
|
||||
}
|
||||
|
||||
# Set base + enzyme inhibitor to S where base is S ----
|
||||
rule_current <- paste0("Set ", ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = S where ",
|
||||
ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = S")
|
||||
rule_current <- paste0(ab_enzyme$enzyme_name[i], " ('", font_bold(col_enzyme), "') = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " ('", font_bold(col_base), "') = S")
|
||||
|
||||
if (info == TRUE) {
|
||||
cat(word_wrap(rule_current))
|
||||
cat("\n")
|
||||
cat(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6))
|
||||
}
|
||||
run_changes <- edit_rsi(x = x,
|
||||
col_mo = col_mo,
|
||||
to = "S",
|
||||
rule = c(rule_current, "Other rules", "",
|
||||
paste0("Non-EUCAST: AMR package v", utils::packageDescription("AMR")$Version)),
|
||||
rows = which(as.rsi_no_warning(x[, cols_ab[ab_enzyme[i, ]$base_ab]]) == "S"),
|
||||
cols = cols_ab[ab_enzyme[i, ]$ab],
|
||||
rows = which(as.rsi_no_warning(x[, col_base, drop = TRUE]) == "S"),
|
||||
cols = col_enzyme,
|
||||
last_verbose_info = verbose_info,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info)
|
||||
info = info,
|
||||
verbose = verbose)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
@@ -724,44 +544,52 @@ eucast_rules <- function(x,
|
||||
|
||||
} else {
|
||||
if (info == TRUE) {
|
||||
message_("\n\nSkipping inheritance rules defined by this package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R.",
|
||||
as_note = FALSE,
|
||||
add_fn = font_red)
|
||||
message_("Use eucast_rules(..., rules = \"all\") to also apply those rules.",
|
||||
as_note = FALSE,
|
||||
add_fn = font_red)
|
||||
cat("\n")
|
||||
message_("Skipping inheritance rules defined by this AMR package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R. Add \"other\" or \"all\" to the `rules` argument to apply those rules.")
|
||||
}
|
||||
}
|
||||
|
||||
if (!any(c("all", "custom") %in% rules) & !is.null(custom_rules)) {
|
||||
if (info == TRUE) {
|
||||
message_("Skipping custom EUCAST rules, since the `rules` argument does not contain \"custom\".")
|
||||
}
|
||||
custom_rules <- NULL
|
||||
}
|
||||
|
||||
# Official EUCAST rules ---------------------------------------------------
|
||||
eucast_notification_shown <- FALSE
|
||||
if (!is.null(list(...)$eucast_rules_df)) {
|
||||
# this allows: eucast_rules(x, eucast_rules_df = AMR:::eucast_rules_file %>% filter(is.na(have_these_values)))
|
||||
eucast_rules_df <- list(...)$eucast_rules_df
|
||||
} else {
|
||||
# otherwise internal data file, created in data-raw/internals.R
|
||||
# otherwise internal data file, created in data-raw/_internals.R
|
||||
eucast_rules_df <- eucast_rules_file
|
||||
}
|
||||
|
||||
# filter on user-set guideline versions ----
|
||||
if (any(c("all", "breakpoints") %in% rules)) {
|
||||
eucast_rules_df <- subset(eucast_rules_df,
|
||||
!reference.rule_group %like% "breakpoint" |
|
||||
reference.rule_group %unlike% "breakpoint" |
|
||||
(reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints))
|
||||
}
|
||||
if (any(c("all", "expert") %in% rules)) {
|
||||
eucast_rules_df <- subset(eucast_rules_df,
|
||||
!reference.rule_group %like% "expert" |
|
||||
reference.rule_group %unlike% "expert" |
|
||||
(reference.rule_group %like% "expert" & reference.version == version_expertrules))
|
||||
}
|
||||
# filter out AmpC de-repressed cephalosporin-resistant mutants ----
|
||||
if (is.null(ampc_cephalosporin_resistance)) {
|
||||
# cefotaxime, ceftriaxone, ceftazidime
|
||||
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
|
||||
eucast_rules_df <- subset(eucast_rules_df,
|
||||
!reference.rule %like% "ampc")
|
||||
reference.rule %unlike% "ampc")
|
||||
} else {
|
||||
if (isTRUE(ampc_cephalosporin_resistance)) {
|
||||
ampc_cephalosporin_resistance <- "R"
|
||||
}
|
||||
eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
|
||||
}
|
||||
|
||||
# Go over all rules and apply them ----
|
||||
for (i in seq_len(nrow(eucast_rules_df))) {
|
||||
|
||||
rule_previous <- eucast_rules_df[max(1, i - 1), "reference.rule", drop = TRUE]
|
||||
@@ -769,6 +597,14 @@ eucast_rules <- function(x,
|
||||
rule_next <- eucast_rules_df[min(nrow(eucast_rules_df), i + 1), "reference.rule", drop = TRUE]
|
||||
rule_group_previous <- eucast_rules_df[max(1, i - 1), "reference.rule_group", drop = TRUE]
|
||||
rule_group_current <- eucast_rules_df[i, "reference.rule_group", drop = TRUE]
|
||||
# don't apply rules if user doesn't want to apply them
|
||||
if (rule_group_current %like% "breakpoint" & !any(c("all", "breakpoints") %in% rules)) {
|
||||
next
|
||||
}
|
||||
if (rule_group_current %like% "expert" & !any(c("all", "expert") %in% rules)) {
|
||||
next
|
||||
}
|
||||
|
||||
if (isFALSE(info) | isFALSE(verbose)) {
|
||||
rule_text <- ""
|
||||
} else {
|
||||
@@ -789,17 +625,9 @@ eucast_rules <- function(x,
|
||||
rule_next <- ""
|
||||
}
|
||||
|
||||
# don't apply rules if user doesn't want to apply them
|
||||
if (rule_group_current %like% "breakpoint" & !any(c("all", "breakpoints") %in% rules)) {
|
||||
next
|
||||
}
|
||||
if (rule_group_current %like% "expert" & !any(c("all", "expert") %in% rules)) {
|
||||
next
|
||||
}
|
||||
|
||||
if (info == TRUE) {
|
||||
# Print EUCAST intro ------------------------------------------------------
|
||||
if (!rule_group_current %like% "other" & eucast_notification_shown == FALSE) {
|
||||
if (rule_group_current %unlike% "other" & eucast_notification_shown == FALSE) {
|
||||
cat(
|
||||
paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n",
|
||||
word_wrap("Rules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)")), "\n",
|
||||
@@ -828,9 +656,10 @@ eucast_rules <- function(x,
|
||||
# Print rule -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
# is new rule within group, print its name
|
||||
cat(markup_italics_where_needed(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 4)))
|
||||
cat(italicise_taxonomy(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6),
|
||||
type = "ansi"))
|
||||
warned <- FALSE
|
||||
}
|
||||
}
|
||||
@@ -884,29 +713,29 @@ eucast_rules <- function(x,
|
||||
source_value <- trimws(unlist(strsplit(eucast_rules_df[i, "have_these_values", drop = TRUE], ",", fixed = TRUE)))
|
||||
target_antibiotics <- eucast_rules_df[i, "then_change_these_antibiotics", drop = TRUE]
|
||||
target_value <- eucast_rules_df[i, "to_value", drop = TRUE]
|
||||
|
||||
|
||||
if (is.na(source_antibiotics)) {
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like_perl% mo_value),
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value),
|
||||
error = function(e) integer(0))
|
||||
} else {
|
||||
source_antibiotics <- get_antibiotic_columns(source_antibiotics, x)
|
||||
source_antibiotics <- get_antibiotic_columns(source_antibiotics, cols_ab)
|
||||
if (length(source_value) == 1 & length(source_antibiotics) > 1) {
|
||||
source_value <- rep(source_value, length(source_antibiotics))
|
||||
}
|
||||
if (length(source_antibiotics) == 0) {
|
||||
rows <- integer(0)
|
||||
} else if (length(source_antibiotics) == 1) {
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like_perl% mo_value
|
||||
& as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
||||
error = function(e) integer(0))
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value
|
||||
& as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
||||
error = function(e) integer(0))
|
||||
} else if (length(source_antibiotics) == 2) {
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like_perl% mo_value
|
||||
& as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]
|
||||
& as.rsi_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
||||
error = function(e) integer(0))
|
||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value
|
||||
& as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]
|
||||
& as.rsi_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
||||
error = function(e) integer(0))
|
||||
# nolint start
|
||||
# } else if (length(source_antibiotics) == 3) {
|
||||
# rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like_perl% mo_value
|
||||
# rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value
|
||||
# & as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]
|
||||
# & as.rsi_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]
|
||||
# & as.rsi_no_warning(x[, source_antibiotics[3L]]) == source_value[3L]),
|
||||
@@ -917,12 +746,11 @@ eucast_rules <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
cols <- get_antibiotic_columns(target_antibiotics, x)
|
||||
cols <- get_antibiotic_columns(target_antibiotics, cols_ab)
|
||||
|
||||
# Apply rule on data ------------------------------------------------------
|
||||
# this will return the unique number of changes
|
||||
run_changes <- edit_rsi(x = x,
|
||||
col_mo = col_mo,
|
||||
to = target_value,
|
||||
rule = c(rule_text, rule_group_current, rule_current,
|
||||
ifelse(rule_group_current %like% "breakpoint",
|
||||
@@ -933,7 +761,8 @@ eucast_rules <- function(x,
|
||||
last_verbose_info = verbose_info,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info)
|
||||
info = info,
|
||||
verbose = verbose)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
@@ -947,6 +776,61 @@ eucast_rules <- function(x,
|
||||
n_added <- 0
|
||||
n_changed <- 0
|
||||
}
|
||||
} # end of going over all rules
|
||||
|
||||
# Apply custom rules ----
|
||||
if (!is.null(custom_rules)) {
|
||||
if (info == TRUE) {
|
||||
cat("\n")
|
||||
cat(font_bold("Custom EUCAST rules, set by user"), "\n")
|
||||
}
|
||||
for (i in seq_len(length(custom_rules))) {
|
||||
rule <- custom_rules[[i]]
|
||||
rows <- which(eval(parse(text = rule$query), envir = x))
|
||||
cols <- as.character(rule$result_group)
|
||||
cols <- c(cols[cols %in% colnames(x)], # direct column names
|
||||
unname(cols_ab[names(cols_ab) %in% cols])) # based on previous cols_ab finding
|
||||
cols <- unique(cols)
|
||||
target_value <- as.character(rule$result_value)
|
||||
rule_text <- paste0("report as '", target_value, "' when ",
|
||||
format_custom_query_rule(rule$query, colours = FALSE), ": ",
|
||||
get_antibiotic_names(cols))
|
||||
if (info == TRUE) {
|
||||
# print rule
|
||||
cat(italicise_taxonomy(word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6),
|
||||
type = "ansi"))
|
||||
warned <- FALSE
|
||||
}
|
||||
run_changes <- edit_rsi(x = x,
|
||||
to = target_value,
|
||||
rule = c(rule_text,
|
||||
"Custom EUCAST rules",
|
||||
paste0("Custom EUCAST rule ", i),
|
||||
paste0("Object '", deparse(substitute(custom_rules)),
|
||||
"' consisting of ", length(custom_rules), " custom rules")),
|
||||
rows = rows,
|
||||
cols = cols,
|
||||
last_verbose_info = verbose_info,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info,
|
||||
verbose = verbose)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
x <- run_changes$output
|
||||
warn_lacking_rsi_class <- c(warn_lacking_rsi_class, run_changes$rsi_warn)
|
||||
# Print number of new changes ---------------------------------------------
|
||||
if (info == TRUE & rule_next != rule_current) {
|
||||
# print only on last one of rules in this group
|
||||
txt_ok(n_added = n_added, n_changed = n_changed, warned = warned)
|
||||
# and reset counters
|
||||
n_added <- 0
|
||||
n_changed <- 0
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Print overview ----------------------------------------------------------
|
||||
@@ -1038,12 +922,15 @@ eucast_rules <- function(x,
|
||||
|
||||
if (length(warn_lacking_rsi_class) > 0) {
|
||||
warn_lacking_rsi_class <- unique(warn_lacking_rsi_class)
|
||||
# take order from original data set
|
||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[order(colnames(x.bak))]
|
||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[!is.na(warn_lacking_rsi_class)]
|
||||
warning_("Not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\n",
|
||||
" ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||
" ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
|
||||
" - ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
|
||||
warn_lacking_rsi_class,
|
||||
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])),
|
||||
")",
|
||||
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])), ")\n",
|
||||
" - ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||
" - ", x_deparsed, " %>% mutate(across(where(is.rsi.eligible), as.rsi))",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
@@ -1064,16 +951,16 @@ eucast_rules <- function(x,
|
||||
}
|
||||
|
||||
# helper function for editing the table ----
|
||||
edit_rsi <- function(x,
|
||||
col_mo,
|
||||
to,
|
||||
rule,
|
||||
edit_rsi <- function(x,
|
||||
to,
|
||||
rule,
|
||||
rows,
|
||||
cols,
|
||||
last_verbose_info,
|
||||
last_verbose_info,
|
||||
original_data,
|
||||
warned,
|
||||
info) {
|
||||
info,
|
||||
verbose) {
|
||||
cols <- unique(cols[!is.na(cols) & !is.null(cols)])
|
||||
|
||||
# for Verbose Mode, keep track of all changes and return them
|
||||
@@ -1088,7 +975,7 @@ edit_rsi <- function(x,
|
||||
}
|
||||
txt_warning <- function() {
|
||||
if (warned == FALSE) {
|
||||
if (info == TRUE) cat("", font_yellow_bg(font_black(" WARNING ")))
|
||||
if (info == TRUE) cat(" ", font_rsi_I_bg(" WARNING "), sep = "")
|
||||
}
|
||||
warned <<- TRUE
|
||||
}
|
||||
@@ -1109,13 +996,15 @@ edit_rsi <- function(x,
|
||||
TRUE
|
||||
})
|
||||
suppressWarnings(new_edits[rows, cols] <<- to)
|
||||
warning_('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE)
|
||||
warning_("Value \"", to, "\" added to the factor levels of column", ifelse(length(cols) == 1, "", "s"),
|
||||
" ", vector_and(cols, quotes = "`", sort = FALSE),
|
||||
" because this value was not an existing factor level.",
|
||||
call = FALSE)
|
||||
txt_warning()
|
||||
warned <- FALSE
|
||||
} else {
|
||||
warning_(w$message, call = FALSE)
|
||||
txt_warning()
|
||||
cat("\n") # txt_warning() does not append a "\n" on itself
|
||||
}
|
||||
},
|
||||
error = function(e) {
|
||||
@@ -1130,7 +1019,7 @@ edit_rsi <- function(x,
|
||||
)
|
||||
|
||||
track_changes$output <- new_edits
|
||||
if (isTRUE(info) && !isTRUE(all.equal(x, track_changes$output))) {
|
||||
if ((info == TRUE | verbose == TRUE) && !isTRUE(all.equal(x, track_changes$output))) {
|
||||
get_original_rows <- function(rowids) {
|
||||
as.integer(rownames(original_data[which(original_data$.rowid %in% rowids), , drop = FALSE]))
|
||||
}
|
||||
@@ -1168,3 +1057,38 @@ edit_rsi <- function(x,
|
||||
}
|
||||
return(track_changes)
|
||||
}
|
||||
|
||||
#' @rdname eucast_rules
|
||||
#' @export
|
||||
eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 11.0) {
|
||||
meet_criteria(ab, allow_class = c("character", "numeric", "integer", "factor"))
|
||||
meet_criteria(administration, allow_class = "character", is_in = dosage$administration[!is.na(dosage$administration)], has_length = 1)
|
||||
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 (pkg_env will reload every session)
|
||||
if (message_not_thrown_before(paste0("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), ". ",
|
||||
font_red("This note will be shown once per session."))
|
||||
remember_thrown_message(paste0("eucast_dosage_v", gsub("[^0-9]", "", version_breakpoints)), entire_session = TRUE)
|
||||
}
|
||||
|
||||
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]
|
||||
lst[[i]] <- list(ab = "",
|
||||
name = "",
|
||||
standard_dosage = ifelse("standard_dosage" %in% df$type,
|
||||
df[which(df$type == "standard_dosage"), ]$original_txt,
|
||||
NA_character_),
|
||||
high_dosage = ifelse("high_dosage" %in% df$type,
|
||||
df[which(df$type == "high_dosage"), ]$original_txt,
|
||||
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)
|
||||
out
|
||||
}
|
||||
|
||||
+69
-21
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,18 +20,19 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Filter isolates on result in antimicrobial class
|
||||
#' Filter Isolates on Result in Antimicrobial Class
|
||||
#'
|
||||
#' Filter isolates on results in specific antimicrobial classes. This makes it easy to filter on isolates that were tested for e.g. any aminoglycoside, or to filter on carbapenem-resistant isolates without the need to specify the drugs.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a data set
|
||||
#' @param ab_class an antimicrobial class, like `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
|
||||
#' @param result an antibiotic result: S, I or R (or a combination of more of them)
|
||||
#' @param scope the scope to check which variables to check, can be `"any"` (default) or `"all"`
|
||||
#' @param ... previously used when this package still depended on the `dplyr` package, now ignored
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param ... arguments passed on to [filter_ab_class()]
|
||||
#' @details All columns of `x` will be searched for known antibiotic names, abbreviations, brand names and codes (ATC, EARS-Net, WHO, etc.). This means that a filter function like e.g. [filter_aminoglycosides()] will include column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
|
||||
#' @rdname filter_ab_class
|
||||
#' @seealso [antibiotic_class_selectors()] for the `select()` equivalent.
|
||||
@@ -70,16 +71,18 @@
|
||||
#' filter_aminoglycosides("R", "all") %>%
|
||||
#' filter_fluoroquinolones("R", "all")
|
||||
#'
|
||||
#' # with dplyr 1.0.0 and higher (that adds 'across()'), this is equal:
|
||||
#' # with dplyr 1.0.0 and higher (that adds 'across()'), this is all equal:
|
||||
#' # (though the row names on the first are more correct)
|
||||
#' example_isolates %>% filter_carbapenems("R", "all")
|
||||
#' example_isolates %>% filter(across(carbapenems(), ~. == "R"))
|
||||
#' example_isolates %>% filter(across(carbapenems(), function(x) x == "R"))
|
||||
#' }
|
||||
#' }
|
||||
filter_ab_class <- function(x,
|
||||
ab_class,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
.call_depth <- list(...)$`.call_depth`
|
||||
if (is.null(.call_depth)) {
|
||||
@@ -89,6 +92,7 @@ filter_ab_class <- function(x,
|
||||
meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = .call_depth)
|
||||
meet_criteria(result, allow_class = "character", has_length = c(1, 2, 3), allow_NULL = TRUE, .call_depth = .call_depth)
|
||||
meet_criteria(scope, allow_class = "character", has_length = 1, is_in = c("all", "any"), .call_depth = .call_depth)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = .call_depth)
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
@@ -107,7 +111,7 @@ filter_ab_class <- function(x,
|
||||
stop_ifnot(all(scope %in% c("any", "all")), "`scope` must be one of: 'any', 'all'")
|
||||
|
||||
# get all columns in data with names that resemble antibiotics
|
||||
ab_in_data <- get_column_abx(x, info = FALSE)
|
||||
ab_in_data <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns)
|
||||
if (length(ab_in_data) == 0) {
|
||||
message_("No columns with class <rsi> found (see ?as.rsi), data left unchanged.")
|
||||
return(x.bak)
|
||||
@@ -129,31 +133,30 @@ filter_ab_class <- function(x,
|
||||
# get the columns with a group names in the chosen ab class
|
||||
agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab]
|
||||
if (length(agents) == 0) {
|
||||
message_("NOTE: no antimicrobial agents of class ", ab_group,
|
||||
message_("No antimicrobial agents of class ", ab_group,
|
||||
" found (such as ", find_ab_names(ab_class, 2),
|
||||
"), data left unchanged.")
|
||||
")",
|
||||
ifelse(only_rsi_columns == TRUE, " with class <rsi>,", ","),
|
||||
" data left unchanged.")
|
||||
return(x.bak)
|
||||
}
|
||||
|
||||
if (length(result) == 1) {
|
||||
operator <- " is "
|
||||
} else {
|
||||
operator <- " is one of "
|
||||
}
|
||||
if (scope == "any") {
|
||||
scope_txt <- " or "
|
||||
scope_fn <- any
|
||||
} else {
|
||||
scope_txt <- " and "
|
||||
scope_fn <- all
|
||||
if (length(agents) > 1) {
|
||||
operator <- gsub("is", "are", operator)
|
||||
}
|
||||
}
|
||||
if (length(agents) > 1) {
|
||||
scope <- paste(scope, "of columns ")
|
||||
operator <- " are"
|
||||
scope <- paste("values in", scope, "of columns ")
|
||||
} else {
|
||||
scope <- "column "
|
||||
operator <- " is"
|
||||
scope <- "value in column "
|
||||
}
|
||||
if (length(result) > 1) {
|
||||
operator <- paste(operator, "either")
|
||||
}
|
||||
|
||||
# sort columns on official name
|
||||
@@ -163,7 +166,9 @@ filter_ab_class <- function(x,
|
||||
paste(paste0("`", font_bold(agents, collapse = NULL),
|
||||
"` (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"),
|
||||
collapse = scope_txt),
|
||||
operator, toString(result), as_note = FALSE)
|
||||
operator, " ", vector_or(result, quotes = TRUE),
|
||||
as_note = FALSE,
|
||||
extra_indent = 6)
|
||||
x_transposed <- as.list(as.data.frame(t(x[, agents, drop = FALSE]), stringsAsFactors = FALSE))
|
||||
filtered <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE))
|
||||
x <- x[which(filtered), , drop = FALSE]
|
||||
@@ -176,11 +181,13 @@ filter_ab_class <- function(x,
|
||||
filter_aminoglycosides <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "aminoglycoside",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -190,11 +197,13 @@ filter_aminoglycosides <- function(x,
|
||||
filter_carbapenems <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "carbapenem",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -204,11 +213,13 @@ filter_carbapenems <- function(x,
|
||||
filter_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporin",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -218,11 +229,13 @@ filter_cephalosporins <- function(x,
|
||||
filter_1st_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporins (1st gen.)",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -232,11 +245,13 @@ filter_1st_cephalosporins <- function(x,
|
||||
filter_2nd_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporins (2nd gen.)",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -246,11 +261,13 @@ filter_2nd_cephalosporins <- function(x,
|
||||
filter_3rd_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporins (3rd gen.)",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -260,11 +277,13 @@ filter_3rd_cephalosporins <- function(x,
|
||||
filter_4th_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporins (4th gen.)",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -274,11 +293,13 @@ filter_4th_cephalosporins <- function(x,
|
||||
filter_5th_cephalosporins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "cephalosporins (5th gen.)",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -288,11 +309,13 @@ filter_5th_cephalosporins <- function(x,
|
||||
filter_fluoroquinolones <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "fluoroquinolone",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -302,11 +325,13 @@ filter_fluoroquinolones <- function(x,
|
||||
filter_glycopeptides <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "glycopeptide",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -316,11 +341,29 @@ filter_glycopeptides <- function(x,
|
||||
filter_macrolides <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "macrolide",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
|
||||
#' @rdname filter_ab_class
|
||||
#' @export
|
||||
filter_oxazolidinones <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "oxazolidinone",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -330,11 +373,13 @@ filter_macrolides <- function(x,
|
||||
filter_penicillins <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "penicillin",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -344,11 +389,13 @@ filter_penicillins <- function(x,
|
||||
filter_tetracyclines <- function(x,
|
||||
result = NULL,
|
||||
scope = "any",
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
filter_ab_class(x = x,
|
||||
ab_class = "tetracycline",
|
||||
result = result,
|
||||
scope = scope,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
.call_depth = 1,
|
||||
...)
|
||||
}
|
||||
@@ -361,6 +408,7 @@ find_ab_group <- function(ab_class) {
|
||||
"fluoroquinolone",
|
||||
"glycopeptide",
|
||||
"macrolide",
|
||||
"oxazolidinone",
|
||||
"tetracycline"),
|
||||
paste0(ab_class, "s"),
|
||||
antibiotics %pm>%
|
||||
@@ -377,7 +425,7 @@ find_ab_group <- function(ab_class) {
|
||||
|
||||
find_ab_names <- function(ab_group, n = 3) {
|
||||
ab_group <- gsub("[^a-zA-Z0-9]", ".*", ab_group)
|
||||
drugs <- antibiotics[which(antibiotics$group %like% ab_group & !antibiotics$ab %like% "[0-9]$"), ]$name
|
||||
drugs <- antibiotics[which(antibiotics$group %like% ab_group & antibiotics$ab %unlike% "[0-9]$"), ]$name
|
||||
paste0(sort(ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
|
||||
tolower = TRUE, language = NULL)),
|
||||
collapse = ", ")
|
||||
|
||||
+280
-157
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,104 +20,138 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine first (weighted) isolates
|
||||
#' Determine First (Weighted) Isolates
|
||||
#'
|
||||
#' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type. To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x a [data.frame] containing isolates. Can be left blank when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()].
|
||||
#' Determine first (weighted) 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 *et al.* in 2007 (\doi{10.1086/511864}). To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [data.frame] containing isolates. Can be left blank for automatic determination, see *Examples*.
|
||||
#' @param col_date column name of the result date (or date that is was received on the lab), defaults to the first column with a date class
|
||||
#' @param col_patient_id column name of the unique IDs of the patients, defaults to the first column that starts with 'patient' or 'patid' (case insensitive)
|
||||
#' @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_keyantibiotics column name of the key antibiotics to determine first *weighted* isolates, see [key_antibiotics()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' (case insensitive). Use `col_keyantibiotics = FALSE` to prevent this.
|
||||
#' @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 character vector with test codes that should be excluded (case-insensitive)
|
||||
#' @param icu_exclude logical whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
|
||||
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first (weighted) 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)
|
||||
#' @param icu_exclude a [logical] to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
|
||||
#' @param specimen_group value in the column set with `col_specimen` to filter on
|
||||
#' @param type type to determine weighed isolates; can be `"keyantibiotics"` or `"points"`, see Details
|
||||
#' @param ignore_I logical to determine whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantibiotics"`, see Details
|
||||
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when `type = "points"`, see Details
|
||||
#' @param info print progress
|
||||
#' @param include_unknown logical to determine whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
|
||||
#' @param type type to determine weighed isolates; can be `"keyantimicrobials"` or `"points"`, see *Details*
|
||||
#' @param method the method to apply, either `"phenotype-based"`, `"episode-based"`, `"patient-based"` or `"isolate-based"` (can be abbreviated), see *Details*. The default is `"phenotype-based"` if antimicrobial test results are present in the data, and `"episode-based"` otherwise.
|
||||
#' @param ignore_I [logical] to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*
|
||||
#' @param points_threshold minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*
|
||||
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param include_unknown a [logical] to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param include_untested_rsi a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], otherwise arguments passed on to [key_antimicrobials()] (such as `universal`, `gram_negative`, `gram_positive`)
|
||||
#' @details
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be left blank, please see *Examples*.
|
||||
#' To conduct epidemiological analyses on antimicrobial resistance data, only so-called first isolates should be included to prevent overestimation and underestimation of antimicrobial resistance. Different methods can be used to do so, see below.
|
||||
#'
|
||||
#' These functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but more efficient for data sets containing microorganism codes or names.
|
||||
#'
|
||||
#' All isolates with a microbial ID of `NA` will be excluded as first isolate.
|
||||
#'
|
||||
#' ### Why this is so important
|
||||
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode [(Hindler *et al.* 2007)](https://pubmed.ncbi.nlm.nih.gov/17304462/). If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all *S. aureus* isolates would be overestimated, because you included this MRSA more than once. It would be [selection bias](https://en.wikipedia.org/wiki/Selection_bias).
|
||||
#'
|
||||
#' ### `filter_*()` shortcuts
|
||||
#'
|
||||
#' The functions [filter_first_isolate()] and [filter_first_weighted_isolate()] are helper functions to quickly filter on first isolates.
|
||||
#' ## Different methods
|
||||
#'
|
||||
#' The function [filter_first_isolate()] is essentially equal to either:
|
||||
#' According to Hindler *et al.* (2007, \doi{10.1086/511864}), there are different methods (algorithms) to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All methods select on a combination of the taxonomic genus and species (not subspecies).
|
||||
#'
|
||||
#' ```
|
||||
#' x[first_isolate(x, ...), ]
|
||||
#'
|
||||
#' x %>% filter(first_isolate(...))
|
||||
#' ```
|
||||
#' All mentioned methods are covered in the [first_isolate()] function:
|
||||
#'
|
||||
#' The function [filter_first_weighted_isolate()] is essentially equal to:
|
||||
#'
|
||||
#' ```
|
||||
#' x %>%
|
||||
#' mutate(keyab = key_antibiotics(.)) %>%
|
||||
#' mutate(only_weighted_firsts = first_isolate(x,
|
||||
#' col_keyantibiotics = "keyab", ...)) %>%
|
||||
#' filter(only_weighted_firsts == TRUE) %>%
|
||||
#' select(-only_weighted_firsts, -keyab)
|
||||
#' ```
|
||||
#' @section Key antibiotics:
|
||||
#' There are two ways to determine whether isolates can be included as first *weighted* isolates which will give generally the same results:
|
||||
#'
|
||||
#' 1. Using `type = "keyantibiotics"` and argument `ignore_I`
|
||||
#' | **Method** | **Function to apply** |
|
||||
#' |--------------------------------------------------|-------------------------------------------------------|
|
||||
#' | **Isolate-based** | `first_isolate(x, method = "isolate-based")` |
|
||||
#' | *(= all isolates)* | |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Patient-based** | `first_isolate(x, method = "patient-based")` |
|
||||
#' | *(= first isolate per patient)* | |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Episode-based** | `first_isolate(x, method = "episode-based")`, or: |
|
||||
#' | *(= first isolate per episode)* | |
|
||||
#' | - 7-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 7)` |
|
||||
#' | - 30-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 30)` |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Phenotype-based** | `first_isolate(x, method = "phenotype-based")`, or: |
|
||||
#' | *(= first isolate per phenotype)* | |
|
||||
#' | - Major difference in any antimicrobial result | - `first_isolate(x, type = "points")` |
|
||||
#' | - Any difference in key antimicrobial results | - `first_isolate(x, type = "keyantimicrobials")` |
|
||||
#'
|
||||
#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the [key_antibiotics()] function.
|
||||
#' ### Isolate-based
|
||||
#'
|
||||
#' This method does not require any selection, as all isolates should be included. It does, however, respect all arguments set in the [first_isolate()] function. For example, the default setting for `include_unknown` (`FALSE`) will omit selection of rows without a microbial ID.
|
||||
#'
|
||||
#' ### Patient-based
|
||||
#'
|
||||
#' To include every genus-species combination per patient once, set the `episode_days` to `Inf`. Although often inappropriate, this method makes sure that no duplicate isolates are selected from the same patient. In a large longitudinal data set, this could mean that isolates are *excluded* that were found years after the initial isolate.
|
||||
#'
|
||||
#' ### Episode-based
|
||||
#'
|
||||
#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data, long episodes are common for analysing regional and national data.
|
||||
#'
|
||||
#' This is the most common method to correct for duplicate isolates. Patients are categorised into episodes based on their ID and dates (e.g., the date of specimen receipt or laboratory result). While this is a common method, it does not take into account antimicrobial test results. This means that e.g. a methicillin-resistant *Staphylococcus aureus* (MRSA) isolate cannot be differentiated from a wildtype *Staphylococcus aureus* isolate.
|
||||
#'
|
||||
#' ### Phenotype-based
|
||||
#'
|
||||
#' This is a more reliable method, since it also *weighs* the antibiogram (antimicrobial test results) yielding so-called 'first weighted isolates'. There are two different methods to weigh the antibiogram:
|
||||
#'
|
||||
#' 1. Using `type = "points"` and argument `points_threshold`
|
||||
#'
|
||||
#' This method weighs *all* antimicrobial agents available in the data set. Any difference from I to S or R (or vice versa) counts as 0.5 points, a difference from S to R (or vice versa) counts as 1 point. When the sum of points exceeds `points_threshold`, which defaults to `2`, an isolate will be selected as a first weighted isolate.
|
||||
#'
|
||||
#' 2. Using `type = "points"` and argument `points_threshold`
|
||||
#' All antimicrobials are internally selected using the [all_antimicrobials()] function. The output of this function does not need to be passed to the [first_isolate()] function.
|
||||
#'
|
||||
#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds `points_threshold`, which default to `2`, an isolate will be (re)selected as a first weighted isolate.
|
||||
#'
|
||||
#' 2. Using `type = "keyantimicrobials"` and argument `ignore_I`
|
||||
#'
|
||||
#' This method only weighs specific antimicrobial agents, called *key antimicrobials*. Any difference from S to R (or vice versa) in these key antimicrobials will select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S or R (or vice versa) will lead to this.
|
||||
#'
|
||||
#' Key antimicrobials are internally selected using the [key_antimicrobials()] function, but can also be added manually as a variable to the data and set in the `col_keyantimicrobials` argument. Another option is to pass the output of the [key_antimicrobials()] function directly to the `col_keyantimicrobials` argument.
|
||||
#'
|
||||
#'
|
||||
#' The default method is phenotype-based (using `type = "points"`) and episode-based (using `episode_days = 365`). This makes sure that every genus-species combination is selected per patient once per year, while taking into account all antimicrobial test results. If no antimicrobial test results are available in the data set, only the episode-based method is applied at default.
|
||||
#' @rdname first_isolate
|
||||
#' @seealso [key_antibiotics()]
|
||||
#' @seealso [key_antimicrobials()]
|
||||
#' @export
|
||||
#' @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/>.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' - **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/>.
|
||||
#'
|
||||
#' - Hindler JF and Stelling J (2007). **Analysis and Presentation of Cumulative Antibiograms: A New Consensus Guideline from the Clinical and Laboratory Standards Institute.** Clinical Infectious Diseases, 44(6), 867–873. \doi{10.1086/511864}
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # basic filtering on first isolates
|
||||
#' example_isolates[first_isolate(example_isolates), ]
|
||||
#'
|
||||
#' # filtering based on isolates ----------------------------------------------
|
||||
#' \donttest{
|
||||
#' # faster way, only works in R 3.2 and later:
|
||||
#' example_isolates[first_isolate(), ]
|
||||
#'
|
||||
#' # get all first Gram-negatives
|
||||
#' example_isolates[which(first_isolate() & mo_is_gram_negative()), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' # filter on first isolates:
|
||||
#' example_isolates %>%
|
||||
#' mutate(first_isolate = first_isolate(.)) %>%
|
||||
#' filter(first_isolate == TRUE)
|
||||
#'
|
||||
#' # short-hand versions:
|
||||
#' # filter on first isolates using dplyr:
|
||||
#' example_isolates %>%
|
||||
#' filter(first_isolate())
|
||||
#'
|
||||
#' # short-hand version:
|
||||
#' example_isolates %>%
|
||||
#' filter_first_isolate()
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' filter_first_weighted_isolate()
|
||||
#' # grouped determination of first isolates (also prints group names):
|
||||
#' example_isolates %>%
|
||||
#' group_by(hospital_id) %>%
|
||||
#' mutate(first = first_isolate())
|
||||
#'
|
||||
#' # now let's see if first isolates matter:
|
||||
#' A <- example_isolates %>%
|
||||
@@ -126,37 +160,54 @@
|
||||
#' resistance = resistance(GEN)) # gentamicin resistance
|
||||
#'
|
||||
#' B <- example_isolates %>%
|
||||
#' filter_first_weighted_isolate() %>% # the 1st isolate filter
|
||||
#' 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.
|
||||
#' # B is more reliable because every isolate is counted only once.
|
||||
#' # Gentamicin resistance in hospital D appears to be 3.7% higher than
|
||||
#' # Gentamicin resistance in hospital D appears to be 4.2% higher than
|
||||
#' # when you (erroneously) would have used all isolates for analysis.
|
||||
#' }
|
||||
#' }
|
||||
first_isolate <- function(x,
|
||||
first_isolate <- function(x = NULL,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
col_testcode = NULL,
|
||||
col_specimen = NULL,
|
||||
col_icu = NULL,
|
||||
col_keyantibiotics = NULL,
|
||||
col_keyantimicrobials = NULL,
|
||||
episode_days = 365,
|
||||
testcodes_exclude = NULL,
|
||||
icu_exclude = FALSE,
|
||||
specimen_group = NULL,
|
||||
type = "keyantibiotics",
|
||||
type = "points",
|
||||
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = interactive(),
|
||||
include_unknown = FALSE,
|
||||
include_untested_rsi = TRUE,
|
||||
...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- names(dots)
|
||||
if ("filter_specimen" %in% dots.names) {
|
||||
specimen_group <- dots[which(dots.names == "filter_specimen")]
|
||||
}
|
||||
if ("col_keyantibiotics" %in% dots.names) {
|
||||
col_keyantimicrobials <- dots[which(dots.names == "col_keyantibiotics")]
|
||||
}
|
||||
}
|
||||
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
@@ -168,41 +219,93 @@ first_isolate <- function(x,
|
||||
}
|
||||
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 (isFALSE(col_keyantibiotics)) {
|
||||
col_keyantibiotics <- NULL
|
||||
# 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", "p", "e", "i"))
|
||||
# key antimicrobials
|
||||
if (length(col_keyantimicrobials) > 1) {
|
||||
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = nrow(x))
|
||||
x$keyabcol <- col_keyantimicrobials
|
||||
col_keyantimicrobials <- "keyabcol"
|
||||
} else {
|
||||
if (isFALSE(col_keyantimicrobials)) {
|
||||
col_keyantimicrobials <- NULL
|
||||
# method cannot be phenotype-based anymore
|
||||
if (method == "phenotype-based") {
|
||||
method <- "episode-based"
|
||||
}
|
||||
}
|
||||
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
}
|
||||
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
meet_criteria(testcodes_exclude, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(icu_exclude, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(specimen_group, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(type, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
if ("filter_specimen" %in% dots.names) {
|
||||
specimen_group <- dots[which(dots.names == "filter_specimen")]
|
||||
}
|
||||
if ("tbl" %in% dots.names) {
|
||||
x <- dots[which(dots.names == "tbl")]
|
||||
}
|
||||
}
|
||||
meet_criteria(include_untested_rsi, allow_class = "logical", has_length = 1)
|
||||
|
||||
# remove data.table, grouping from tibbles, etc.
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
# try to find columns based on type
|
||||
any_col_contains_rsi <- any(vapply(FUN.VALUE = logical(1),
|
||||
X = x,
|
||||
FUN = function(x) any(as.character(x) %in% c("R", "S", "I"), na.rm = TRUE),
|
||||
USE.NAMES = FALSE))
|
||||
if (method == "phenotype-based" & !any_col_contains_rsi) {
|
||||
method <- "episode-based"
|
||||
}
|
||||
if (info == TRUE & message_not_thrown_before("first_isolate.method")) {
|
||||
message_(paste0("Determining first isolates using the '", font_bold(method), "' method",
|
||||
ifelse(method %in% c("episode-based", "phenotype-based"),
|
||||
ifelse(is.infinite(episode_days),
|
||||
" without a specified episode length",
|
||||
paste(" and an episode length of", episode_days, "days")),
|
||||
"")),
|
||||
as_note = FALSE,
|
||||
add_fn = font_black)
|
||||
remember_thrown_message("first_isolate.method")
|
||||
}
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
}
|
||||
|
||||
# methods ----
|
||||
if (method == "isolate-based") {
|
||||
episode_days <- Inf
|
||||
col_keyantimicrobials <- NULL
|
||||
x$dummy_dates <- Sys.Date()
|
||||
col_date <- "dummy_dates"
|
||||
x$dummy_patients <- paste("dummy", seq_len(nrow(x))) # all 'patients' must be unique
|
||||
col_patient_id <- "dummy_patients"
|
||||
} else if (method == "patient-based") {
|
||||
episode_days <- Inf
|
||||
col_keyantimicrobials <- NULL
|
||||
} else if (method == "episode-based") {
|
||||
col_keyantimicrobials <- NULL
|
||||
} else if (method == "phenotype-based") {
|
||||
if (missing(type) & !is.null(col_keyantimicrobials)) {
|
||||
# type = "points" is default, but not set explicitly, while col_keyantimicrobials is
|
||||
type <- "keyantimicrobials"
|
||||
}
|
||||
if (type == "points") {
|
||||
x$keyantimicrobials <- all_antimicrobials(x, only_rsi_columns = FALSE)
|
||||
col_keyantimicrobials <- "keyantimicrobials"
|
||||
} else if (type == "keyantimicrobials" & is.null(col_keyantimicrobials)) {
|
||||
col_keyantimicrobials <- search_type_in_df(x = x, type = "keyantibiotics")
|
||||
if (is.null(col_keyantimicrobials)) {
|
||||
# still not found as a column, create it ourselves
|
||||
x$keyantimicrobials <- key_antimicrobials(x, only_rsi_columns = FALSE, col_mo = col_mo, ...)
|
||||
col_keyantimicrobials <- "keyantimicrobials"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# -- date
|
||||
@@ -223,11 +326,6 @@ first_isolate <- function(x,
|
||||
}
|
||||
stop_if(is.null(col_patient_id), "`col_patient_id` must be set")
|
||||
}
|
||||
|
||||
# -- key antibiotics
|
||||
if (is.null(col_keyantibiotics)) {
|
||||
col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
|
||||
}
|
||||
|
||||
# -- specimen
|
||||
if (is.null(col_specimen) & !is.null(specimen_group)) {
|
||||
@@ -247,7 +345,7 @@ first_isolate <- function(x,
|
||||
check_columns_existance(col_mo)
|
||||
check_columns_existance(col_testcode)
|
||||
check_columns_existance(col_icu)
|
||||
check_columns_existance(col_keyantibiotics)
|
||||
check_columns_existance(col_keyantimicrobials)
|
||||
|
||||
# convert dates to Date
|
||||
dates <- as.Date(x[, col_date, drop = TRUE])
|
||||
@@ -256,7 +354,7 @@ first_isolate <- function(x,
|
||||
|
||||
# create original row index
|
||||
x$newvar_row_index <- seq_len(nrow(x))
|
||||
x$newvar_mo <- x[, col_mo, drop = TRUE]
|
||||
x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||
x$newvar_genus_species <- paste(mo_genus(x$newvar_mo), mo_species(x$newvar_mo))
|
||||
x$newvar_date <- x[, col_date, drop = TRUE]
|
||||
x$newvar_patient_id <- x[, col_patient_id, drop = TRUE]
|
||||
@@ -265,10 +363,11 @@ first_isolate <- function(x,
|
||||
testcodes_exclude <- NULL
|
||||
}
|
||||
# remove testcodes
|
||||
if (!is.null(testcodes_exclude) & info == TRUE) {
|
||||
message_("[Criterion] Exclude test codes: ", toString(paste0("'", testcodes_exclude, "'")),
|
||||
if (!is.null(testcodes_exclude) & info == TRUE & message_not_thrown_before("first_isolate.excludingtestcodes")) {
|
||||
message_("Excluding test codes: ", toString(paste0("'", testcodes_exclude, "'")),
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
remember_thrown_message("first_isolate.excludingtestcodes")
|
||||
}
|
||||
|
||||
if (is.null(col_specimen)) {
|
||||
@@ -278,14 +377,15 @@ first_isolate <- function(x,
|
||||
# filter on specimen group and keyantibiotics when they are filled in
|
||||
if (!is.null(specimen_group)) {
|
||||
check_columns_existance(col_specimen, x)
|
||||
if (info == TRUE) {
|
||||
message_("[Criterion] Exclude other than specimen group '", specimen_group, "'",
|
||||
if (info == TRUE & message_not_thrown_before("first_isolate.excludingspecimen")) {
|
||||
message_("Excluding other than specimen group '", specimen_group, "'",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
remember_thrown_message("first_isolate.excludingspecimen")
|
||||
}
|
||||
}
|
||||
if (!is.null(col_keyantibiotics)) {
|
||||
x$newvar_key_ab <- x[, col_keyantibiotics, drop = TRUE]
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
x$newvar_key_ab <- x[, col_keyantimicrobials, drop = TRUE]
|
||||
}
|
||||
|
||||
if (is.null(testcodes_exclude)) {
|
||||
@@ -326,7 +426,7 @@ first_isolate <- function(x,
|
||||
}
|
||||
if (row.start == row.end) {
|
||||
if (info == TRUE) {
|
||||
message_("=> Found ", font_bold("1 isolate"), ", as the data only contained 1 row",
|
||||
message_("=> Found ", font_bold("1 first isolate"), ", as the data only contained 1 row",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
}
|
||||
@@ -334,7 +434,7 @@ first_isolate <- function(x,
|
||||
}
|
||||
if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) {
|
||||
if (info == TRUE) {
|
||||
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "isolates")),
|
||||
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")),
|
||||
", as all isolates were different microorganisms",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
@@ -354,40 +454,38 @@ first_isolate <- function(x,
|
||||
FALSE,
|
||||
TRUE)
|
||||
x$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
|
||||
x$more_than_episode_ago <- unlist(lapply(unique(x$episode_group),
|
||||
function(g,
|
||||
df = x,
|
||||
days = episode_days) {
|
||||
is_new_episode(x = df[which(df$episode_group == g), ]$newvar_date,
|
||||
episode_days = days)
|
||||
}))
|
||||
x$more_than_episode_ago <- unlist(lapply(split(x$newvar_date,
|
||||
x$episode_group),
|
||||
is_new_episode,
|
||||
episode_days = episode_days),
|
||||
use.names = FALSE)
|
||||
|
||||
weighted.notice <- ""
|
||||
if (!is.null(col_keyantibiotics)) {
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
weighted.notice <- "weighted "
|
||||
if (info == TRUE) {
|
||||
if (type == "keyantibiotics") {
|
||||
message_("[Criterion] Base inclusion on key antibiotics, ",
|
||||
if (info == TRUE & message_not_thrown_before("first_isolate.type")) {
|
||||
if (type == "keyantimicrobials") {
|
||||
message_("Basing inclusion on key antimicrobials, ",
|
||||
ifelse(ignore_I == FALSE, "not ", ""),
|
||||
"ignoring I",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
}
|
||||
if (type == "points") {
|
||||
message_("[Criterion] Base inclusion on key antibiotics, using points threshold of "
|
||||
message_("Basing inclusion on all antimicrobial results, using a points threshold of "
|
||||
, points_threshold,
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
}
|
||||
remember_thrown_message("first_isolate.type")
|
||||
}
|
||||
type_param <- type
|
||||
|
||||
x$other_key_ab <- !key_antibiotics_equal(y = x$newvar_key_ab,
|
||||
z = pm_lag(x$newvar_key_ab),
|
||||
type = type_param,
|
||||
ignore_I = ignore_I,
|
||||
points_threshold = points_threshold,
|
||||
info = info)
|
||||
x$other_key_ab <- !antimicrobials_equal(y = x$newvar_key_ab,
|
||||
z = pm_lag(x$newvar_key_ab),
|
||||
type = type_param,
|
||||
ignore_I = ignore_I,
|
||||
points_threshold = points_threshold)
|
||||
# with key antibiotics
|
||||
x$newvar_first_isolate <- pm_if_else(x$newvar_row_index_sorted >= row.start &
|
||||
x$newvar_row_index_sorted <= row.end &
|
||||
@@ -414,12 +512,12 @@ first_isolate <- function(x,
|
||||
}
|
||||
if (!is.null(col_icu)) {
|
||||
if (icu_exclude == TRUE) {
|
||||
message_("[Criterion] Exclude isolates from ICU.",
|
||||
message_("Excluding isolates from ICU.",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
x[which(as.logical(x[, col_icu, drop = TRUE])), "newvar_first_isolate"] <- FALSE
|
||||
} else {
|
||||
message_("[Criterion] Include isolates from ICU.",
|
||||
message_("Including isolates from ICU.",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE)
|
||||
}
|
||||
@@ -428,12 +526,35 @@ first_isolate <- function(x,
|
||||
decimal.mark <- getOption("OutDec")
|
||||
big.mark <- ifelse(decimal.mark != ",", ",", ".")
|
||||
|
||||
if (info == TRUE) {
|
||||
# print group name if used in dplyr::group_by()
|
||||
cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_group)) {
|
||||
group_df <- tryCatch(cur_group(), error = function(e) data.frame())
|
||||
if (NCOL(group_df) > 0) {
|
||||
# transform factors to characters
|
||||
group <- vapply(FUN.VALUE = character(1), group_df, function(x) {
|
||||
if (is.numeric(x)) {
|
||||
format(x)
|
||||
} else if (is.logical(x)) {
|
||||
as.character(x)
|
||||
} else {
|
||||
paste0('"', x, '"')
|
||||
}
|
||||
})
|
||||
message_("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n",
|
||||
as_note = FALSE,
|
||||
add_fn = font_red)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# handle empty microorganisms
|
||||
if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) & info == TRUE) {
|
||||
message_(ifelse(include_unknown == TRUE, "Included ", "Excluded "),
|
||||
format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark),
|
||||
" isolates with a microbial ID 'UNKNOWN' (column '", font_bold(col_mo), "')")
|
||||
" isolates with a microbial ID 'UNKNOWN' (in column '", font_bold(col_mo), "')")
|
||||
}
|
||||
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
|
||||
|
||||
@@ -441,10 +562,18 @@ first_isolate <- function(x,
|
||||
if (any(is.na(x$newvar_mo)) & info == TRUE) {
|
||||
message_("Excluded ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark),
|
||||
" isolates with a microbial ID 'NA' (column '", font_bold(col_mo), "')")
|
||||
" isolates with a microbial ID 'NA' (in column '", font_bold(col_mo), "')")
|
||||
}
|
||||
x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
|
||||
|
||||
# handle isolates without antibiogram
|
||||
if (include_untested_rsi == FALSE && any(is.rsi(x))) {
|
||||
rsi_all_NA <- which(unname(vapply(FUN.VALUE = logical(1),
|
||||
as.data.frame(t(x[, is.rsi(x), drop = FALSE])),
|
||||
function(rsi_values) all(is.na(rsi_values)))))
|
||||
x[rsi_all_NA, "newvar_first_isolate"] <- FALSE
|
||||
}
|
||||
|
||||
# arrange back according to original sorting again
|
||||
x <- x[order(x$newvar_row_index), ]
|
||||
rownames(x) <- NULL
|
||||
@@ -453,10 +582,10 @@ first_isolate <- function(x,
|
||||
n_found <- sum(x$newvar_first_isolate, na.rm = TRUE)
|
||||
p_found_total <- percentage(n_found / nrow(x[which(!is.na(x$newvar_mo)), , drop = FALSE]), digits = 1)
|
||||
p_found_scope <- percentage(n_found / scope.size, digits = 1)
|
||||
if (!p_found_total %like% "[.]") {
|
||||
if (p_found_total %unlike% "[.]") {
|
||||
p_found_total <- gsub("%", ".0%", p_found_total, fixed = TRUE)
|
||||
}
|
||||
if (!p_found_scope %like% "[.]") {
|
||||
if (p_found_scope %unlike% "[.]") {
|
||||
p_found_scope <- gsub("%", ".0%", p_found_scope, fixed = TRUE)
|
||||
}
|
||||
# mark up number of found
|
||||
@@ -464,11 +593,11 @@ first_isolate <- function(x,
|
||||
if (p_found_total != p_found_scope) {
|
||||
msg_txt <- paste0("=> Found ",
|
||||
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),
|
||||
" (", p_found_scope, " within scope and ", p_found_total, " of total where a microbial ID was available)")
|
||||
" (", method, ", ", p_found_scope, " within scope and ", p_found_total, " of total where a microbial ID was available)")
|
||||
} else {
|
||||
msg_txt <- paste0("=> Found ",
|
||||
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),
|
||||
" (", p_found_total, " of total where a microbial ID was available)")
|
||||
" (", method, ", ", p_found_total, " of total where a microbial ID was available)")
|
||||
}
|
||||
message_(msg_txt, add_fn = font_black, as_note = FALSE)
|
||||
}
|
||||
@@ -479,49 +608,43 @@ first_isolate <- function(x,
|
||||
|
||||
#' @rdname first_isolate
|
||||
#' @export
|
||||
filter_first_isolate <- function(x,
|
||||
filter_first_isolate <- function(x = NULL,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
episode_days = 365,
|
||||
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
method <- coerce_method(method)
|
||||
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based", "p", "e", "i"))
|
||||
|
||||
subset(x, first_isolate(x = x,
|
||||
col_date = col_date,
|
||||
col_patient_id = col_patient_id,
|
||||
col_mo = col_mo,
|
||||
episode_days = episode_days,
|
||||
method = method,
|
||||
...))
|
||||
}
|
||||
|
||||
#' @rdname first_isolate
|
||||
#' @export
|
||||
filter_first_weighted_isolate <- function(x,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
col_keyantibiotics = NULL,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
y <- x
|
||||
if (is.null(col_keyantibiotics)) {
|
||||
# first try to look for it
|
||||
col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
|
||||
# still NULL? Then create it since we are calling filter_first_WEIGHTED_isolate()
|
||||
if (is.null(col_keyantibiotics)) {
|
||||
y$keyab <- suppressMessages(key_antibiotics(x,
|
||||
col_mo = col_mo,
|
||||
...))
|
||||
col_keyantibiotics <- "keyab"
|
||||
}
|
||||
coerce_method <- function(method) {
|
||||
if (is.null(method)) {
|
||||
return(method)
|
||||
}
|
||||
|
||||
subset(x, first_isolate(x = y,
|
||||
col_date = col_date,
|
||||
col_patient_id = col_patient_id))
|
||||
method <- tolower(as.character(method[1L]))
|
||||
method[method %like% "^(p$|pheno)"] <- "phenotype-based"
|
||||
method[method %like% "^(e$|episode)"] <- "episode-based"
|
||||
method[method %like% "^patient"] <- "patient-based"
|
||||
method[method %like% "^(i$|iso)"] <- "isolate-based"
|
||||
method
|
||||
}
|
||||
|
||||
+9
-9
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,17 +20,17 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' *G*-test for Count Data
|
||||
#'
|
||||
#' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**).
|
||||
#' @inheritSection lifecycle Questioning lifecycle
|
||||
#' @inheritSection lifecycle Questioning Lifecycle
|
||||
#' @inherit stats::chisq.test params return
|
||||
#' @details If `x` is a matrix with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
|
||||
#' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
|
||||
#'
|
||||
#' If `x` is a matrix with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
|
||||
#' If `x` is a [matrix] with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
|
||||
#'
|
||||
#' The p-value is computed from the asymptotic chi-squared distribution of the test statistic.
|
||||
#'
|
||||
@@ -38,14 +38,14 @@
|
||||
#'
|
||||
#' In the goodness-of-fit case simulation is done by random sampling from the discrete distribution specified by `p`, each sample being of size `n = sum(x)`. This simulation is done in \R and may be slow.
|
||||
#'
|
||||
#' ## *G*-test of goodness-of-fit (likelihood ratio test)
|
||||
#' ## *G*-test Of Goodness-of-Fit (Likelihood Ratio Test)
|
||||
#' Use the *G*-test of goodness-of-fit when you have one nominal variable with two or more values (such as male and female, or red, pink and white flowers). You compare the observed counts of numbers of observations in each category with the expected counts, which you calculate using some kind of theoretical expectation (such as a 1:1 sex ratio or a 1:2:1 ratio in a genetic cross).
|
||||
#'
|
||||
#' If the expected number of observations in any category is too small, the *G*-test may give inaccurate results, and you should use an exact test instead ([fisher.test()]).
|
||||
#'
|
||||
#' The *G*-test of goodness-of-fit is an alternative to the chi-square test of goodness-of-fit ([chisq.test()]); each of these tests has some advantages and some disadvantages, and the results of the two tests are usually very similar.
|
||||
#'
|
||||
#' ## *G*-test of independence
|
||||
#' ## *G*-test of Independence
|
||||
#' Use the *G*-test of independence when you have two nominal variables, each with two or more possible values. You want to know whether the proportions for one variable are different among values of the other variable.
|
||||
#'
|
||||
#' It is also possible to do a *G*-test of independence with more than two nominal variables. For example, Jackson et al. (2013) also had data for children under 3, so you could do an analysis of old vs. young, thigh vs. arm, and reaction vs. no reaction, all analyzed together.
|
||||
@@ -54,7 +54,7 @@
|
||||
#'
|
||||
#' The *G*-test of independence is an alternative to the chi-square test of independence ([chisq.test()]), and they will give approximately the same results.
|
||||
#'
|
||||
#' ## How the test works
|
||||
#' ## How the Test Works
|
||||
#' Unlike the exact test of goodness-of-fit ([fisher.test()]), the *G*-test does not directly calculate the probability of obtaining the observed results or something more extreme. Instead, like almost all statistical tests, the *G*-test has an intermediate step; it uses the data to calculate a test statistic that measures how far the observed data are from the null expectation. You then use a mathematical relationship, in this case the chi-square distribution, to estimate the probability of obtaining that value of the test statistic.
|
||||
#'
|
||||
#' The *G*-test uses the log of the ratio of two likelihoods as the test statistic, which is why it is also called a likelihood ratio test or log-likelihood ratio test. The formula to calculate a *G*-statistic is:
|
||||
@@ -76,7 +76,7 @@
|
||||
#' - The possibility to simulate p values with `simulate.p.value` was removed
|
||||
#' @export
|
||||
#' @importFrom stats pchisq complete.cases
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # = EXAMPLE 1 =
|
||||
#' # Shivrain et al. (2006) crossed clearfield rice (which are resistant
|
||||
|
||||
+22
-22
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,34 +20,34 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' PCA biplot with `ggplot2`
|
||||
#' PCA Biplot with `ggplot2`
|
||||
#'
|
||||
#' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x an object returned by [pca()], [prcomp()] or [princomp()]
|
||||
#' @inheritParams stats::biplot.prcomp
|
||||
#' @param labels an optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
|
||||
#' @param labels_textsize the size of the text used for the labels
|
||||
#' @param labels_text_placement adjustment factor the placement of the variable names (`>=1` means further away from the arrow head)
|
||||
#' @param groups an optional vector of groups for the labels, with the same length as `labels`. If set, the points and labels will be coloured according to these groups. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
|
||||
#' @param ellipse a logical to indicate whether a normal data ellipse should be drawn for each group (set with `groups`)
|
||||
#' @param ellipse a [logical] to indicate whether a normal data ellipse should be drawn for each group (set with `groups`)
|
||||
#' @param ellipse_prob statistical size of the ellipse in normal probability
|
||||
#' @param ellipse_size the size of the ellipse line
|
||||
#' @param ellipse_alpha the alpha (transparency) of the ellipse line
|
||||
#' @param points_size the size of the points
|
||||
#' @param points_alpha the alpha (transparency) of the points
|
||||
#' @param arrows a logical to indicate whether arrows should be drawn
|
||||
#' @param arrows a [logical] to indicate whether arrows should be drawn
|
||||
#' @param arrows_textsize the size of the text for variable names
|
||||
#' @param arrows_colour the colour of the arrow and their text
|
||||
#' @param arrows_size the size (thickness) of the arrow lines
|
||||
#' @param arrows_textsize the size of the text at the end of the arrows
|
||||
#' @param arrows_textangled a logical whether the text at the end of the arrows should be angled
|
||||
#' @param arrows_textangled a [logical] whether the text at the end of the arrows should be angled
|
||||
#' @param arrows_alpha the alpha (transparency) of the arrows and their text
|
||||
#' @param base_textsize the text size for all plot elements except the labels and arrows
|
||||
#' @param ... Arguments passed on to functions
|
||||
#' @param ... arguments passed on to functions
|
||||
#' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015).
|
||||
#'
|
||||
#' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
|
||||
@@ -57,11 +57,11 @@
|
||||
#' 4. Added total amount of explained variance as a caption in the plot
|
||||
#' 5. Cleaned all syntax based on the `lintr` package, fixed grammatical errors and added integrity checks
|
||||
#' 6. Updated documentation
|
||||
#' @details The colours for labels and points can be changed by adding another scale layer for colour, like `scale_colour_viridis_d()` or `scale_colour_brewer()`.
|
||||
#' @details The colours for labels and points can be changed by adding another scale layer for colour, such as `scale_colour_viridis_d()` and `scale_colour_brewer()`.
|
||||
#' @rdname ggplot_pca
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # See ?pca for more info about Principal Component Analysis (PCA).
|
||||
@@ -109,26 +109,26 @@ ggplot_pca <- function(x,
|
||||
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(x, allow_class = c("prcomp", "princomp", "PCA", "lda"))
|
||||
meet_criteria(choices, allow_class = c("numeric", "integer"), has_length = 2)
|
||||
meet_criteria(choices, allow_class = c("numeric", "integer"), has_length = 2, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(scale, allow_class = c("numeric", "integer", "logical"), has_length = 1)
|
||||
meet_criteria(pc.biplot, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(labels, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(labels_textsize, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(labels_text_placement, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(labels_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(labels_text_placement, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(groups, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ellipse, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(ellipse_prob, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(ellipse_size, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(ellipse_alpha, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(points_size, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(points_alpha, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(ellipse_prob, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(ellipse_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(ellipse_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(points_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(points_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(arrows_colour, allow_class = "character", has_length = 1)
|
||||
meet_criteria(arrows_size, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(arrows_textsize, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(arrows_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows_textangled, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(arrows_alpha, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(base_textsize, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(arrows_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(base_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
calculations <- pca_calculations(pca_model = x,
|
||||
groups = groups,
|
||||
|
||||
+93
-65
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,23 +20,24 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' AMR plots with `ggplot2`
|
||||
#' AMR Plots with `ggplot2`
|
||||
#'
|
||||
#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on [ggplot2][ggplot2::ggplot()] functions.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' Use these functions to create bar plots for AMR data analysis. All functions rely on [ggplot2][ggplot2::ggplot()] functions.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param data a [data.frame] with column(s) of class [`rsi`] (see [as.rsi()])
|
||||
#' @param position position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`
|
||||
#' @param x variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable
|
||||
#' @param fill variable to categorise using the plots legend, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable
|
||||
#' @param breaks numeric vector of positions
|
||||
#' @param limits numeric vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum
|
||||
#' @param breaks a [numeric] vector of positions
|
||||
#' @param limits a [numeric] vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum
|
||||
#' @param facet variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable
|
||||
#' @inheritParams proportion
|
||||
#' @param nrow (when using `facet`) number of rows
|
||||
#' @param colours a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be `FALSE` to use default [ggplot2][ggplot2::ggplot()] colours.
|
||||
#' @param colours a named vactor with colour to be used for filling. The default colours are colour-blind friendly.
|
||||
#' @param aesthetics aesthetics to apply the colours to, defaults to "fill" but can also be (a combination of) "alpha", "colour", "fill", "linetype", "shape" or "size"
|
||||
#' @param datalabels show datalabels using [labels_rsi_count()]
|
||||
#' @param datalabels.size size of the datalabels
|
||||
#' @param datalabels.colour colour of the datalabels
|
||||
@@ -45,26 +46,26 @@
|
||||
#' @param caption text to show as caption of the plot
|
||||
#' @param x.title text to show as x axis description
|
||||
#' @param y.title text to show as y axis description
|
||||
#' @param ... other arguments passed on to [geom_rsi()]
|
||||
#' @param ... other arguments passed on to [geom_rsi()] or, in case of [scale_rsi_colours()], named values to set colours. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red. See *Examples*.
|
||||
#' @details At default, the names of antibiotics will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
|
||||
#'
|
||||
#' ## The functions
|
||||
#' ## The Functions
|
||||
#' [geom_rsi()] will take any variable from the data that has an [`rsi`] class (created with [as.rsi()]) using [rsi_df()] and will plot bars with the percentage R, I and S. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis.
|
||||
#'
|
||||
#' [facet_rsi()] creates 2d plots (at default based on S/I/R) using [ggplot2::facet_wrap()].
|
||||
#'
|
||||
#' [scale_y_percent()] transforms the y axis to a 0 to 100% range using [ggplot2::scale_y_continuous()].
|
||||
#'
|
||||
#' [scale_rsi_colours()] sets colours to the bars: pastel blue for S, pastel turquoise for I and pastel red for R, using [ggplot2::scale_fill_manual()].
|
||||
#' [scale_rsi_colours()] sets colours to the bars (green for S, yellow for I, and red for R). with multilingual support. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red.
|
||||
#'
|
||||
#' [theme_rsi()] is a [ggplot2 theme][[ggplot2::theme()] with minimal distraction.
|
||||
#'
|
||||
#' [labels_rsi_count()] print datalabels on the bars with percentage and amount of isolates using [ggplot2::geom_text()].
|
||||
#'
|
||||
#' [ggplot_rsi()] is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (`%>%`). See Examples.
|
||||
#' [ggplot_rsi()] is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (`%>%`). See *Examples*.
|
||||
#' @rdname ggplot_rsi
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' if (require("ggplot2") & require("dplyr")) {
|
||||
#'
|
||||
@@ -99,11 +100,20 @@
|
||||
#' size = 1,
|
||||
#' linetype = 2,
|
||||
#' alpha = 0.25)
|
||||
#'
|
||||
#'
|
||||
#' # you can alter the colours with colour names:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX) %>%
|
||||
#' ggplot_rsi(colours = c(SI = "yellow"))
|
||||
#'
|
||||
#'
|
||||
#' # 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"),
|
||||
#' y = c(1, 2, 3),
|
||||
#' z = c("Value4", "Value5", "Value6")) %>%
|
||||
#' ggplot() +
|
||||
#' geom_col(aes(x = x, y = y, fill = z)) +
|
||||
#' scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
||||
#' }
|
||||
#'
|
||||
#' \donttest{
|
||||
@@ -118,11 +128,6 @@
|
||||
#' CIP) %>%
|
||||
#' ggplot_rsi(x = "age_group")
|
||||
#'
|
||||
#' # for colourblind mode, use divergent colours from the viridis package:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_rsi() +
|
||||
#' scale_fill_viridis_d()
|
||||
#' # a shorter version which also adjusts data label colours:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
@@ -154,11 +159,11 @@ ggplot_rsi <- function(data,
|
||||
minimum = 30,
|
||||
language = get_locale(),
|
||||
nrow = NULL,
|
||||
colours = c(S = "#61a8ff",
|
||||
SI = "#61a8ff",
|
||||
I = "#61f7ff",
|
||||
IR = "#ff6961",
|
||||
R = "#ff6961"),
|
||||
colours = c(S = "#3CAEA3",
|
||||
SI = "#3CAEA3",
|
||||
I = "#F6D55C",
|
||||
IR = "#ED553B",
|
||||
R = "#ED553B"),
|
||||
datalabels = TRUE,
|
||||
datalabels.size = 2.5,
|
||||
datalabels.colour = "grey15",
|
||||
@@ -180,12 +185,12 @@ ggplot_rsi <- function(data,
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(colours, allow_class = c("character", "logical"))
|
||||
meet_criteria(datalabels, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(datalabels.colour, allow_class = "character", has_length = 1)
|
||||
meet_criteria(title, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(subtitle, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
@@ -223,11 +228,6 @@ ggplot_rsi <- function(data,
|
||||
theme_rsi()
|
||||
|
||||
if (fill == "interpretation") {
|
||||
# set RSI colours
|
||||
if (isFALSE(colours) & missing(datalabels.colour)) {
|
||||
# set datalabel colour to middle grey
|
||||
datalabels.colour <- "grey50"
|
||||
}
|
||||
p <- p + scale_rsi_colours(colours = colours)
|
||||
}
|
||||
|
||||
@@ -279,7 +279,7 @@ geom_rsi <- function(position = NULL,
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(fill, allow_class = "character", has_length = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
@@ -308,17 +308,19 @@ geom_rsi <- function(position = NULL,
|
||||
x <- "interpretation"
|
||||
}
|
||||
|
||||
ggplot2::layer(geom = "bar", stat = "identity", position = position,
|
||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||
params = list(...), data = function(x) {
|
||||
rsi_df(data = x,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR)
|
||||
})
|
||||
|
||||
ggplot2::geom_col(
|
||||
data = function(x) {
|
||||
rsi_df(data = x,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR)
|
||||
},
|
||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||
position = position,
|
||||
...
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_rsi
|
||||
@@ -327,7 +329,7 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
|
||||
facet <- facet[1]
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(facet, allow_class = "character", has_length = 1)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
# we work with aes_string later on
|
||||
facet_deparse <- deparse(substitute(facet))
|
||||
@@ -364,26 +366,52 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
|
||||
|
||||
#' @rdname ggplot_rsi
|
||||
#' @export
|
||||
scale_rsi_colours <- function(colours = c(S = "#61a8ff",
|
||||
SI = "#61a8ff",
|
||||
I = "#61f7ff",
|
||||
IR = "#ff6961",
|
||||
R = "#ff6961")) {
|
||||
scale_rsi_colours <- function(...,
|
||||
aesthetics = "fill") {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(colours, allow_class = c("character", "logical"))
|
||||
meet_criteria(aesthetics, allow_class = "character", is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
|
||||
|
||||
# previous colour: palette = "RdYlGn"
|
||||
# previous colours: values = c("#b22222", "#ae9c20", "#7cfc00")
|
||||
|
||||
if (!identical(colours, FALSE)) {
|
||||
original_cols <- c(S = "#61a8ff",
|
||||
SI = "#61a8ff",
|
||||
I = "#61f7ff",
|
||||
IR = "#ff6961",
|
||||
R = "#ff6961")
|
||||
colours <- replace(original_cols, names(colours), colours)
|
||||
ggplot2::scale_fill_manual(values = colours)
|
||||
# behaviour until AMR pkg v1.5.0 and also when coming from ggplot_rsi()
|
||||
if ("colours" %in% names(list(...))) {
|
||||
original_cols <- c(S = "#3CAEA3",
|
||||
SI = "#3CAEA3",
|
||||
I = "#F6D55C",
|
||||
IR = "#ED553B",
|
||||
R = "#ED553B")
|
||||
colours <- replace(original_cols, names(list(...)$colours), list(...)$colours)
|
||||
return(ggplot2::scale_fill_manual(values = colours))
|
||||
}
|
||||
if (identical(unlist(list(...)), FALSE)) {
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible",
|
||||
unique(translations_file[which(translations_file$pattern == "Susceptible"),
|
||||
"replacement", drop = TRUE]))
|
||||
names_incr_exposure <- c("I", "intermediate", "increased exposure", "incr. exposure", "Increased exposure", "Incr. exposure",
|
||||
unique(translations_file[which(translations_file$pattern == "Intermediate"),
|
||||
"replacement", drop = TRUE]),
|
||||
unique(translations_file[which(translations_file$pattern == "Incr. exposure"),
|
||||
"replacement", drop = TRUE]))
|
||||
names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant",
|
||||
unique(translations_file[which(translations_file$pattern == "Resistant"),
|
||||
"replacement", drop = TRUE]))
|
||||
|
||||
susceptible <- rep("#3CAEA3", length(names_susceptible))
|
||||
names(susceptible) <- names_susceptible
|
||||
incr_exposure <- rep("#F6D55C", length(names_incr_exposure))
|
||||
names(incr_exposure) <- names_incr_exposure
|
||||
resistant <- rep("#ED553B", length(names_resistant))
|
||||
names(resistant) <- names_resistant
|
||||
|
||||
original_cols = c(susceptible, incr_exposure, resistant)
|
||||
dots <- c(...)
|
||||
# replace S, I, R as colours: scale_rsi_colours(mydatavalue = "S")
|
||||
dots[dots == "S"] <- "#3CAEA3"
|
||||
dots[dots == "I"] <- "#F6D55C"
|
||||
dots[dots == "R"] <- "#ED553B"
|
||||
cols <- replace(original_cols, names(dots), dots)
|
||||
ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = cols)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_rsi
|
||||
@@ -414,11 +442,11 @@ labels_rsi_count <- function(position = NULL,
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(datalabels.colour, allow_class = "character", has_length = 1)
|
||||
|
||||
if (is.null(position)) {
|
||||
|
||||
+49
-3
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,19 +20,61 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and rsi_translation
|
||||
# (sourcing "data-raw/_internals.R" will process the TSV file)
|
||||
EUCAST_VERSION_BREAKPOINTS <- list("11.0" = list(version_txt = "v11.0",
|
||||
year = 2021,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"),
|
||||
"10.0" = list(version_txt = "v10.0",
|
||||
year = 2020,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/ast_of_bacteria/previous_versions_of_documents/"))
|
||||
EUCAST_VERSION_EXPERT_RULES <- list("3.1" = list(version_txt = "v3.1",
|
||||
year = 2016,
|
||||
title = "'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"),
|
||||
"3.2" = list(version_txt = "v3.2",
|
||||
year = 2020,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"))
|
||||
|
||||
SNOMED_VERSION <- list(title = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS)",
|
||||
current_source = "US Edition of SNOMED CT from 1 September 2020",
|
||||
current_version = 12,
|
||||
current_oid = "2.16.840.1.114222.4.11.1009",
|
||||
value_set_name = "Microorganism",
|
||||
url = "https://phinvads.cdc.gov/vads/ViewValueSet.action?oid=2.16.840.1.114222.4.11.1009")
|
||||
|
||||
CATALOGUE_OF_LIFE <- list(
|
||||
year = 2019,
|
||||
version = "Catalogue of Life: {year} Annual Checklist",
|
||||
url_CoL = "http://www.catalogueoflife.org/col/",
|
||||
url_LPSN = "https://lpsn.dsmz.de",
|
||||
yearmonth_LPSN = "March 2021"
|
||||
)
|
||||
|
||||
globalVariables(c(".rowid",
|
||||
"ab",
|
||||
"ab_txt",
|
||||
"affect_mo_name",
|
||||
"angle",
|
||||
"antibiotic",
|
||||
"antibiotics",
|
||||
"atc_group1",
|
||||
"atc_group2",
|
||||
"base_ab",
|
||||
"code",
|
||||
"cols",
|
||||
"count",
|
||||
"data",
|
||||
"disk",
|
||||
"dosage",
|
||||
"dose",
|
||||
"dose_times",
|
||||
"fullname",
|
||||
"fullname_lower",
|
||||
"g_species",
|
||||
@@ -48,6 +90,8 @@ globalVariables(c(".rowid",
|
||||
"language",
|
||||
"lookup",
|
||||
"method",
|
||||
"mic",
|
||||
"mic ",
|
||||
"microorganism",
|
||||
"microorganisms",
|
||||
"microorganisms.codes",
|
||||
@@ -63,8 +107,9 @@ globalVariables(c(".rowid",
|
||||
"reference.rule",
|
||||
"reference.rule_group",
|
||||
"reference.version",
|
||||
"rsi_translation",
|
||||
"rowid",
|
||||
"rsi",
|
||||
"rsi_translation",
|
||||
"rule_group",
|
||||
"rule_name",
|
||||
"se_max",
|
||||
@@ -73,6 +118,7 @@ globalVariables(c(".rowid",
|
||||
"species_id",
|
||||
"total",
|
||||
"txt",
|
||||
"type",
|
||||
"value",
|
||||
"varname",
|
||||
"xvar",
|
||||
|
||||
+50
-50
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,20 +20,21 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Guess antibiotic column
|
||||
#' Guess Antibiotic Column
|
||||
#'
|
||||
#' This tries to find a column name in a data set based on information from the [antibiotics] data set. Also supports WHONET abbreviations.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [data.frame]
|
||||
#' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`
|
||||
#' @param verbose a logical to indicate whether additional info should be printed
|
||||
#' @param verbose a [logical] to indicate whether additional info should be printed
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precedence over shorter column names.**
|
||||
#' @return A column name of `x`, or `NULL` when no result is found.
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' df <- data.frame(amox = "S",
|
||||
#' tetr = "R")
|
||||
@@ -62,35 +63,21 @@
|
||||
#' AMP_ED20 = "S")
|
||||
#' guess_ab_col(df, "ampicillin")
|
||||
#' # [1] "AMP_ED20"
|
||||
guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
|
||||
guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_rsi_columns = FALSE) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (is.null(x) & is.null(search_string)) {
|
||||
return(as.name("guess_ab_col"))
|
||||
} else {
|
||||
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = FALSE)
|
||||
}
|
||||
|
||||
if (search_string %in% colnames(x)) {
|
||||
ab_result <- search_string
|
||||
} else {
|
||||
search_string.ab <- suppressWarnings(as.ab(search_string))
|
||||
if (search_string.ab %in% colnames(x)) {
|
||||
ab_result <- colnames(x)[colnames(x) == search_string.ab][1L]
|
||||
|
||||
} else if (any(tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations", language = NULL))))) {
|
||||
ab_result <- colnames(x)[tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations", language = NULL)))][1L]
|
||||
|
||||
} else {
|
||||
# sort colnames on length - longest first
|
||||
cols <- colnames(x[, x %pm>% colnames() %pm>% nchar() %pm>% order() %pm>% rev()])
|
||||
df_trans <- data.frame(cols = cols,
|
||||
abs = suppressWarnings(as.ab(cols)),
|
||||
stringsAsFactors = FALSE)
|
||||
ab_result <- df_trans[which(df_trans$abs == search_string.ab), "cols"]
|
||||
ab_result <- ab_result[!is.na(ab_result)][1L]
|
||||
}
|
||||
}
|
||||
all_found <- get_column_abx(x, info = verbose, only_rsi_columns = only_rsi_columns, verbose = verbose)
|
||||
search_string.ab <- suppressWarnings(as.ab(search_string))
|
||||
ab_result <- unname(all_found[names(all_found) == search_string.ab])
|
||||
|
||||
if (length(ab_result) == 0) {
|
||||
if (verbose == TRUE) {
|
||||
@@ -114,18 +101,26 @@ get_column_abx <- function(x,
|
||||
hard_dependencies = NULL,
|
||||
verbose = FALSE,
|
||||
info = TRUE,
|
||||
only_rsi_columns = FALSE,
|
||||
sort = TRUE,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(soft_dependencies, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(hard_dependencies, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(sort, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (info == TRUE) {
|
||||
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE)
|
||||
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
if (only_rsi_columns == TRUE) {
|
||||
x <- x[, which(is.rsi(x)), drop = FALSE]
|
||||
}
|
||||
|
||||
if (NROW(x) > 10000) {
|
||||
# only test maximum of 10,000 values per column
|
||||
if (info == TRUE) {
|
||||
@@ -137,25 +132,27 @@ get_column_abx <- function(x,
|
||||
} else if (info == TRUE) {
|
||||
message_("...", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
x_bak <- x
|
||||
|
||||
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
|
||||
# or already have the <rsi> class (as.rsi)
|
||||
# and that they have no more than 50% invalid values
|
||||
vectr_antibiotics <- unique(toupper(unlist(antibiotics[, c("ab", "atc", "name", "abbreviations", "synonyms")])))
|
||||
vectr_antibiotics <- unlist(AB_lookup$generalised_all)
|
||||
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
|
||||
x_columns <- vapply(FUN.VALUE = character(1), colnames(x), function(col, df = x_bak) {
|
||||
if (toupper(col) %in% vectr_antibiotics ||
|
||||
is.rsi(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE]) ||
|
||||
is.rsi.eligible(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE],
|
||||
threshold = 0.5)) {
|
||||
return(col)
|
||||
} else {
|
||||
return(NA_character_)
|
||||
}
|
||||
})
|
||||
x_columns <- x_columns[!is.na(x_columns)]
|
||||
x <- x[, x_columns, drop = FALSE] # without drop = TRUE, x will become a vector when x_columns is length 1
|
||||
x_columns <- vapply(FUN.VALUE = character(1),
|
||||
colnames(x),
|
||||
function(col, df = x) {
|
||||
if (generalise_antibiotic_name(col) %in% vectr_antibiotics ||
|
||||
is.rsi(x[, col, drop = TRUE]) ||
|
||||
is.rsi.eligible(x[, col, drop = TRUE], threshold = 0.5)
|
||||
) {
|
||||
return(col)
|
||||
} else {
|
||||
return(NA_character_)
|
||||
}
|
||||
})
|
||||
|
||||
x_columns <- x_columns[!is.na(x_columns)]
|
||||
x <- x[, x_columns, drop = FALSE] # without drop = FALSE, x will become a vector when x_columns is length 1
|
||||
df_trans <- data.frame(colnames = colnames(x),
|
||||
abcode = suppressWarnings(as.ab(colnames(x), info = FALSE)),
|
||||
stringsAsFactors = FALSE)
|
||||
@@ -164,7 +161,7 @@ get_column_abx <- function(x,
|
||||
names(x) <- df_trans$abcode
|
||||
|
||||
# add from self-defined dots (...):
|
||||
# such as get_column_abx(example_isolates %pm>% rename(thisone = AMX), amox = "thisone")
|
||||
# such as get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
|
||||
dots <- list(...)
|
||||
if (length(dots) > 0) {
|
||||
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
|
||||
@@ -191,11 +188,15 @@ get_column_abx <- function(x,
|
||||
}
|
||||
|
||||
# sort on name
|
||||
x <- x[order(names(x), x)]
|
||||
if (sort == TRUE) {
|
||||
x <- x[order(names(x), x)]
|
||||
}
|
||||
duplicates <- c(x[duplicated(x)], x[duplicated(names(x))])
|
||||
duplicates <- duplicates[unique(names(duplicates))]
|
||||
x <- c(x[!names(x) %in% names(duplicates)], duplicates)
|
||||
x <- x[order(names(x), x)]
|
||||
if (sort == TRUE) {
|
||||
x <- x[order(names(x), x)]
|
||||
}
|
||||
|
||||
# succeeded with auto-guessing
|
||||
if (info == TRUE) {
|
||||
@@ -217,7 +218,6 @@ get_column_abx <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (!is.null(hard_dependencies)) {
|
||||
hard_dependencies <- unique(hard_dependencies)
|
||||
if (!all(hard_dependencies %in% names(x))) {
|
||||
@@ -232,9 +232,9 @@ get_column_abx <- function(x,
|
||||
if (info == TRUE & !all(soft_dependencies %in% names(x))) {
|
||||
# missing a soft dependency may lower the reliability
|
||||
missing <- soft_dependencies[!soft_dependencies %in% names(x)]
|
||||
missing_msg <- paste(paste0(ab_name(missing, tolower = TRUE, language = NULL),
|
||||
" (", font_bold(missing, collapse = NULL), ")"),
|
||||
collapse = ", ")
|
||||
missing_msg <- vector_and(paste0(ab_name(missing, tolower = TRUE, language = NULL),
|
||||
" (", font_bold(missing, collapse = NULL), ")"),
|
||||
quotes = FALSE)
|
||||
message_("Reliability would be improved if these antimicrobial results would be available too: ",
|
||||
missing_msg)
|
||||
}
|
||||
@@ -250,7 +250,7 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
|
||||
any_txt <- c("", "are")
|
||||
}
|
||||
warning_(paste0("Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||
paste(missing, collapse = ", ")),
|
||||
vector_and(missing, quotes = FALSE)),
|
||||
immediate = TRUE,
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
@@ -0,0 +1,131 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Italicise Taxonomic Families, Genera, Species, Subspecies
|
||||
#'
|
||||
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.
|
||||
#' @inheritSection lifecycle Maturing Lifecycle
|
||||
#' @param string a [character] (vector)
|
||||
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
|
||||
#' @details
|
||||
#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set.
|
||||
#'
|
||||
#' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or using ANSI colours by adding `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
|
||||
#'
|
||||
#' This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' italicise_taxonomy("An overview of Staphylococcus aureus isolates")
|
||||
#' italicise_taxonomy("An overview of S. aureus isolates")
|
||||
#'
|
||||
#' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
|
||||
#'
|
||||
#' # since ggplot2 supports no markdown (yet), use
|
||||
#' # italicise_taxonomy() and the `ggtext` pkg for titles:
|
||||
#'
|
||||
#' if (require("ggplot2") && require("ggtext")) {
|
||||
#' ggplot(example_isolates$AMC,
|
||||
#' title = italicise_taxonomy("Amoxi/clav in E. coli")) +
|
||||
#' theme(plot.title = ggtext::element_markdown())
|
||||
#' }
|
||||
italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
meet_criteria(string, allow_class = "character")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi"))
|
||||
|
||||
if (type == "markdown") {
|
||||
before <- "*"
|
||||
after <- "*"
|
||||
} else if (type == "ansi") {
|
||||
if (!has_colour()) {
|
||||
return(string)
|
||||
}
|
||||
before <- "\033[3m"
|
||||
after <- "\033[23m"
|
||||
}
|
||||
|
||||
vapply(FUN.VALUE = character(1),
|
||||
string,
|
||||
function(s) {
|
||||
s_split <- unlist(strsplit(s, " "))
|
||||
|
||||
search_strings <- gsub("[^a-zA-Z-]", "", s_split)
|
||||
|
||||
ind_species <- search_strings != "" &
|
||||
search_strings %in% MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"species",
|
||||
drop = TRUE]
|
||||
|
||||
ind_fullname <- search_strings != "" &
|
||||
search_strings %in% c(MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"fullname",
|
||||
drop = TRUE],
|
||||
MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"subspecies",
|
||||
drop = TRUE])
|
||||
|
||||
# also support E. coli, add "E." to indices
|
||||
has_previous_genera_abbr <- s_split[which(ind_species) - 1] %like_case% "^[A-Z][.]?$"
|
||||
ind_species <- c(which(ind_species), which(ind_species)[has_previous_genera_abbr] - 1)
|
||||
|
||||
ind <- c(ind_species, which(ind_fullname))
|
||||
|
||||
s_split[ind] <- paste0(before, s_split[ind], after)
|
||||
s_paste <- paste(s_split, collapse = " ")
|
||||
|
||||
# clean up a bit
|
||||
s_paste <- gsub(paste0(after, " ", before), " ", s_paste, fixed = TRUE)
|
||||
|
||||
s_paste
|
||||
},
|
||||
USE.NAMES = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname italicise_taxonomy
|
||||
#' @export
|
||||
italicize_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
italicise_taxonomy(string = string, type = type)
|
||||
}
|
||||
+64
-173
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,28 +20,29 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Join [microorganisms] to a data set
|
||||
#' Join [microorganisms] to a Data Set
|
||||
#'
|
||||
#' Join the data set [microorganisms] easily to an existing table or character vector.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' Join the data set [microorganisms] easily to an existing data set or to a [character] vector.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @rdname join
|
||||
#' @name join
|
||||
#' @aliases join inner_join
|
||||
#' @param x existing table to join, or character vector
|
||||
#' @param x existing data set to join, or [character] vector. In case of a [character] vector, the resulting [data.frame] will contain a column 'x' with these values.
|
||||
#' @param by a variable to join by - if left empty will search for a column with class [`mo`] (created with [as.mo()]) or will be `"mo"` if that column name exists in `x`, could otherwise be a column name of `x` with values that exist in `microorganisms$mo` (such as `by = "bacteria_id"`), or another column in [microorganisms] (but then it should be named, like `by = c("bacteria_id" = "fullname")`)
|
||||
#' @param suffix if there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.
|
||||
#' @param ... ignored
|
||||
#' @param suffix if there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a [character] vector of length 2.
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
|
||||
#'
|
||||
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] function from base R will be used.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] and [interaction()] functions from base R will be used.
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @return a [data.frame]
|
||||
#' @export
|
||||
#' @examples
|
||||
#' left_join_microorganisms(as.mo("K. pneumoniae"))
|
||||
#' left_join_microorganisms("B_KLBSL_PNE")
|
||||
#' left_join_microorganisms("B_KLBSL_PNMN")
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
@@ -65,28 +66,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "inner_join_microorganisms")
|
||||
checked <- joins_check_df(x, by)
|
||||
x_class <- get_prejoined_class(x)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_inner <- import_fn("inner_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_inner)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_inner(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_inner_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
}
|
||||
if (NROW(join) > NROW(x)) {
|
||||
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "inner_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
@@ -96,28 +76,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "left_join_microorganisms")
|
||||
checked <- joins_check_df(x, by)
|
||||
x_class <- get_prejoined_class(x)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_left <- import_fn("left_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_left)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_left(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_left_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
}
|
||||
if (NROW(join) > NROW(x)) {
|
||||
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "left_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
@@ -127,28 +86,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "right_join_microorganisms")
|
||||
checked <- joins_check_df(x, by)
|
||||
x_class <- get_prejoined_class(x)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_right <- import_fn("right_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_right)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_right(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_right_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
}
|
||||
if (NROW(join) > NROW(x)) {
|
||||
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "right_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
@@ -158,28 +96,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "full_join_microorganisms")
|
||||
checked <- joins_check_df(x, by)
|
||||
x_class <- get_prejoined_class(x)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_full <- import_fn("full_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_full)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_full(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_full_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
|
||||
)
|
||||
}
|
||||
if (NROW(join) > NROW(x)) {
|
||||
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "full_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
@@ -188,25 +105,7 @@ semi_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "semi_join_microorganisms")
|
||||
x_class <- get_prejoined_class(x)
|
||||
checked <- joins_check_df(x, by)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_semi <- import_fn("semi_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_semi)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_semi(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_semi_join(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "semi_join", x = x, by = by, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
@@ -215,72 +114,64 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
|
||||
check_dataset_integrity()
|
||||
x <- check_groups_before_join(x, "anti_join_microorganisms")
|
||||
checked <- joins_check_df(x, by)
|
||||
x_class <- get_prejoined_class(x)
|
||||
x <- checked$x
|
||||
by <- checked$by
|
||||
# use dplyr if available - it's much faster
|
||||
dplyr_anti <- import_fn("anti_join", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_anti)) {
|
||||
join <- suppressWarnings(
|
||||
dplyr_anti(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
} else {
|
||||
join <- suppressWarnings(
|
||||
pm_anti_join(x = x, y = microorganisms, by = by, ...)
|
||||
)
|
||||
}
|
||||
class(join) <- x_class
|
||||
join
|
||||
join_microorganisms(type = "anti_join", x = x, by = by, ...)
|
||||
}
|
||||
|
||||
joins_check_df <- function(x, by) {
|
||||
if (!any(class(x) %in% c("data.frame", "matrix"))) {
|
||||
x <- data.frame(mo = as.mo(x), stringsAsFactors = FALSE)
|
||||
if (is.null(by)) {
|
||||
by <- "mo"
|
||||
}
|
||||
join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||
check_dataset_integrity()
|
||||
|
||||
if (!is.data.frame(x)) {
|
||||
x <- data.frame(mo = x, stringsAsFactors = FALSE)
|
||||
by <- "mo"
|
||||
}
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
if (is.null(by)) {
|
||||
# search for column with class `mo` and return first one found
|
||||
by <- colnames(x)[lapply(x, is.mo) == TRUE][1]
|
||||
if (is.na(by)) {
|
||||
if ("mo" %in% colnames(x)) {
|
||||
by <- "mo"
|
||||
x[, "mo"] <- as.mo(x[, "mo"])
|
||||
} else {
|
||||
stop("Cannot join - no column found with name 'mo' or with class <mo>.", call. = FALSE)
|
||||
}
|
||||
by <- search_type_in_df(x, "mo", info = FALSE)
|
||||
if (is.null(by) && NCOL(x) == 1) {
|
||||
by <- colnames(x)[1L]
|
||||
} else {
|
||||
stop_if(is.null(by), "no column with microorganism names or codes found, set this column with `by`", call = -2)
|
||||
}
|
||||
message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
|
||||
}
|
||||
if (!all(x[, by, drop = TRUE] %in% MO_lookup$mo, na.rm = TRUE)) {
|
||||
x$join.mo <- as.mo(x[, by, drop = TRUE])
|
||||
by <- c("join.mo" = "mo")
|
||||
} else {
|
||||
x[, by] <- as.mo(x[, by, drop = TRUE])
|
||||
}
|
||||
|
||||
if (is.null(names(by))) {
|
||||
joinby <- colnames(microorganisms)[1]
|
||||
names(joinby) <- by
|
||||
# will always be joined to microorganisms$mo, so add name to that
|
||||
by <- stats::setNames("mo", by)
|
||||
}
|
||||
|
||||
# use dplyr if available - it's much faster than poorman alternatives
|
||||
dplyr_join <- import_fn(name = type, pkg = "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_join)) {
|
||||
join_fn <- dplyr_join
|
||||
} else {
|
||||
joinby <- by
|
||||
# otherwise use poorman, see R/aa_helper_pm_functions.R
|
||||
join_fn <- get(paste0("pm_", type), envir = asNamespace("AMR"))
|
||||
}
|
||||
list(x = x,
|
||||
by = joinby)
|
||||
}
|
||||
|
||||
get_prejoined_class <- function(x) {
|
||||
if (is.data.frame(x)) {
|
||||
class(x)
|
||||
if (type %like% "full|left|right|inner") {
|
||||
joined <- join_fn(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
|
||||
} else {
|
||||
"data.frame"
|
||||
joined <- join_fn(x = x, y = AMR::microorganisms, by = by, ...)
|
||||
}
|
||||
}
|
||||
|
||||
check_groups_before_join <- function(x, fn) {
|
||||
if (is.data.frame(x) && !is.null(attributes(x)$groups)) {
|
||||
x <- pm_ungroup(x)
|
||||
attr(x, "groups") <- NULL
|
||||
class(x) <- class(x)[!class(x) %like% "group"]
|
||||
warning_("Groups are dropped, since the ", fn, "() function relies on merge() from base R.", call = FALSE)
|
||||
|
||||
if ("join.mo" %in% colnames(joined)) {
|
||||
if ("mo" %in% colnames(joined)) {
|
||||
ind_mo <- which(colnames(joined) %in% c("mo", "join.mo"))
|
||||
colnames(joined)[ind_mo[1L]] <- paste0("mo", suffix[1L])
|
||||
colnames(joined)[ind_mo[2L]] <- paste0("mo", suffix[2L])
|
||||
} else {
|
||||
colnames(joined)[colnames(joined) == "join.mo"] <- "mo"
|
||||
}
|
||||
}
|
||||
x
|
||||
|
||||
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
|
||||
warning_("The newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.", call = FALSE)
|
||||
}
|
||||
|
||||
joined
|
||||
}
|
||||
|
||||
@@ -1,372 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Key antibiotics for first *weighted* isolates
|
||||
#'
|
||||
#' These function can be used to determine first isolates (see [first_isolate()]). Using key antibiotics to determine first isolates is more reliable than without key antibiotics. These selected isolates can then be called first *weighted* isolates.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`.
|
||||
#' @param y,z character vectors to compare
|
||||
#' @inheritParams first_isolate
|
||||
#' @param universal_1,universal_2,universal_3,universal_4,universal_5,universal_6 column names of **broad-spectrum** antibiotics, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
|
||||
#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for **Gram-positives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
|
||||
#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for **Gram-negatives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
|
||||
#' @param warnings give a warning about missing antibiotic columns (they will be ignored)
|
||||
#' @param ... other arguments passed on to functions
|
||||
#' @details
|
||||
#' The [key_antibiotics()] function is context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be left blank, please see *Examples*.
|
||||
#'
|
||||
#' The function [key_antibiotics()] returns a character vector with 12 antibiotic results for every isolate. These isolates can then be compared using [key_antibiotics_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antibiotics()] and ignored by [key_antibiotics_equal()].
|
||||
#'
|
||||
#' The [first_isolate()] function only uses this function on the same microbial species from the same patient. Using this, e.g. an MRSA will be included after a susceptible *S. aureus* (MSSA) is found within the same patient episode. Without key antibiotic comparison it would not. See [first_isolate()] for more info.
|
||||
#'
|
||||
#' At default, the antibiotics that are used for **Gram-positive bacteria** are:
|
||||
#' - Amoxicillin
|
||||
#' - Amoxicillin/clavulanic acid
|
||||
#' - Cefuroxime
|
||||
#' - Piperacillin/tazobactam
|
||||
#' - Ciprofloxacin
|
||||
#' - Trimethoprim/sulfamethoxazole
|
||||
#' - Vancomycin
|
||||
#' - Teicoplanin
|
||||
#' - Tetracycline
|
||||
#' - Erythromycin
|
||||
#' - Oxacillin
|
||||
#' - Rifampin
|
||||
#'
|
||||
#' At default the antibiotics that are used for **Gram-negative bacteria** are:
|
||||
#' - Amoxicillin
|
||||
#' - Amoxicillin/clavulanic acid
|
||||
#' - Cefuroxime
|
||||
#' - Piperacillin/tazobactam
|
||||
#' - Ciprofloxacin
|
||||
#' - Trimethoprim/sulfamethoxazole
|
||||
#' - Gentamicin
|
||||
#' - Tobramycin
|
||||
#' - Colistin
|
||||
#' - Cefotaxime
|
||||
#' - Ceftazidime
|
||||
#' - Meropenem
|
||||
#'
|
||||
#' The function [key_antibiotics_equal()] checks the characters returned by [key_antibiotics()] for equality, and returns a [`logical`] vector.
|
||||
#' @inheritSection first_isolate Key antibiotics
|
||||
#' @rdname key_antibiotics
|
||||
#' @export
|
||||
#' @seealso [first_isolate()]
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # output of the `key_antibiotics()` function could be like this:
|
||||
#' strainA <- "SSSRR.S.R..S"
|
||||
#' strainB <- "SSSIRSSSRSSS"
|
||||
#'
|
||||
#' # those strings can be compared with:
|
||||
#' key_antibiotics_equal(strainA, strainB)
|
||||
#' # TRUE, because I is ignored (as well as missing values)
|
||||
#'
|
||||
#' key_antibiotics_equal(strainA, strainB, ignore_I = FALSE)
|
||||
#' # FALSE, because I is not ignored and so the 4th character differs
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # set key antibiotics to a new variable
|
||||
#' my_patients <- example_isolates %>%
|
||||
#' mutate(keyab = key_antibiotics()) %>% # no need to define `x`
|
||||
#' mutate(
|
||||
#' # now calculate first isolates
|
||||
#' first_regular = first_isolate(col_keyantibiotics = FALSE),
|
||||
#' # and first WEIGHTED isolates
|
||||
#' first_weighted = first_isolate(col_keyantibiotics = "keyab")
|
||||
#' )
|
||||
#'
|
||||
#' # Check the difference, in this data set it results in a lot more isolates:
|
||||
#' sum(my_patients$first_regular, na.rm = TRUE)
|
||||
#' sum(my_patients$first_weighted, na.rm = TRUE)
|
||||
#' }
|
||||
#' }
|
||||
key_antibiotics <- function(x,
|
||||
col_mo = NULL,
|
||||
universal_1 = guess_ab_col(x, "amoxicillin"),
|
||||
universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
|
||||
universal_3 = guess_ab_col(x, "cefuroxime"),
|
||||
universal_4 = guess_ab_col(x, "piperacillin/tazobactam"),
|
||||
universal_5 = guess_ab_col(x, "ciprofloxacin"),
|
||||
universal_6 = guess_ab_col(x, "trimethoprim/sulfamethoxazole"),
|
||||
GramPos_1 = guess_ab_col(x, "vancomycin"),
|
||||
GramPos_2 = guess_ab_col(x, "teicoplanin"),
|
||||
GramPos_3 = guess_ab_col(x, "tetracycline"),
|
||||
GramPos_4 = guess_ab_col(x, "erythromycin"),
|
||||
GramPos_5 = guess_ab_col(x, "oxacillin"),
|
||||
GramPos_6 = guess_ab_col(x, "rifampin"),
|
||||
GramNeg_1 = guess_ab_col(x, "gentamicin"),
|
||||
GramNeg_2 = guess_ab_col(x, "tobramycin"),
|
||||
GramNeg_3 = guess_ab_col(x, "colistin"),
|
||||
GramNeg_4 = guess_ab_col(x, "cefotaxime"),
|
||||
GramNeg_5 = guess_ab_col(x, "ceftazidime"),
|
||||
GramNeg_6 = guess_ab_col(x, "meropenem"),
|
||||
warnings = TRUE,
|
||||
...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(universal_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramPos_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(GramNeg_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(warnings, allow_class = "logical", has_length = 1)
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
if ("info" %in% dots.names) {
|
||||
warnings <- dots[which(dots.names == "info")]
|
||||
}
|
||||
}
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
}
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
|
||||
# check columns
|
||||
col.list <- c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6,
|
||||
GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6,
|
||||
GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6)
|
||||
check_available_columns <- function(x, col.list, warnings = TRUE) {
|
||||
# check columns
|
||||
col.list <- col.list[!is.na(col.list) & !is.null(col.list)]
|
||||
names(col.list) <- col.list
|
||||
col.list.bak <- col.list
|
||||
# are they available as upper case or lower case then?
|
||||
for (i in seq_len(length(col.list))) {
|
||||
if (is.null(col.list[i]) | isTRUE(is.na(col.list[i]))) {
|
||||
col.list[i] <- NA
|
||||
} else if (toupper(col.list[i]) %in% colnames(x)) {
|
||||
col.list[i] <- toupper(col.list[i])
|
||||
} else if (tolower(col.list[i]) %in% colnames(x)) {
|
||||
col.list[i] <- tolower(col.list[i])
|
||||
} else if (!col.list[i] %in% colnames(x)) {
|
||||
col.list[i] <- NA
|
||||
}
|
||||
}
|
||||
if (!all(col.list %in% colnames(x))) {
|
||||
if (warnings == TRUE) {
|
||||
warning_("Some columns do not exist and will be ignored: ",
|
||||
col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(),
|
||||
".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
|
||||
immediate = TRUE,
|
||||
call = FALSE)
|
||||
}
|
||||
}
|
||||
col.list
|
||||
}
|
||||
|
||||
col.list <- check_available_columns(x = x, col.list = col.list, warnings = warnings)
|
||||
universal_1 <- col.list[universal_1]
|
||||
universal_2 <- col.list[universal_2]
|
||||
universal_3 <- col.list[universal_3]
|
||||
universal_4 <- col.list[universal_4]
|
||||
universal_5 <- col.list[universal_5]
|
||||
universal_6 <- col.list[universal_6]
|
||||
GramPos_1 <- col.list[GramPos_1]
|
||||
GramPos_2 <- col.list[GramPos_2]
|
||||
GramPos_3 <- col.list[GramPos_3]
|
||||
GramPos_4 <- col.list[GramPos_4]
|
||||
GramPos_5 <- col.list[GramPos_5]
|
||||
GramPos_6 <- col.list[GramPos_6]
|
||||
GramNeg_1 <- col.list[GramNeg_1]
|
||||
GramNeg_2 <- col.list[GramNeg_2]
|
||||
GramNeg_3 <- col.list[GramNeg_3]
|
||||
GramNeg_4 <- col.list[GramNeg_4]
|
||||
GramNeg_5 <- col.list[GramNeg_5]
|
||||
GramNeg_6 <- col.list[GramNeg_6]
|
||||
|
||||
universal <- c(universal_1, universal_2, universal_3,
|
||||
universal_4, universal_5, universal_6)
|
||||
|
||||
gram_positive <- c(universal,
|
||||
GramPos_1, GramPos_2, GramPos_3,
|
||||
GramPos_4, GramPos_5, GramPos_6)
|
||||
gram_positive <- gram_positive[!is.null(gram_positive)]
|
||||
gram_positive <- gram_positive[!is.na(gram_positive)]
|
||||
if (length(gram_positive) < 12) {
|
||||
warning_("Only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call = FALSE)
|
||||
}
|
||||
|
||||
gram_negative <- c(universal,
|
||||
GramNeg_1, GramNeg_2, GramNeg_3,
|
||||
GramNeg_4, GramNeg_5, GramNeg_6)
|
||||
gram_negative <- gram_negative[!is.null(gram_negative)]
|
||||
gram_negative <- gram_negative[!is.na(gram_negative)]
|
||||
if (length(gram_negative) < 12) {
|
||||
warning_("Only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call = FALSE)
|
||||
}
|
||||
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE])
|
||||
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
|
||||
x$key_ab <- NA_character_
|
||||
|
||||
# Gram +
|
||||
x$key_ab <- pm_if_else(x$gramstain == "Gram-positive",
|
||||
tryCatch(apply(X = x[, gram_positive],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
error = function(e) paste0(rep(".", 12), collapse = "")),
|
||||
x$key_ab)
|
||||
|
||||
# Gram -
|
||||
x$key_ab <- pm_if_else(x$gramstain == "Gram-negative",
|
||||
tryCatch(apply(X = x[, gram_negative],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
error = function(e) paste0(rep(".", 12), collapse = "")),
|
||||
x$key_ab)
|
||||
|
||||
# format
|
||||
key_abs <- toupper(gsub("[^SIR]", ".", gsub("(NA|NULL)", ".", x$key_ab)))
|
||||
|
||||
if (pm_n_distinct(key_abs) == 1) {
|
||||
warning_("No distinct key antibiotics determined.", call = FALSE)
|
||||
}
|
||||
|
||||
key_abs
|
||||
|
||||
}
|
||||
|
||||
#' @rdname key_antibiotics
|
||||
#' @export
|
||||
key_antibiotics_equal <- function(y,
|
||||
z,
|
||||
type = c("keyantibiotics", "points"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = FALSE) {
|
||||
meet_criteria(y, allow_class = "character")
|
||||
meet_criteria(z, allow_class = "character")
|
||||
meet_criteria(type, allow_class = "character", has_length = c(1, 2))
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
|
||||
# y is active row, z is lag
|
||||
x <- y
|
||||
y <- z
|
||||
|
||||
type <- type[1]
|
||||
|
||||
# only show progress bar on points or when at least 5000 isolates
|
||||
info_needed <- info == TRUE & (type == "points" | length(x) > 5000)
|
||||
|
||||
result <- logical(length(x))
|
||||
|
||||
if (info_needed == TRUE) {
|
||||
p <- progress_ticker(length(x))
|
||||
on.exit(close(p))
|
||||
}
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
|
||||
if (info_needed == TRUE) {
|
||||
p$tick()
|
||||
}
|
||||
|
||||
if (is.na(x[i])) {
|
||||
x[i] <- ""
|
||||
}
|
||||
if (is.na(y[i])) {
|
||||
y[i] <- ""
|
||||
}
|
||||
|
||||
if (x[i] == y[i]) {
|
||||
|
||||
result[i] <- TRUE
|
||||
|
||||
} else if (nchar(x[i]) != nchar(y[i])) {
|
||||
|
||||
result[i] <- FALSE
|
||||
|
||||
} else {
|
||||
|
||||
x_split <- strsplit(x[i], "")[[1]]
|
||||
y_split <- strsplit(y[i], "")[[1]]
|
||||
|
||||
if (type == "keyantibiotics") {
|
||||
|
||||
if (ignore_I == TRUE) {
|
||||
x_split[x_split == "I"] <- "."
|
||||
y_split[y_split == "I"] <- "."
|
||||
}
|
||||
|
||||
y_split[x_split == "."] <- "."
|
||||
x_split[y_split == "."] <- "."
|
||||
|
||||
result[i] <- all(x_split == y_split)
|
||||
|
||||
} else if (type == "points") {
|
||||
# count points for every single character:
|
||||
# - no change is 0 points
|
||||
# - I <-> S|R is 0.5 point
|
||||
# - S|R <-> R|S is 1 point
|
||||
# use the levels of as.rsi (S = 1, I = 2, R = 3)
|
||||
|
||||
suppressWarnings(x_split <- x_split %pm>% as.rsi() %pm>% as.double())
|
||||
suppressWarnings(y_split <- y_split %pm>% as.rsi() %pm>% as.double())
|
||||
|
||||
points <- (x_split - y_split) %pm>% abs() %pm>% sum(na.rm = TRUE) / 2
|
||||
result[i] <- points >= points_threshold
|
||||
|
||||
} else {
|
||||
stop("`", type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
|
||||
}
|
||||
}
|
||||
}
|
||||
if (info_needed == TRUE) {
|
||||
close(p)
|
||||
}
|
||||
result
|
||||
}
|
||||
Executable
+325
@@ -0,0 +1,325 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' (Key) Antimicrobials for First Weighted Isolates
|
||||
#'
|
||||
#' These functions can be used to determine first weighted isolates by considering the phenotype for isolate selection (see [first_isolate()]). Using a phenotype-based method to determine first isolates is more reliable than methods that disregard phenotypes.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
|
||||
#' @param y,z [character] vectors to compare
|
||||
#' @inheritParams first_isolate
|
||||
#' @param universal names of **broad-spectrum** antimicrobial agents, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param gram_negative names of antibiotic agents for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param gram_positive names of antibiotic agents for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param antifungal names of antifungal agents for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
|
||||
#'
|
||||
#' The function [key_antimicrobials()] returns a [character] vector with 12 antimicrobial results for every isolate. The function [all_antimicrobials()] returns a [character] vector with all antimicrobial results for every isolate. These vectors can then be compared using [antimicrobials_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antimicrobials()] and ignored by [antimicrobials_equal()].
|
||||
#'
|
||||
#' Please see the [first_isolate()] function how these important functions enable the 'phenotype-based' method for determination of first isolates.
|
||||
#'
|
||||
#' The default antimicrobial agents used for **all rows** (set in `universal`) are:
|
||||
#'
|
||||
#' - Ampicillin
|
||||
#' - Amoxicillin/clavulanic acid
|
||||
#' - Cefuroxime
|
||||
#' - Ciprofloxacin
|
||||
#' - Piperacillin/tazobactam
|
||||
#' - Trimethoprim/sulfamethoxazole
|
||||
#'
|
||||
#' The default antimicrobial agents used for **Gram-negative bacteria** (set in `gram_negative`) are:
|
||||
#'
|
||||
#' - Cefotaxime
|
||||
#' - Ceftazidime
|
||||
#' - Colistin
|
||||
#' - Gentamicin
|
||||
#' - Meropenem
|
||||
#' - Tobramycin
|
||||
#'
|
||||
#' The default antimicrobial agents used for **Gram-positive bacteria** (set in `gram_positive`) are:
|
||||
#'
|
||||
#' - Erythromycin
|
||||
#' - Oxacillin
|
||||
#' - Rifampin
|
||||
#' - Teicoplanin
|
||||
#' - Tetracycline
|
||||
#' - Vancomycin
|
||||
#'
|
||||
#'
|
||||
#' The default antimicrobial agents used for **fungi** (set in `antifungal`) are:
|
||||
#'
|
||||
#' - Anidulafungin
|
||||
#' - Caspofungin
|
||||
#' - Fluconazole
|
||||
#' - Miconazole
|
||||
#' - Nystatin
|
||||
#' - Voriconazole
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
#' @seealso [first_isolate()]
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # output of the `key_antimicrobials()` function could be like this:
|
||||
#' strainA <- "SSSRR.S.R..S"
|
||||
#' strainB <- "SSSIRSSSRSSS"
|
||||
#'
|
||||
#' # those strings can be compared with:
|
||||
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials")
|
||||
#' # TRUE, because I is ignored (as well as missing values)
|
||||
#'
|
||||
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials", ignore_I = FALSE)
|
||||
#' # FALSE, because I is not ignored and so the 4th [character] differs
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # set key antibiotics to a new variable
|
||||
#' my_patients <- example_isolates %>%
|
||||
#' mutate(keyab = key_antimicrobials(antifungal = NULL)) %>% # no need to define `x`
|
||||
#' mutate(
|
||||
#' # now calculate first isolates
|
||||
#' first_regular = first_isolate(col_keyantimicrobials = FALSE),
|
||||
#' # and first WEIGHTED isolates
|
||||
#' first_weighted = first_isolate(col_keyantimicrobials = "keyab")
|
||||
#' )
|
||||
#'
|
||||
#' # Check the difference, in this data set it results in more isolates:
|
||||
#' sum(my_patients$first_regular, na.rm = TRUE)
|
||||
#' sum(my_patients$first_weighted, na.rm = TRUE)
|
||||
#' }
|
||||
#' }
|
||||
key_antimicrobials <- function(x = NULL,
|
||||
col_mo = NULL,
|
||||
universal = c("ampicillin", "amoxicillin/clavulanic acid", "cefuroxime",
|
||||
"piperacillin/tazobactam", "ciprofloxacin", "trimethoprim/sulfamethoxazole"),
|
||||
gram_negative = c("gentamicin", "tobramycin", "colistin",
|
||||
"cefotaxime", "ceftazidime", "meropenem"),
|
||||
gram_positive = c("vancomycin", "teicoplanin", "tetracycline",
|
||||
"erythromycin", "oxacillin", "rifampin"),
|
||||
antifungal = c("anidulafungin", "caspofungin", "fluconazole",
|
||||
"miconazole", "nystatin", "voriconazole"),
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x))
|
||||
meet_criteria(universal, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(gram_negative, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
# force regular [data.frame], not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
cols <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns)
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
|
||||
}
|
||||
if (is.null(col_mo)) {
|
||||
warning_("No column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`", call = FALSE)
|
||||
gramstain <- NA_character_
|
||||
kingdom <- NA_character_
|
||||
} else {
|
||||
x.mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||
gramstain <- mo_gramstain(x.mo, language = NULL)
|
||||
kingdom <- mo_kingdom(x.mo, language = NULL)
|
||||
}
|
||||
|
||||
AMR_string <- function(x, values, name, filter, cols = cols) {
|
||||
if (is.null(values)) {
|
||||
return(rep(NA_character_, length(which(filter))))
|
||||
}
|
||||
|
||||
values_old_length <- length(values)
|
||||
values <- as.ab(values, flag_multiple_results = FALSE, info = FALSE)
|
||||
values <- cols[names(cols) %in% values]
|
||||
values_new_length <- length(values)
|
||||
|
||||
if (values_new_length < values_old_length &
|
||||
any(filter, na.rm = TRUE) &
|
||||
message_not_thrown_before(paste0("key_antimicrobials.", name))) {
|
||||
warning_(ifelse(values_new_length == 0,
|
||||
"No columns available ",
|
||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")),
|
||||
"as key antimicrobials for ", name, "s. See ?key_antimicrobials.",
|
||||
call = FALSE)
|
||||
remember_thrown_message(paste0("key_antimicrobials.", name))
|
||||
}
|
||||
|
||||
generate_antimcrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
||||
}
|
||||
|
||||
if (is.null(universal)) {
|
||||
universal <- character(0)
|
||||
} else {
|
||||
universal <- as.ab(universal, flag_multiple_results = FALSE, info = FALSE)
|
||||
universal <- cols[names(cols) %in% universal]
|
||||
}
|
||||
|
||||
key_ab <- rep(NA_character_, nrow(x))
|
||||
|
||||
key_ab[which(gramstain == "Gram-negative")] <- AMR_string(x = x,
|
||||
values = gram_negative,
|
||||
name = "Gram-negative",
|
||||
filter = gramstain == "Gram-negative",
|
||||
cols = cols)
|
||||
|
||||
key_ab[which(gramstain == "Gram-positive")] <- AMR_string(x = x,
|
||||
values = gram_positive,
|
||||
name = "Gram-positive",
|
||||
filter = gramstain == "Gram-positive",
|
||||
cols = cols)
|
||||
|
||||
key_ab[which(kingdom == "Fungi")] <- AMR_string(x = x,
|
||||
values = antifungal,
|
||||
name = "antifungal",
|
||||
filter = kingdom == "Fungi",
|
||||
cols = cols)
|
||||
|
||||
# back-up - only use `universal`
|
||||
key_ab[which(is.na(key_ab))] <- AMR_string(x = x,
|
||||
values = character(0),
|
||||
name = "",
|
||||
filter = is.na(key_ab),
|
||||
cols = cols)
|
||||
|
||||
if (length(unique(key_ab)) == 1) {
|
||||
warning_("No distinct key antibiotics determined.", call = FALSE)
|
||||
}
|
||||
|
||||
key_ab
|
||||
}
|
||||
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
all_antimicrobials <- function(x = NULL,
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
# force regular [data.frame], not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
cols <- get_column_abx(x, only_rsi_columns = only_rsi_columns, info = FALSE, sort = FALSE)
|
||||
|
||||
generate_antimcrobials_string(x[ , cols, drop = FALSE])
|
||||
}
|
||||
|
||||
generate_antimcrobials_string <- function(df) {
|
||||
if (NCOL(df) == 0) {
|
||||
return(rep("", NROW(df)))
|
||||
}
|
||||
if (NROW(df) == 0) {
|
||||
return(character(0))
|
||||
}
|
||||
out <- tryCatch(
|
||||
do.call(paste0,
|
||||
lapply(as.list(df),
|
||||
function(x) {
|
||||
x <- toupper(as.character(x))
|
||||
x[!x %in% c("R", "S", "I")] <- "."
|
||||
paste(x)
|
||||
})),
|
||||
error = function(e) rep(strrep(".", NCOL(df)), NROW(df)))
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
antimicrobials_equal <- function(y,
|
||||
z,
|
||||
type = c("points", "keyantimicrobials"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
...) {
|
||||
meet_criteria(y, allow_class = "character")
|
||||
meet_criteria(z, allow_class = "character")
|
||||
stop_if(missing(type), "argument \"type\" is missing, with no default")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
|
||||
|
||||
key2rsi <- function(val) {
|
||||
as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE)))
|
||||
}
|
||||
y <- lapply(y, key2rsi)
|
||||
z <- lapply(z, key2rsi)
|
||||
|
||||
determine_equality <- function(a, b, type, points_threshold, ignore_I) {
|
||||
if (length(a) != length(b)) {
|
||||
# incomparable, so not equal
|
||||
return(FALSE)
|
||||
}
|
||||
# ignore NAs on both sides
|
||||
NA_ind <- which(is.na(a) | is.na(b))
|
||||
a[NA_ind] <- NA_real_
|
||||
b[NA_ind] <- NA_real_
|
||||
|
||||
if (type == "points") {
|
||||
# count points for every single character:
|
||||
# - no change is 0 points
|
||||
# - I <-> S|R is 0.5 point
|
||||
# - S|R <-> R|S is 1 point
|
||||
# use the levels of as.rsi (S = 1, I = 2, R = 3)
|
||||
# and divide by 2 (S = 0.5, I = 1, R = 1.5)
|
||||
(sum(abs(a - b), na.rm = TRUE) / 2) < points_threshold
|
||||
} else {
|
||||
if (ignore_I == TRUE) {
|
||||
ind <- which(a == 2 | b == 2) # since as.double(as.rsi("I")) == 2
|
||||
a[ind] <- NA_real_
|
||||
b[ind] <- NA_real_
|
||||
}
|
||||
all(a == b, na.rm = TRUE)
|
||||
}
|
||||
}
|
||||
out <- unlist(mapply(FUN = determine_equality,
|
||||
y,
|
||||
z,
|
||||
MoreArgs = list(type = type,
|
||||
points_threshold = points_threshold,
|
||||
ignore_I = ignore_I),
|
||||
SIMPLIFY = FALSE,
|
||||
USE.NAMES = FALSE))
|
||||
out[is.na(y) | is.na(z)] <- NA
|
||||
out
|
||||
}
|
||||
+7
-7
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,19 +20,19 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Kurtosis of the sample
|
||||
#' Kurtosis of the Sample
|
||||
#'
|
||||
#' @description Kurtosis is a measure of the "tailedness" of the probability distribution of a real-valued random variable. A normal distribution has a kurtosis of 3 and a excess kurtosis of 0.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a vector of values, a [matrix] or a [data.frame]
|
||||
#' @param na.rm a logical to indicate whether `NA` values should be stripped before the computation proceeds
|
||||
#' @param excess a logical to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
|
||||
#' @param na.rm a [logical] to indicate whether `NA` values should be stripped before the computation proceeds
|
||||
#' @param excess a [logical] to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
|
||||
#' @seealso [skewness()]
|
||||
#' @rdname kurtosis
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
kurtosis <- function(x, na.rm = FALSE, excess = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
+9
-9
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,35 +20,35 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
###############
|
||||
# NOTE TO SELF: could also have done this with the 'lifecycle' package, but why add a package dependency for such an easy job??
|
||||
###############
|
||||
|
||||
#' Lifecycles of functions in the `AMR` package
|
||||
#' Lifecycles of Functions in the `AMR` Package
|
||||
#' @name lifecycle
|
||||
#' @rdname lifecycle
|
||||
#' @description Functions in this `AMR` package are categorised using [the lifecycle circle of the Tidyverse as found on www.tidyverse.org/lifecycle](https://www.Tidyverse.org/lifecycle).
|
||||
#' @description Functions in this `AMR` package are categorised using [the lifecycle circle of the Tidyverse as found on www.tidyverse.org/lifecycle](https://lifecycle.r-lib.org/articles/stages.html).
|
||||
#'
|
||||
#' \if{html}{\figure{lifecycle_tidyverse.svg}{options: height=200px style=margin-bottom:5px} \cr}
|
||||
#' This page contains a section for every lifecycle (with text borrowed from the aforementioned Tidyverse website), so they can be used in the manual pages of the functions.
|
||||
#' @section Experimental lifecycle:
|
||||
#' @section Experimental Lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_experimental.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **experimental**. An experimental function is in early stages of development. The unlying code might be changing frequently. Experimental functions might be removed without deprecation, so you are generally best off waiting until a function is more mature before you use it in production code. Experimental functions are only available in development versions of this `AMR` package and will thus not be included in releases that are submitted to CRAN, since such functions have not yet matured enough.
|
||||
#' @section Maturing lifecycle:
|
||||
#' @section Maturing Lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_maturing.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **maturing**. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome [to suggest changes at our repository](https://github.com/msberends/AMR/issues) or [write us an email (see section 'Contact Us')][AMR::AMR].
|
||||
#' @section Stable lifecycle:
|
||||
#' @section Stable Lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **stable**. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
|
||||
#'
|
||||
#' If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
|
||||
#' @section Retired lifecycle:
|
||||
#' @section Retired Lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_retired.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **retired**. A retired function is no longer under active development, and (if appropiate) a better alternative is available. No new arguments will be added, and only the most critical bugs will be fixed. In a future version, this function will be removed.
|
||||
#' @section Questioning lifecycle:
|
||||
#' @section Questioning Lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_questioning.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **questioning**. This function might be no longer be optimal approach, or is it questionable whether this function should be in this `AMR` package at all.
|
||||
NULL
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,125 +20,104 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Pattern matching with keyboard shortcut
|
||||
#' Vectorised Pattern Matching with Keyboard Shortcut
|
||||
#'
|
||||
#' Convenient wrapper around [grep()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x a character vector where matches are sought, or an object which can be coerced by [as.character()] to a character vector.
|
||||
#' @param pattern a character string containing a regular expression (or [character] string for `fixed = TRUE`) to be matched in the given character vector. Coerced by [as.character()] to a character string if possible. If a [character] vector of length 2 or more is supplied, the first element is used with a warning.
|
||||
#' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [character] vector where matches are sought, or an object which can be coerced by [as.character()] to a [character] vector.
|
||||
#' @param pattern a [character] vector containing regular expressions (or a [character] string for `fixed = TRUE`) to be matched in the given [character] vector. Coerced by [as.character()] to a [character] string if possible.
|
||||
#' @param ignore.case if `FALSE`, the pattern matching is *case sensitive* and if `TRUE`, case is ignored during matching.
|
||||
#' @return A [`logical`] vector
|
||||
#' @return A [logical] vector
|
||||
#' @name like
|
||||
#' @rdname like
|
||||
#' @export
|
||||
#' @details
|
||||
#' The `%like%` function:
|
||||
#' * Is case-insensitive (use `%like_case%` for case-sensitive matching)
|
||||
#' * Supports multiple patterns
|
||||
#' * Checks if `pattern` is a regular expression and sets `fixed = TRUE` if not, to greatly improve speed
|
||||
#' * Tries again with `perl = TRUE` if regex fails
|
||||
#' These [like()] and `%like%`/`%unlike%` functions:
|
||||
#' * Are case-insensitive (use `%like_case%`/`%unlike_case%` for case-sensitive matching)
|
||||
#' * Support multiple patterns
|
||||
#' * Check if `pattern` is a valid regular expression and sets `fixed = TRUE` if not, to greatly improve speed (vectorised over `pattern`)
|
||||
#' * Always use compatibility with Perl unless `fixed = TRUE`, to greatly improve speed
|
||||
#'
|
||||
#' Using RStudio? The text `%like%` can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
|
||||
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R)
|
||||
#' @seealso [grep()]
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' Using RStudio? The `%like%`/`%unlike%` functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like `Shift+Ctrl+L` or `Shift+Cmd+L` (see menu `Tools` > `Modify Keyboard Shortcuts...`). If you keep pressing your shortcut, the inserted text will be iterated over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%`.
|
||||
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R), although altered as explained in *Details*.
|
||||
#' @seealso [grepl()]
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # simple test
|
||||
#' a <- "This is a test"
|
||||
#' b <- "TEST"
|
||||
#' a %like% b
|
||||
#' #> TRUE
|
||||
#' b %like% a
|
||||
#' #> FALSE
|
||||
#'
|
||||
#' # also supports multiple patterns, length must be equal to x
|
||||
#'
|
||||
#' # also supports multiple patterns
|
||||
#' a <- c("Test case", "Something different", "Yet another thing")
|
||||
#' b <- c( "case", "diff", "yet")
|
||||
#' a %like% b
|
||||
#' #> TRUE TRUE TRUE
|
||||
#'
|
||||
#' a %unlike% b
|
||||
#' #> FALSE FALSE FALSE
|
||||
#'
|
||||
#' a[1] %like% b
|
||||
#' #> TRUE FALSE FALSE
|
||||
#' a %like% b[1]
|
||||
#' #> TRUE FALSE FALSE
|
||||
#'
|
||||
#' # get isolates whose name start with 'Ent' or 'ent'
|
||||
#' example_isolates[which(mo_name(example_isolates$mo) %like% "^ent"), ]
|
||||
#' \donttest{
|
||||
#' # faster way, only works in R 3.2 and later:
|
||||
#' example_isolates[which(mo_name() %like% "^ent"), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_name(mo) %like% "^ent")
|
||||
#' filter(mo_name() %like% "^ent")
|
||||
#' }
|
||||
#' }
|
||||
like <- function(x, pattern, ignore.case = TRUE) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(pattern, allow_NA = FALSE)
|
||||
meet_criteria(ignore.case, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (all(is.na(x))) {
|
||||
return(rep(FALSE, length(x)))
|
||||
}
|
||||
|
||||
# set to fixed if no valid regex (vectorised)
|
||||
fixed <- !is_valid_regex(pattern)
|
||||
|
||||
# set to fixed if no regex found
|
||||
fixed <- !any(is_possibly_regex(pattern))
|
||||
if (ignore.case == TRUE) {
|
||||
# set here, otherwise if fixed = TRUE, this warning will be thrown: argument `ignore.case = TRUE` will be ignored
|
||||
x <- tolower(x)
|
||||
pattern <- tolower(pattern)
|
||||
}
|
||||
|
||||
if (length(pattern) > 1 & length(x) == 1) {
|
||||
x <- rep(x, length(pattern))
|
||||
}
|
||||
|
||||
if (all(is.na(x))) {
|
||||
return(rep(FALSE, length(x)))
|
||||
}
|
||||
|
||||
if (length(pattern) > 1) {
|
||||
res <- vector(length = length(pattern))
|
||||
if (length(x) != length(pattern)) {
|
||||
if (length(x) == 1) {
|
||||
x <- rep(x, length(pattern))
|
||||
}
|
||||
# return TRUE for every 'x' that matches any 'pattern', FALSE otherwise
|
||||
for (i in seq_len(length(res))) {
|
||||
if (is.factor(x[i])) {
|
||||
res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed)
|
||||
} else {
|
||||
res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed)
|
||||
}
|
||||
}
|
||||
res <- vapply(FUN.VALUE = logical(1), pattern, function(pttrn) grepl(pttrn, x, ignore.case = FALSE, fixed = fixed))
|
||||
res2 <- as.logical(rowSums(res))
|
||||
# get only first item of every hit in pattern
|
||||
res2[duplicated(res)] <- FALSE
|
||||
res2[rowSums(res) == 0] <- NA
|
||||
return(res2)
|
||||
} else {
|
||||
# x and pattern are of same length, so items with each other
|
||||
for (i in seq_len(length(res))) {
|
||||
if (is.factor(x[i])) {
|
||||
res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed)
|
||||
} else {
|
||||
res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed)
|
||||
}
|
||||
}
|
||||
return(res)
|
||||
}
|
||||
}
|
||||
|
||||
# the regular way how grepl works; just one pattern against one or more x
|
||||
|
||||
if (is.factor(x)) {
|
||||
as.integer(x) %in% grep(pattern, levels(x), ignore.case = FALSE, fixed = fixed)
|
||||
x <- as.character(x)
|
||||
}
|
||||
|
||||
if (length(pattern) == 1) {
|
||||
grepl(pattern, x, ignore.case = FALSE, fixed = fixed, perl = !fixed)
|
||||
} else {
|
||||
tryCatch(grepl(pattern, x, ignore.case = FALSE, fixed = fixed),
|
||||
error = function(e) {
|
||||
if (grepl("invalid reg(ular )?exp", e$message, ignore.case = TRUE)) {
|
||||
# try with perl = TRUE:
|
||||
return(grepl(pattern = pattern,
|
||||
x = x,
|
||||
ignore.case = FALSE,
|
||||
fixed = fixed,
|
||||
perl = TRUE))
|
||||
} else {
|
||||
# stop otherwise
|
||||
stop(e$message)
|
||||
}
|
||||
})
|
||||
if (length(x) == 1) {
|
||||
x <- rep(x, length(pattern))
|
||||
} else if (length(pattern) != length(x)) {
|
||||
stop_("arguments `x` and `pattern` must be of same length, or either one must be 1 ",
|
||||
"(`x` has length ", length(x), " and `pattern` has length ", length(pattern), ")")
|
||||
}
|
||||
unlist(
|
||||
mapply(FUN = grepl,
|
||||
x = x,
|
||||
pattern = pattern,
|
||||
fixed = fixed,
|
||||
perl = !fixed,
|
||||
MoreArgs = list(ignore.case = FALSE),
|
||||
SIMPLIFY = FALSE,
|
||||
USE.NAMES = FALSE)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -150,6 +129,14 @@ like <- function(x, pattern, ignore.case = TRUE) {
|
||||
like(x, pattern, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%unlike%" <- function(x, pattern) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(pattern, allow_NA = FALSE)
|
||||
!like(x, pattern, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%like_case%" <- function(x, pattern) {
|
||||
@@ -158,14 +145,10 @@ like <- function(x, pattern, ignore.case = TRUE) {
|
||||
like(x, pattern, ignore.case = FALSE)
|
||||
}
|
||||
|
||||
"%like_perl%" <- function(x, pattern) {
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%unlike_case%" <- function(x, pattern) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(pattern, allow_NA = FALSE)
|
||||
# convenient for e.g. matching all Klebsiella and Raoultella, but not
|
||||
# K. aerogenes: fullname %like_perl% "^(Klebsiella(?! aerogenes)|Raoultella)"
|
||||
grepl(x = tolower(x),
|
||||
pattern = tolower(pattern),
|
||||
perl = TRUE,
|
||||
fixed = FALSE,
|
||||
ignore.case = TRUE)
|
||||
!like(x, pattern, ignore.case = FALSE)
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,25 +20,31 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine multidrug-resistant organisms (MDRO)
|
||||
#' Determine Multidrug-Resistant Organisms (MDRO)
|
||||
#'
|
||||
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international and national guidelines.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()].
|
||||
#' @param guideline a specific guideline to follow. When left empty, the publication by Magiorakos *et al.* (2012, Clinical Microbiology and Infection) will be followed, please see *Details*.
|
||||
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international, national and custom guidelines.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank for automatic determination.
|
||||
#' @param guideline a specific guideline to follow, see sections *Supported international / national guidelines* and *Using Custom Guidelines* below. When left empty, the publication by Magiorakos *et al.* (see below) will be followed.
|
||||
#' @param ... in case of [custom_mdro_guideline()]: a set of rules, see section *Using Custom Guidelines* below. Otherwise: column name of an antibiotic, see section *Antibiotics* below.
|
||||
#' @param as_factor a [logical] to indicate whether the returned value should be an ordered [factor] (`TRUE`, default), or otherwise a [character] vector
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param pct_required_classes minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
|
||||
#' @param verbose a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
|
||||
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
|
||||
#' @inheritSection eucast_rules Antibiotics
|
||||
#' @details
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be left blank, please see *Examples*.
|
||||
#' These functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
|
||||
#'
|
||||
#' For the `pct_required_classes` argument, values above 1 will be divided by 100. This is to support both fractions (`0.75` or `3/4`) and percentages (`75`).
|
||||
#'
|
||||
#' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named *order* Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
|
||||
#'
|
||||
#' @section Supported International / National Guidelines:
|
||||
#'
|
||||
#' Currently supported guidelines are (case-insensitive):
|
||||
#'
|
||||
#' * `guideline = "CMI2012"` (default)
|
||||
@@ -67,7 +73,54 @@
|
||||
#'
|
||||
#' Please suggest your own (country-specific) guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
|
||||
#'
|
||||
#' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named *order* Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
|
||||
#'
|
||||
#' @section Using Custom Guidelines:
|
||||
#'
|
||||
#' Custom guidelines can be set with the [custom_mdro_guideline()] function. This is of great importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
|
||||
#'
|
||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||
#'
|
||||
#' ```
|
||||
#' custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
|
||||
#' ERY == "R" & age > 60 ~ "Elderly Type B")
|
||||
#' ```
|
||||
#'
|
||||
#' If a row/an isolate matches the first rule, the value after the first `~` (in this case *'Elderly Type A'*) will be set as MDRO value. Otherwise, the second rule will be tried and so on. The number of rules is unlimited.
|
||||
#'
|
||||
#' You can print the rules set in the console for an overview. Colours will help reading it if your console supports colours.
|
||||
#'
|
||||
#' ```
|
||||
#' custom
|
||||
#' #> A set of custom MDRO rules:
|
||||
#' #> 1. CIP is "R" and age is higher than 60 -> Elderly Type A
|
||||
#' #> 2. ERY is "R" and age is higher than 60 -> Elderly Type B
|
||||
#' #> 3. Otherwise -> Negative
|
||||
#' #>
|
||||
#' #> Unmatched rows will return NA.
|
||||
#' ```
|
||||
#'
|
||||
#' The outcome of the function can be used for the `guideline` argument in the [mdro()] function:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- mdro(example_isolates,
|
||||
#' guideline = custom)
|
||||
#' table(x)
|
||||
#' #> Negative Elderly Type A Elderly Type B
|
||||
#' #> 1070 198 732
|
||||
#' ```
|
||||
#'
|
||||
#' Rules can also be combined with other custom rules by using [c()]:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- mdro(example_isolates,
|
||||
#' guideline = c(custom,
|
||||
#' custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C")))
|
||||
#' table(x)
|
||||
#' #> Negative Elderly Type A Elderly Type B Elderly Type C
|
||||
#' #> 961 198 732 109
|
||||
#' ```
|
||||
#'
|
||||
#' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @return
|
||||
#' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
|
||||
@@ -76,17 +129,21 @@
|
||||
#' Ordered [factor] with levels `Negative` < `Mono-resistant` < `Poly-resistant` < `Multi-drug-resistant` < `Extensively drug-resistant`
|
||||
#' - German guideline - function [mrgn()] or [`mdro(..., guideline = "MRGN")`][mdro()]:\cr
|
||||
#' Ordered [factor] with levels `Negative` < `3MRGN` < `4MRGN`
|
||||
#' - Everything else:\cr
|
||||
#' - Everything else, except for custom guidelines:\cr
|
||||
#' Ordered [factor] with levels `Negative` < `Positive, unconfirmed` < `Positive`. The value `"Positive, unconfirmed"` means that, according to the guideline, it is not entirely sure if the isolate is multi-drug resistant and this should be confirmed with additional (e.g. molecular) tests
|
||||
#' @rdname mdro
|
||||
#' @aliases MDR XDR PDR BRMO 3MRGN 4MRGN
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @source
|
||||
#' Please see *Details* for the list of publications used for this function.
|
||||
#' See the supported guidelines above for the [list] of publications used for this function.
|
||||
#' @examples
|
||||
#' mdro(example_isolates, guideline = "EUCAST")
|
||||
#'
|
||||
#' mdro(example_isolates,
|
||||
#' guideline = custom_mdro_guideline(AMX == "R" ~ "Custom MDRO 1",
|
||||
#' VAN == "R" ~ "Custom MDRO 2"))
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
@@ -101,27 +158,42 @@
|
||||
#' MRGN = mrgn())
|
||||
#' }
|
||||
#' }
|
||||
mdro <- function(x,
|
||||
mdro <- function(x = NULL,
|
||||
guideline = "CMI2012",
|
||||
col_mo = NULL,
|
||||
info = interactive(),
|
||||
pct_required_classes = 0.5,
|
||||
combine_SI = TRUE,
|
||||
verbose = FALSE,
|
||||
only_rsi_columns = FALSE,
|
||||
...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(guideline, allow_class = c("list", "character"), allow_NULL = TRUE)
|
||||
if (!is.list(guideline)) {
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
info.bak <- info
|
||||
if (message_not_thrown_before("mdro")) {
|
||||
remember_thrown_message("mdro")
|
||||
} else {
|
||||
# don't thrown info's more than once per call
|
||||
info <- FALSE
|
||||
}
|
||||
|
||||
if (interactive() & verbose == TRUE & info == TRUE) {
|
||||
txt <- paste0("WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.",
|
||||
"\n\nThis may overwrite your existing data if you use e.g.:",
|
||||
@@ -138,24 +210,76 @@ mdro <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
stop_ifnot(is.data.frame(x), "`x` must be a data.frame")
|
||||
stop_if(any(dim(x) == 0), "`x` must contain rows and columns")
|
||||
|
||||
# force regular data.frame, not a tibble or data.table
|
||||
group_msg <- ""
|
||||
if (info.bak == TRUE) {
|
||||
# print group name if used in dplyr::group_by()
|
||||
cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_group)) {
|
||||
group_df <- tryCatch(cur_group(), error = function(e) data.frame())
|
||||
if (NCOL(group_df) > 0) {
|
||||
# transform factors to characters
|
||||
group <- vapply(FUN.VALUE = character(1), group_df, function(x) {
|
||||
if (is.numeric(x)) {
|
||||
format(x)
|
||||
} else if (is.logical(x)) {
|
||||
as.character(x)
|
||||
} else {
|
||||
paste0('"', x, '"')
|
||||
}
|
||||
})
|
||||
group_msg <- paste0("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# force regular [data.frame], not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
stop_ifnot(is.numeric(pct_required_classes), "`pct_required_classes` must be numeric")
|
||||
if (pct_required_classes > 1) {
|
||||
# allow pct_required_classes = 75 -> pct_required_classes = 0.75
|
||||
pct_required_classes <- pct_required_classes / 100
|
||||
}
|
||||
|
||||
if (!is.null(list(...)$country)) {
|
||||
warning_("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call = FALSE)
|
||||
warning_("Using `country` is deprecated, use `guideline` instead. See ?mdro.", call = FALSE)
|
||||
guideline <- list(...)$country
|
||||
}
|
||||
|
||||
guideline.bak <- guideline
|
||||
|
||||
guideline.bak <- guideline
|
||||
if (is.list(guideline)) {
|
||||
# Custom MDRO guideline ---------------------------------------------------
|
||||
stop_ifnot(inherits(guideline, "custom_mdro_guideline"), "use `custom_mdro_guideline()` to create custom guidelines")
|
||||
if (info == TRUE) {
|
||||
txt <- paste0("Determining MDROs based on custom rules",
|
||||
ifelse(isTRUE(attributes(guideline)$as_factor),
|
||||
paste0(", resulting in [factor] levels: ", paste0(attributes(guideline)$values, collapse = " < ")),
|
||||
""),
|
||||
".")
|
||||
txt <- word_wrap(txt)
|
||||
cat(txt, "\n", sep = "")
|
||||
}
|
||||
x <- run_custom_mdro_guideline(df = x, guideline = guideline, info = info)
|
||||
if (info.bak == TRUE) {
|
||||
cat(group_msg)
|
||||
if (sum(!is.na(x$MDRO)) == 0) {
|
||||
cat(word_wrap(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the custom guideline"))))
|
||||
} else {
|
||||
cat(word_wrap(font_bold(paste0("=> Found ", sum(x$MDRO != "Negative", na.rm = TRUE),
|
||||
" custom defined MDROs out of ", sum(!is.na(x$MDRO)),
|
||||
" isolates (",
|
||||
trimws(percentage(sum(x$MDRO != "Negative", na.rm = TRUE) / sum(!is.na(x$MDRO)))),
|
||||
")\n"))))
|
||||
}
|
||||
}
|
||||
if (verbose == TRUE) {
|
||||
return(x[, c("row_number",
|
||||
"MDRO",
|
||||
"reason",
|
||||
"columns_nonsusceptible")])
|
||||
} else {
|
||||
return(x$MDRO)
|
||||
}
|
||||
}
|
||||
guideline <- tolower(gsub("[^a-zA-Z0-9.]+", "", guideline))
|
||||
if (is.null(guideline)) {
|
||||
# default to the paper by Magiorakos et al. (2012)
|
||||
@@ -182,12 +306,11 @@ mdro <- function(x,
|
||||
}
|
||||
if (is.null(col_mo) & guideline$code == "tb") {
|
||||
message_("No column found as input for `col_mo`, ",
|
||||
font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis.")))
|
||||
x$mo <- as.mo("Mycobacterium tuberculosis")
|
||||
col_mo <- "mo"
|
||||
font_bold(paste0("assuming all records contain", font_italic("Mycobacterium tuberculosis"), ".")))
|
||||
x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE]
|
||||
col_mo <- "mo"
|
||||
}
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
|
||||
if (guideline$code == "cmi2012") {
|
||||
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
|
||||
@@ -238,7 +361,7 @@ mdro <- function(x,
|
||||
if (guideline$code == "cmi2012") {
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
soft_dependencies = c(
|
||||
# table 1 (S aureus):
|
||||
# [table] 1 (S aureus):
|
||||
"GEN",
|
||||
"RIF",
|
||||
"CPT",
|
||||
@@ -261,7 +384,7 @@ mdro <- function(x,
|
||||
"TCY",
|
||||
"DOX",
|
||||
"MNO",
|
||||
# table 2 (Enterococcus)
|
||||
# [table] 2 (Enterococcus)
|
||||
"GEH",
|
||||
"STH",
|
||||
"IPM",
|
||||
@@ -279,7 +402,7 @@ mdro <- function(x,
|
||||
"QDA",
|
||||
"DOX",
|
||||
"MNO",
|
||||
# table 3 (Enterobacteriaceae)
|
||||
# [table] 3 (Enterobacteriaceae)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
@@ -311,7 +434,7 @@ mdro <- function(x,
|
||||
"TCY",
|
||||
"DOX",
|
||||
"MNO",
|
||||
# table 4 (Pseudomonas)
|
||||
# [table] 4 (Pseudomonas)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
@@ -329,7 +452,7 @@ mdro <- function(x,
|
||||
"FOS",
|
||||
"COL",
|
||||
"PLB",
|
||||
# table 5 (Acinetobacter)
|
||||
# [table] 5 (Acinetobacter)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
@@ -354,6 +477,7 @@ mdro <- function(x,
|
||||
"MNO"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
} else if (guideline$code == "eucast3.2") {
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
@@ -379,8 +503,9 @@ mdro <- function(x,
|
||||
"TOB",
|
||||
"TZD",
|
||||
"VAN"),
|
||||
info = info,
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
} else if (guideline$code == "tb") {
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
@@ -392,8 +517,9 @@ mdro <- function(x,
|
||||
"RIF",
|
||||
"RIB",
|
||||
"RFP"),
|
||||
info = info,
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
} else if (guideline$code == "mrgn") {
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
@@ -405,14 +531,16 @@ mdro <- function(x,
|
||||
"CIP"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
} else {
|
||||
cols_ab <- get_column_abx(x = x,
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
...)
|
||||
}
|
||||
|
||||
|
||||
# nolint start
|
||||
AMC <- cols_ab["AMC"]
|
||||
AMK <- cols_ab["AMK"]
|
||||
@@ -586,6 +714,11 @@ mdro <- function(x,
|
||||
ab_NA <- function(x) {
|
||||
x[!is.na(x)]
|
||||
}
|
||||
try_ab <- function(expr) {
|
||||
out <- tryCatch(expr, error = function(e) FALSE)
|
||||
out[is.na(out)] <- FALSE
|
||||
out
|
||||
}
|
||||
|
||||
# antibiotic classes
|
||||
# nolint start
|
||||
@@ -627,7 +760,11 @@ mdro <- function(x,
|
||||
row_filter <- x[which(row_filter), "row_number", drop = TRUE]
|
||||
rows <- rows[rows %in% row_filter]
|
||||
x[rows, "MDRO"] <<- to
|
||||
x[rows, "reason"] <<- paste0(any_all, " of the required antibiotics ", ifelse(any_all == "any", "is", "are"), " R")
|
||||
x[rows, "reason"] <<- paste0(any_all,
|
||||
" of the required antibiotics ",
|
||||
ifelse(any_all == "any", "is", "are"),
|
||||
" R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
}
|
||||
}
|
||||
trans_tbl2 <- function(txt, rows, lst) {
|
||||
@@ -680,6 +817,9 @@ mdro <- function(x,
|
||||
}
|
||||
|
||||
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
|
||||
# rename col_mo to prevent interference with joined columns
|
||||
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
|
||||
col_mo <- ".col_mo"
|
||||
# join to microorganisms data set
|
||||
x <- left_join_microorganisms(x, by = col_mo)
|
||||
x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_)
|
||||
@@ -722,6 +862,7 @@ mdro <- function(x,
|
||||
x[which(x$genus == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA
|
||||
x[which((x$genus == "Citrobacter" & x$species == "freundii")
|
||||
| (x$genus == "Enterobacter" & x$species == "aerogenes")
|
||||
| (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||
| (x$genus == "Enterobacter" & x$species == "cloacae")
|
||||
| (x$genus == "Hafnia" & x$species == "alvei")
|
||||
| (x$genus == "Morganella" & x$species == "morganii")
|
||||
@@ -741,6 +882,7 @@ mdro <- function(x,
|
||||
x[which((x$genus == "Citrobacter" & x$species == "koseri")
|
||||
| (x$genus == "Citrobacter" & x$species == "freundii")
|
||||
| (x$genus == "Enterobacter" & x$species == "aerogenes")
|
||||
| (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||
| (x$genus == "Enterobacter" & x$species == "cloacae")
|
||||
| (x$genus == "Escherichia" & x$species == "hermannii")
|
||||
| (x$genus == "Hafnia" & x$species == "alvei")
|
||||
@@ -753,6 +895,7 @@ mdro <- function(x,
|
||||
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
|
||||
x[which((x$genus == "Citrobacter" & x$species == "freundii")
|
||||
| (x$genus == "Enterobacter" & x$species == "aerogenes")
|
||||
| (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||
| (x$genus == "Enterobacter" & x$species == "cloacae")
|
||||
| (x$genus == "Hafnia" & x$species == "alvei")
|
||||
| (x$genus == "Morganella" & x$species == "morganii")
|
||||
@@ -762,6 +905,7 @@ mdro <- function(x,
|
||||
x[which((x$genus == "Citrobacter" & x$species == "freundii")
|
||||
| (x$genus == "Citrobacter" & x$species == "koseri")
|
||||
| (x$genus == "Enterobacter" & x$species == "aerogenes")
|
||||
| (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||
| (x$genus == "Enterobacter" & x$species == "cloacae")
|
||||
| (x$genus == "Hafnia" & x$species == "alvei")
|
||||
| (x$genus == "Providencia" & x$species == "rettgeri")
|
||||
@@ -873,7 +1017,9 @@ mdro <- function(x,
|
||||
# MDR (=2): >=3 classes affected
|
||||
x[which(x$classes_affected >= 3), "MDRO"] <- 2
|
||||
if (verbose == TRUE) {
|
||||
x[which(x$classes_affected >= 3), "reason"] <- paste0("at least 3 classes contain R or I: ", x$classes_affected[which(x$classes_affected >= 3)],
|
||||
x[which(x$classes_affected >= 3), "reason"] <- paste0("at least 3 classes contain R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", ""), ": ",
|
||||
x$classes_affected[which(x$classes_affected >= 3)],
|
||||
" out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes")
|
||||
}
|
||||
|
||||
@@ -887,7 +1033,10 @@ mdro <- function(x,
|
||||
# PDR (=4): all agents are R
|
||||
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
|
||||
if (verbose == TRUE) {
|
||||
x[which(x$MDRO == 4), "reason"] <- paste("all antibiotics in all", x$classes_in_guideline[which(x$MDRO == 4)], "classes were tested R or I")
|
||||
x[which(x$MDRO == 4), "reason"] <- paste("all antibiotics in all",
|
||||
x$classes_in_guideline[which(x$MDRO == 4)],
|
||||
"classes were tested R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
}
|
||||
|
||||
# not enough classes available
|
||||
@@ -1042,51 +1191,57 @@ mdro <- function(x,
|
||||
|
||||
if (guideline$code == "mrgn") {
|
||||
# Germany -----------------------------------------------------------------
|
||||
CTX_or_CAZ <- CTX %or% CAZ
|
||||
IPM_or_MEM <- IPM %or% MEM
|
||||
x$missing <- NA_character_
|
||||
if (is.na(PIP)) PIP <- "missing"
|
||||
if (is.na(CTX_or_CAZ)) CTX_or_CAZ <- "missing"
|
||||
if (is.na(IPM_or_MEM)) IPM_or_MEM <- "missing"
|
||||
if (is.na(IPM)) IPM <- "missing"
|
||||
if (is.na(MEM)) MEM <- "missing"
|
||||
if (is.na(CIP)) CIP <- "missing"
|
||||
|
||||
# Table 1
|
||||
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
x[, PIP] == "R" &
|
||||
x[, CTX_or_CAZ] == "R" &
|
||||
x[, IPM_or_MEM] == "S" &
|
||||
x[, CIP] == "R"),
|
||||
"MDRO"] <- 2 # 2 = 3MRGN
|
||||
trans_tbl(2, # 3MRGN
|
||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
try_ab(x[, PIP, drop = TRUE] == "R") &
|
||||
(try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
|
||||
(try_ab(x[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) &
|
||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||
"any")
|
||||
|
||||
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
x[, PIP] == "R" &
|
||||
x[, CTX_or_CAZ] == "R" &
|
||||
x[, IPM_or_MEM] == "R" &
|
||||
x[, CIP] == "R"),
|
||||
"MDRO"] <- 3 # 3 = 4MRGN, overwrites 3MRGN if applicable
|
||||
trans_tbl(3, # 4MRGN, overwrites 3MRGN if applicable
|
||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
try_ab(x[, PIP, drop = TRUE] == "R") &
|
||||
(try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
|
||||
(try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
|
||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||
"any")
|
||||
|
||||
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
x[, IPM] == "R" | x[, MEM] == "R"),
|
||||
"MDRO"] <- 3 # 3 = 4MRGN, always when imipenem or meropenem is R
|
||||
trans_tbl(3, # 4MRGN, overwrites 3MRGN if applicable
|
||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||
(try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))),
|
||||
c(IPM, MEM),
|
||||
"any")
|
||||
|
||||
x[which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
||||
(x[, PIP] == "S") +
|
||||
(x[, CTX_or_CAZ] == "S") +
|
||||
(x[, IPM_or_MEM] == "S") +
|
||||
(x[, CIP] == "S") == 1),
|
||||
"MDRO"] <- 2 # 2 = 3MRGN, if only 1 group is S
|
||||
trans_tbl(2, # 3MRGN, if only 1 group is S
|
||||
which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
||||
try_ab(x[, PIP, drop = TRUE] == "S") +
|
||||
try_ab(x[, CTX, drop = TRUE] == "S") +
|
||||
try_ab(x[, CAZ, drop = TRUE] == "S") +
|
||||
try_ab(x[, IPM, drop = TRUE] == "S") +
|
||||
try_ab(x[, MEM, drop = TRUE] == "S") +
|
||||
try_ab(x[, CIP, drop = TRUE] == "S") == 1),
|
||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||
"any")
|
||||
|
||||
x[which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
|
||||
x[, PIP] == "R" &
|
||||
x[, CTX_or_CAZ] == "R" &
|
||||
x[, IPM_or_MEM] == "R" &
|
||||
x[, CIP] == "R"),
|
||||
"MDRO"] <- 3 # 3 = 4MRGN
|
||||
trans_tbl(3, # 4MRGN otherwise
|
||||
which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
|
||||
try_ab(x[, PIP, drop = TRUE] == "R") &
|
||||
(try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
|
||||
(try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
|
||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||
"any")
|
||||
|
||||
x[which(x$MDRO == 2), "reason"] <- "3MRGN"
|
||||
x[which(x$MDRO == 3), "reason"] <- "4MRGN"
|
||||
}
|
||||
|
||||
if (guideline$code == "brmo") {
|
||||
@@ -1139,17 +1294,21 @@ mdro <- function(x,
|
||||
& !ab_missing(CAZ)
|
||||
& !ab_missing(TZP)) {
|
||||
x$psae <- 0
|
||||
x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"] <- 1 + x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"]
|
||||
x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"] <- 1 + x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"]
|
||||
x[which(x[, CIP] == "R"), "psae"] <- 1 + x[which(x[, CIP] == "R"), "psae"]
|
||||
x[which(x[, CAZ] == "R"), "psae"] <- 1 + x[which(x[, CAZ] == "R"), "psae"]
|
||||
x[which(x[, TZP] == "R"), "psae"] <- 1 + x[which(x[, TZP] == "R"), "psae"]
|
||||
x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"]
|
||||
x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"]
|
||||
x[which(x[, CIP, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, CIP, drop = TRUE] == "R"), "psae"]
|
||||
x[which(x[, CAZ, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, CAZ, drop = TRUE] == "R"), "psae"]
|
||||
x[which(x[, TZP, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, TZP, drop = TRUE] == "R"), "psae"]
|
||||
} else {
|
||||
x$psae <- 0
|
||||
}
|
||||
trans_tbl(3,
|
||||
which(x$genus == "Pseudomonas" & x$species == "aeruginosa" & x$psae >= 3),
|
||||
c(CAZ, CIP, GEN, IPM, MEM, TOB, TZP),
|
||||
"any")
|
||||
x[which(
|
||||
x$genus == "Pseudomonas" & x$species == "aeruginosa"
|
||||
& x$psae >= 3), "MDRO"] <- 3
|
||||
& x$psae >= 3), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
|
||||
# Table 3
|
||||
trans_tbl(3,
|
||||
@@ -1181,7 +1340,7 @@ mdro <- function(x,
|
||||
ab
|
||||
}
|
||||
drug_is_R <- function(ab) {
|
||||
# returns logical vector
|
||||
# returns [logical] vector
|
||||
ab <- prepare_drug(ab)
|
||||
if (length(ab) == 0) {
|
||||
rep(FALSE, NROW(x))
|
||||
@@ -1192,7 +1351,7 @@ mdro <- function(x,
|
||||
}
|
||||
}
|
||||
drug_is_not_R <- function(ab) {
|
||||
# returns logical vector
|
||||
# returns [logical] vector
|
||||
ab <- prepare_drug(ab)
|
||||
if (length(ab) == 0) {
|
||||
rep(TRUE, NROW(x))
|
||||
@@ -1224,10 +1383,12 @@ mdro <- function(x,
|
||||
1))))
|
||||
# keep all real TB, make other species NA
|
||||
x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_)
|
||||
x$reason <- "PDR/MDR/XDR criteria were met"
|
||||
}
|
||||
|
||||
if (info == TRUE) {
|
||||
if (sum(!is.na(x$MDRO) == 0)) {
|
||||
if (info.bak == TRUE) {
|
||||
cat(group_msg)
|
||||
if (sum(!is.na(x$MDRO)) == 0) {
|
||||
cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline")))
|
||||
} else {
|
||||
cat(font_bold(paste0("=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " ", guideline$type, " out of ", sum(!is.na(x$MDRO)),
|
||||
@@ -1238,7 +1399,12 @@ mdro <- function(x,
|
||||
# some more info on negative results
|
||||
if (verbose == TRUE) {
|
||||
if (guideline$code == "cmi2012") {
|
||||
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
|
||||
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))],
|
||||
" of ",
|
||||
x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))],
|
||||
" available classes contain R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", ""),
|
||||
" (3 required for MDR)")
|
||||
} else {
|
||||
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
|
||||
}
|
||||
@@ -1247,8 +1413,11 @@ mdro <- function(x,
|
||||
# Results ----
|
||||
if (guideline$code == "cmi2012") {
|
||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||
warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
|
||||
if (message_not_thrown_before("mdro.availability")) {
|
||||
warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
|
||||
remember_thrown_message("mdro.availability")
|
||||
}
|
||||
# set these -1s to NA
|
||||
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_
|
||||
}
|
||||
@@ -1276,12 +1445,14 @@ mdro <- function(x,
|
||||
}
|
||||
|
||||
if (verbose == TRUE) {
|
||||
colnames(x)[colnames(x) == col_mo] <- "microorganism"
|
||||
x$microorganism <- mo_name(x$microorganism, language = NULL)
|
||||
x[, c("row_number",
|
||||
col_mo,
|
||||
"microorganism",
|
||||
"MDRO",
|
||||
"reason",
|
||||
"columns_nonsusceptible")]
|
||||
#x
|
||||
"columns_nonsusceptible"),
|
||||
drop = FALSE]
|
||||
} else {
|
||||
x$MDRO
|
||||
}
|
||||
@@ -1290,55 +1461,206 @@ mdro <- function(x,
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
brmo <- function(x, guideline = "BRMO", ...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
||||
meet_criteria(as_factor, allow_class = "logical", has_length = 1)
|
||||
|
||||
dots <- tryCatch(list(...),
|
||||
error = function(e) "error")
|
||||
stop_if(identical(dots, "error"),
|
||||
"rules must be a valid formula inputs (e.g., using '~'), see `?mdro`")
|
||||
n_dots <- length(dots)
|
||||
stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?mdro`.")
|
||||
out <- vector("list", n_dots)
|
||||
for (i in seq_len(n_dots)) {
|
||||
stop_ifnot(inherits(dots[[i]], "formula"),
|
||||
"rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`")
|
||||
|
||||
# Query
|
||||
qry <- dots[[i]][[2]]
|
||||
if (inherits(qry, "call")) {
|
||||
qry <- as.expression(qry)
|
||||
}
|
||||
qry <- as.character(qry)
|
||||
# these will prevent vectorisation, so replace them:
|
||||
qry <- gsub("&&", "&", qry, fixed = TRUE)
|
||||
qry <- gsub("||", "|", qry, fixed = TRUE)
|
||||
# support filter()-like writing: custom_mdro_guideline('CIP == "R", AMX == "S"' ~ "result 1")
|
||||
qry <- gsub(" *, *", " & ", qry)
|
||||
# format nicely, setting spaces around operators
|
||||
qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
|
||||
qry <- gsub("'", "\"", qry, fixed = TRUE)
|
||||
out[[i]]$query <- as.expression(qry)
|
||||
|
||||
# Value
|
||||
val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL)
|
||||
stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) e$message))
|
||||
stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
|
||||
out[[i]]$value <- as.character(val)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
mdro(x, guideline = "BRMO", ...)
|
||||
|
||||
names(out) <- paste0("rule", seq_len(n_dots))
|
||||
out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list"))
|
||||
attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value)))
|
||||
attr(out, "as_factor") <- as_factor
|
||||
out
|
||||
}
|
||||
|
||||
#' @method c custom_mdro_guideline
|
||||
#' @noRd
|
||||
#' @export
|
||||
c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
|
||||
if (length(list(...)) == 0) {
|
||||
return(x)
|
||||
}
|
||||
if (!is.null(as_factor)) {
|
||||
meet_criteria(as_factor, allow_class = "logical", has_length = 1)
|
||||
} else {
|
||||
as_factor <- attributes(x)$as_factor
|
||||
}
|
||||
for (g in list(...)) {
|
||||
stop_ifnot(inherits(g, "custom_mdro_guideline"),
|
||||
"for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
|
||||
call = FALSE)
|
||||
vals <- attributes(x)$values
|
||||
if (!all(attributes(g)$values %in% vals)) {
|
||||
vals <- unname(unique(c(vals, attributes(g)$values)))
|
||||
}
|
||||
attributes(g) <- NULL
|
||||
x <- c(unclass(x), unclass(g))
|
||||
attr(x, "values") <- vals
|
||||
}
|
||||
names(x) <- paste0("rule", seq_len(length(x)))
|
||||
x <- set_clean_class(x, new_class = c("custom_mdro_guideline", "list"))
|
||||
attr(x, "values") <- vals
|
||||
attr(x, "as_factor") <- as_factor
|
||||
x
|
||||
}
|
||||
|
||||
#' @method as.list custom_mdro_guideline
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.list.custom_mdro_guideline <- function(x, ...) {
|
||||
c(x, ...)
|
||||
}
|
||||
|
||||
#' @method print custom_mdro_guideline
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.custom_mdro_guideline <- function(x, ...) {
|
||||
cat("A set of custom MDRO rules:\n")
|
||||
for (i in seq_len(length(x))) {
|
||||
rule <- x[[i]]
|
||||
rule$query <- format_custom_query_rule(rule$query)
|
||||
cat(" ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
|
||||
}
|
||||
cat(" ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
|
||||
cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
|
||||
if (isTRUE(attributes(x)$as_factor)) {
|
||||
cat("Results will be of class <factor>, with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
|
||||
} else {
|
||||
cat("Results will be of class <character>.\n")
|
||||
}
|
||||
}
|
||||
|
||||
run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||
n_dots <- length(guideline)
|
||||
stop_if(n_dots == 0, "no custom guidelines set", call = -2)
|
||||
out <- character(length = NROW(df))
|
||||
reasons <- character(length = NROW(df))
|
||||
for (i in seq_len(n_dots)) {
|
||||
qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
|
||||
error = function(e) {
|
||||
pkg_env$err_msg <- e$message
|
||||
return("error")
|
||||
})
|
||||
if (identical(qry, "error")) {
|
||||
warning_("in custom_mdro_guideline(): rule ", i,
|
||||
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
||||
pkg_env$err_msg,
|
||||
call = FALSE,
|
||||
add_fn = font_red)
|
||||
next
|
||||
}
|
||||
stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
|
||||
"`) must return `TRUE` or `FALSE`, not ",
|
||||
format_class(class(qry), plural = FALSE), call = FALSE)
|
||||
|
||||
new_mdros <- which(qry == TRUE & out == "")
|
||||
|
||||
if (info == TRUE) {
|
||||
cat(word_wrap("- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
|
||||
"` (", length(new_mdros), " rows matched)"), "\n", sep = "")
|
||||
}
|
||||
val <- guideline[[i]]$value
|
||||
out[new_mdros] <- val
|
||||
reasons[new_mdros] <- paste0("matched rule ", gsub("rule", "", names(guideline)[i]), ": ", as.character(guideline[[i]]$query))
|
||||
}
|
||||
out[out == ""] <- "Negative"
|
||||
reasons[out == "Negative"] <- "no rules matched"
|
||||
|
||||
if (isTRUE(attributes(guideline)$as_factor)) {
|
||||
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
|
||||
}
|
||||
|
||||
columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df)] == "R"))
|
||||
columns_nonsusceptible <- vapply(FUN.VALUE = character(1),
|
||||
columns_nonsusceptible,
|
||||
function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " "))
|
||||
columns_nonsusceptible[is.na(out)] <- NA_character_
|
||||
|
||||
data.frame(row_number = seq_len(NROW(df)),
|
||||
MDRO = out,
|
||||
reason = reasons,
|
||||
columns_nonsusceptible = columns_nonsusceptible,
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mrgn <- function(x, guideline = "MRGN", ...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
mdro(x = x, guideline = "MRGN", ...)
|
||||
brmo <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if("guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function")
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "BRMO", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_tb <- function(x, guideline = "TB", ...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
mdro(x = x, guideline = "TB", ...)
|
||||
mrgn <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if("guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function")
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "MRGN", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_cmi2012 <- function(x, guideline = "CMI2012", ...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
mdro(x = x, guideline = "CMI2012", ...)
|
||||
mdr_tb <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if("guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function")
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "TB", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
eucast_exceptional_phenotypes <- function(x, guideline = "EUCAST", ...) {
|
||||
if (missing(x)) {
|
||||
x <- get_current_data(arg_name = "x", call = -2)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
mdro(x = x, guideline = "EUCAST", ...)
|
||||
mdr_cmi2012 <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if("guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function")
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "CMI2012", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
eucast_exceptional_phenotypes <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if("guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function")
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "EUCAST", ...)
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,28 +20,71 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform input to minimum inhibitory concentrations (MIC)
|
||||
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
|
||||
#'
|
||||
#' This transforms a vector to a new class [`mic`], which is an ordered [factor] with valid minimum inhibitory concentrations (MIC) as levels. Invalid MIC values will be translated as `NA` with a warning.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' This ransforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @rdname as.mic
|
||||
#' @param x vector
|
||||
#' @param na.rm a logical indicating whether missing values should be removed
|
||||
#' @param x a [character] or [numeric] vector
|
||||
#' @param na.rm a [logical] indicating whether missing values should be removed
|
||||
#' @details To interpret MIC values as RSI values, use [as.rsi()] on MIC values. It supports guidelines from EUCAST and CLSI.
|
||||
#' @return Ordered [factor] with additional class [`mic`]
|
||||
#'
|
||||
#' This class for MIC values is a quite a special data type: formally it is an ordered [factor] with valid MIC values as [factor] levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- random_mic(10)
|
||||
#' x
|
||||
#' #> Class <mic>
|
||||
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
#'
|
||||
#' is.factor(x)
|
||||
#' #> [1] TRUE
|
||||
#'
|
||||
#' x[1] * 2
|
||||
#' #> [1] 32
|
||||
#'
|
||||
#' median(x)
|
||||
#' #> [1] 26
|
||||
#' ```
|
||||
#'
|
||||
#' This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using [numeric] values in data analysis, e.g.:
|
||||
#'
|
||||
#' ```
|
||||
#' x[x > 4]
|
||||
#' #> Class <mic>
|
||||
#' #> [1] 16 8 8 64 >=128 32 32 16
|
||||
#'
|
||||
#' df <- data.frame(x, hospital = "A")
|
||||
#' subset(df, x > 4) # or with dplyr: df %>% filter(x > 4)
|
||||
#' #> x hospital
|
||||
#' #> 1 16 A
|
||||
#' #> 5 64 A
|
||||
#' #> 6 >=128 A
|
||||
#' #> 8 32 A
|
||||
#' #> 9 32 A
|
||||
#' #> 10 16 A
|
||||
#' ```
|
||||
#'
|
||||
#' The following [generic functions][groupGeneric()] are implemented for the MIC class: `!`, `!=`, `%%`, `%/%`, `&`, `*`, `+`, `-`, `/`, `<`, `<=`, `==`, `>`, `>=`, `^`, `|`, [abs()], [acos()], [acosh()], [all()], [any()], [asin()], [asinh()], [atan()], [atanh()], [ceiling()], [cos()], [cosh()], [cospi()], [cummax()], [cummin()], [cumprod()], [cumsum()], [digamma()], [exp()], [expm1()], [floor()], [gamma()], [lgamma()], [log()], [log1p()], [log2()], [log10()], [max()], [mean()], [min()], [prod()], [range()], [round()], [sign()], [signif()], [sin()], [sinh()], [sinpi()], [sqrt()], [sum()], [tan()], [tanh()], [tanpi()], [trigamma()] and [trunc()]. Some functions of the `stats` package are also implemented: [median()], [quantile()], [mad()], [IQR()], [fivenum()]. Also, [boxplot.stats()] is supported. Since [sd()] and [var()] are non-generic functions, these could not be extended. Use [mad()] as an alternative, or use e.g. `sd(as.numeric(x))` where `x` is your vector of MIC values.
|
||||
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
|
||||
#' @aliases mic
|
||||
#' @export
|
||||
#' @seealso [as.rsi()]
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
||||
#' is.mic(mic_data)
|
||||
#'
|
||||
#' # this can also coerce combined MIC/RSI values:
|
||||
#' as.mic("<=0.002; S") # will return <=0.002
|
||||
#'
|
||||
#' # mathematical processing treats MICs as [numeric] values
|
||||
#' fivenum(mic_data)
|
||||
#' quantile(mic_data)
|
||||
#' all(mic_data < 512)
|
||||
#'
|
||||
#' # interpret MIC values
|
||||
#' as.rsi(x = as.mic(2),
|
||||
@@ -53,16 +96,17 @@
|
||||
#' ab = "AMX",
|
||||
#' guideline = "EUCAST")
|
||||
#'
|
||||
#' # plot MIC values, see ?plot
|
||||
#' plot(mic_data)
|
||||
#' barplot(mic_data)
|
||||
#' plot(mic_data, mo = "E. coli", ab = "cipro")
|
||||
as.mic <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer"), allow_NA = TRUE)
|
||||
meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (is.mic(x)) {
|
||||
x
|
||||
} else {
|
||||
x <- x %pm>% unlist()
|
||||
x <- as.character(unlist(x))
|
||||
if (na.rm == TRUE) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
@@ -74,29 +118,29 @@ as.mic <- function(x, na.rm = FALSE) {
|
||||
x <- gsub("\u2264", "<=", x, fixed = TRUE)
|
||||
x <- gsub("\u2265", ">=", x, fixed = TRUE)
|
||||
# remove space between operator and number ("<= 0.002" -> "<=0.002")
|
||||
x <- gsub("(<|=|>) +", "\\1", x)
|
||||
x <- gsub("(<|=|>) +", "\\1", x, perl = TRUE)
|
||||
# transform => to >= and =< to <=
|
||||
x <- gsub("=<", "<=", x, fixed = TRUE)
|
||||
x <- gsub("=>", ">=", x, fixed = TRUE)
|
||||
# dots without a leading zero must start with 0
|
||||
x <- gsub("([^0-9]|^)[.]", "\\10.", x)
|
||||
x <- gsub("([^0-9]|^)[.]", "\\10.", x, perl = TRUE)
|
||||
# values like "<=0.2560.512" should be 0.512
|
||||
x <- gsub(".*[.].*[.]", "0.", x)
|
||||
x <- gsub(".*[.].*[.]", "0.", x, perl = TRUE)
|
||||
# remove ending .0
|
||||
x <- gsub("[.]+0$", "", x)
|
||||
x <- gsub("[.]+0$", "", x, perl = TRUE)
|
||||
# remove all after last digit
|
||||
x <- gsub("[^0-9]+$", "", x)
|
||||
x <- gsub("[^0-9]+$", "", x, perl = TRUE)
|
||||
# keep only one zero before dot
|
||||
x <- gsub("0+[.]", "0.", x)
|
||||
x <- gsub("0+[.]", "0.", x, perl = TRUE)
|
||||
# starting 00 is probably 0.0 if there's no dot yet
|
||||
x[!x %like% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
||||
x[x %unlike% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
||||
# remove last zeroes
|
||||
x <- gsub("([.].?)0+$", "\\1", x)
|
||||
x <- gsub("(.*[.])0+$", "\\10", x)
|
||||
x <- gsub("([.].?)0+$", "\\1", x, perl = TRUE)
|
||||
x <- gsub("(.*[.])0+$", "\\10", x, perl = TRUE)
|
||||
# remove ending .0 again
|
||||
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
|
||||
# never end with dot
|
||||
x <- gsub("[.]$", "", x)
|
||||
x <- gsub("[.]$", "", x, perl = TRUE)
|
||||
# force to be character
|
||||
x <- as.character(x)
|
||||
# trim it
|
||||
@@ -105,7 +149,7 @@ as.mic <- function(x, na.rm = FALSE) {
|
||||
## previously unempty values now empty - should return a warning later on
|
||||
x[x.bak != "" & x == ""] <- "invalid"
|
||||
|
||||
# these are allowed MIC values and will become factor levels
|
||||
# these are allowed MIC values and will become [factor] levels
|
||||
ops <- c("<", "<=", "", ">=", ">")
|
||||
lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))),
|
||||
unique(c(t(vapply(FUN.VALUE = character(104), ops, function(x) paste0(x, sort(as.double(paste0("0.0",
|
||||
@@ -123,8 +167,8 @@ as.mic <- function(x, na.rm = FALSE) {
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %pm>%
|
||||
unique() %pm>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
@@ -155,29 +199,31 @@ is.mic <- function(x) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.double.mic <- function(x, ...) {
|
||||
as.double(gsub("[<=>]+", "", as.character(x)))
|
||||
as.double(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
||||
}
|
||||
|
||||
#' @method as.integer mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.integer.mic <- function(x, ...) {
|
||||
as.integer(gsub("[<=>]+", "", as.character(x)))
|
||||
as.integer(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
||||
}
|
||||
|
||||
#' @method as.numeric mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.numeric.mic <- function(x, ...) {
|
||||
as.numeric(gsub("[<=>]+", "", as.character(x)))
|
||||
as.numeric(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
||||
}
|
||||
|
||||
#' @method droplevels mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA, ...) {
|
||||
droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA, as.mic = TRUE, ...) {
|
||||
x <- droplevels.factor(x, exclude = exclude, ...)
|
||||
class(x) <- c("mic", "ordered", "factor")
|
||||
if (as.mic == TRUE) {
|
||||
class(x) <- c("mic", "ordered", "factor")
|
||||
}
|
||||
x
|
||||
}
|
||||
|
||||
@@ -189,6 +235,7 @@ pillar_shaft.mic <- function(x, ...) {
|
||||
out <- pasted
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
out <- gsub("(<|=|>)", font_silver("\\1"), out)
|
||||
out <- gsub("([.]?0+)$", font_white("\\1"), out)
|
||||
create_pillar_column(out, align = "right", width = max(nchar(pasted)))
|
||||
}
|
||||
|
||||
@@ -203,70 +250,24 @@ type_sum.mic <- function(x, ...) {
|
||||
print.mic <- function(x, ...) {
|
||||
cat("Class <mic>\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
att <- attributes(x)
|
||||
if ("na.action" %in% names(att)) {
|
||||
cat(font_silver(paste0("(NA ", class(att$na.action), ": ", paste0(att$na.action, collapse = ", "), ")\n")))
|
||||
}
|
||||
}
|
||||
|
||||
#' @method summary mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
summary.mic <- function(object, ...) {
|
||||
x <- object
|
||||
n_total <- length(x)
|
||||
x <- x[!is.na(x)]
|
||||
n <- length(x)
|
||||
value <- c("Class" = "mic",
|
||||
"<NA>" = n_total - n,
|
||||
"Min." = as.character(sort(x)[1]),
|
||||
"Max." = as.character(sort(x)[n]))
|
||||
class(value) <- c("summaryDefault", "table")
|
||||
value
|
||||
summary(as.double(object), ...)
|
||||
}
|
||||
|
||||
#' @method plot mic
|
||||
#' @method as.matrix mic
|
||||
#' @export
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @rdname plot
|
||||
plot.mic <- function(x,
|
||||
main = paste("MIC values of", deparse(substitute(x))),
|
||||
ylab = "Frequency",
|
||||
xlab = "MIC value",
|
||||
axes = FALSE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(axes, allow_class = "logical", has_length = 1)
|
||||
|
||||
barplot(table(as.double(x)),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
axes = axes,
|
||||
main = main,
|
||||
...)
|
||||
axis(2, seq(0, max(table(as.double(x)))))
|
||||
}
|
||||
|
||||
#' @method barplot mic
|
||||
#' @export
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @rdname plot
|
||||
barplot.mic <- function(height,
|
||||
main = paste("MIC values of", deparse(substitute(height))),
|
||||
ylab = "Frequency",
|
||||
xlab = "MIC value",
|
||||
axes = FALSE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(axes, allow_class = "logical", has_length = 1)
|
||||
|
||||
barplot(table(as.double(height)),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
axes = axes,
|
||||
main = main,
|
||||
...)
|
||||
axis(2, seq(0, max(table(as.double(height)))))
|
||||
#' @noRd
|
||||
as.matrix.mic <- function(x, ...) {
|
||||
as.matrix(as.double(x), ...)
|
||||
}
|
||||
|
||||
#' @method [ mic
|
||||
@@ -306,10 +307,8 @@ barplot.mic <- function(height,
|
||||
#' @method c mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.mic <- function(x, ...) {
|
||||
y <- unlist(lapply(list(...), as.character))
|
||||
x <- as.character(x)
|
||||
as.mic(c(x, y))
|
||||
c.mic <- function(...) {
|
||||
as.mic(unlist(lapply(list(...), as.character)))
|
||||
}
|
||||
|
||||
#' @method unique mic
|
||||
@@ -321,14 +320,447 @@ unique.mic <- function(x, incomparables = FALSE, ...) {
|
||||
y
|
||||
}
|
||||
|
||||
#' @method sort mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sort.mic <- function(x, decreasing = FALSE, ...) {
|
||||
if (decreasing == TRUE) {
|
||||
ord <- order(-as.double(x))
|
||||
} else {
|
||||
ord <- order(as.double(x))
|
||||
}
|
||||
x[ord]
|
||||
}
|
||||
|
||||
#' @method hist mic
|
||||
#' @importFrom graphics hist
|
||||
#' @export
|
||||
#' @noRd
|
||||
hist.mic <- function(x, ...) {
|
||||
warning_("Use `plot()` or `ggplot()` for optimal plotting of MIC values", call = FALSE)
|
||||
hist(log2(x))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
get_skimmers.mic <- function(column) {
|
||||
skimr::sfl(
|
||||
skim_type = "mic",
|
||||
min = ~as.character(sort(stats::na.omit(.))[1]),
|
||||
max = ~as.character(sort(stats::na.omit(.))[length(stats::na.omit(.))]),
|
||||
median = ~as.character(stats::na.omit(.)[as.double(stats::na.omit(.)) == median(as.double(stats::na.omit(.)))])[1],
|
||||
n_unique = ~pm_n_distinct(., na.rm = TRUE),
|
||||
hist_log2 = ~skimr::inline_hist(log2(as.double(stats::na.omit(.))))
|
||||
p0 = ~stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
|
||||
p25 = ~stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE),
|
||||
p50 = ~stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE),
|
||||
p75 = ~stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE),
|
||||
p100 = ~stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
|
||||
hist = ~skimr::inline_hist(log2(stats::na.omit(.)), 5)
|
||||
)
|
||||
}
|
||||
|
||||
# Miscellaneous mathematical functions ------------------------------------
|
||||
|
||||
#' @method mean mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
mean.mic <- function(x, trim = 0, na.rm = FALSE, ...) {
|
||||
mean(as.double(x), trim = trim, na.rm = na.rm, ...)
|
||||
}
|
||||
|
||||
#' @method median mic
|
||||
#' @importFrom stats median
|
||||
#' @export
|
||||
#' @noRd
|
||||
median.mic <- function(x, na.rm = FALSE, ...) {
|
||||
median(as.double(x), na.rm = na.rm, ...)
|
||||
}
|
||||
|
||||
#' @method quantile mic
|
||||
#' @importFrom stats quantile
|
||||
#' @export
|
||||
#' @noRd
|
||||
quantile.mic <- function(x, probs = seq(0, 1, 0.25), na.rm = FALSE,
|
||||
names = TRUE, type = 7, ...) {
|
||||
quantile(as.double(x), probs = probs, na.rm = na.rm, names = names, type = type, ...)
|
||||
}
|
||||
|
||||
# Math (see ?groupGeneric) ----------------------------------------------
|
||||
|
||||
#' @method abs mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
abs.mic <- function(x) {
|
||||
abs(as.double(x))
|
||||
}
|
||||
#' @method sign mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sign.mic <- function(x) {
|
||||
sign(as.double(x))
|
||||
}
|
||||
#' @method sqrt mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sqrt.mic <- function(x) {
|
||||
sqrt(as.double(x))
|
||||
}
|
||||
#' @method floor mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
floor.mic <- function(x) {
|
||||
floor(as.double(x))
|
||||
}
|
||||
#' @method ceiling mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
ceiling.mic <- function(x) {
|
||||
ceiling(as.double(x))
|
||||
}
|
||||
#' @method trunc mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
trunc.mic <- function(x, ...) {
|
||||
trunc(as.double(x), ...)
|
||||
}
|
||||
#' @method round mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
round.mic <- function(x, digits = 0) {
|
||||
round(as.double(x), digits = digits)
|
||||
}
|
||||
#' @method signif mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
signif.mic <- function(x, digits = 6) {
|
||||
signif(as.double(x), digits = digits)
|
||||
}
|
||||
#' @method exp mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
exp.mic <- function(x) {
|
||||
exp(as.double(x))
|
||||
}
|
||||
#' @method log mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log.mic <- function(x, base = exp(1)) {
|
||||
log(as.double(x), base = base)
|
||||
}
|
||||
#' @method log10 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log10.mic <- function(x) {
|
||||
log10(as.double(x))
|
||||
}
|
||||
#' @method log2 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log2.mic <- function(x) {
|
||||
log2(as.double(x))
|
||||
}
|
||||
#' @method expm1 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
expm1.mic <- function(x) {
|
||||
expm1(as.double(x))
|
||||
}
|
||||
#' @method log1p mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log1p.mic <- function(x) {
|
||||
log1p(as.double(x))
|
||||
}
|
||||
#' @method cos mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cos.mic <- function(x) {
|
||||
cos(as.double(x))
|
||||
}
|
||||
#' @method sin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sin.mic <- function(x) {
|
||||
sin(as.double(x))
|
||||
}
|
||||
#' @method tan mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tan.mic <- function(x) {
|
||||
tan(as.double(x))
|
||||
}
|
||||
#' @method cospi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cospi.mic <- function(x) {
|
||||
cospi(as.double(x))
|
||||
}
|
||||
#' @method sinpi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sinpi.mic <- function(x) {
|
||||
sinpi(as.double(x))
|
||||
}
|
||||
#' @method tanpi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tanpi.mic <- function(x) {
|
||||
tanpi(as.double(x))
|
||||
}
|
||||
#' @method acos mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
acos.mic <- function(x) {
|
||||
acos(as.double(x))
|
||||
}
|
||||
#' @method asin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
asin.mic <- function(x) {
|
||||
asin(as.double(x))
|
||||
}
|
||||
#' @method atan mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
atan.mic <- function(x) {
|
||||
atan(as.double(x))
|
||||
}
|
||||
#' @method cosh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cosh.mic <- function(x) {
|
||||
cosh(as.double(x))
|
||||
}
|
||||
#' @method sinh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sinh.mic <- function(x) {
|
||||
sinh(as.double(x))
|
||||
}
|
||||
#' @method tanh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tanh.mic <- function(x) {
|
||||
tanh(as.double(x))
|
||||
}
|
||||
#' @method acosh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
acosh.mic <- function(x) {
|
||||
acosh(as.double(x))
|
||||
}
|
||||
#' @method asinh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
asinh.mic <- function(x) {
|
||||
asinh(as.double(x))
|
||||
}
|
||||
#' @method atanh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
atanh.mic <- function(x) {
|
||||
atanh(as.double(x))
|
||||
}
|
||||
#' @method lgamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
lgamma.mic <- function(x) {
|
||||
lgamma(as.double(x))
|
||||
}
|
||||
#' @method gamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
gamma.mic <- function(x) {
|
||||
gamma(as.double(x))
|
||||
}
|
||||
#' @method digamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
digamma.mic <- function(x) {
|
||||
digamma(as.double(x))
|
||||
}
|
||||
#' @method trigamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
trigamma.mic <- function(x) {
|
||||
trigamma(as.double(x))
|
||||
}
|
||||
#' @method cumsum mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cumsum.mic <- function(x) {
|
||||
cumsum(as.double(x))
|
||||
}
|
||||
#' @method cumprod mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cumprod.mic <- function(x) {
|
||||
cumprod(as.double(x))
|
||||
}
|
||||
#' @method cummax mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cummax.mic <- function(x) {
|
||||
cummax(as.double(x))
|
||||
}
|
||||
#' @method cummin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cummin.mic <- function(x) {
|
||||
cummin(as.double(x))
|
||||
}
|
||||
|
||||
# Ops (see ?groupGeneric) -----------------------------------------------
|
||||
|
||||
|
||||
#' @method + mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`+.mic` <- function(e1, e2) {
|
||||
as.double(e1) + as.double(e2)
|
||||
}
|
||||
|
||||
#' @method - mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`-.mic` <- function(e1, e2) {
|
||||
as.double(e1) - as.double(e2)
|
||||
}
|
||||
|
||||
#' @method * mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`*.mic` <- function(e1, e2) {
|
||||
as.double(e1) * as.double(e2)
|
||||
}
|
||||
|
||||
#' @method / mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`/.mic` <- function(e1, e2) {
|
||||
as.double(e1) / as.double(e2)
|
||||
}
|
||||
|
||||
#' @method ^ mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`^.mic` <- function(e1, e2) {
|
||||
as.double(e1) ^ as.double(e2)
|
||||
}
|
||||
|
||||
#' @method %% mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`%%.mic` <- function(e1, e2) {
|
||||
as.double(e1) %% as.double(e2)
|
||||
}
|
||||
|
||||
#' @method %/% mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`%/%.mic` <- function(e1, e2) {
|
||||
as.double(e1) %/% as.double(e2)
|
||||
}
|
||||
|
||||
#' @method & mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`&.mic` <- function(e1, e2) {
|
||||
as.double(e1) & as.double(e2)
|
||||
}
|
||||
|
||||
#' @method | mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`|.mic` <- function(e1, e2) {
|
||||
as.double(e1) | as.double(e2)
|
||||
}
|
||||
|
||||
#' @method ! mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`!.mic` <- function(x) {
|
||||
!as.double(x)
|
||||
}
|
||||
|
||||
#' @method == mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`==.mic` <- function(e1, e2) {
|
||||
as.double(e1) == as.double(e2)
|
||||
}
|
||||
|
||||
#' @method != mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`!=.mic` <- function(e1, e2) {
|
||||
as.double(e1) != as.double(e2)
|
||||
}
|
||||
|
||||
#' @method < mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`<.mic` <- function(e1, e2) {
|
||||
as.double(e1) < as.double(e2)
|
||||
}
|
||||
|
||||
#' @method <= mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`<=.mic` <- function(e1, e2) {
|
||||
as.double(e1) <= as.double(e2)
|
||||
}
|
||||
|
||||
#' @method >= mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`>=.mic` <- function(e1, e2) {
|
||||
as.double(e1) >= as.double(e2)
|
||||
}
|
||||
|
||||
#' @method > mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`>.mic` <- function(e1, e2) {
|
||||
as.double(e1) > as.double(e2)
|
||||
}
|
||||
|
||||
# Summary (see ?groupGeneric) -------------------------------------------
|
||||
|
||||
#' @method all mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
all.mic <- function(..., na.rm = FALSE) {
|
||||
all(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method any mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
any.mic <- function(..., na.rm = FALSE) {
|
||||
any(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method sum mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sum.mic <- function(..., na.rm = FALSE) {
|
||||
sum(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method prod mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
prod.mic <- function(..., na.rm = FALSE) {
|
||||
prod(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method min mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
min.mic <- function(..., na.rm = FALSE) {
|
||||
min(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method max mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
max.mic <- function(..., na.rm = FALSE) {
|
||||
max(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method range mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
range.mic <- function(..., na.rm = FALSE) {
|
||||
range(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
|
||||
+15
-13
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,34 +20,36 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Calculate the matching score for microorganisms
|
||||
#' Calculate the Matching Score for Microorganisms
|
||||
#'
|
||||
#' This algorithm is used by [as.mo()] and all the [`mo_*`][mo_property()] functions to determine the most probable match of taxonomic records based on user input.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @author Matthijs S. Berends
|
||||
#' @param x Any user input value(s)
|
||||
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
|
||||
#' @section Matching score for microorganisms:
|
||||
#' @section Matching Score for Microorganisms:
|
||||
#' With ambiguous user input in [as.mo()] and all the [`mo_*`][mo_property()] functions, the returned results are chosen based on their matching score using [mo_matching_score()]. This matching score \eqn{m}, is calculated as:
|
||||
#'
|
||||
#' \deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}{m(x, n) = ( l_n * min(l_n, lev(x, n) ) ) / ( l_n * p_n * k_n )}
|
||||
#' \ifelse{latex}{\deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}}{\ifelse{html}{\figure{mo_matching_score.png}{options: width="300px" alt="mo matching score"}}{m(x, n) = ( l_n * min(l_n, lev(x, n) ) ) / ( l_n * p_n * k_n )}}
|
||||
#'
|
||||
#' where:
|
||||
#'
|
||||
#' * \eqn{x} is the user input;
|
||||
#' * \eqn{n} is a taxonomic name (genus, species, and subspecies);
|
||||
#' * \eqn{l_n}{l_n} is the length of \eqn{n};
|
||||
#' * lev is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance), which counts any insertion, deletion and substitution as 1 that is needed to change \eqn{x} into \eqn{n};
|
||||
#' * \eqn{p_n}{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
|
||||
#' * \eqn{k_n}{p_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.
|
||||
#' * \ifelse{html}{\out{<i>x</i> is the user input;}}{\eqn{x} is the user input;}
|
||||
#' * \ifelse{html}{\out{<i>n</i> is a taxonomic name (genus, species, and subspecies);}}{\eqn{n} is a taxonomic name (genus, species, and subspecies);}
|
||||
#' * \ifelse{html}{\out{<i>l<sub>n</sub></i> is the length of <i>n</i>;}}{l_n is the length of \eqn{n};}
|
||||
#' * \ifelse{html}{\out{<i>lev</i> is the <a href="https://en.wikipedia.org/wiki/Levenshtein_distance">Levenshtein distance function</a>, which counts any insertion, deletion and substitution as 1 that is needed to change <i>x</i> into <i>n</i>;}}{lev is the Levenshtein distance function, which counts any insertion, deletion and substitution as 1 that is needed to change \eqn{x} into \eqn{n};}
|
||||
#' * \ifelse{html}{\out{<i>p<sub>n</sub></i> is the human pathogenic prevalence group of <i>n</i>, as described below;}}{p_n is the human pathogenic prevalence group of \eqn{n}, as described below;}
|
||||
#' * \ifelse{html}{\out{<i>k<sub>n</sub></i> is the taxonomic kingdom of <i>n</i>, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.}}{l_n is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.}
|
||||
#'
|
||||
#' The grouping into human pathogenic prevalence (\eqn{p}) is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence. **Group 1** (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Pseudomonas* and *Legionella* and all species within the order Enterobacterales. **Group 2** consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is *Absidia*, *Acremonium*, *Actinotignum*, *Alternaria*, *Anaerosalibacter*, *Apophysomyces*, *Arachnia*, *Aspergillus*, *Aureobacterium*, *Aureobasidium*, *Bacteroides*, *Basidiobolus*, *Beauveria*, *Blastocystis*, *Branhamella*, *Calymmatobacterium*, *Candida*, *Capnocytophaga*, *Catabacter*, *Chaetomium*, *Chryseobacterium*, *Chryseomonas*, *Chrysonilia*, *Cladophialophora*, *Cladosporium*, *Conidiobolus*, *Cryptococcus*, *Curvularia*, *Exophiala*, *Exserohilum*, *Flavobacterium*, *Fonsecaea*, *Fusarium*, *Fusobacterium*, *Hendersonula*, *Hypomyces*, *Koserella*, *Lelliottia*, *Leptosphaeria*, *Leptotrichia*, *Malassezia*, *Malbranchea*, *Mortierella*, *Mucor*, *Mycocentrospora*, *Mycoplasma*, *Nectria*, *Ochroconis*, *Oidiodendron*, *Phoma*, *Piedraia*, *Pithomyces*, *Pityrosporum*, *Prevotella*,\\*Pseudallescheria*, *Rhizomucor*, *Rhizopus*, *Rhodotorula*, *Scolecobasidium*, *Scopulariopsis*, *Scytalidium*,*Sporobolomyces*, *Stachybotrys*, *Stomatococcus*, *Treponema*, *Trichoderma*, *Trichophyton*, *Trichosporon*, *Tritirachium* or *Ureaplasma*. **Group 3** consists of all other microorganisms.
|
||||
#' The grouping into human pathogenic prevalence (\eqn{p}) is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence. **Group 1** (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Pseudomonas* and *Legionella* and all species within the order Enterobacterales. **Group 2** consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is *Absidia*, *Acremonium*, *Actinotignum*, *Alternaria*, *Anaerosalibacter*, *Apophysomyces*, *Arachnia*, *Aspergillus*, *Aureobacterium*, *Aureobasidium*, *Bacteroides*, *Basidiobolus*, *Beauveria*, *Blastocystis*, *Branhamella*, *Calymmatobacterium*, *Candida*, *Capnocytophaga*, *Catabacter*, *Chaetomium*, *Chryseobacterium*, *Chryseomonas*, *Chrysonilia*, *Cladophialophora*, *Cladosporium*, *Conidiobolus*, *Cryptococcus*, *Curvularia*, *Exophiala*, *Exserohilum*, *Flavobacterium*, *Fonsecaea*, *Fusarium*, *Fusobacterium*, *Hendersonula*, *Hypomyces*, *Koserella*, *Lelliottia*, *Leptosphaeria*, *Leptotrichia*, *Malassezia*, *Malbranchea*, *Mortierella*, *Mucor*, *Mycocentrospora*, *Mycoplasma*, *Nectria*, *Ochroconis*, *Oidiodendron*, *Phoma*, *Piedraia*, *Pithomyces*, *Pityrosporum*, *Prevotella*, *Pseudallescheria*, *Rhizomucor*, *Rhizopus*, *Rhodotorula*, *Scolecobasidium*, *Scopulariopsis*, *Scytalidium*, *Sporobolomyces*, *Stachybotrys*, *Stomatococcus*, *Treponema*, *Trichoderma*, *Trichophyton*, *Trichosporon*, *Tritirachium* or *Ureaplasma*. **Group 3** consists of all other microorganisms.
|
||||
#'
|
||||
#' All matches are sorted descending on their matching score and for all user input values, the top match will be returned. This will lead to the effect that e.g., `"E. coli"` will return the microbial ID of *Escherichia coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Escherichia coli"), 3)`}, a highly prevalent microorganism found in humans) and not *Entamoeba coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Entamoeba coli"), 3)`}, a less prevalent microorganism in humans), although the latter would alphabetically come first.
|
||||
#' @export
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' as.mo("E. coli")
|
||||
#' mo_uncertainties()
|
||||
|
||||
+82
-40
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,15 +20,15 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get properties of a microorganism
|
||||
#' Get Properties of a Microorganism
|
||||
#'
|
||||
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. Please see *Examples*.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()], please see *Examples*.
|
||||
#' @param property one of the column names of the [microorganisms] data set: `r paste0('"``', colnames(microorganisms), '\``"', collapse = ", ")`, or must be `"shortname"`
|
||||
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
|
||||
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
|
||||
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
@@ -44,12 +44,16 @@
|
||||
#'
|
||||
#' The Gram stain - [mo_gramstain()] - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318)), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] 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.
|
||||
#'
|
||||
#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics).
|
||||
#' Determination of yeasts - [mo_is_yeast()] - will be based on the taxonomic kingdom and class. *Budding yeasts* are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). *True yeasts* are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (except when the input is `NA` or the MO code is `UNKNOWN`).
|
||||
#'
|
||||
#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] functions can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics).
|
||||
#'
|
||||
#' All output will be [translate]d where possible.
|
||||
#' All output [will be translated][translate] where possible.
|
||||
#'
|
||||
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
|
||||
#' @inheritSection mo_matching_score Matching score for microorganisms
|
||||
#'
|
||||
#' SNOMED codes - [mo_snomed()] - are from the `r SNOMED_VERSION$current_source`. See the [microorganisms] data set for more info.
|
||||
#' @inheritSection mo_matching_score Matching Score for Microorganisms
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @inheritSection as.mo Source
|
||||
#' @rdname mo_property
|
||||
@@ -58,12 +62,12 @@
|
||||
#' - An [integer] in case of [mo_year()]
|
||||
#' - A [list] in case of [mo_taxonomy()] and [mo_info()]
|
||||
#' - A named [character] in case of [mo_url()]
|
||||
#' - A [double] in case of [mo_snomed()]
|
||||
#' - A [numeric] in case of [mo_snomed()]
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso [microorganisms]
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # taxonomic tree -----------------------------------------------------------
|
||||
#' mo_kingdom("E. coli") # "Bacteria"
|
||||
@@ -145,6 +149,8 @@
|
||||
#'
|
||||
#' # other --------------------------------------------------------------------
|
||||
#'
|
||||
#' mo_is_yeast(c("Candida", "E. coli")) # TRUE, FALSE
|
||||
#'
|
||||
#' # gram stains and intrinsic resistance can also be used as a filter in dplyr verbs
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
@@ -157,7 +163,8 @@
|
||||
#'
|
||||
#' # get a list with the complete taxonomy (from kingdom to subspecies)
|
||||
#' mo_taxonomy("E. coli")
|
||||
#' # get a list with the taxonomy, the authors, Gram-stain and URL to the online database
|
||||
#' # get a list with the taxonomy, the authors, Gram-stain,
|
||||
#' # SNOMED codes, and URL to the online database
|
||||
#' mo_info("E. coli")
|
||||
#' }
|
||||
mo_name <- function(x, language = get_locale(), ...) {
|
||||
@@ -168,7 +175,10 @@ mo_name <- function(x, language = get_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "fullname", language = language, ...), language = language, only_unknown = FALSE)
|
||||
translate_AMR(mo_validate(x = x, property = "fullname", language = language, ...),
|
||||
language = language,
|
||||
only_unknown = FALSE,
|
||||
affect_mo_name = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@@ -210,7 +220,7 @@ mo_shortname <- function(x, language = get_locale(), ...) {
|
||||
|
||||
shortnames[is.na(x.mo)] <- NA_character_
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
translate_AMR(shortnames, language = language, only_unknown = FALSE)
|
||||
translate_AMR(shortnames, language = language, only_unknown = FALSE, affect_mo_name = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@@ -331,7 +341,10 @@ mo_type <- function(x, language = get_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = FALSE)
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
out <- mo_kingdom(x.mo, language = NULL)
|
||||
out[which(mo_is_yeast(x.mo))] <- "Yeasts"
|
||||
translate_AMR(out, language = language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
@@ -410,6 +423,32 @@ mo_is_gram_positive <- function(x, language = get_locale(), ...) {
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_yeast <- function(x, language = get_locale(), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
x <- find_mo_col(fn = "mo_is_yeast")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
x.mo <- as.mo(x, language = language, ...)
|
||||
metadata <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
x.kingdom <- mo_kingdom(x.mo, language = NULL)
|
||||
x.phylum <- mo_phylum(x.mo, language = NULL)
|
||||
x.class <- mo_class(x.mo, language = NULL)
|
||||
x.order <- mo_order(x.mo, language = NULL)
|
||||
|
||||
load_mo_failures_uncertainties_renamed(metadata)
|
||||
|
||||
out <- rep(FALSE, length(x))
|
||||
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
|
||||
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_is_intrinsic_resistant <- function(x, ab, language = get_locale(), ...) {
|
||||
@@ -593,7 +632,8 @@ mo_info <- function(x, language = get_locale(), ...) {
|
||||
list(synonyms = mo_synonyms(y),
|
||||
gramstain = mo_gramstain(y, language = language),
|
||||
url = unname(mo_url(y, open = FALSE)),
|
||||
ref = mo_ref(y))))
|
||||
ref = mo_ref(y),
|
||||
snomed = unlist(mo_snomed(y)))))
|
||||
if (length(info) > 1) {
|
||||
names(info) <- mo_name(x)
|
||||
result <- info
|
||||
@@ -623,11 +663,21 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
|
||||
df <- data.frame(mo, stringsAsFactors = FALSE) %pm>%
|
||||
pm_left_join(pm_select(microorganisms, mo, source, species_id), by = "mo")
|
||||
df$url <- ifelse(df$source == "CoL",
|
||||
paste0(catalogue_of_life$url_CoL, "details/species/id/", df$species_id, "/"),
|
||||
ifelse(df$source == "DSMZ",
|
||||
paste0(catalogue_of_life$url_DSMZ, "/advanced_search?adv[taxon-name]=", gsub(" ", "+", mo_names), "/"),
|
||||
NA_character_))
|
||||
paste0(CATALOGUE_OF_LIFE$url_CoL, "details/species/id/", df$species_id, "/"),
|
||||
NA_character_)
|
||||
u <- df$url
|
||||
u[mo_kingdom(mo) == "Bacteria"] <- paste0(CATALOGUE_OF_LIFE$url_LPSN, "/species/", gsub(" ", "-", tolower(mo_names), fixed = TRUE))
|
||||
u[mo_kingdom(mo) == "Bacteria" & mo_rank(mo) == "genus"] <- gsub("/species/",
|
||||
"/genus/",
|
||||
u[mo_kingdom(mo) == "Bacteria" & mo_rank(mo) == "genus"],
|
||||
fixed = TRUE)
|
||||
u[mo_kingdom(mo) == "Bacteria" &
|
||||
mo_rank(mo) %in% c("subsp.", "infraspecies")] <- gsub("/species/",
|
||||
"/subspecies/",
|
||||
u[mo_kingdom(mo) == "Bacteria" &
|
||||
mo_rank(mo) %in% c("subsp.", "infraspecies")],
|
||||
fixed = TRUE)
|
||||
|
||||
names(u) <- mo_names
|
||||
|
||||
if (open == TRUE) {
|
||||
@@ -658,36 +708,28 @@ mo_property <- function(x, property = "fullname", language = get_locale(), ...)
|
||||
|
||||
mo_validate <- function(x, property, language, ...) {
|
||||
check_dataset_integrity()
|
||||
|
||||
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & length(list(...)) == 0, error = function(e) FALSE)) {
|
||||
# special case for mo_* functions where class is already <mo>
|
||||
return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE])
|
||||
}
|
||||
|
||||
dots <- list(...)
|
||||
Becker <- dots$Becker
|
||||
if (is.null(Becker)) {
|
||||
if (is.null(Becker) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
Becker <- FALSE
|
||||
}
|
||||
Lancefield <- dots$Lancefield
|
||||
if (is.null(Lancefield)) {
|
||||
if (is.null(Lancefield) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") | Lancefield %in% c(TRUE, "all")
|
||||
|
||||
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & !has_Becker_or_Lancefield, error = function(e) FALSE)) {
|
||||
# special case for mo_* functions where class is already <mo>
|
||||
return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE])
|
||||
}
|
||||
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
if (is.mo(x)
|
||||
& !Becker %in% c(TRUE, "all")
|
||||
& !Lancefield %in% c(TRUE, "all")) {
|
||||
# this will not reset mo_uncertainties and mo_failures
|
||||
# because it's already a valid MO
|
||||
x <- exec_as.mo(x, property = property, initial_search = FALSE, language = language, ...)
|
||||
} else if (!all(x %in% MO_lookup[, property, drop = TRUE])
|
||||
| Becker %in% c(TRUE, "all")
|
||||
| Lancefield %in% c(TRUE, "all")) {
|
||||
|
||||
if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) {
|
||||
x <- exec_as.mo(x, property = property, language = language, ...)
|
||||
}
|
||||
|
||||
|
||||
+11
-11
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,16 +20,16 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' User-defined reference data set for microorganisms
|
||||
#' User-Defined Reference Data Set for Microorganisms
|
||||
#'
|
||||
#' @description These functions can be used to predefine your own reference to be used in [as.mo()] and consequently all [`mo_*`][mo_property()] functions (such as [mo_genus()] and [mo_gramstain()]).
|
||||
#'
|
||||
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package, since you don't have to bother about it again after setting it up once.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param path location of your reference file, see Details. Can be `""`, `NULL` or `FALSE` to delete the reference file.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param path location of your reference file, see *Details*. Can be `""`, `NULL` or `FALSE` to delete the reference file.
|
||||
#' @param destination destination of the compressed data file, default to the user's home directory.
|
||||
#' @rdname mo_source
|
||||
#' @name mo_source
|
||||
@@ -44,7 +44,7 @@
|
||||
#'
|
||||
#' Reading an Excel file (`.xlsx`) with only one row has a size of 8-9 kB. The compressed file created with [set_mo_source()] will then have a size of 0.1 kB and can be read by [get_mo_source()] in only a couple of microseconds (millionths of a second).
|
||||
#'
|
||||
#' @section How to setup:
|
||||
#' @section How to Setup:
|
||||
#'
|
||||
#' Imagine this data on a sheet of an Excel file (mo codes were looked up in the [microorganisms] data set). The first column contains the organisation specific codes, the second column contains an MO code from this package:
|
||||
#'
|
||||
@@ -121,7 +121,7 @@
|
||||
#'
|
||||
#' If the original file (in the previous case an Excel file) is moved or deleted, the `mo_source.rds` file will be removed upon the next use of [as.mo()] or any [`mo_*`][mo_property()] function.
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
meet_criteria(path, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(destination, allow_class = "character", has_length = 1)
|
||||
@@ -200,8 +200,8 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
"', for which your permission is needed.")),
|
||||
"\n\n",
|
||||
word_wrap("Do you agree that this file will be created?"))
|
||||
if ("rsasdtudioapi" %in% rownames(utils::installed.packages())) {
|
||||
showQuestion <- import_fn("showQuestion", "rstudioapi")
|
||||
showQuestion <- import_fn("showQuestion", "rstudioapi", error_on_fail = FALSE)
|
||||
if (!is.null(showQuestion)) {
|
||||
q_continue <- showQuestion("Create new file in home directory", txt)
|
||||
} else {
|
||||
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
|
||||
@@ -283,9 +283,9 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
|
||||
} else {
|
||||
plural <- ""
|
||||
}
|
||||
stop_("Value", plural, " ", paste0("'", invalid[, 1, drop = TRUE], "'", collapse = ", "),
|
||||
stop_("Value", plural, " ", vector_and(invalid[, 1, drop = TRUE], quotes = TRUE),
|
||||
" found in ", tolower(refer_to_name),
|
||||
", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "),
|
||||
", but with invalid microorganism code", plural, " ", vector_and(invalid$mo, quotes = TRUE),
|
||||
call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,24 +20,25 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Principal Component Analysis (for AMR)
|
||||
#'
|
||||
#' Performs a principal component analysis (PCA) based on a data set with automatic determination for afterwards plotting the groups and labels, and automatic filtering on only suitable (i.e. non-empty and numeric) variables.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' @param x a [data.frame] containing numeric columns
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [data.frame] containing [numeric] columns
|
||||
#' @param ... columns of `x` to be selected for PCA, can be unquoted since it supports quasiquotation.
|
||||
#' @inheritParams stats::prcomp
|
||||
#' @details The [pca()] function takes a [data.frame] as input and performs the actual PCA with the \R function [prcomp()].
|
||||
#'
|
||||
#' The result of the [pca()] function is a [prcomp] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain numeric values. These are probably the groups and labels, and will be used by [ggplot_pca()].
|
||||
#' The result of the [pca()] function is a [prcomp] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain [numeric] values. These are probably the groups and labels, and will be used by [ggplot_pca()].
|
||||
#' @return An object of classes [pca] and [prcomp]
|
||||
#' @importFrom stats prcomp
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # `example_isolates` is a dataset available in the AMR package.
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' \donttest{
|
||||
@@ -46,7 +47,7 @@
|
||||
#' # calculate the resistance per group first
|
||||
#' resistance_data <- example_isolates %>%
|
||||
#' group_by(order = mo_order(mo), # group on anything, like order
|
||||
#' genus = mo_genus(mo)) %>% # and genus as we do here
|
||||
#' genus = mo_genus(mo)) %>% # and genus as we do here;
|
||||
#' summarise_if(is.rsi, resistance) # then get resistance of all drugs
|
||||
#'
|
||||
#' # now conduct PCA for certain antimicrobial agents
|
||||
@@ -98,14 +99,14 @@ pca <- function(x,
|
||||
|
||||
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
||||
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
||||
warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. Please see Examples in ?pca.")
|
||||
warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with [numeric] variables only. See Examples in ?pca.", call = FALSE)
|
||||
}
|
||||
|
||||
# set column names
|
||||
tryCatch(colnames(x) <- as.character(dots)[2:length(dots)],
|
||||
error = function(e) warning("column names could not be set"))
|
||||
|
||||
# keep only numeric columns
|
||||
# keep only [numeric] columns
|
||||
x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y))]
|
||||
# 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)
|
||||
@@ -116,11 +117,49 @@ pca <- function(x,
|
||||
|
||||
pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x)))]
|
||||
|
||||
message_("Columns selected for PCA: ", paste0(font_bold(colnames(pca_data)), collapse = "/"),
|
||||
message_("Columns selected for PCA: ", vector_and(font_bold(colnames(pca_data), collapse = NULL), quotes = TRUE),
|
||||
". Total observations available: ", nrow(pca_data), ".")
|
||||
|
||||
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol, rank. = rank.)
|
||||
attr(pca_model, "non_numeric_cols") <- x[, vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE]
|
||||
if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.4) {
|
||||
# stats::prcomp prior to 3.4.0 does not have the 'rank.' argument
|
||||
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol)
|
||||
} else {
|
||||
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol, rank. = rank.)
|
||||
}
|
||||
groups <- x[, vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE]
|
||||
rownames(groups) <- NULL
|
||||
attr(pca_model, "non_numeric_cols") <- groups
|
||||
class(pca_model) <- c("pca", class(pca_model))
|
||||
pca_model
|
||||
}
|
||||
|
||||
#' @method print pca
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.pca <- function(x, ...) {
|
||||
a <- attributes(x)$non_numeric_cols
|
||||
if (!is.null(a)) {
|
||||
print_pca_group(a)
|
||||
class(x) <- class(x)[class(x) != "pca"]
|
||||
}
|
||||
print(x, ...)
|
||||
}
|
||||
|
||||
#' @method summary pca
|
||||
#' @export
|
||||
#' @noRd
|
||||
summary.pca <- function(object, ...) {
|
||||
a <- attributes(object)$non_numeric_cols
|
||||
if (!is.null(a)) {
|
||||
print_pca_group(a)
|
||||
class(object) <- class(object)[class(object) != "pca"]
|
||||
}
|
||||
summary(object, ...)
|
||||
}
|
||||
|
||||
print_pca_group <- function(a) {
|
||||
grps <- sort(unique(a[, 1, drop = TRUE]))
|
||||
cat("Groups (n=", length(grps), ", named as '", colnames(a)[1], "'):\n", sep = "")
|
||||
print(grps)
|
||||
cat("\n")
|
||||
}
|
||||
|
||||
@@ -0,0 +1,731 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Plotting for Classes `rsi`, `mic` and `disk`
|
||||
#'
|
||||
#' Functions to plot classes `rsi`, `mic` and `disk`, with support for base R and `ggplot2`.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @param x,data MIC values created with [as.mic()] or disk diffusion values created with [as.disk()]
|
||||
#' @param mapping aesthetic mappings to use for [`ggplot()`][ggplot2::ggplot()]
|
||||
#' @param main,title title of the plot
|
||||
#' @param xlab,ylab axis title
|
||||
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()]
|
||||
#' @param guideline interpretation guideline to use, defaults to the latest included EUCAST guideline, see *Details*
|
||||
#' @param colours_RSI colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly.
|
||||
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant', defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param expand a [logical] to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.
|
||||
#' @details
|
||||
#' The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
|
||||
#'
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the `guideline` argument are: `r vector_and(AMR::rsi_translation$guideline, quotes = TRUE, reverse = TRUE)`.
|
||||
#'
|
||||
#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline.
|
||||
#' @name plot
|
||||
#' @rdname plot
|
||||
#' @return The `ggplot` functions return a [`ggplot`][ggplot2::ggplot()] model that is extendible with any `ggplot2` function.
|
||||
#' @param ... arguments passed on to [as.rsi()]
|
||||
#' @examples
|
||||
#' some_mic_values <- random_mic(size = 100)
|
||||
#' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
|
||||
#' some_rsi_values <- random_rsi(50, prob_RSI = c(0.30, 0.55, 0.05))
|
||||
#'
|
||||
#' plot(some_mic_values)
|
||||
#' plot(some_disk_values)
|
||||
#' plot(some_rsi_values)
|
||||
#'
|
||||
#' # when providing the microorganism and antibiotic, colours will show interpretations:
|
||||
#' plot(some_mic_values, mo = "S. aureus", ab = "ampicillin")
|
||||
#' plot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
|
||||
#'
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(some_mic_values)
|
||||
#' ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
|
||||
#' ggplot(some_rsi_values)
|
||||
#' }
|
||||
NULL
|
||||
|
||||
#' @method plot mic
|
||||
#' @importFrom graphics barplot axis mtext legend
|
||||
#' @export
|
||||
#' @rdname plot
|
||||
plot.mic <- function(x,
|
||||
main = paste("MIC values of", deparse(substitute(x))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_RSI) == 1) {
|
||||
colours_RSI <- rep(colours_RSI, 3)
|
||||
}
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
x <- plot_prepare_table(x, expand = expand)
|
||||
|
||||
cols_sub <- plot_colours_subtitle_guideline(x = x,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
...)
|
||||
barplot(x,
|
||||
col = cols_sub$cols,
|
||||
main = main,
|
||||
ylim = c(0, max(x) * ifelse(any(colours_RSI %in% cols_sub$cols), 1.1, 1)),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
axes = FALSE)
|
||||
axis(2, seq(0, max(x)))
|
||||
if (!is.null(cols_sub$sub)) {
|
||||
mtext(side = 3, line = 0.5, adj = 0.5, cex = 0.75, cols_sub$sub)
|
||||
}
|
||||
|
||||
if (any(colours_RSI %in% cols_sub$cols)) {
|
||||
legend_txt <- character(0)
|
||||
legend_col <- character(0)
|
||||
if (any(cols_sub$cols == colours_RSI[2] & cols_sub$count > 0)) {
|
||||
legend_txt <- "Susceptible"
|
||||
legend_col <- colours_RSI[2]
|
||||
}
|
||||
if (any(cols_sub$cols == colours_RSI[3] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
|
||||
legend_col <- c(legend_col, colours_RSI[3])
|
||||
}
|
||||
if (any(cols_sub$cols == colours_RSI[1] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, "Resistant")
|
||||
legend_col <- c(legend_col, colours_RSI[1])
|
||||
}
|
||||
legend("top",
|
||||
x.intersp = 0.5,
|
||||
legend = translate_AMR(legend_txt, language = language),
|
||||
fill = legend_col,
|
||||
horiz = TRUE,
|
||||
cex = 0.75,
|
||||
box.lwd = 0,
|
||||
box.col = "#FFFFFF55",
|
||||
bg = "#FFFFFF55")
|
||||
}
|
||||
}
|
||||
|
||||
#' @method barplot mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
barplot.mic <- function(height,
|
||||
main = paste("MIC values of", deparse(substitute(height))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
plot(x = height,
|
||||
main = main,
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
...)
|
||||
}
|
||||
|
||||
#' @method ggplot mic
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
ggplot.mic <- function(data,
|
||||
mapping = NULL,
|
||||
title = paste("MIC values of", deparse(substitute(data))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
if (!is.null(title)) {
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
x <- plot_prepare_table(data, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(x = x,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
...)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("mic", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
df$cols[df$cols == colours_RSI[1]] <- "Resistant"
|
||||
df$cols[df$cols == colours_RSI[2]] <- "Susceptible"
|
||||
df$cols[df$cols == colours_RSI[3]] <- plot_name_of_I(cols_sub$guideline)
|
||||
df$cols <- factor(translate_AMR(df$cols, language = language),
|
||||
levels = translate_AMR(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
|
||||
language = language),
|
||||
ordered = TRUE)
|
||||
if (!is.null(mapping)) {
|
||||
p <- ggplot2::ggplot(df, mapping = mapping)
|
||||
} else {
|
||||
p <- ggplot2::ggplot(df)
|
||||
}
|
||||
|
||||
if (any(colours_RSI %in% cols_sub$cols)) {
|
||||
vals <- c("Resistant" = colours_RSI[1],
|
||||
"Susceptible" = colours_RSI[2],
|
||||
"Incr. exposure" = colours_RSI[3],
|
||||
"Intermediate" = colours_RSI[3])
|
||||
names(vals) <- translate_AMR(names(vals), language = language)
|
||||
p <- p +
|
||||
ggplot2::geom_col(ggplot2::aes(x = mic, y = count, fill = cols)) +
|
||||
ggplot2::scale_fill_manual(values = vals,
|
||||
name = NULL)
|
||||
} else {
|
||||
p <- p +
|
||||
ggplot2::geom_col(ggplot2::aes(x = mic, y = count))
|
||||
}
|
||||
|
||||
p +
|
||||
ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub)
|
||||
}
|
||||
|
||||
#' @method plot disk
|
||||
#' @export
|
||||
#' @importFrom graphics barplot axis mtext legend
|
||||
#' @rdname plot
|
||||
plot.disk <- function(x,
|
||||
main = paste("Disk zones of", deparse(substitute(x))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_RSI) == 1) {
|
||||
colours_RSI <- rep(colours_RSI, 3)
|
||||
}
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
x <- plot_prepare_table(x, expand = expand)
|
||||
|
||||
cols_sub <- plot_colours_subtitle_guideline(x = x,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
...)
|
||||
|
||||
barplot(x,
|
||||
col = cols_sub$cols,
|
||||
main = main,
|
||||
ylim = c(0, max(x) * ifelse(any(colours_RSI %in% cols_sub$cols), 1.1, 1)),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
axes = FALSE)
|
||||
axis(2, seq(0, max(x)))
|
||||
if (!is.null(cols_sub$sub)) {
|
||||
mtext(side = 3, line = 0.5, adj = 0.5, cex = 0.75, cols_sub$sub)
|
||||
}
|
||||
|
||||
if (any(colours_RSI %in% cols_sub$cols)) {
|
||||
legend_txt <- character(0)
|
||||
legend_col <- character(0)
|
||||
if (any(cols_sub$cols == colours_RSI[1] & cols_sub$count > 0)) {
|
||||
legend_txt <- "Resistant"
|
||||
legend_col <- colours_RSI[1]
|
||||
}
|
||||
if (any(cols_sub$cols == colours_RSI[3] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
|
||||
legend_col <- c(legend_col, colours_RSI[3])
|
||||
}
|
||||
if (any(cols_sub$cols == colours_RSI[2] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, "Susceptible")
|
||||
legend_col <- c(legend_col, colours_RSI[2])
|
||||
}
|
||||
legend("top",
|
||||
x.intersp = 0.5,
|
||||
legend = translate_AMR(legend_txt, language = language),
|
||||
fill = legend_col,
|
||||
horiz = TRUE,
|
||||
cex = 0.75,
|
||||
box.lwd = 0,
|
||||
box.col = "#FFFFFF55",
|
||||
bg = "#FFFFFF55")
|
||||
}
|
||||
}
|
||||
|
||||
#' @method barplot disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
barplot.disk <- function(height,
|
||||
main = paste("Disk zones of", deparse(substitute(height))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
plot(x = height,
|
||||
main = main,
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
...)
|
||||
}
|
||||
|
||||
#' @method ggplot disk
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
ggplot.disk <- function(data,
|
||||
mapping = NULL,
|
||||
title = paste("Disk zones of", deparse(substitute(data))),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
if (!is.null(title)) {
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
x <- plot_prepare_table(data, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(x = x,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
guideline = guideline,
|
||||
colours_RSI = colours_RSI,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
...)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("disk", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
|
||||
df$cols[df$cols == colours_RSI[1]] <- "Resistant"
|
||||
df$cols[df$cols == colours_RSI[2]] <- "Susceptible"
|
||||
df$cols[df$cols == colours_RSI[3]] <- plot_name_of_I(cols_sub$guideline)
|
||||
df$cols <- factor(translate_AMR(df$cols, language = language),
|
||||
levels = translate_AMR(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
|
||||
language = language),
|
||||
ordered = TRUE)
|
||||
if (!is.null(mapping)) {
|
||||
p <- ggplot2::ggplot(df, mapping = mapping)
|
||||
} else {
|
||||
p <- ggplot2::ggplot(df)
|
||||
}
|
||||
|
||||
if (any(colours_RSI %in% cols_sub$cols)) {
|
||||
vals <- c("Resistant" = colours_RSI[1],
|
||||
"Susceptible" = colours_RSI[2],
|
||||
"Incr. exposure" = colours_RSI[3],
|
||||
"Intermediate" = colours_RSI[3])
|
||||
names(vals) <- translate_AMR(names(vals), language = language)
|
||||
p <- p +
|
||||
ggplot2::geom_col(ggplot2::aes(x = disk, y = count, fill = cols)) +
|
||||
ggplot2::scale_fill_manual(values = vals,
|
||||
name = NULL)
|
||||
} else {
|
||||
p <- p +
|
||||
ggplot2::geom_col(ggplot2::aes(x = disk, y = count))
|
||||
}
|
||||
|
||||
p +
|
||||
ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub)
|
||||
}
|
||||
|
||||
#' @method plot rsi
|
||||
#' @export
|
||||
#' @importFrom graphics plot text axis
|
||||
#' @rdname plot
|
||||
plot.rsi <- function(x,
|
||||
ylab = "Percentage",
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
main = paste("Resistance Overview of", deparse(substitute(x))),
|
||||
...) {
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
data <- as.data.frame(table(x), stringsAsFactors = FALSE)
|
||||
colnames(data) <- c("x", "n")
|
||||
data$s <- round((data$n / sum(data$n)) * 100, 1)
|
||||
|
||||
if (!"S" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
if (!"I" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
if (!"R" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
|
||||
ymax <- pm_if_else(max(data$s) > 95, 105, 100)
|
||||
|
||||
plot(x = data$x,
|
||||
y = data$s,
|
||||
lwd = 2,
|
||||
ylim = c(0, ymax),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
main = main,
|
||||
axes = FALSE)
|
||||
# x axis
|
||||
axis(side = 1, at = 1:pm_n_distinct(data$x), labels = levels(data$x), lwd = 0)
|
||||
# y axis, 0-100%
|
||||
axis(side = 2, at = seq(0, 100, 5))
|
||||
|
||||
text(x = data$x,
|
||||
y = data$s + 4,
|
||||
labels = paste0(data$s, "% (n = ", data$n, ")"))
|
||||
}
|
||||
|
||||
|
||||
#' @method barplot rsi
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @export
|
||||
#' @noRd
|
||||
barplot.rsi <- function(height,
|
||||
main = paste("Resistance Overview of", deparse(substitute(height))),
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
ylab = "Frequency",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
expand = TRUE,
|
||||
...) {
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_RSI) == 1) {
|
||||
colours_RSI <- rep(colours_RSI, 3)
|
||||
} else {
|
||||
colours_RSI <- c(colours_RSI[2], colours_RSI[3], colours_RSI[1])
|
||||
}
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
x <- table(height)
|
||||
x <- x[c(1, 2, 3)]
|
||||
barplot(x,
|
||||
col = colours_RSI,
|
||||
xlab = xlab,
|
||||
main = main,
|
||||
ylab = ylab,
|
||||
axes = FALSE)
|
||||
axis(2, seq(0, max(x)))
|
||||
}
|
||||
|
||||
#' @method ggplot rsi
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
ggplot.rsi <- function(data,
|
||||
mapping = NULL,
|
||||
title = paste("Resistance Overview of", deparse(substitute(data))),
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
ylab = "Frequency",
|
||||
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
|
||||
language = get_locale(),
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_AMR(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_AMR(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
if (!is.null(title)) {
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
if (length(colours_RSI) == 1) {
|
||||
colours_RSI <- rep(colours_RSI, 3)
|
||||
}
|
||||
|
||||
df <- as.data.frame(table(data), stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("rsi", "count")
|
||||
if (!is.null(mapping)) {
|
||||
p <- ggplot2::ggplot(df, mapping = mapping)
|
||||
} else {
|
||||
p <- ggplot2::ggplot(df)
|
||||
}
|
||||
|
||||
p +
|
||||
ggplot2::geom_col(ggplot2::aes(x = rsi, y = count, fill = rsi)) +
|
||||
ggplot2::scale_fill_manual(values = c("R" = colours_RSI[1],
|
||||
"S" = colours_RSI[2],
|
||||
"I" = colours_RSI[3])) +
|
||||
ggplot2::labs(title = title, x = xlab, y = ylab) +
|
||||
ggplot2::theme(legend.position = "none")
|
||||
}
|
||||
|
||||
plot_prepare_table <- function(x, expand) {
|
||||
x <- x[!is.na(x)]
|
||||
stop_if(length(x) == 0, "no observations to plot", call = FALSE)
|
||||
if (is.mic(x)) {
|
||||
if (expand == TRUE) {
|
||||
# expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print
|
||||
extra_range <- max(x) / 2
|
||||
while (min(extra_range) / 2 > min(x)) {
|
||||
extra_range <- c(min(extra_range) / 2, extra_range)
|
||||
}
|
||||
nms <- extra_range
|
||||
extra_range <- rep(0, length(extra_range))
|
||||
names(extra_range) <- nms
|
||||
x <- table(droplevels(x, as.mic = FALSE))
|
||||
extra_range <- extra_range[!names(extra_range) %in% names(x)]
|
||||
x <- as.table(c(x, extra_range))
|
||||
} else {
|
||||
x <- table(droplevels(x, as.mic = FALSE))
|
||||
}
|
||||
x <- x[order(as.double(as.mic(names(x))))]
|
||||
} else if (is.disk(x)) {
|
||||
if (expand == TRUE) {
|
||||
# expand range for disks from lowest to highest so all mm's in between also print
|
||||
extra_range <- rep(0, max(x) - min(x) - 1)
|
||||
names(extra_range) <- seq(min(x) + 1, max(x) - 1)
|
||||
x <- table(x)
|
||||
extra_range <- extra_range[!names(extra_range) %in% names(x)]
|
||||
x <- as.table(c(x, extra_range))
|
||||
} else {
|
||||
x <- table(x)
|
||||
}
|
||||
x <- x[order(as.double(names(x)))]
|
||||
}
|
||||
as.table(x)
|
||||
}
|
||||
|
||||
plot_name_of_I <- function(guideline) {
|
||||
if (guideline %unlike% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) {
|
||||
# interpretation since 2019
|
||||
"Incr. exposure"
|
||||
} else {
|
||||
# interpretation until 2019
|
||||
"Intermediate"
|
||||
}
|
||||
}
|
||||
|
||||
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, fn, language, ...) {
|
||||
guideline <- get_guideline(guideline, AMR::rsi_translation)
|
||||
if (!is.null(mo) && !is.null(ab)) {
|
||||
# interpret and give colour based on MIC values
|
||||
mo <- as.mo(mo)
|
||||
ab <- as.ab(ab)
|
||||
rsi <- suppressWarnings(suppressMessages(as.rsi(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...)))
|
||||
cols <- character(length = length(rsi))
|
||||
cols[is.na(rsi)] <- "#BEBEBE"
|
||||
cols[rsi == "R"] <- colours_RSI[1]
|
||||
cols[rsi == "S"] <- colours_RSI[2]
|
||||
cols[rsi == "I"] <- colours_RSI[3]
|
||||
moname <- mo_name(mo, language = language)
|
||||
abname <- ab_name(ab, language = language)
|
||||
if (all(cols == "#BEBEBE")) {
|
||||
message_("No ", guideline, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", moname)
|
||||
guideline_txt <- ""
|
||||
} else {
|
||||
guideline_txt <- paste0("(", guideline, ")")
|
||||
}
|
||||
sub <- bquote(.(abname)~"-"~italic(.(moname))~.(guideline_txt))
|
||||
} else {
|
||||
cols <- "#BEBEBE"
|
||||
sub <- NULL
|
||||
}
|
||||
list(cols = cols, count = as.double(x), sub = sub, guideline = guideline)
|
||||
}
|
||||
+14
-14
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,34 +20,34 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Calculate microbial resistance
|
||||
#' Calculate Microbial Resistance
|
||||
#'
|
||||
#' @description These functions can be used to calculate the (co-)resistance or susceptibility of microbial isolates (i.e. percentage of S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, please see *Examples*.
|
||||
#' @description These functions can be used to calculate the (co-)resistance or susceptibility of microbial isolates (i.e. percentage of S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
|
||||
#'
|
||||
#' [resistance()] should be used to calculate resistance, [susceptibility()] should be used to calculate susceptibility.\cr
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.
|
||||
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see Source.
|
||||
#' @param as_percent a logical to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
|
||||
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a logical to indicate that isolates must be tested for all antibiotics, see section *Combination therapy* below
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
|
||||
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
|
||||
#' @param as_percent a [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
|
||||
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antibiotics, see section *Combination Therapy* below
|
||||
#' @param data a [data.frame] containing columns with class [`rsi`] (see [as.rsi()])
|
||||
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @inheritParams ab_property
|
||||
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
|
||||
#' @param combine_IR a logical to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
|
||||
#' @param combine_IR a [logical] to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @details
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
#' **Remember that you should filter your table to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
|
||||
#'
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to `count_susceptible() / count_all()`. *Low counts can influence the outcome - the `proportion` functions may camouflage this, since they only return the proportion (albeit being dependent on the `minimum` argument).*
|
||||
#'
|
||||
#' The function [proportion_df()] takes any variable from `data` that has an [`rsi`] class (created with [as.rsi()]) and calculates the proportions R, I and S. It also supports grouped variables. The function [rsi_df()] works exactly like [proportion_df()], but adds the number of isolates.
|
||||
#' @section Combination therapy:
|
||||
#' @section Combination Therapy:
|
||||
#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antibiotics/variables that you test them for. See this example for two antibiotics, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
|
||||
#'
|
||||
#' ```
|
||||
@@ -88,7 +88,7 @@
|
||||
#' @aliases portion
|
||||
#' @name proportion
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' ?example_isolates
|
||||
|
||||
+25
-17
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,18 +20,18 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Random MIC values/disk zones/RSI generation
|
||||
#' Random MIC Values/Disk Zones/RSI Generation
|
||||
#'
|
||||
#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR analysis practice.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param size desired size of the returned vector
|
||||
#' @param mo any character that can be coerced to a valid microorganism code with [as.mo()]
|
||||
#' @param ab any character that can be coerced to a valid antimicrobial agent code with [as.ab()]
|
||||
#' @param mo any [character] that can be coerced to a valid microorganism code with [as.mo()]
|
||||
#' @param ab any [character] that can be coerced to a valid antimicrobial agent code with [as.ab()]
|
||||
#' @param prob_RSI a vector of length 3: the probabilities for R (1st value), S (2nd value) and I (3rd value)
|
||||
#' @param ... extension for future versions, not used at the moment
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details The base R function [sample()] is used for generating values.
|
||||
#'
|
||||
#' Generated values are based on the latest EUCAST guideline implemented in the [rsi_translation] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument.
|
||||
@@ -39,7 +39,7 @@
|
||||
#' @name random
|
||||
#' @rdname random
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' random_mic(100)
|
||||
#' random_disk(100)
|
||||
@@ -51,9 +51,9 @@
|
||||
#' random_mic(100, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
|
||||
#' random_mic(100, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4
|
||||
#'
|
||||
#' random_disk(100, "Klebsiella pneumoniae") # range 11-50
|
||||
#' random_disk(100, "Klebsiella pneumoniae", "ampicillin") # range 6-14
|
||||
#' random_disk(100, "Streptococcus pneumoniae", "ampicillin") # range 16-22
|
||||
#' random_disk(100, "Klebsiella pneumoniae") # range 8-50
|
||||
#' random_disk(100, "Klebsiella pneumoniae", "ampicillin") # range 11-17
|
||||
#' random_disk(100, "Streptococcus pneumoniae", "ampicillin") # range 12-27
|
||||
#' }
|
||||
random_mic <- function(size, mo = NULL, ab = NULL, ...) {
|
||||
random_exec("MIC", size = size, mo = mo, ab = ab)
|
||||
@@ -111,18 +111,26 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
||||
if (log(set_range_max, 2) %% 1 == 0) {
|
||||
# return powers of 2
|
||||
valid_range <- unique(as.double(valid_range))
|
||||
# add one higher MIC level to set_range_max
|
||||
set_range_max <- 2 ^ (log(set_range_max, 2) + 1)
|
||||
# add 1-3 higher MIC levels to set_range_max
|
||||
set_range_max <- 2 ^ (log(set_range_max, 2) + sample(c(1:3), 1))
|
||||
set_range <- as.mic(valid_range[log(valid_range, 2) %% 1 == 0 & valid_range <= set_range_max])
|
||||
} else {
|
||||
# no power of 2, return factors of 2 to left and right side
|
||||
valid_mics <- suppressWarnings(as.mic(set_range_max / (2 ^ c(-3:3))))
|
||||
set_range <- valid_mics[!is.na(valid_mics)]
|
||||
}
|
||||
return(as.mic(sample(set_range, size = size, replace = TRUE)))
|
||||
out <- as.mic(sample(set_range, size = size, replace = TRUE))
|
||||
# 50% chance that lowest will get <= and highest will get >=
|
||||
if (stats::runif(1) > 0.5) {
|
||||
out[out == min(out)] <- paste0("<=", out[out == min(out)])
|
||||
}
|
||||
if (stats::runif(1) > 0.5) {
|
||||
out[out == max(out)] <- paste0(">=", out[out == max(out)])
|
||||
}
|
||||
return(out)
|
||||
} else if (type == "DISK") {
|
||||
set_range <- seq(from = as.integer(min(df$breakpoint_R)),
|
||||
to = as.integer(max(df$breakpoint_S)),
|
||||
set_range <- seq(from = as.integer(min(df$breakpoint_R) / 1.25),
|
||||
to = as.integer(max(df$breakpoint_S) * 1.25),
|
||||
by = 1)
|
||||
out <- sample(set_range, size = size, replace = TRUE)
|
||||
out[out < 6] <- sample(c(6:10), length(out[out < 6]), replace = TRUE)
|
||||
|
||||
+31
-17
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,25 +20,25 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Predict antimicrobial resistance
|
||||
#'
|
||||
#' Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns `se_min` and `se_max`. See *Examples* for a real live example.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param col_ab column name of `x` containing antimicrobial interpretations (`"R"`, `"I"` and `"S"`)
|
||||
#' @param col_date column name of the date, will be used to calculate years if this column doesn't consist of years already, defaults to the first column of with a date class
|
||||
#' @param year_min lowest year to use in the prediction model, dafaults to the lowest year in `col_date`
|
||||
#' @param year_max highest year to use in the prediction model, defaults to 10 years after today
|
||||
#' @param year_every unit of sequence between lowest year found in the data and `year_max`
|
||||
#' @param minimum minimal amount of available isolates per year to include. Years containing less observations will be estimated by the model.
|
||||
#' @param model the statistical model of choice. This could be a generalised linear regression model with binomial distribution (i.e. using `glm(..., family = binomial)``, assuming that a period of zero resistance was followed by a period of increasing resistance leading slowly to more and more resistance. See Details for all valid options.
|
||||
#' @param I_as_S a logical to indicate whether values `"I"` should be treated as `"S"` (will otherwise be treated as `"R"`). The default, `TRUE`, follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section *Interpretation of S, I and R* below.
|
||||
#' @param preserve_measurements a logical to indicate whether predictions of years that are actually available in the data should be overwritten by the original data. The standard errors of those years will be `NA`.
|
||||
#' @param info a logical to indicate whether textual analysis should be printed with the name and [summary()] of the statistical model.
|
||||
#' @param model the statistical model of choice. This could be a generalised linear regression model with binomial distribution (i.e. using `glm(..., family = binomial)``, assuming that a period of zero resistance was followed by a period of increasing resistance leading slowly to more and more resistance. See *Details* for all valid options.
|
||||
#' @param I_as_S a [logical] to indicate whether values `"I"` should be treated as `"S"` (will otherwise be treated as `"R"`). The default, `TRUE`, follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section *Interpretation of S, I and R* below.
|
||||
#' @param preserve_measurements a [logical] to indicate whether predictions of years that are actually available in the data should be overwritten by the original data. The standard errors of those years will be `NA`.
|
||||
#' @param info a [logical] to indicate whether textual analysis should be printed with the name and [summary()] of the statistical model.
|
||||
#' @param main title of the plot
|
||||
#' @param ribbon a logical to indicate whether a ribbon should be shown (default) or error bars
|
||||
#' @param ribbon a [logical] to indicate whether a ribbon should be shown (default) or error bars
|
||||
#' @param ... arguments passed on to functions
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @inheritParams first_isolate
|
||||
@@ -56,14 +56,14 @@
|
||||
#' - `observed`, the original observed resistant percentages
|
||||
#' - `estimated`, the estimated resistant percentages, calculated by the model
|
||||
#'
|
||||
#' Furthermore, the model itself is available as an attribute: `attributes(x)$model`, please see *Examples*.
|
||||
#' Furthermore, the model itself is available as an attribute: `attributes(x)$model`, see *Examples*.
|
||||
#' @seealso The [proportion()] functions to calculate resistance
|
||||
#'
|
||||
#' Models: [lm()] [glm()]
|
||||
#' @rdname resistance_predict
|
||||
#' @export
|
||||
#' @importFrom stats predict glm lm
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' x <- resistance_predict(example_isolates,
|
||||
#' col_ab = "AMX",
|
||||
@@ -129,10 +129,10 @@ resistance_predict <- function(x,
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_ab, allow_class = "character", has_length = 1, is_in = colnames(x))
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(year_min, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(year_max, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(year_every, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(year_min, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(year_max, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(year_every, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(model, allow_class = c("character", "function"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(I_as_S, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(preserve_measurements, allow_class = "logical", has_length = 1)
|
||||
@@ -143,7 +143,7 @@ resistance_predict <- function(x,
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
dots.names <- names(dots)
|
||||
if ("tbl" %in% dots.names) {
|
||||
x <- dots[which(dots.names == "tbl")]
|
||||
}
|
||||
@@ -347,6 +347,20 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of",
|
||||
col = "grey40")
|
||||
}
|
||||
|
||||
|
||||
#' @method ggplot resistance_predict
|
||||
#' @rdname resistance_predict
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
ggplot.resistance_predict <- function(x,
|
||||
main = paste("Resistance Prediction of", x_name),
|
||||
ribbon = TRUE,
|
||||
...) {
|
||||
x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")")
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ribbon, allow_class = "logical", has_length = 1)
|
||||
ggplot_rsi_predict(x = x, main = main, ribbon = ribbon, ...)
|
||||
}
|
||||
|
||||
#' @rdname resistance_predict
|
||||
#' @export
|
||||
ggplot_rsi_predict <- function(x,
|
||||
@@ -360,14 +374,14 @@ ggplot_rsi_predict <- function(x,
|
||||
stop_ifnot_installed("ggplot2")
|
||||
stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
|
||||
|
||||
|
||||
if (attributes(x)$I_as_S == TRUE) {
|
||||
ylab <- "%R"
|
||||
} else {
|
||||
ylab <- "%IR"
|
||||
}
|
||||
|
||||
p <- ggplot2::ggplot(x, ggplot2::aes(x = year, y = value)) +
|
||||
p <- ggplot2::ggplot(as.data.frame(x, stringsAsFactors = FALSE),
|
||||
ggplot2::aes(x = year, y = value)) +
|
||||
ggplot2::geom_point(data = subset(x, !is.na(observations)),
|
||||
size = 2) +
|
||||
scale_y_percent(limits = c(0, 1)) +
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,27 +20,27 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Interpret MIC and disk values, or clean raw R/SI data
|
||||
#' Interpret MIC and Disk Values, or Clean Raw R/SI Data
|
||||
#'
|
||||
#' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class [`rsi`], which is an ordered factor with levels `S < I < R`. Values that cannot be interpreted will be returned as `NA` with a warning.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class [`rsi`], which is an ordered [factor] with levels `S < I < R`.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @rdname as.rsi
|
||||
#' @param x vector of values (for class [`mic`]: an MIC value in mg/L, for class [`disk`]: a disk diffusion radius in millimetres)
|
||||
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()], will be determined automatically if the `dplyr` package is installed
|
||||
#' @param x vector of values (for class [`mic`]: MIC values in mg/L, for class [`disk`]: a disk diffusion radius in millimetres)
|
||||
#' @param mo any (vector of) text that can be coerced to valid microorganism codes with [as.mo()], can be left empty to determine it automatically
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()]
|
||||
#' @param uti (Urinary Tract Infection) A vector with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.rsi()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be searched for a 'specimen' and rows containing 'urin' (such as 'urine', 'urina') in that column will be regarded isolates from a UTI. See *Examples*.
|
||||
#' @param uti (Urinary Tract Infection) A vector with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.rsi()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be searched for a column 'specimen', and rows within this column containing 'urin' (such as 'urine', 'urina') will be regarded isolates from a UTI. See *Examples*.
|
||||
#' @inheritParams first_isolate
|
||||
#' @param guideline defaults to the latest included EUCAST guideline, see Details for all options
|
||||
#' @param conserve_capped_values a logical to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
|
||||
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a logical to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.2)`.
|
||||
#' @param guideline defaults to the latest included EUCAST guideline, see *Details* for all options
|
||||
#' @param conserve_capped_values a [logical] to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
|
||||
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a [logical] to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.2)`.
|
||||
#' @param reference_data a [data.frame] to be used for interpretation, which defaults to the [rsi_translation] data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the [rsi_translation] data set (same column names and column types). Please note that the `guideline` argument will be ignored when `reference_data` is manually set.
|
||||
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, please see *Examples*
|
||||
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*
|
||||
#' @param ... for using on a [data.frame]: names of columns to apply [as.rsi()] on (supports tidy selection like `AMX:VAN`). Otherwise: arguments passed on to methods.
|
||||
#' @details
|
||||
#' ## How it works
|
||||
#' ## How it Works
|
||||
#'
|
||||
#' The [as.rsi()] function works in four ways:
|
||||
#'
|
||||
@@ -63,23 +63,25 @@
|
||||
#'
|
||||
#' 4. For **interpreting a complete data set**, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running `as.rsi(data)`.
|
||||
#'
|
||||
#' ## Supported guidelines
|
||||
#' ## Supported Guidelines
|
||||
#'
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the `guideline` argument are: `r paste0('"', sort(unique(AMR::rsi_translation$guideline)), '"', collapse = ", ")`.
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, currently supported guidelines to be used as input for the `guideline` argument are: `r vector_and(AMR::rsi_translation$guideline, quotes = TRUE, reverse = TRUE)`.
|
||||
#'
|
||||
#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
|
||||
#'
|
||||
#' ## After interpretation
|
||||
#' ## After Interpretation
|
||||
#'
|
||||
#' After using [as.rsi()], you can use the [eucast_rules()] defined by EUCAST to (1) apply inferred susceptibility and resistance based on results of other antimicrobials and (2) apply intrinsic resistance based on taxonomic properties of a microorganism.
|
||||
#'
|
||||
#' ## Machine readable interpretation guidelines
|
||||
#' ## Machine-Readable Interpretation Guidelines
|
||||
#'
|
||||
#' The repository of this package [contains a machine readable version](https://github.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt) of all guidelines. This is a CSV file consisting of `r format(nrow(AMR::rsi_translation), big.mark = ",")` rows and `r ncol(AMR::rsi_translation)` columns. This file is machine readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial agent and the microorganism. **This allows for easy implementation of these rules in laboratory information systems (LIS)**. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed.
|
||||
#' The repository of this package [contains a machine-readable version](https://github.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt) of all guidelines. This is a CSV file consisting of `r format(nrow(AMR::rsi_translation), big.mark = ",")` rows and `r ncol(AMR::rsi_translation)` columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial agent and the microorganism. **This allows for easy implementation of these rules in laboratory information systems (LIS)**. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed.
|
||||
#'
|
||||
#' ## Other
|
||||
#'
|
||||
#' The function [is.rsi()] detects if the input contains class `<rsi>`. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#'
|
||||
#' The function [is.rsi.eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument.
|
||||
#' The function [is.rsi.eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#' @section Interpretation of R and S/I:
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories R and S/I as shown below (<https://www.eucast.org/newsiandr/>).
|
||||
#'
|
||||
@@ -91,12 +93,12 @@
|
||||
#' A microorganism is categorised as *Susceptible, Increased exposure* when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
|
||||
#'
|
||||
#' This AMR package honours this new insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
|
||||
#' @return Ordered [factor] with new class [`rsi`]
|
||||
#' @return Ordered [factor] with new class `<rsi>`
|
||||
#' @aliases rsi
|
||||
#' @export
|
||||
#' @seealso [as.mic()], [as.disk()], [as.mo()]
|
||||
#' @inheritSection AMR Reference data publicly available
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' summary(example_isolates) # see all R/SI results at a glance
|
||||
#'
|
||||
@@ -189,7 +191,11 @@ as.rsi <- function(x, ...) {
|
||||
#' @rdname as.rsi
|
||||
#' @export
|
||||
is.rsi <- function(x) {
|
||||
inherits(x, "rsi")
|
||||
if (inherits(x, "data.frame")) {
|
||||
unname(vapply(FUN.VALUE = logical(1), x, is.rsi))
|
||||
} else {
|
||||
inherits(x, "rsi")
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname as.rsi
|
||||
@@ -197,24 +203,48 @@ is.rsi <- function(x) {
|
||||
is.rsi.eligible <- function(x, threshold = 0.05) {
|
||||
meet_criteria(threshold, allow_class = "numeric", has_length = 1)
|
||||
|
||||
if (inherits(x, "data.frame")) {
|
||||
# iterate this function over all columns
|
||||
return(unname(vapply(FUN.VALUE = logical(1), x, is.rsi.eligible)))
|
||||
}
|
||||
|
||||
stop_if(NCOL(x) > 1, "`x` must be a one-dimensional vector.")
|
||||
if (any(c("logical",
|
||||
"numeric",
|
||||
if (any(c("numeric",
|
||||
"integer",
|
||||
"mo",
|
||||
"ab",
|
||||
"Date",
|
||||
"POSIXct",
|
||||
"POSIXt",
|
||||
"rsi",
|
||||
"raw",
|
||||
"hms")
|
||||
"hms",
|
||||
"mic",
|
||||
"disk")
|
||||
%in% class(x))) {
|
||||
# no transformation needed
|
||||
FALSE
|
||||
return(FALSE)
|
||||
} else if (all(x %in% c("R", "S", "I", NA)) & !all(is.na(x))) {
|
||||
return(TRUE)
|
||||
} else if (!any(c("R", "S", "I") %in% x, na.rm = TRUE) & !all(is.na(x))) {
|
||||
return(FALSE)
|
||||
} else {
|
||||
x <- x[!is.na(x) & !is.null(x) & !identical(x, "")]
|
||||
x <- x[!is.na(x) & !is.null(x) & x != ""]
|
||||
if (length(x) == 0) {
|
||||
# no other values than NA or ""
|
||||
cur_col <- get_current_column()
|
||||
if (!is.null(cur_col)) {
|
||||
ab <- suppressWarnings(as.ab(cur_col, fast_mode = TRUE, info = FALSE))
|
||||
if (!is.na(ab)) {
|
||||
# this is a valid antibiotic code
|
||||
message_("Column '", font_bold(cur_col), "' is as.rsi()-eligible (despite only having empty values), since it seems to be ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " (", ab, ")")
|
||||
return(TRUE)
|
||||
}
|
||||
}
|
||||
# all values empty and no antibiotic col name - return FALSE
|
||||
return(FALSE)
|
||||
}
|
||||
# transform all values and see if it meets the set threshold
|
||||
checked <- suppressWarnings(as.rsi(x))
|
||||
outcome <- sum(is.na(checked)) / length(x)
|
||||
outcome <= threshold
|
||||
@@ -222,24 +252,36 @@ is.rsi.eligible <- function(x, threshold = 0.05) {
|
||||
}
|
||||
|
||||
#' @export
|
||||
# extra param: warn (never throw warning)
|
||||
as.rsi.default <- function(x, ...) {
|
||||
if (is.rsi(x)) {
|
||||
return(x)
|
||||
}
|
||||
|
||||
if (inherits(x, "integer") & all(x %in% c(1:3, NA))) {
|
||||
x[x == 1] <- "S"
|
||||
x[x == 2] <- "I"
|
||||
x[x == 3] <- "R"
|
||||
if (inherits(x, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) {
|
||||
x.bak <- x
|
||||
x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error
|
||||
|
||||
} else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R"))) {
|
||||
|
||||
if (!any(x %like% "(R|S|I)", na.rm = TRUE)) {
|
||||
# check if they are actually MICs or disks now that the antibiotic name is valid
|
||||
# support haven package for importing e.g., from SPSS - it adds the 'labels' attribute
|
||||
lbls <- attributes(x)$labels
|
||||
if (!is.null(lbls) && all(c("R", "S", "I") %in% names(lbls)) && all(c(1:3) %in% lbls)) {
|
||||
x[x.bak == 1] <- names(lbls[lbls == 1])
|
||||
x[x.bak == 2] <- names(lbls[lbls == 2])
|
||||
x[x.bak == 3] <- names(lbls[lbls == 3])
|
||||
} else {
|
||||
x[x.bak == 1] <- "S"
|
||||
x[x.bak == 2] <- "I"
|
||||
x[x.bak == 3] <- "R"
|
||||
}
|
||||
|
||||
} else if (!all(is.na(x)) && !identical(levels(x), c("R", "S", "I")) && !all(x %in% c("R", "S", "I", NA))) {
|
||||
|
||||
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
|
||||
# check if they are actually MICs or disks
|
||||
if (all_valid_mics(x)) {
|
||||
warning_("The input seems to be MIC values. Transform them with as.mic() before running as.rsi() to interpret them.")
|
||||
warning_("The input seems to be MIC values. Transform them with `as.mic()` before running `as.rsi()` to interpret them.")
|
||||
} else if (all_valid_disks(x)) {
|
||||
warning_("The input seems to be disk diffusion values. Transform them with as.disk() before running as.rsi() to interpret them.")
|
||||
warning_("The input seems to be disk diffusion values. Transform them with `as.disk()` before running `as.rsi()` to interpret them.")
|
||||
}
|
||||
}
|
||||
|
||||
@@ -271,8 +313,8 @@ as.rsi.default <- function(x, ...) {
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %pm>%
|
||||
unique() %pm>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing, '"', collapse = ", ")
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
warning_(na_after - na_before, " results truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid antimicrobial interpretations: ",
|
||||
@@ -308,7 +350,7 @@ as.rsi.mic <- function(x,
|
||||
|
||||
# for dplyr's across()
|
||||
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_column_dplyr)) {
|
||||
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", 0)), error = function(e) FALSE)) {
|
||||
# try to get current column, which will only be available when in across()
|
||||
ab <- tryCatch(cur_column_dplyr(),
|
||||
error = function(e) ab)
|
||||
@@ -397,7 +439,7 @@ as.rsi.disk <- function(x,
|
||||
|
||||
# for dplyr's across()
|
||||
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_column_dplyr)) {
|
||||
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", 0)), error = function(e) FALSE)) {
|
||||
# try to get current column, which will only be available when in across()
|
||||
ab <- tryCatch(cur_column_dplyr(),
|
||||
error = function(e) ab)
|
||||
@@ -474,7 +516,7 @@ as.rsi.data.frame <- function(x,
|
||||
uti = NULL,
|
||||
conserve_capped_values = FALSE,
|
||||
add_intrinsic_resistance = FALSE,
|
||||
reference_data = rsi_translation) {
|
||||
reference_data = AMR::rsi_translation) {
|
||||
meet_criteria(x, allow_class = "data.frame") # will also check for dimensions > 0
|
||||
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
@@ -504,7 +546,7 @@ as.rsi.data.frame <- function(x,
|
||||
}
|
||||
if (!is.null(col_uti)) {
|
||||
if (is.logical(col_uti)) {
|
||||
# already a logical vector as input
|
||||
# already a [logical] vector as input
|
||||
if (length(col_uti) == 1) {
|
||||
uti <- rep(col_uti, NROW(x))
|
||||
} else {
|
||||
@@ -513,7 +555,7 @@ as.rsi.data.frame <- function(x,
|
||||
} else {
|
||||
# column found, transform to logical
|
||||
stop_if(length(col_uti) != 1 | !col_uti %in% colnames(x),
|
||||
"argument `uti` must be a logical vector, of must be a single column name of `x`")
|
||||
"argument `uti` must be a [logical] vector, of must be a single column name of `x`")
|
||||
uti <- as.logical(x[, col_uti, drop = TRUE])
|
||||
}
|
||||
} else {
|
||||
@@ -528,7 +570,7 @@ as.rsi.data.frame <- function(x,
|
||||
plural <- c("", "s", "a ")
|
||||
}
|
||||
message_("Assuming value", plural[1], " ",
|
||||
paste(paste0('"', values, '"'), collapse = ", "),
|
||||
vector_and(values, quotes = TRUE),
|
||||
" in column '", font_bold(col_specimen),
|
||||
"' reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
".\n Use `as.rsi(uti = FALSE)` to prevent this.")
|
||||
@@ -652,17 +694,16 @@ get_guideline <- function(guideline, reference_data) {
|
||||
if (guideline_param %in% c("CLSI", "EUCAST")) {
|
||||
guideline_param <- rev(sort(subset(reference_data, guideline %like% guideline_param)$guideline))[1L]
|
||||
}
|
||||
if (!guideline_param %like% " ") {
|
||||
if (guideline_param %unlike% " ") {
|
||||
# like 'EUCAST2020', should be 'EUCAST 2020'
|
||||
guideline_param <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
stop_ifnot(guideline_param %in% reference_data$guideline,
|
||||
"invalid guideline: '", guideline,
|
||||
"'.\nValid guidelines are: ", paste0("'", unique(reference_data$guideline), "'", collapse = ", "), call = FALSE)
|
||||
"'.\nValid guidelines are: ", vector_and(reference_data$guideline, quotes = TRUE, reverse = TRUE), call = FALSE)
|
||||
|
||||
guideline_param
|
||||
|
||||
}
|
||||
|
||||
exec_as.rsi <- function(method,
|
||||
@@ -674,7 +715,6 @@ exec_as.rsi <- function(method,
|
||||
conserve_capped_values,
|
||||
add_intrinsic_resistance,
|
||||
reference_data) {
|
||||
|
||||
metadata_mo <- get_mo_failures_uncertainties_renamed()
|
||||
|
||||
x_bak <- data.frame(x_mo = paste0(x, mo), stringsAsFactors = FALSE)
|
||||
@@ -691,10 +731,10 @@ exec_as.rsi <- function(method,
|
||||
warned <- FALSE
|
||||
method_param <- toupper(method)
|
||||
|
||||
genera <- mo_genus(mo)
|
||||
mo_genus <- as.mo(genera)
|
||||
mo_family <- as.mo(mo_family(mo))
|
||||
mo_order <- as.mo(mo_order(mo))
|
||||
genera <- mo_genus(mo, language = NULL)
|
||||
mo_genus <- as.mo(genera, language = NULL)
|
||||
mo_family <- as.mo(mo_family(mo, language = NULL))
|
||||
mo_order <- as.mo(mo_order(mo, language = NULL))
|
||||
if (any(genera == "Staphylococcus", na.rm = TRUE)) {
|
||||
mo_becker <- as.mo(mo, Becker = TRUE)
|
||||
} else {
|
||||
@@ -747,7 +787,7 @@ exec_as.rsi <- function(method,
|
||||
any_is_intrinsic_resistant <- any_is_intrinsic_resistant | is_intrinsic_r
|
||||
|
||||
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
|
||||
if (!guideline_coerced %like% "EUCAST") {
|
||||
if (guideline_coerced %unlike% "EUCAST") {
|
||||
if (message_not_thrown_before("as.rsi2")) {
|
||||
warning_("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call = FALSE)
|
||||
remember_thrown_message("as.rsi2")
|
||||
@@ -778,23 +818,19 @@ exec_as.rsi <- function(method,
|
||||
pm_filter(uti == FALSE) %pm>% # 'uti' is a column in rsi_translation
|
||||
pm_arrange(pm_desc(nchar(mo)))
|
||||
}
|
||||
|
||||
get_record <- get_record[1L, , drop = FALSE]
|
||||
|
||||
if (NROW(get_record) > 0) {
|
||||
if (is.na(x[i])) {
|
||||
if (is.na(x[i]) | (is.na(get_record$breakpoint_S) & is.na(get_record$breakpoint_R))) {
|
||||
new_rsi[i] <- NA_character_
|
||||
} else if (method == "mic") {
|
||||
mic_input <- x[i]
|
||||
mic_S <- as.mic(get_record$breakpoint_S)
|
||||
mic_R <- as.mic(get_record$breakpoint_R)
|
||||
new_rsi[i] <- quick_case_when(isTRUE(conserve_capped_values) & mic_input %like% "^<[0-9]" ~ "S",
|
||||
isTRUE(conserve_capped_values) & mic_input %like% "^>[0-9]" ~ "R",
|
||||
new_rsi[i] <- quick_case_when(isTRUE(conserve_capped_values) & x[i] %like% "^<[0-9]" ~ "S",
|
||||
isTRUE(conserve_capped_values) & x[i] %like% "^>[0-9]" ~ "R",
|
||||
# start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R
|
||||
isTRUE(which(levels(mic_input) == mic_input) <= which(levels(mic_S) == mic_S)) ~ "S",
|
||||
guideline_coerced %like% "EUCAST" &
|
||||
isTRUE(which(levels(mic_input) == mic_input) > which(levels(mic_R) == mic_R)) ~ "R",
|
||||
guideline_coerced %like% "CLSI" &
|
||||
isTRUE(which(levels(mic_input) == mic_input) >= which(levels(mic_R) == mic_R)) ~ "R",
|
||||
x[i] <= get_record$breakpoint_S ~ "S",
|
||||
guideline_coerced %like% "EUCAST" & x[i] > get_record$breakpoint_R ~ "R",
|
||||
guideline_coerced %like% "CLSI" & x[i] >= get_record$breakpoint_R ~ "R",
|
||||
# return "I" when not match the bottom or top
|
||||
!is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I",
|
||||
# and NA otherwise
|
||||
@@ -843,10 +879,14 @@ exec_as.rsi <- function(method,
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.rsi <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- font_grey(" NA")
|
||||
out[x == "R"] <- font_rsi_R_bg(font_black(" R "))
|
||||
out[x == "S"] <- font_rsi_S_bg(font_black(" S "))
|
||||
out[x == "I"] <- font_rsi_I_bg(font_black(" I "))
|
||||
if (has_colour()) {
|
||||
# colours will anyway not work when has_colour() == FALSE,
|
||||
# but then the indentation should also not be applied
|
||||
out[is.na(x)] <- font_grey(" NA")
|
||||
out[x == "R"] <- font_rsi_R_bg(font_black(" R "))
|
||||
out[x == "S"] <- font_rsi_S_bg(font_black(" S "))
|
||||
out[x == "I"] <- font_rsi_I_bg(font_black(" I "))
|
||||
}
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
|
||||
@@ -894,28 +934,16 @@ get_skimmers.rsi <- function(column) {
|
||||
# get the variable name 'skim_variable'
|
||||
name_call <- function(.data) {
|
||||
calls <- sys.calls()
|
||||
frms <- sys.frames()
|
||||
calls_txt <- vapply(calls, function(x) paste(deparse(x), collapse = ""), FUN.VALUE = character(1))
|
||||
if (any(calls_txt %like% "skim_variable", na.rm = TRUE)) {
|
||||
ind <- which(calls_txt %like% "skim_variable")[1L]
|
||||
vars <- tryCatch(eval(parse(text = ".data$skim_variable"), envir = sys.frame(ind)),
|
||||
vars <- tryCatch(eval(parse(text = ".data$skim_variable$rsi"), envir = frms[[ind]]),
|
||||
error = function(e) NULL)
|
||||
tryCatch(ab_name(as.character(calls[[length(calls)]][[2]]), language = NULL),
|
||||
error = function(e) NA_character_)
|
||||
} else {
|
||||
vars <- NULL
|
||||
}
|
||||
i <- tryCatch(attributes(calls[[length(calls)]])$position,
|
||||
error = function(e) NULL)
|
||||
if (is.null(vars) | is.null(i)) {
|
||||
NA_character_
|
||||
} else {
|
||||
lengths <- vapply(FUN.VALUE = double(1), vars, length)
|
||||
when_starts_rsi <- which(names(vapply(FUN.VALUE = double(1), vars, length)) == "rsi")
|
||||
offset <- sum(lengths[c(1:when_starts_rsi - 1)])
|
||||
var <- vars$rsi[i - offset]
|
||||
if (!isFALSE(var == "data")) {
|
||||
NA_character_
|
||||
} else{
|
||||
ab_name(var)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -977,107 +1005,6 @@ summary.rsi <- function(object, ...) {
|
||||
value
|
||||
}
|
||||
|
||||
#' @method plot rsi
|
||||
#' @export
|
||||
#' @importFrom graphics plot text axis
|
||||
#' @rdname plot
|
||||
plot.rsi <- function(x,
|
||||
lwd = 2,
|
||||
ylim = NULL,
|
||||
ylab = "Percentage",
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
main = paste("Resistance Overview of", deparse(substitute(x))),
|
||||
axes = FALSE,
|
||||
...) {
|
||||
meet_criteria(lwd, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
meet_criteria(ylim, allow_class = c("numeric", "integer"), allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(axes, allow_class = "logical", has_length = 1)
|
||||
|
||||
data <- as.data.frame(table(x), stringsAsFactors = FALSE)
|
||||
colnames(data) <- c("x", "n")
|
||||
data$s <- round((data$n / sum(data$n)) * 100, 1)
|
||||
|
||||
if (!"S" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
if (!"I" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
if (!"R" %in% data$x) {
|
||||
data <- rbind(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
# don't use as.rsi() here, it will confuse plot()
|
||||
data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
|
||||
ymax <- pm_if_else(max(data$s) > 95, 105, 100)
|
||||
|
||||
plot(x = data$x,
|
||||
y = data$s,
|
||||
lwd = lwd,
|
||||
ylim = c(0, ymax),
|
||||
ylab = ylab,
|
||||
xlab = xlab,
|
||||
main = main,
|
||||
axes = axes,
|
||||
...)
|
||||
# x axis
|
||||
axis(side = 1, at = 1:pm_n_distinct(data$x), labels = levels(data$x), lwd = 0)
|
||||
# y axis, 0-100%
|
||||
axis(side = 2, at = seq(0, 100, 5))
|
||||
|
||||
text(x = data$x,
|
||||
y = data$s + 4,
|
||||
labels = paste0(data$s, "% (n = ", data$n, ")"))
|
||||
}
|
||||
|
||||
|
||||
#' @method barplot rsi
|
||||
#' @export
|
||||
#' @importFrom graphics barplot axis par
|
||||
#' @rdname plot
|
||||
barplot.rsi <- function(height,
|
||||
col = c("chartreuse4", "chartreuse3", "brown3"),
|
||||
xlab = ifelse(beside, "Antimicrobial Interpretation", ""),
|
||||
main = paste("Resistance Overview of", deparse(substitute(height))),
|
||||
ylab = "Frequency",
|
||||
beside = TRUE,
|
||||
axes = beside,
|
||||
...) {
|
||||
meet_criteria(col, allow_class = "character", has_length = 3)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(beside, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(axes, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (axes == TRUE) {
|
||||
par(mar = c(5, 4, 4, 2) + 0.1)
|
||||
} else {
|
||||
par(mar = c(2, 4, 4, 2) + 0.1)
|
||||
}
|
||||
|
||||
barplot(as.matrix(table(height)),
|
||||
col = col,
|
||||
xlab = xlab,
|
||||
main = main,
|
||||
ylab = ylab,
|
||||
beside = beside,
|
||||
axes = FALSE,
|
||||
...)
|
||||
# y axis, 0-100%
|
||||
axis(side = 2, at = seq(0, max(table(height)) + max(table(height)) * 1.1, by = 25))
|
||||
if (axes == TRUE && beside == TRUE) {
|
||||
axis(side = 1, labels = levels(height), at = c(1, 2, 3) + 0.5, lwd = 0)
|
||||
}
|
||||
}
|
||||
|
||||
#' @method [<- rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
@@ -1099,10 +1026,8 @@ barplot.rsi <- function(height,
|
||||
#' @method c rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.rsi <- function(x, ...) {
|
||||
y <- unlist(lapply(list(...), as.character))
|
||||
x <- as.character(x)
|
||||
as.rsi(c(x, y))
|
||||
c.rsi <- function(...) {
|
||||
as.rsi(unlist(lapply(list(...), as.character)))
|
||||
}
|
||||
|
||||
#' @method unique rsi
|
||||
|
||||
+9
-7
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,14 +20,14 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
dots2vars <- function(...) {
|
||||
# this function is to give more informative output about
|
||||
# variable names in count_* and proportion_* functions
|
||||
dots <- substitute(list(...))
|
||||
paste(as.character(dots)[2:length(dots)], collapse = ", ")
|
||||
vector_and(as.character(dots)[2:length(dots)], quotes = FALSE)
|
||||
}
|
||||
|
||||
rsi_calc <- function(...,
|
||||
@@ -37,7 +37,7 @@ rsi_calc <- function(...,
|
||||
only_all_tested = FALSE,
|
||||
only_count = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1, 2, 3), .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, .call_depth = 1)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(only_count, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
@@ -78,7 +78,7 @@ rsi_calc <- function(...,
|
||||
dots <- c(dots[dots %in% colnames(dots_df)],
|
||||
eval(parse(text = dots[!dots %in% colnames(dots_df)]), envir = dots_df, enclos = globalenv()))
|
||||
dots_not_exist <- dots[!dots %in% colnames(dots_df)]
|
||||
stop_if(length(dots_not_exist) > 0, "column(s) not found: ", paste0("'", dots_not_exist, "'", collapse = ", "), call = -2)
|
||||
stop_if(length(dots_not_exist) > 0, "column(s) not found: ", vector_and(dots_not_exist, quotes = TRUE), call = -2)
|
||||
x <- dots_df[, dots, drop = FALSE]
|
||||
}
|
||||
} else if (ndots == 1) {
|
||||
@@ -148,7 +148,9 @@ rsi_calc <- function(...,
|
||||
|
||||
if (print_warning == TRUE) {
|
||||
if (message_not_thrown_before("rsi_calc")) {
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand: your_data %>% mutate_if(is.rsi.eligible, as.rsi)",
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand:\n",
|
||||
" your_data %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||
" your_data %>% mutate(across(where(is.rsi.eligible), as.rsi))",
|
||||
call = FALSE)
|
||||
remember_thrown_message("rsi_calc")
|
||||
}
|
||||
@@ -189,7 +191,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = "rsi", .call_depth = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE, .call_depth = 1)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, .call_depth = 1)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(combine_SI_missing, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
|
||||
+2
-2
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' @rdname proportion
|
||||
|
||||
+6
-6
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,20 +20,20 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Skewness of the sample
|
||||
#' Skewness of the Sample
|
||||
#'
|
||||
#' @description Skewness is a measure of the asymmetry of the probability distribution of a real-valued random variable about its mean.
|
||||
#'
|
||||
#' When negative ('left-skewed'): the left tail is longer; the mass of the distribution is concentrated on the right of a histogram. When positive ('right-skewed'): the right tail is longer; the mass of the distribution is concentrated on the left of a histogram. A normal distribution has a skewness of 0.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a vector of values, a [matrix] or a [data.frame]
|
||||
#' @param na.rm a logical value indicating whether `NA` values should be stripped before the computation proceeds
|
||||
#' @param na.rm a [logical] value indicating whether `NA` values should be stripped before the computation proceeds
|
||||
#' @seealso [kurtosis()]
|
||||
#' @rdname skewness
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
skewness <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
Binary file not shown.
+32
-25
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,27 +20,27 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Translate strings from AMR package
|
||||
#' Translate Strings from AMR Package
|
||||
#'
|
||||
#' For language-dependent output of AMR functions, like [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @details Strings will be translated to foreign languages if they are defined in a local translation file. Additions to this file can be suggested at our repository. The file can be found here: <https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv>. This file will be read by all functions where a translated output can be desired, like all [`mo_*`][mo_property()] functions (such as [mo_name()], [mo_gramstain()], [mo_type()], etc.) and [`ab_*`][ab_property()] functions (such as [ab_name()], [ab_group()], etc.).
|
||||
#'
|
||||
#' Currently supported languages are: `r paste(sort(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% LANGUAGES_SUPPORTED), "Name"])), collapse = ", ")`. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.
|
||||
#' Currently supported languages are: `r vector_and(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% LANGUAGES_SUPPORTED), "Name"]), quotes = FALSE)`. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.
|
||||
#'
|
||||
#' Please suggest your own translations [by creating a new issue on our repository](https://github.com/msberends/AMR/issues/new?title=Translations).
|
||||
#'
|
||||
#' ## Changing the default language
|
||||
#' ## 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()]), 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`, e.g. by running `options(AMR_locale = "de")`
|
||||
#' 2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory
|
||||
#'
|
||||
#' So if the R option `AMR_locale` is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @rdname translate
|
||||
#' @name translate
|
||||
#' @export
|
||||
@@ -83,8 +83,8 @@ get_locale <- function() {
|
||||
if (lang %in% LANGUAGES_SUPPORTED) {
|
||||
return(lang)
|
||||
} else {
|
||||
stop_("unsupported language set as option 'AMR_locale': '", lang, "' - use one of: ",
|
||||
paste0("'", LANGUAGES_SUPPORTED, "'", collapse = ", "))
|
||||
stop_("unsupported language set as option 'AMR_locale': \"", lang, "\" - use either ",
|
||||
vector_or(LANGUAGES_SUPPORTED, quotes = TRUE))
|
||||
}
|
||||
} else {
|
||||
# we now support the LANGUAGE system variable - return it if set
|
||||
@@ -123,7 +123,7 @@ coerce_language_setting <- function(lang) {
|
||||
}
|
||||
|
||||
# translate strings based on inst/translations.tsv
|
||||
translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
|
||||
translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, affect_mo_name = FALSE) {
|
||||
|
||||
if (is.null(language)) {
|
||||
return(from)
|
||||
@@ -138,36 +138,43 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
|
||||
from_unique_translated <- from_unique
|
||||
|
||||
stop_ifnot(language %in% LANGUAGES_SUPPORTED,
|
||||
"unsupported language: '", language, "' - use one of: ",
|
||||
paste0("'", LANGUAGES_SUPPORTED, "'", collapse = ", "),
|
||||
"unsupported language: \"", language, "\" - use either ",
|
||||
vector_or(LANGUAGES_SUPPORTED, quotes = TRUE),
|
||||
call = FALSE)
|
||||
|
||||
df_trans <- subset(df_trans, lang == language)
|
||||
# only keep lines where translation is available for this language
|
||||
df_trans <- df_trans[which(!is.na(df_trans[, language, drop = TRUE])), , drop = FALSE]
|
||||
if (only_unknown == TRUE) {
|
||||
df_trans <- subset(df_trans, pattern %like% "unknown")
|
||||
}
|
||||
if (affect_mo_name == TRUE) {
|
||||
df_trans <- subset(df_trans, affect_mo_name == TRUE)
|
||||
}
|
||||
|
||||
# default case sensitive if value if 'ignore.case' is missing:
|
||||
df_trans$ignore.case[is.na(df_trans$ignore.case)] <- FALSE
|
||||
# default not using regular expressions (fixed = TRUE) if 'fixed' is missing:
|
||||
df_trans$fixed[is.na(df_trans$fixed)] <- TRUE
|
||||
# default: case sensitive if value if 'case_sensitive' is missing:
|
||||
df_trans$case_sensitive[is.na(df_trans$case_sensitive)] <- TRUE
|
||||
# default: not using regular expressions if 'regular_expr' is missing:
|
||||
df_trans$regular_expr[is.na(df_trans$regular_expr)] <- FALSE
|
||||
|
||||
# check if text to look for is in one of the patterns
|
||||
any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
|
||||
error = function(e) {
|
||||
warning_("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call = FALSE)
|
||||
return(FALSE)
|
||||
})
|
||||
any_form_in_patterns <- tryCatch(
|
||||
any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")),
|
||||
error = function(e) {
|
||||
warning_("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call = FALSE)
|
||||
return(FALSE)
|
||||
})
|
||||
|
||||
if (NROW(df_trans) == 0 | !any_form_in_patterns) {
|
||||
return(from)
|
||||
}
|
||||
|
||||
lapply(seq_len(nrow(df_trans)),
|
||||
function(i) from_unique_translated <<- gsub(pattern = df_trans$pattern[i],
|
||||
replacement = df_trans$replacement[i],
|
||||
replacement = df_trans[i, language, drop = TRUE],
|
||||
x = from_unique_translated,
|
||||
ignore.case = df_trans$ignore.case[i],
|
||||
fixed = df_trans$fixed[i]))
|
||||
ignore.case = !df_trans$case_sensitive[i] & df_trans$regular_expr[i],
|
||||
fixed = !df_trans$regular_expr[i],
|
||||
perl = df_trans$regular_expr[i]))
|
||||
|
||||
# force UTF-8 for diacritics
|
||||
from_unique_translated <- enc2utf8(from_unique_translated)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' WHOCC: WHO Collaborating Centre for Drug Statistics Methodology
|
||||
@@ -35,7 +35,7 @@
|
||||
#' The WHOCC is located in Oslo at the Norwegian Institute of Public Health and funded by the Norwegian government. The European Commission is the executive of the European Union and promotes its general interest.
|
||||
#'
|
||||
#' **NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package.** See <https://www.whocc.no/copyright_disclaimer/.>
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @name WHOCC
|
||||
#' @rdname WHOCC
|
||||
#' @examples
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,42 +20,25 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# set up package environment, used by numerous AMR functions
|
||||
pkg_env <- new.env(hash = FALSE)
|
||||
pkg_env$mo_failed <- character(0)
|
||||
|
||||
# determine info icon for messages
|
||||
utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)
|
||||
is_latex <- tryCatch(import_fn("is_latex_output", "knitr", error_on_fail = FALSE)(),
|
||||
error = function(e) FALSE)
|
||||
if (utf8_supported && !is_latex) {
|
||||
# \u2139 is a symbol officially named 'information source'
|
||||
pkg_env$info_icon <- "\u2139"
|
||||
} else {
|
||||
pkg_env$info_icon <- "i"
|
||||
}
|
||||
|
||||
.onLoad <- function(libname, pkgname) {
|
||||
|
||||
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"))
|
||||
|
||||
assign(x = "INTRINSIC_R",
|
||||
value = create_intr_resistance(),
|
||||
envir = asNamespace("AMR"))
|
||||
|
||||
assign(x = "LANGUAGES_SUPPORTED",
|
||||
value = sort(c("en", unique(translations_file$lang))),
|
||||
envir = asNamespace("AMR"))
|
||||
|
||||
assign(x = "MO_CONS",
|
||||
value = create_species_cons_cops("CoNS"),
|
||||
envir = asNamespace("AMR"))
|
||||
|
||||
assign(x = "MO_COPS",
|
||||
value = create_species_cons_cops("CoPS"),
|
||||
envir = asNamespace("AMR"))
|
||||
|
||||
# Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
|
||||
# without the need to depend on other packages. This was suggested by the
|
||||
# developers of the vctrs package:
|
||||
@@ -78,6 +61,10 @@ pkg_env <- new.env(hash = FALSE)
|
||||
s3_register("skimr::get_skimmers", "rsi")
|
||||
s3_register("skimr::get_skimmers", "mic")
|
||||
s3_register("skimr::get_skimmers", "disk")
|
||||
s3_register("ggplot2::ggplot", "rsi")
|
||||
s3_register("ggplot2::ggplot", "mic")
|
||||
s3_register("ggplot2::ggplot", "disk")
|
||||
s3_register("ggplot2::ggplot", "resistance_predict")
|
||||
|
||||
# if mo source exists, fire it up (see mo_source())
|
||||
try({
|
||||
@@ -86,104 +73,3 @@ pkg_env <- new.env(hash = FALSE)
|
||||
}
|
||||
}, silent = TRUE)
|
||||
}
|
||||
|
||||
.onAttach <- function(...) {
|
||||
# show notice in 10% of cases in interactive session
|
||||
if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(getOption("AMR_silentstart", FALSE)))) {
|
||||
return()
|
||||
}
|
||||
packageStartupMessage(word_wrap("Thank you for using the AMR package! ",
|
||||
"If you have a minute, please anonymously fill in this short questionnaire to improve the package and its functionalities: ",
|
||||
font_blue("https://msberends.github.io/AMR/survey.html\n"),
|
||||
"[prevent his notice with ",
|
||||
font_bold("suppressPackageStartupMessages(library(AMR))"),
|
||||
" or use ",
|
||||
font_bold("options(AMR_silentstart = TRUE)"), "]"))
|
||||
}
|
||||
|
||||
create_intr_resistance <- function() {
|
||||
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
|
||||
paste(AMR::microorganisms[match(AMR::intrinsic_resistant$microorganism, AMR::microorganisms$fullname), "mo", drop = TRUE],
|
||||
AMR::antibiotics[match(AMR::intrinsic_resistant$antibiotic, AMR::antibiotics$name), "ab", drop = TRUE])
|
||||
}
|
||||
|
||||
create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
# Determination of which staphylococcal species are CoNS/CoPS according to:
|
||||
# - Becker et al. 2014, PMID 25278577
|
||||
# - Becker et al. 2019, PMID 30872103
|
||||
# - Becker et al. 2020, PMID 32056452
|
||||
# this function returns class <mo>
|
||||
MO_staph <- AMR::microorganisms
|
||||
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
|
||||
if (type == "CoNS") {
|
||||
MO_staph[which(MO_staph$species %in% c("coagulase-negative", "argensis", "arlettae",
|
||||
"auricularis", "caeli", "capitis", "caprae",
|
||||
"carnosus", "chromogenes", "cohnii", "condimenti",
|
||||
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
||||
"equorum", "felis", "fleurettii", "gallinarum",
|
||||
"haemolyticus", "hominis", "jettensis", "kloosii",
|
||||
"lentus", "lugdunensis", "massiliensis", "microti",
|
||||
"muscae", "nepalensis", "pasteuri", "petrasii",
|
||||
"pettenkoferi", "piscifermentans", "pseudoxylosus",
|
||||
"rostri", "saccharolyticus", "saprophyticus",
|
||||
"sciuri", "simulans", "stepanovicii", "succinus",
|
||||
"vitulinus", "warneri", "xylosus")
|
||||
| (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
|
||||
"mo", drop = TRUE]
|
||||
} else if (type == "CoPS") {
|
||||
MO_staph[which(MO_staph$species %in% c("coagulase-positive",
|
||||
"simiae", "agnetis",
|
||||
"delphini", "lutrae",
|
||||
"hyicus", "intermedius",
|
||||
"pseudintermedius", "pseudointermedius",
|
||||
"schweitzeri", "argenteus")
|
||||
| (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
|
||||
"mo", drop = TRUE]
|
||||
}
|
||||
}
|
||||
|
||||
create_AB_lookup <- function() {
|
||||
AB_lookup <- AMR::antibiotics
|
||||
AB_lookup$generalised_name <- generalise_antibiotic_name(AB_lookup$name)
|
||||
AB_lookup$generalised_synonyms <- lapply(AB_lookup$synonyms, generalise_antibiotic_name)
|
||||
AB_lookup$generalised_abbreviations <- lapply(AB_lookup$abbreviations, generalise_antibiotic_name)
|
||||
AB_lookup$generalised_loinc <- lapply(AB_lookup$loinc, generalise_antibiotic_name)
|
||||
AB_lookup
|
||||
}
|
||||
|
||||
create_MO_lookup <- function() {
|
||||
MO_lookup <- AMR::microorganisms
|
||||
|
||||
MO_lookup$kingdom_index <- NA_real_
|
||||
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
|
||||
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
|
||||
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 3
|
||||
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
|
||||
# all the rest
|
||||
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
|
||||
|
||||
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
|
||||
MO_lookup$fullname_lower <- tolower(trimws(paste(MO_lookup$genus,
|
||||
MO_lookup$species,
|
||||
MO_lookup$subspecies)))
|
||||
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname)
|
||||
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname"])
|
||||
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
|
||||
|
||||
# add a column with only "e coli" like combinations
|
||||
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), ]
|
||||
}
|
||||
|
||||
create_MO.old_lookup <- function() {
|
||||
MO.old_lookup <- AMR::microorganisms.old
|
||||
MO.old_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", tolower(trimws(MO.old_lookup$fullname))))
|
||||
|
||||
# add a column with only "e coli"-like combinations
|
||||
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), ]
|
||||
}
|
||||
|
||||
@@ -10,15 +10,17 @@
|
||||
|
||||
<img src="https://msberends.github.io/AMR/works_great_on.png" align="center" height="150px" />
|
||||
|
||||
`AMR` is a free, open-source and independent R package 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 antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
||||
|
||||
After installing this package, R knows ~70,000 distinct microbial species and all ~550 antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
|
||||
The latest built **source package** (`AMR_latest.tar.gz`) can be found in folder [/data-raw/](https://github.com/msberends/AMR/tree/master/data-raw).
|
||||
|
||||
This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.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, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
|
||||
`AMR` is a free, open-source and independent R package 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 antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. It is currently being used in over 150 countries.
|
||||
|
||||
After installing this package, R knows ~70,000 distinct microbial species and all ~550 antibiotic, antimycotic, and antiviral drugs by name and code (including ATC, EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
|
||||
|
||||
This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.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, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice Foundation and University Medical Center Groningen. This R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
|
||||
|
||||
This is the development source of the `AMR` package for R. Not a developer? Then please visit our website [https://msberends.github.io/AMR/](https://msberends.github.io/AMR/) to read more about this package.
|
||||
|
||||
*NOTE: this source code is on GitHub (https://github.com/msberends/AMR), but also automatically mirrored to GitLab (https://gitlab.com/msberends/AMR).*
|
||||
*NOTE: this source code is on GitHub (https://github.com/msberends/AMR), but also automatically mirrored to our university's Gitea server (https://git.web.rug.nl/P281424/AMR) and to GitLab (https://gitlab.com/msberends/AMR).*
|
||||
|
||||
### How to get this package
|
||||
Please see [our website](https://msberends.github.io/AMR/#get-this-package).
|
||||
|
||||
+13
-10
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
title: "AMR (for R)"
|
||||
@@ -99,18 +99,19 @@ reference:
|
||||
for more information about how to work with functions in this package.
|
||||
contents:
|
||||
- "`AMR`"
|
||||
- "`example_isolates`"
|
||||
- "`microorganisms`"
|
||||
- "`microorganisms.codes`"
|
||||
- "`microorganisms.old`"
|
||||
- "`antibiotics`"
|
||||
- "`intrinsic_resistant`"
|
||||
- "`dosage`"
|
||||
- "`catalogue_of_life`"
|
||||
- "`catalogue_of_life_version`"
|
||||
- "`WHOCC`"
|
||||
- "`lifecycle`"
|
||||
- "`microorganisms`"
|
||||
- "`antibiotics`"
|
||||
- "`intrinsic_resistant`"
|
||||
- "`example_isolates`"
|
||||
- "`example_isolates_unclean`"
|
||||
- "`rsi_translation`"
|
||||
- "`microorganisms.codes`"
|
||||
- "`microorganisms.old`"
|
||||
- "`WHONET`"
|
||||
|
||||
- title: "Preparing data: microorganisms"
|
||||
@@ -142,7 +143,7 @@ reference:
|
||||
- "`as.mic`"
|
||||
- "`as.disk`"
|
||||
- "`eucast_rules`"
|
||||
- "`plot`"
|
||||
- "`custom_eucast_rules`"
|
||||
|
||||
- title: "Analysing data: antimicrobial resistance"
|
||||
desc: >
|
||||
@@ -154,9 +155,10 @@ reference:
|
||||
- "`count`"
|
||||
- "`is_new_episode`"
|
||||
- "`first_isolate`"
|
||||
- "`key_antibiotics`"
|
||||
- "`key_antimicrobials`"
|
||||
- "`mdro`"
|
||||
- "`count`"
|
||||
- "`plot`"
|
||||
- "`ggplot_rsi`"
|
||||
- "`bug_drug_combinations`"
|
||||
- "`antibiotic_class_selectors`"
|
||||
@@ -175,6 +177,7 @@ reference:
|
||||
- "`availability`"
|
||||
- "`get_locale`"
|
||||
- "`ggplot_pca`"
|
||||
- "`italicise_taxonomy`"
|
||||
- "`join`"
|
||||
- "`like`"
|
||||
- "`mo_matching_score`"
|
||||
|
||||
+2
-2
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
codecov:
|
||||
|
||||
+1
-1
@@ -1 +1 @@
|
||||
* Since version 0.3.0 (2018-08-14), CHECK returns a NOTE for having a data directory over 3 MB. This is needed to offer users reference data for the complete taxonomy of microorganisms - one of the most important features of this package.
|
||||
* This package has a tarball size of over 7 MB and an installation size of over 5 MB, which will return a NOTE on R CMD CHECK. The package size is needed to offer users reference data for the complete taxonomy of microorganisms - one of the most important features of this package. This was written and explained in a manuscript that was accepted for publication in the Journal of Statistical Software 4 weeks ago. We will add the paper as a vignette in the next version. Please allow this exception in package size for CRAN. We already compressed all data sets using `compression = "xz"` to make them as small as possible.
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,47 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
pkg_suggests <- AMR:::trimws(unlist(strsplit(packageDescription("AMR")$Suggests, ",(\n)?")))
|
||||
|
||||
to_install <- pkg_suggests[!pkg_suggests %in% rownames(utils::installed.packages())]
|
||||
to_update <- as.data.frame(old.packages(), stringsAsFactors = FALSE)
|
||||
|
||||
for (i in seq_len(length(to_install))) {
|
||||
cat("Installing package", to_install[i], "\n")
|
||||
tryCatch(install.packages(to_install[i], repos = "https://cran.rstudio.com/", dependencies = TRUE, quiet = TRUE),
|
||||
message = function(m) invisible(),
|
||||
warning = function(w) message(w$message),
|
||||
error = function(e) message(e$message))
|
||||
}
|
||||
|
||||
for (i in seq_len(length(to_update))) {
|
||||
cat("Updating package", to_install[i], "\n")
|
||||
tryCatch(update.packages(to_update[i], repos = "https://cran.rstudio.com/", ask = FALSE),
|
||||
message = function(m) invisible(),
|
||||
warning = function(w) message(w$message),
|
||||
error = function(e) message(e$message))
|
||||
}
|
||||
|
||||
# saveRDS(to_update, ".github/depends.Rds", version = 2)
|
||||
@@ -0,0 +1,360 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# Run this file to update the package using:
|
||||
# source("data-raw/_internals.R")
|
||||
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
devtools::load_all(quiet = TRUE)
|
||||
|
||||
old_globalenv <- ls(envir = globalenv())
|
||||
|
||||
# Helper functions --------------------------------------------------------
|
||||
|
||||
create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
# Determination of which staphylococcal species are CoNS/CoPS according to:
|
||||
# - Becker et al. 2014, PMID 25278577
|
||||
# - Becker et al. 2019, PMID 30872103
|
||||
# - Becker et al. 2020, PMID 32056452
|
||||
# this function returns class <mo>
|
||||
MO_staph <- AMR::microorganisms
|
||||
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
|
||||
if (type == "CoNS") {
|
||||
MO_staph[which(MO_staph$species %in% c("coagulase-negative", "argensis", "arlettae",
|
||||
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
||||
"carnosus", "casei", "chromogenes", "cohnii", "condimenti",
|
||||
"croceilyticus",
|
||||
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
||||
"equorum", "felis", "fleurettii", "gallinarum",
|
||||
"haemolyticus", "hominis", "jettensis", "kloosii",
|
||||
"lentus", "lugdunensis", "massiliensis", "microti",
|
||||
"muscae", "nepalensis", "pasteuri", "petrasii",
|
||||
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
|
||||
"pulvereri", "rostri", "saccharolyticus", "saprophyticus",
|
||||
"sciuri", "simulans", "stepanovicii", "succinus",
|
||||
"ureilyticus",
|
||||
"vitulinus", "vitulus", "warneri", "xylosus")
|
||||
| (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
|
||||
"mo", drop = TRUE]
|
||||
} else if (type == "CoPS") {
|
||||
MO_staph[which(MO_staph$species %in% c("coagulase-positive", "coagulans",
|
||||
"agnetis", "argenteus",
|
||||
"cornubiensis",
|
||||
"delphini", "lutrae",
|
||||
"hyicus", "intermedius",
|
||||
"pseudintermedius", "pseudointermedius",
|
||||
"schweitzeri", "simiae")
|
||||
| (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
|
||||
"mo", drop = TRUE]
|
||||
}
|
||||
}
|
||||
|
||||
create_AB_lookup <- function() {
|
||||
AB_lookup <- AMR::antibiotics
|
||||
AB_lookup$generalised_name <- generalise_antibiotic_name(AB_lookup$name)
|
||||
AB_lookup$generalised_synonyms <- lapply(AB_lookup$synonyms, generalise_antibiotic_name)
|
||||
AB_lookup$generalised_abbreviations <- lapply(AB_lookup$abbreviations, generalise_antibiotic_name)
|
||||
AB_lookup$generalised_loinc <- lapply(AB_lookup$loinc, generalise_antibiotic_name)
|
||||
AB_lookup$generalised_all <- unname(lapply(as.list(as.data.frame(t(AB_lookup[,
|
||||
c("ab", "atc", "cid", "name",
|
||||
colnames(AB_lookup)[colnames(AB_lookup) %like% "generalised"]),
|
||||
drop = FALSE]),
|
||||
stringsAsFactors = FALSE)),
|
||||
function(x) {
|
||||
x <- generalise_antibiotic_name(unname(unlist(x)))
|
||||
x[x != ""]
|
||||
}))
|
||||
AB_lookup
|
||||
}
|
||||
|
||||
create_MO_lookup <- function() {
|
||||
MO_lookup <- AMR::microorganisms
|
||||
|
||||
MO_lookup$kingdom_index <- NA_real_
|
||||
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
|
||||
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
|
||||
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 3
|
||||
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
|
||||
# all the rest
|
||||
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
|
||||
|
||||
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
|
||||
MO_lookup$fullname_lower <- tolower(trimws(paste(MO_lookup$genus,
|
||||
MO_lookup$species,
|
||||
MO_lookup$subspecies)))
|
||||
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname)
|
||||
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname"])
|
||||
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
|
||||
|
||||
# add a column with only "e coli" like combinations
|
||||
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), ]
|
||||
}
|
||||
|
||||
create_MO.old_lookup <- function() {
|
||||
MO.old_lookup <- AMR::microorganisms.old
|
||||
MO.old_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", tolower(trimws(MO.old_lookup$fullname))))
|
||||
|
||||
# add a column with only "e coli"-like combinations
|
||||
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), ]
|
||||
}
|
||||
|
||||
create_intr_resistance <- function() {
|
||||
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
|
||||
paste(AMR::microorganisms[match(AMR::intrinsic_resistant$microorganism, AMR::microorganisms$fullname), "mo", drop = TRUE],
|
||||
AMR::antibiotics[match(AMR::intrinsic_resistant$antibiotic, AMR::antibiotics$name), "ab", drop = TRUE])
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Save internal data to R/sysdata.rda -------------------------------------
|
||||
|
||||
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
|
||||
eucast_rules_file <- utils::read.delim(file = "data-raw/eucast_rules.tsv",
|
||||
skip = 10,
|
||||
sep = "\t",
|
||||
stringsAsFactors = FALSE,
|
||||
header = TRUE,
|
||||
strip.white = TRUE,
|
||||
na = c(NA, "", NULL)) %>%
|
||||
# take the order of the reference.rule_group column in the original data file
|
||||
mutate(reference.rule_group = factor(reference.rule_group,
|
||||
levels = unique(reference.rule_group),
|
||||
ordered = TRUE),
|
||||
sorting_rule = ifelse(grepl("^Table", reference.rule, ignore.case = TRUE), 1, 2)) %>%
|
||||
arrange(reference.rule_group,
|
||||
reference.version,
|
||||
sorting_rule,
|
||||
reference.rule) %>%
|
||||
mutate(reference.rule_group = as.character(reference.rule_group)) %>%
|
||||
select(-sorting_rule)
|
||||
|
||||
# Translations
|
||||
translations_file <- utils::read.delim(file = "data-raw/translations.tsv",
|
||||
sep = "\t",
|
||||
stringsAsFactors = FALSE,
|
||||
header = TRUE,
|
||||
blank.lines.skip = TRUE,
|
||||
fill = TRUE,
|
||||
strip.white = TRUE,
|
||||
encoding = "UTF-8",
|
||||
fileEncoding = "UTF-8",
|
||||
na.strings = c(NA, "", NULL),
|
||||
allowEscapes = TRUE, # else "\\1" will be imported as "\\\\1"
|
||||
quote = "")
|
||||
|
||||
# Old microorganism codes
|
||||
microorganisms.translation <- readRDS("data-raw/microorganisms.translation.rds")
|
||||
|
||||
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
|
||||
INTRINSIC_R <- create_intr_resistance()
|
||||
|
||||
# for checking input in `language` argument in e.g. mo_*() and ab_*() functions
|
||||
LANGUAGES_SUPPORTED <- sort(c("en", colnames(translations_file)[nchar(colnames(translations_file)) == 2]))
|
||||
|
||||
# vectors of CoNS and CoPS, improves speed in as.mo()
|
||||
MO_CONS <- create_species_cons_cops("CoNS")
|
||||
MO_COPS <- create_species_cons_cops("CoPS")
|
||||
|
||||
# reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed
|
||||
AB_lookup <- create_AB_lookup()
|
||||
MO_lookup <- create_MO_lookup()
|
||||
MO.old_lookup <- create_MO.old_lookup()
|
||||
|
||||
# antibiotic groups
|
||||
# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv)
|
||||
globalenv_before_ab <- c(ls(envir = globalenv()), "globalenv_before_ab")
|
||||
AMINOGLYCOSIDES <- antibiotics %>% filter(group %like% "aminoglycoside") %>% pull(ab)
|
||||
AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
|
||||
CARBAPENEMS <- antibiotics %>% filter(group %like% "carbapenem") %>% pull(ab)
|
||||
CEPHALOSPORINS <- antibiotics %>% filter(group %like% "cephalosporin") %>% pull(ab)
|
||||
CEPHALOSPORINS_1ST <- antibiotics %>% filter(group %like% "cephalosporin.*1") %>% pull(ab)
|
||||
CEPHALOSPORINS_2ND <- antibiotics %>% filter(group %like% "cephalosporin.*2") %>% pull(ab)
|
||||
CEPHALOSPORINS_3RD <- antibiotics %>% filter(group %like% "cephalosporin.*3") %>% pull(ab)
|
||||
CEPHALOSPORINS_EXCEPT_CAZ <- CEPHALOSPORINS[CEPHALOSPORINS != "CAZ"]
|
||||
FLUOROQUINOLONES <- antibiotics %>% filter(atc_group2 %like% "fluoroquinolone") %>% pull(ab)
|
||||
LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela
|
||||
GLYCOPEPTIDES <- antibiotics %>% filter(group %like% "glycopeptide") %>% pull(ab)
|
||||
GLYCOPEPTIDES_EXCEPT_LIPO <- GLYCOPEPTIDES[!GLYCOPEPTIDES %in% LIPOGLYCOPEPTIDES]
|
||||
LINCOSAMIDES <- antibiotics %>% filter(atc_group2 %like% "lincosamide") %>% pull(ab) %>% c("PRL")
|
||||
MACROLIDES <- antibiotics %>% filter(atc_group2 %like% "macrolide") %>% pull(ab)
|
||||
OXAZOLIDINONES <- antibiotics %>% filter(group %like% "oxazolidinone") %>% pull(ab)
|
||||
PENICILLINS <- antibiotics %>% filter(group %like% "penicillin") %>% pull(ab)
|
||||
POLYMYXINS <- antibiotics %>% filter(group %like% "polymyxin") %>% pull(ab)
|
||||
STREPTOGRAMINS <- antibiotics %>% filter(atc_group2 %like% "streptogramin") %>% pull(ab)
|
||||
TETRACYCLINES <- antibiotics %>% filter(atc_group2 %like% "tetracycline") %>% pull(ab)
|
||||
TETRACYCLINES_EXCEPT_TGC <- TETRACYCLINES[TETRACYCLINES != "TGC"]
|
||||
UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ"))
|
||||
BETALACTAMS <- c(PENICILLINS, CEPHALOSPORINS, CARBAPENEMS)
|
||||
|
||||
DEFINED_AB_GROUPS <- ls(envir = globalenv())
|
||||
DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab]
|
||||
|
||||
# Export to package as internal data ----
|
||||
usethis::use_data(eucast_rules_file,
|
||||
translations_file,
|
||||
microorganisms.translation,
|
||||
INTRINSIC_R,
|
||||
LANGUAGES_SUPPORTED,
|
||||
MO_CONS,
|
||||
MO_COPS,
|
||||
AB_lookup,
|
||||
MO_lookup,
|
||||
MO.old_lookup,
|
||||
AMINOGLYCOSIDES,
|
||||
AMINOPENICILLINS,
|
||||
CARBAPENEMS,
|
||||
CEPHALOSPORINS,
|
||||
CEPHALOSPORINS_1ST,
|
||||
CEPHALOSPORINS_2ND,
|
||||
CEPHALOSPORINS_3RD,
|
||||
CEPHALOSPORINS_EXCEPT_CAZ,
|
||||
FLUOROQUINOLONES,
|
||||
LIPOGLYCOPEPTIDES,
|
||||
GLYCOPEPTIDES,
|
||||
GLYCOPEPTIDES_EXCEPT_LIPO,
|
||||
LINCOSAMIDES,
|
||||
MACROLIDES,
|
||||
OXAZOLIDINONES,
|
||||
PENICILLINS,
|
||||
POLYMYXINS,
|
||||
STREPTOGRAMINS,
|
||||
TETRACYCLINES,
|
||||
TETRACYCLINES_EXCEPT_TGC,
|
||||
UREIDOPENICILLINS,
|
||||
BETALACTAMS,
|
||||
DEFINED_AB_GROUPS,
|
||||
internal = TRUE,
|
||||
overwrite = TRUE,
|
||||
version = 2,
|
||||
compress = "xz")
|
||||
|
||||
# Export data sets to the repository in different formats -----------------
|
||||
|
||||
write_md5 <- function(object) {
|
||||
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
|
||||
writeLines(digest::digest(object, "md5"), conn)
|
||||
close(conn)
|
||||
}
|
||||
changed_md5 <- function(object) {
|
||||
tryCatch({
|
||||
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
|
||||
compared <- digest::digest(object, "md5") != readLines(con = conn)
|
||||
close(conn)
|
||||
compared
|
||||
}, error = function(e) TRUE)
|
||||
}
|
||||
|
||||
# give official names to ABs and MOs
|
||||
rsi <- dplyr::mutate(rsi_translation, ab = ab_name(ab), mo = mo_name(mo))
|
||||
if (changed_md5(rsi)) {
|
||||
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)
|
||||
try(haven::write_sas(rsi, "data-raw/rsi_translation.sas"), silent = TRUE)
|
||||
try(haven::write_sav(rsi, "data-raw/rsi_translation.sav"), silent = TRUE)
|
||||
try(haven::write_dta(rsi, "data-raw/rsi_translation.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(rsi, "data-raw/rsi_translation.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
mo <- dplyr::mutate_if(microorganisms, ~!is.numeric(.), as.character)
|
||||
if (changed_md5(mo)) {
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('/data-raw/')}"))
|
||||
write_md5(mo)
|
||||
try(saveRDS(mo, "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)
|
||||
try(haven::write_sas(dplyr::select(mo, -snomed), "data-raw/microorganisms.sas"), silent = TRUE)
|
||||
try(haven::write_sav(dplyr::select(mo, -snomed), "data-raw/microorganisms.sav"), silent = TRUE)
|
||||
try(haven::write_dta(dplyr::select(mo, -snomed), "data-raw/microorganisms.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
if (changed_md5(microorganisms.old)) {
|
||||
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)
|
||||
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
|
||||
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
|
||||
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
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/')}"))
|
||||
write_md5(ab)
|
||||
try(saveRDS(ab, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(ab, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_sas(ab, "data-raw/antibiotics.sas"), silent = TRUE)
|
||||
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
|
||||
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(ab, "data-raw/antibiotics.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
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/')}"))
|
||||
write_md5(av)
|
||||
try(saveRDS(av, "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)
|
||||
try(haven::write_sas(av, "data-raw/antivirals.sas"), silent = TRUE)
|
||||
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
|
||||
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(av, "data-raw/antivirals.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
if (changed_md5(intrinsic_resistant)) {
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('intrinsic_resistant')} to {usethis::ui_value('/data-raw/')}"))
|
||||
write_md5(intrinsic_resistant)
|
||||
try(saveRDS(intrinsic_resistant, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(intrinsic_resistant, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_sas(intrinsic_resistant, "data-raw/intrinsic_resistant.sas"), silent = TRUE)
|
||||
try(haven::write_sav(intrinsic_resistant, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
|
||||
try(haven::write_dta(intrinsic_resistant, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(intrinsic_resistant, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
if (changed_md5(dosage)) {
|
||||
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)
|
||||
try(haven::write_sas(dosage, "data-raw/dosage.sas"), silent = TRUE)
|
||||
try(haven::write_sav(dosage, "data-raw/dosage.sav"), silent = TRUE)
|
||||
try(haven::write_dta(dosage, "data-raw/dosage.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(dosage, "data-raw/dosage.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
# remove leftovers from global env
|
||||
current_globalenv <- ls(envir = globalenv())
|
||||
rm(list = current_globalenv[!current_globalenv %in% old_globalenv])
|
||||
rm(current_globalenv)
|
||||
+1
-1
@@ -1 +1 @@
|
||||
a30faa0e4475d440d1bb8e44e6857062
|
||||
f6b4a2325c4bf3a8d4da337c8cfa07be
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+20
-19
@@ -1,6 +1,6 @@
|
||||
"ab" "atc" "cid" "name" "group" "atc_group1" "atc_group2" "abbreviations" "synonyms" "oral_ddd" "oral_units" "iv_ddd" "iv_units" "loinc"
|
||||
"AMA" "J04AA01" 4649 "4-aminosalicylic acid" "Antimycobacterials" "Drugs for treatment of tuberculosis" "Aminosalicylic acid and derivatives" "" "c(\"aminopar\", \"aminosalicylic\", \"aminosalicylic acid\", \"aminosalyl\", \"aminox\", \"apacil\", \"deapasil\", \"entepas\", \"ferrosan\", \"gabbropas\", \"helipidyl\", \"hellipidyl\", \"neopasalate\", \"osacyl\", \"pamacyl\", \"pamisyl\", \"paramycin\", \"parasal\", \"parasalicil\", \"parasalindon\", \"pasalon\", \"pasara\", \"pascorbic\", \"pasdium\", \"paser granules\", \"paskalium\", \"pasmed\", \"pasnodia\", \"pasolac\", \"propasa\", \"rezipas\", \"teebacin\", \"wln: zr cq dvq\")" 12 "g" "character(0)"
|
||||
"FCT" "D01AE21" 3366 "5-fluorocytosine" "Antifungals/antimycotics" "Antifungals for topical use" "Other antifungals for topical use" "c(\"5flc\", \"fluo\")" "c(\"alcobon\", \"ancobon\", \"ancotil\", \"ancotyl\", \"flucitosina\", \"flucystine\", \"flucytosin\", \"flucytosine\", \"flucytosinum\", \"flucytosone\", \"fluocytosine\", \"fluorcytosine\")" "c(\"10974-4\", \"23805-5\", \"25142-1\", \"25143-9\", \"3639-2\", \"46218-4\")"
|
||||
"FCT" "D01AE21" 3366 "5-fluorocytosine" "Antifungals/antimycotics" "Antifungals for topical use" "Other antifungals for topical use" "c(\"5flc\", \"fcu\", \"fluo\", \"fluy\")" "c(\"alcobon\", \"ancobon\", \"ancotil\", \"ancotyl\", \"flucitosina\", \"flucystine\", \"flucytosin\", \"flucytosine\", \"flucytosinum\", \"flucytosone\", \"fluocytosine\", \"fluorcytosine\")" "c(\"10974-4\", \"23805-5\", \"25142-1\", \"25143-9\", \"3639-2\", \"46218-4\")"
|
||||
"ACM" 6450012 "Acetylmidecamycin" "Macrolides/lincosamides" "" "" ""
|
||||
"ASP" 49787020 "Acetylspiramycin" "Macrolides/lincosamides" "" "c(\"acetylspiramycin\", \"foromacidin b\", \"spiramycin ii\")" "character(0)"
|
||||
"ALS" "J04BA03" 8954 "Aldesulfone sodium" "Other antibacterials" "Drugs for treatment of lepra" "Drugs for treatment of lepra" "" "c(\"adesulfone sodium\", \"aldapsone\", \"aldesulfona sodica\", \"aldesulfone\", \"aldesulfone sodique\", \"aldesulfone sodium\", \"diamidin\", \"diasone\", \"diasone sodium\", \"diazon\", \"novotrone\", \"sodium aldesulphone\", \"sodium sulfoxone\", \"sulfoxone sodium\")" 0.33 "g" "character(0)"
|
||||
@@ -10,7 +10,7 @@
|
||||
\"piramox\", \"robamox\", \"sawamox pm\", \"tolodina\", \"unicillin\", \"utimox\", \"vetramox\")" 1.5 "g" 3 "g" "c(\"16365-9\", \"25274-2\", \"3344-9\", \"80133-2\")"
|
||||
"AMC" "J01CR02" 23665637 "Amoxicillin/clavulanic acid" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Combinations of penicillins, incl. beta-lactamase inhibitors" "c(\"a/c\", \"amcl\", \"aml\", \"aug\", \"xl\")" "c(\"amocla\", \"amoclan\", \"amoclav\", \"amoxsiklav\", \"augmentan\", \"augmentin\", \"augmentin xr\", \"augmentine\", \"auspilic\", \"clamentin\", \"clamobit\", \"clavamox\", \"clavinex\", \"clavoxilin plus\", \"clavulin\", \"clavumox\", \"coamoxiclav\", \"eumetinex\", \"kmoxilin\", \"spectramox\", \"spektramox\", \"viaclav\", \"xiclav\")" 1.5 "g" 3 "g" "character(0)"
|
||||
"AXS" 465441 "Amoxicillin/sulbactam" "Beta-lactams/penicillins" "" "" ""
|
||||
"AMB" "J02AA01" 5280965 "Amphotericin B" "Antifungals/antimycotics" "Antimycotics for systemic use" "Antibiotics" "c(\"amfb\", \"amph\")" "c(\"abelcet\", \"abelecet\", \"ambisome\", \"amfotericina b\", \"amphocin\", \"amphomoronal\", \"amphortericin b\", \"amphotec\", \"amphotericin\", \"amphotericin b\", \"amphotericine b\", \"amphotericinum b\", \"amphozone\", \"anfotericine b\", \"fungilin\", \"fungisome\", \"fungisone\", \"fungizone\", \"halizon\")" 35 "mg" "c(\"16370-9\", \"3353-0\", \"3354-8\", \"40707-2\", \"40757-7\", \"49859-2\")"
|
||||
"AMB" "J02AA01" 5280965 "Amphotericin B" "Antifungals/antimycotics" "Antimycotics for systemic use" "Antibiotics" "c(\"amf\", \"amfb\", \"amph\")" "c(\"abelcet\", \"abelecet\", \"ambisome\", \"amfotericina b\", \"amphocin\", \"amphomoronal\", \"amphortericin b\", \"amphotec\", \"amphotericin\", \"amphotericin b\", \"amphotericine b\", \"amphotericinum b\", \"amphozone\", \"anfotericine b\", \"fungilin\", \"fungisome\", \"fungisone\", \"fungizone\", \"halizon\")" 35 "mg" "c(\"16370-9\", \"3353-0\", \"3354-8\", \"40707-2\", \"40757-7\", \"49859-2\")"
|
||||
"AMH" "Amphotericin B-high" "Aminoglycosides" "c(\"amfo b high\", \"amhl\", \"ampho b high\", \"amphotericin high\")" "" ""
|
||||
"AMP" "J01CA01" 6249 "Ampicillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Penicillins with extended spectrum" "c(\"am\", \"amp\", \"ampi\")" "c(\"acillin\", \"adobacillin\", \"amblosin\", \"amcill\", \"amfipen\", \"amfipen v\", \"amipenix s\", \"ampichel\", \"ampicil\", \"ampicilina\", \"ampicillin\", \"ampicillin a\", \"ampicillin acid\", \"ampicillin anhydrate\", \"ampicillin anhydrous\", \"ampicillin base\", \"ampicillin sodium\", \"ampicillina\", \"ampicilline\", \"ampicillinum\", \"ampicin\", \"ampifarm\", \"ampikel\", \"ampimed\", \"ampipenin\", \"ampiscel\", \"ampisyn\", \"ampivax\", \"ampivet\", \"amplacilina\", \"amplin\", \"amplipenyl\", \"amplisom\", \"amplital\", \"anhydrous ampicillin\", \"austrapen\",
|
||||
\"binotal\", \"bonapicillin\", \"britacil\", \"campicillin\", \"copharcilin\", \"delcillin\", \"deripen\", \"divercillin\", \"doktacillin\", \"duphacillin\", \"grampenil\", \"guicitrina\", \"guicitrine\", \"lifeampil\", \"marcillin\", \"morepen\", \"norobrittin\", \"nuvapen\", \"olin kid\", \"omnipen\", \"orbicilina\", \"pen a oral\", \"pen ampil\", \"penbristol\", \"penbritin\", \"penbritin paediatric\", \"penbritin syrup\", \"penbrock\", \"penicline\", \"penimic\", \"pensyn\", \"pentrex\", \"pentrexl\", \"pentrexyl\", \"pentritin\", \"pfizerpen a\", \"polycillin\", \"polyflex\",
|
||||
@@ -37,6 +37,8 @@
|
||||
"BEK" 439318 "Bekanamycin" "Aminoglycosides" "" "c(\"aminodeoxykanamycin\", \"becanamicina\", \"bekanamycin\", \"bekanamycine\", \"bekanamycinum\", \"nebramycin v\")" "character(0)"
|
||||
"BNB" "J01CE08" "Benzathine benzylpenicillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase sensitive penicillins" "" "" 3.6 "g" ""
|
||||
"BNP" "J01CE10" 64725 "Benzathine phenoxymethylpenicillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase sensitive penicillins" "" "c(\"bicillin v\", \"biphecillin\")" 2 "g" "character(0)"
|
||||
"PEN" "J01CE01" 5904 "Benzylpenicillin" "Beta-lactams/penicillins" "Combinations of antibacterials" "Combinations of antibacterials" "c(\"bepe\", \"pen\", \"peni\", \"peni g\", \"penicillin\", \"penicillin g\", \"pg\")" "c(\"abbocillin\", \"ayercillin\", \"bencilpenicilina\", \"benzopenicillin\", \"benzyl penicillin\", \"benzylpenicillin\", \"benzylpenicillin g\", \"benzylpenicilline\", \"benzylpenicillinum\", \"bicillin\", \"cillora\", \"cilloral\", \"cilopen\", \"compocillin g\", \"cosmopen\", \"dropcillin\", \"free penicillin g\", \"free penicillin ii\", \"galofak\", \"gelacillin\", \"liquacillin\", \"megacillin\", \"pencillin g\", \"penicillin\", \"penicilling\", \"pentids\", \"permapen\", \"pfizerpen\", \"pfizerpen g\", \"pharmacillin\", \"pradupen\", \"specilline g\", \"ursopen\"
|
||||
)" 3.6 "g" "3913-1"
|
||||
"BES" 10178705 "Besifloxacin" "Quinolones" "" "besifloxacin" "character(0)"
|
||||
"BIA" 71339 "Biapenem" "Carbapenems" "" "c(\"biapenem\", \"biapenern\", \"bipenem\", \"omegacin\")" "character(0)"
|
||||
"BCZ" 65807 "Bicyclomycin (Bicozamycin)" "Other antibacterials" "" "c(\"aizumycin\", \"bacfeed\", \"bacteron\", \"bicozamicina\", \"bicozamycin\", \"bicozamycine\", \"bicozamycinum\")" "character(0)"
|
||||
@@ -106,7 +108,7 @@
|
||||
"CPT" "J01DI02" 56841980 "Ceftaroline" "Cephalosporins (5th gen.)" "c(\"\", \"cfro\")" "c(\"teflaro\", \"zinforo\")" 1.2 "character(0)"
|
||||
"CPA" "Ceftaroline/avibactam" "Cephalosporins (5th gen.)" "" "" ""
|
||||
"CAZ" "J01DD02" 5481173 "Ceftazidime" "Cephalosporins (3rd gen.)" "Other beta-lactam antibacterials" "Third-generation cephalosporins" "c(\"caz\", \"cefta\", \"cfta\", \"cftz\", \"taz\", \"tz\", \"xtz\")" "c(\"ceftazidim\", \"ceftazidima\", \"ceftazidime\", \"ceftazidimum\", \"ceptaz\", \"fortaz\", \"fortum\", \"pentacef\", \"tazicef\", \"tazidime\")" 4 "g" "c(\"21151-6\", \"3449-6\", \"80960-8\")"
|
||||
"CZA" "Ceftazidime/avibactam" "Cephalosporins (3rd gen.)" "c(\"\", \"cfav\")" "" ""
|
||||
"CZA" "J01DD52" 90643431 "Ceftazidime/avibactam" "Cephalosporins (3rd gen.)" "Other beta-lactam antibacterials" "Third-generation cephalosporins" "c(\"\", \"cfav\")" "c(\"avycaz\", \"zavicefta\")" 6 "g" ""
|
||||
"CCV" "J01DD52" 9575352 "Ceftazidime/clavulanic acid" "Cephalosporins (3rd gen.)" "Other beta-lactam antibacterials" "Third-generation cephalosporins" "c(\"czcl\", \"xtzl\")" "" 6 ""
|
||||
"CEM" 6537431 "Cefteram" "Cephalosporins (3rd gen.)" "" "c(\"cefteram\", \"cefterame\", \"cefteramum\", \"ceftetrame\")" "character(0)"
|
||||
"CPL" 5362114 "Cefteram pivoxil" "Cephalosporins (3rd gen.)" "" "c(\"cefteram pivoxil\", \"tomiron\")" "character(0)"
|
||||
@@ -154,7 +156,7 @@
|
||||
"CTR" "G01AF02" 2812 "Clotrimazole" "Antifungals/antimycotics" "clot" "c(\"canesten\", \"canesten cream\", \"canesten solution\", \"canestene\", \"canestine\", \"canifug\", \"chlotrimazole\", \"cimitidine\", \"clomatin\", \"clotrimaderm\", \"clotrimaderm cream\", \"clotrimazol\", \"clotrimazole\", \"clotrimazolum\", \"cutistad\", \"desamix f\", \"diphenylmethane\", \"empecid\", \"esparol\", \"fem care\", \"femcare\", \"gyne lotrimin\", \"jidesheng\", \"kanesten\", \"klotrimazole\", \"lotrimax\", \"lotrimin\", \"lotrimin af\", \"lotrimin af cream\", \"lotrimin af lotion\", \"lotrimin af solution\", \"lotrimin cream\", \"lotrimin lotion\",
|
||||
\"lotrimin solution\", \"monobaycuten\", \"mycelax\", \"mycelex\", \"mycelex cream\", \"mycelex g\", \"mycelex otc\", \"mycelex solution\", \"mycelex troches\", \"mycelex twin pack\", \"myclo cream\", \"myclo solution\", \"myclo spray solution\", \"mycofug\", \"mycosporin\", \"mykosporin\", \"nalbix\", \"otomax\", \"pedisafe\", \"rimazole\", \"stiemazol\", \"tibatin\", \"trimysten\", \"veltrim\")" "character(0)"
|
||||
"CLO" "J01CF02" 6098 "Cloxacillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase resistant penicillins" "c(\"\", \"clox\")" "c(\"chloroxacillin\", \"clossacillina\", \"cloxacilina\", \"cloxacillin\", \"cloxacillin sodium\", \"cloxacilline\", \"cloxacillinna\", \"cloxacillinum\", \"cloxapen\", \"methocillin s\", \"orbenin\", \"syntarpen\", \"tegopen\")" 2 "g" 2 "g" "c(\"16628-0\", \"25250-2\")"
|
||||
"COL" "J01XB01" 5311054 "Colistin" "Polymyxins" "Other antibacterials" "Polymyxins" "c(\"cl\", \"coli\", \"cs\", \"ct\")" "c(\"belcomycine\", \"colimycin\", \"colimycin sulphate\", \"colisticin\", \"colistimethate\", \"colistimethate sodium\", \"colistin sulfate\", \"colistin sulphate\", \"colomycin\", \"coly-mycin\", \"polymyxin e\", \"polymyxin e. sulfate\", \"promixin\", \"totazina\")" 9 "MU" "c(\"16645-4\", \"29493-4\")"
|
||||
"COL" "J01XB01" 5311054 "Colistin" "Polymyxins" "Other antibacterials" "Polymyxins" "c(\"cl\", \"coli\", \"cs\", \"cst\", \"ct\")" "c(\"belcomycine\", \"colimycin\", \"colimycin sulphate\", \"colisticin\", \"colistimethate\", \"colistimethate sodium\", \"colistin sulfate\", \"colistin sulphate\", \"colomycin\", \"coly-mycin\", \"polymyxin e\", \"polymyxin e. sulfate\", \"promixin\", \"totazina\")" 9 "MU" "c(\"16645-4\", \"29493-4\")"
|
||||
"COP" "Colistin/polysorbate" "Other antibacterials" "" "" ""
|
||||
"CYC" "J04AB01" 6234 "Cycloserine" "Oxazolidinones" "Drugs for treatment of tuberculosis" "Antibiotics" "cycl" "c(\"cicloserina\", \"closerin\", \"closina\", \"cyclorin\", \"cycloserin\", \"cycloserine\", \"cycloserinum\", \"farmiserina\", \"micoserina\", \"miroserina\", \"miroseryn\", \"novoserin\", \"oxamicina\", \"oxamycin\", \"seromycin\", \"tebemicina\", \"tisomycin\", \"wasserina\")" 0.75 "g" "c(\"16702-3\", \"25251-0\", \"3519-6\")"
|
||||
"DAL" "J01XA04" 23724878 "Dalbavancin" "Glycopeptides" "Other antibacterials" "Glycopeptide antibacterials" "dalb" "c(\"dalbavancin\", \"dalvance\")" 1.5 "character(0)"
|
||||
@@ -196,23 +198,23 @@
|
||||
"FLO" 65864 "Flomoxef" "Other antibacterials" "" "c(\"flomoxef\", \"flomoxefo\", \"flomoxefum\")" "character(0)"
|
||||
"FLR" 114811 "Florfenicol" "Other antibacterials" "" "c(\"aquafen\", \"florfenicol\", \"nuflor\", \"nuflor gold\")" "87599-7"
|
||||
"FLC" "J01CF05" 21319 "Flucloxacillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase resistant penicillins" "c(\"clox\", \"flux\")" "c(\"floxacillin\", \"floxapen\", \"floxapen sodium salt\", \"fluclox\", \"flucloxacilina\", \"flucloxacillin\", \"flucloxacilline\", \"flucloxacillinum\", \"fluorochloroxacillin\")" 2 "g" 2 "g" "character(0)"
|
||||
"FLU" "J02AC01" 3365 "Fluconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "c(\"fluc\", \"fluz\")" "c(\"alflucoz\", \"alfumet\", \"biocanol\", \"biozole\", \"biozolene\", \"canzol\", \"cryptal\", \"diflazon\", \"diflucan\", \"dimycon\", \"elazor\", \"flucazol\", \"fluconazol\", \"fluconazole\", \"fluconazole capsules\", \"fluconazolum\", \"flucostat\", \"flukezol\", \"flunazol\", \"flunizol\", \"flusol\", \"fluzon\", \"fluzone\", \"forcan\", \"fuconal\", \"fungata\", \"loitin\", \"oxifugol\", \"pritenzol\", \"syscan\", \"trican\", \"triconal\", \"triflucan\", \"zoltec\")" 0.2 "g" 0.2 "g" "c(\"10987-6\", \"16870-8\", \"25255-1\", \"80530-9\")"
|
||||
"FLU" "J02AC01" 3365 "Fluconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "c(\"fluc\", \"fluz\", \"flz\")" "c(\"alflucoz\", \"alfumet\", \"biocanol\", \"biozole\", \"biozolene\", \"canzol\", \"cryptal\", \"diflazon\", \"diflucan\", \"dimycon\", \"elazor\", \"flucazol\", \"fluconazol\", \"fluconazole\", \"fluconazole capsules\", \"fluconazolum\", \"flucostat\", \"flukezol\", \"flunazol\", \"flunizol\", \"flusol\", \"fluzon\", \"fluzone\", \"forcan\", \"fuconal\", \"fungata\", \"loitin\", \"oxifugol\", \"pritenzol\", \"syscan\", \"trican\", \"triconal\", \"triflucan\", \"zoltec\")" 0.2 "g" 0.2 "g" "c(\"10987-6\", \"16870-8\", \"25255-1\", \"80530-9\")"
|
||||
"FLM" "J01MB07" 3374 "Flumequine" "Quinolones" "Quinolone antibacterials" "Other quinolones" "" "c(\"apurone\", \"fantacin\", \"flumequine\", \"flumequino\", \"flumequinum\", \"flumigal\", \"flumiquil\", \"flumisol\", \"flumix\", \"imequyl\")" 1.2 "g" "character(0)"
|
||||
"FLR1" "J01FA14" 71260 "Flurithromycin" "Macrolides/lincosamides" "Macrolides, lincosamides and streptogramins" "Macrolides" "" "c(\"flurithromicina\", \"flurithromycime\", \"flurithromycin\", \"flurithromycine\", \"flurithromycinum\", \"fluritromicina\", \"fluritromycinum\", \"flurizic\")" 0.75 "g" "character(0)"
|
||||
"FFL" 214356 "Fosfluconazole" "Antifungals/antimycotics" "" "c(\"fosfluconazole\", \"phosfluconazole\", \"procif\", \"prodif\")" "character(0)"
|
||||
"FOS" "J01XX01" 446987 "Fosfomycin" "Other antibacterials" "Other antibacterials" "Other antibacterials" "c(\"ff\", \"fm\", \"fo\", \"fos\", \"fosf\")" "c(\"fosfocina\", \"fosfomicina\", \"fosfomycin\", \"fosfomycin sodium\", \"fosfomycine\", \"fosfomycinum\", \"fosfonomycin\", \"monuril\", \"monurol\", \"phosphonemycin\", \"phosphonomycin\", \"veramina\")" 3 "g" 8 "g" "character(0)"
|
||||
"FOS" "J01XX01" 446987 "Fosfomycin" "Other antibacterials" "Other antibacterials" "Other antibacterials" "c(\"ff\", \"fm\", \"fo\", \"fof\", \"fos\", \"fosf\")" "c(\"fosfocina\", \"fosfomicina\", \"fosfomycin\", \"fosfomycin sodium\", \"fosfomycine\", \"fosfomycinum\", \"fosfonomycin\", \"monuril\", \"monurol\", \"phosphonemycin\", \"phosphonomycin\", \"veramina\")" 3 "g" 8 "g" "character(0)"
|
||||
"FMD" 572 "Fosmidomycin" "Other antibacterials" "" "c(\"fosmidomycin\", \"fosmidomycina\", \"fosmidomycine\", \"fosmidomycinum\")" "character(0)"
|
||||
"FRM" 8378 "Framycetin" "Aminoglycosides" "c(\"\", \"fram\")" "c(\"actilin\", \"actiline\", \"antibiotique\", \"bycomycin\", \"endomixin\", \"enterfram\", \"fradiomycin\", \"fradiomycin b\", \"fradiomycinum\", \"framicetina\", \"framycetin\", \"framycetin sulfate\", \"framycetine\", \"framycetinum\", \"framygen\", \"fraquinol\", \"jernadex\", \"myacine\", \"myacyne\", \"mycerin\", \"mycifradin\", \"neobrettin\", \"neolate\", \"neomas\", \"neomcin\", \"neomicina\", \"neomin\", \"neomycin\", \"neomycin b\", \"neomycin b sulfate\", \"neomycin solution\", \"neomycin sulfate\", \"neomycin sulphate\", \"neomycinb\", \"neomycine\", \"neomycinum\",
|
||||
\"nivemycin\", \"pimavecort\", \"soframycin\", \"soframycine\", \"tuttomycin\", \"vonamycin\", \"vonamycin powder v\")" "character(0)"
|
||||
"FRZ" 5323714 "Furazolidone" "Other antibacterials" "" "c(\"bifuron\", \"corizium\", \"coryzium\", \"diafuron\", \"enterotoxon\", \"furall\", \"furaxon\", \"furaxone\", \"furazol\", \"furazolidine\", \"furazolidon\", \"furazolidona\", \"furazolidone\", \"furazolidonum\", \"furazolum\", \"furazon\", \"furidon\", \"furovag\", \"furox aerosol powder\", \"furoxal\", \"furoxane\", \"furoxon\", \"furoxone\", \"furoxone liquid\", \"furoxone swine mix\", \"furozolidine\", \"giardil\", \"giarlam\", \"medaron\", \"neftin\", \"nicolen\", \"nifulidone\", \"nifuran\", \"nifurazolidone\", \"nifurazolidonum\", \"nitrofurazolidone\", \"nitrofurazolidonum\",
|
||||
\"nitrofuroxon\", \"optazol\", \"ortazol\", \"puradin\", \"roptazol\", \"sclaventerol\", \"tikofuran\", \"topazone\", \"trichofuron\", \"tricofuron\", \"tricoron\", \"trifurox\", \"viofuragyn\")" "character(0)"
|
||||
"FUS" "J01XC01" 3000226 "Fusidic acid" "Other antibacterials" "Other antibacterials" "Steroid antibacterials" "fusi" "c(\"acide fusidique\", \"acido fusidico\", \"acidum fusidicum\", \"flucidin\", \"fucidate\", \"fucidate sodium\", \"fucidic acid\", \"fucidin\", \"fucidin acid\", \"fucithalmic\", \"fusidate\", \"fusidate acid\", \"fusidic acid\", \"fusidine\", \"fusidinic acid\", \"ramycin\")" 1.5 "g" 1.5 "g" "character(0)"
|
||||
"FUS" "J01XC01" 3000226 "Fusidic acid" "Other antibacterials" "Other antibacterials" "Steroid antibacterials" "c(\"fa\", \"fusi\")" "c(\"acide fusidique\", \"acido fusidico\", \"acidum fusidicum\", \"flucidin\", \"fucidate\", \"fucidate sodium\", \"fucidic acid\", \"fucidin\", \"fucidin acid\", \"fucithalmic\", \"fusidate\", \"fusidate acid\", \"fusidic acid\", \"fusidine\", \"fusidinic acid\", \"ramycin\")" 1.5 "g" 1.5 "g" "character(0)"
|
||||
"GAM" 59364992 "Gamithromycin" "Macrolides/lincosamides" "" "gamithromycin" "character(0)"
|
||||
"GRN" 124093 "Garenoxacin" "Quinolones" "" "c(\"ganefloxacin\", \"garenfloxacin\", \"garenoxacin\")" "character(0)"
|
||||
"GAT" "J01MA16" 5379 "Gatifloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"gati\")" "c(\"gatiflo\", \"gatifloxacin\", \"gatifloxacine\", \"gatifloxcin\", \"gatilox\", \"gatiquin\", \"gatispan\", \"tequin\", \"tequin and zymar\", \"zymaxid\")" 0.4 "g" 0.4 "g" "character(0)"
|
||||
"GEM" "J01MA15" 9571107 "Gemifloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "" "c(\"factiv\", \"factive\", \"gemifioxacin\", \"gemifloxacin\", \"gemifloxacine\", \"gemifloxacino\", \"gemifloxacinum\")" 0.32 "character(0)"
|
||||
"GEN" "J01GB03" 3467 "Gentamicin" "Aminoglycosides" "Aminoglycoside antibacterials" "Other aminoglycosides" "c(\"cn\", \"gen\", \"gent\", \"gm\")" "c(\"apogen\", \"centicin\", \"cidomycin\", \"garasol\", \"genoptic liquifilm\", \"genoptic s.o.p.\", \"gentacycol\", \"gentafair\", \"gentak\", \"gentamar\", \"gentamcin sulfate\", \"gentamicin\", \"gentamicina\", \"gentamicine\", \"gentamicins\", \"gentamicinum\", \"gentamycin\", \"gentamycins\", \"gentamycinum\", \"gentavet\", \"gentocin\", \"jenamicin\", \"lyramycin\", \"oksitselanim\", \"refobacin\", \"refobacin tm\", \"septigen\", \"uromycine\")" 0.24 "g" "c(\"13561-6\", \"13562-4\", \"15106-8\", \"22746-2\", \"22747-0\", \"31091-2\", \"31092-0\", \"31093-8\", \"35668-3\", \"3663-2\", \"3664-0\", \"3665-7\", \"39082-3\", \"47109-4\", \"59379-8\", \"80971-5\", \"88111-0\")"
|
||||
"GEH" "Gentamicin-high" "Aminoglycosides" "c(\"gehl\", \"genta high\", \"gentamicin high\")" "" ""
|
||||
"GEH" "Gentamicin-high" "Aminoglycosides" "c(\"g_h\", \"gehl\", \"genta high\", \"gentamicin high\")" "" ""
|
||||
"GEP" 25101874 "Gepotidacin" "Other antibacterials" "" "gepotidacin" "character(0)"
|
||||
"GRX" "J01MA11" 72474 "Grepafloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"grep\")" "grepafloxacin" 0.4 "g" "character(0)"
|
||||
"GRI" 441140 "Griseofulvin" "Antifungals/antimycotics" "" "c(\"amudane\", \"curling factor\", \"delmofulvina\", \"fulcin\", \"fulcine\", \"fulvican grisactin\", \"fulvicin\", \"fulvicin bolus\", \"fulvidex\", \"fulvina\", \"fulvinil\", \"fulvistatin\", \"fungivin\", \"greosin\", \"gresfeed\", \"gricin\", \"grifulin\", \"grifulvin\", \"grifulvin v\", \"grisactin\", \"grisactin ultra\", \"grisactin v\", \"griscofulvin\", \"grise ostatin\", \"grisefuline\", \"griseo\", \"griseofulvin\", \"griseofulvin forte\", \"griseofulvina\", \"griseofulvine\", \"griseofulvinum\", \"griseomix\", \"griseostatin\", \"grisetin\", \"grisofulvin\",
|
||||
@@ -236,9 +238,9 @@
|
||||
"ITR" "J02AC02" 3793 "Itraconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "itra" "c(\"itraconazol\", \"itraconazole\", \"itraconazolum\", \"itraconzaole\", \"itrazole\", \"oriconazole\", \"sporanox\")" 0.2 "g" 0.2 "g" "c(\"10989-2\", \"12392-7\", \"25258-5\", \"27081-9\", \"32184-4\", \"32185-1\", \"80531-7\")"
|
||||
"JOS" "J01FA07" 5282165 "Josamycin" "Macrolides/lincosamides" "Macrolides, lincosamides and streptogramins" "Macrolides" "" "c(\"josacine\", \"josamicina\", \"josamycin\", \"josamycine\", \"josamycinum\")" 2 "g" "character(0)"
|
||||
"KAN" "J01GB04" 6032 "Kanamycin" "Aminoglycosides" "Aminoglycoside antibacterials" "Other aminoglycosides" "c(\"hlk\", \"k\", \"kan\", \"kana\", \"km\")" "c(\"kanamicina\", \"kanamycin\", \"kanamycin a\", \"kanamycin base\", \"kanamycine\", \"kanamycinum\", \"kantrex\", \"kenamycin a\", \"klebcil\", \"liposomal kanamycin\")" 1 "g" "c(\"23889-9\", \"3698-8\", \"3699-6\", \"3700-2\", \"47395-9\")"
|
||||
"KAH" "Kanamycin-high" "Aminoglycosides" "c(\"\", \"kahl\")" "" ""
|
||||
"KAH" "Kanamycin-high" "Aminoglycosides" "c(\"\", \"k_h\", \"kahl\")" "" ""
|
||||
"KAC" "Kanamycin/cephalexin" "Aminoglycosides" "" "" ""
|
||||
"KET" "J02AB02" 456201 "Ketoconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Imidazole derivatives" "keto" "c(\"extina\", \"fungarest\", \"fungoral\", \"ketocanazole\", \"ketoconazol\", \"ketoconazole\", \"ketoconazolum\", \"ketoderm\", \"nizoral\", \"xolegel\")" 0.2 "g" "c(\"10990-0\", \"12393-5\", \"25259-3\", \"60091-6\", \"60092-4\")"
|
||||
"KET" "J02AB02" 456201 "Ketoconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Imidazole derivatives" "c(\"keto\", \"ktc\")" "c(\"extina\", \"fungarest\", \"fungoral\", \"ketocanazole\", \"ketoconazol\", \"ketoconazole\", \"ketoconazolum\", \"ketoderm\", \"nizoral\", \"xolegel\")" 0.2 "g" "c(\"10990-0\", \"12393-5\", \"25259-3\", \"60091-6\", \"60092-4\")"
|
||||
"KIT" "Kitasamycin (Leucomycin)" "Macrolides/lincosamides" "" "" ""
|
||||
"LAS" 5360807 "Lasalocid" "Other antibacterials" "" "c(\"avatec\", \"lasalocid\", \"lasalocid a\", \"lasalocide\", \"lasalocide a\", \"lasalocido\", \"lasalocidum\")" "87598-9"
|
||||
"LTM" "J01DD06" 47499 "Latamoxef" "Cephalosporins (3rd gen.)" "Other beta-lactam antibacterials" "Third-generation cephalosporins" "c(\"mox\", \"moxa\")" "c(\"disodium moxalactam\", \"festamoxin\", \"lamoxactam\", \"latamoxef\", \"latamoxefum\", \"shiomarin\")" 4 "g" "character(0)"
|
||||
@@ -328,8 +330,6 @@
|
||||
"PAZ" "J01MA18" 65957 "Pazufloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "" "c(\"pazufloxacin\", \"pazufloxacine\", \"pazufloxacino\", \"pazufloxacinum\")" 1 "g" "character(0)"
|
||||
"PEF" "J01MA03" 51081 "Pefloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"pefl\")" "c(\"abactal\", \"labocton\", \"pefloxacin\", \"pefloxacine\", \"pefloxacino\", \"pefloxacinum\", \"perfloxacin\", \"silver pefloxacin\")" 0.8 "g" 0.8 "g" "3906-5"
|
||||
"PNM" "J01CE06" 10250769 "Penamecillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase sensitive penicillins" "" "c(\"hydroxymethyl\", \"penamecilina\", \"penamecillin\", \"penamecillina\", \"penamecilline\", \"penamecillinum\")" 1.05 "g" "character(0)"
|
||||
"PEN" "J01CE01" 5904 "Benzylpenicillin" "Beta-lactams/penicillins" "Combinations of antibacterials" "Combinations of antibacterials" "c(\"bepe\", \"pen\", \"peni\", \"peni g\", \"penicillin\", \"penicillin g\", \"pg\")" "c(\"abbocillin\", \"ayercillin\", \"bencilpenicilina\", \"benzopenicillin\", \"benzyl penicillin\", \"benzylpenicillin\", \"benzylpenicillin g\", \"benzylpenicilline\", \"benzylpenicillinum\", \"bicillin\", \"cillora\", \"cilloral\", \"cilopen\", \"compocillin g\", \"cosmopen\", \"dropcillin\", \"free penicillin g\", \"free penicillin ii\", \"galofak\", \"gelacillin\", \"liquacillin\", \"megacillin\", \"pencillin g\", \"penicillin\", \"penicilling\", \"pentids\", \"permapen\", \"pfizerpen\", \"pfizerpen g\", \"pharmacillin\", \"pradupen\", \"specilline g\", \"ursopen\"
|
||||
)" 3.6 "g" "3913-1"
|
||||
"PNO" "Penicillin/novobiocin" "Beta-lactams/penicillins" "" "" ""
|
||||
"PSU" "Penicillin/sulbactam" "Beta-lactams/penicillins" "" "" ""
|
||||
"PNM1" "J01AA10" 54686187 "Penimepicycline" "Tetracyclines" "Tetracyclines" "Tetracyclines" "" "c(\"duamine\", \"hydrocycline\", \"penetracyne\", \"penimepiciclina\", \"penimepicycline\", \"penimepicyclinum\")" "character(0)"
|
||||
@@ -342,7 +342,7 @@
|
||||
"PPA" "J01MB04" 4831 "Pipemidic acid" "Quinolones" "Quinolone antibacterials" "Other quinolones" "c(\"pipz\", \"pizu\")" "c(\"acide pipemidique\", \"acido pipemidico\", \"acidum pipemidicum\", \"deblaston\", \"dolcol\", \"pipedac\", \"pipemid\", \"pipemidic\", \"pipemidic acid\", \"pipemidicacid\", \"pipram\", \"uromidin\")" 0.8 "g" "character(0)"
|
||||
"PIP" "J01CA12" 43672 "Piperacillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Penicillins with extended spectrum" "c(\"pi\", \"pip\", \"pipc\", \"pipe\", \"pp\")" "c(\"isipen\", \"pentcillin\", \"peperacillin\", \"peracin\", \"piperacilina\", \"piperacillin\", \"piperacillin na\", \"piperacillin sodium\", \"piperacilline\", \"piperacillinum\", \"pipercillin\", \"pipracil\", \"pipril\")" 14 "g" "c(\"25268-4\", \"3972-7\")"
|
||||
"PIS" "Piperacillin/sulbactam" "Beta-lactams/penicillins" "" "" ""
|
||||
"TZP" "J01CR05" 461573 "Piperacillin/tazobactam" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Combinations of penicillins, incl. beta-lactamase inhibitors" "c(\"p/t\", \"piptaz\", \"piptazo\", \"pita\", \"pt\", \"ptc\", \"ptz\", \"tzp\")" "c(\"\", \"tazocel\", \"tazocillin\", \"tazocin\", \"zosyn\")" 14 "g" "character(0)"
|
||||
"TZP" "J01CR05" 461573 "Piperacillin/tazobactam" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Combinations of penicillins, incl. beta-lactamase inhibitors" "c(\"p/t\", \"piptaz\", \"piptazo\", \"pit\", \"pita\", \"pt\", \"ptc\", \"ptz\", \"tzp\")" "c(\"\", \"tazocel\", \"tazocillin\", \"tazocin\", \"zosyn\")" 14 "g" "character(0)"
|
||||
"PRC" 71978 "Piridicillin" "Beta-lactams/penicillins" "" "piridicillin" "character(0)"
|
||||
"PRL" 157385 "Pirlimycin" "Other antibacterials" "" "c(\"pirlimycin\", \"pirlimycina\", \"pirlimycine\", \"pirlimycinum\", \"pirsue\")" "character(0)"
|
||||
"PIR" "J01MB03" 4855 "Piromidic acid" "Quinolones" "Quinolone antibacterials" "Other quinolones" "" "c(\"acide piromidique\", \"acido piromidico\", \"acidum piromidicum\", \"actrun c\", \"bactramyl\", \"enterol\", \"gastrurol\", \"panacid\", \"pirodal\", \"piromidic acid\", \"pyrido\", \"reelon\", \"septural\", \"urisept\", \"uropir\", \"zaomeal\")" 2 "g" "character(0)"
|
||||
@@ -354,6 +354,7 @@
|
||||
"POS" "J02AC04" 468595 "Posaconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "posa" "c(\"noxafil\", \"posaconazole\", \"posaconazole sp\", \"posconazole\")" 0.3 "g" 0.3 "g" "c(\"53731-6\", \"80545-7\")"
|
||||
"PRA" 9802884 "Pradofloxacin" "Quinolones" "" "pradofloxacin" "character(0)"
|
||||
"PRX" 71455 "Premafloxacin" "Quinolones" "" "premafloxacin" "character(0)"
|
||||
"PMD" "J04AK08" 456199 "Pretomanid" "Antimycobacterials" "Drugs for treatment of tuberculosis" "Other drugs for treatment of tuberculosis" "" "" ""
|
||||
"PRM" 6446787 "Primycin" "Macrolides/lincosamides" "" "" ""
|
||||
"PRI" "J01FG01" 11979535 "Pristinamycin" "Macrolides/lincosamides" "Macrolides, lincosamides and streptogramins" "Streptogramins" "c(\"\", \"pris\")" "c(\"eskalin v\", \"mikamycin\", \"mikamycine\", \"mikamycinum\", \"ostreogrycinum\", \"pristinamycine\", \"pristinamycinum\", \"stafac\", \"stafytracine\", \"staphylomycin\", \"starfac\", \"streptogramin\", \"vernamycin\", \"virgimycin\", \"virgimycine\", \"virginiamycina\", \"virginiamycine\", \"virginiamycinum\")" 2 "g" "character(0)"
|
||||
"PRB" "J01CE09" 5903 "Procaine benzylpenicillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase sensitive penicillins" "" "c(\"depocillin\", \"duphapen\", \"hostacillin\", \"hydracillin\", \"jenacillin o\", \"nopcaine\", \"penicillin procaine\", \"retardillin\", \"vetspen\", \"vitablend\")" 0.6 "g" "character(0)"
|
||||
@@ -396,13 +397,13 @@
|
||||
"SIT" 461399 "Sitafloxacin" "Quinolones" "" "c(\"gracevit\", \"sitafloxacinisomer\")" "character(0)"
|
||||
"SDA" "J04AA02" 2724368 "Sodium aminosalicylate" "Antimycobacterials" "Drugs for treatment of tuberculosis" "Aminosalicylic acid and derivatives" "" "c(\"bactylan\", \"decapasil\", \"lepasen\", \"monopas\", \"nippas\", \"p.a.s. sodium\", \"pamisyl sodium\", \"parasal sodium\", \"pas sodium\", \"pasade\", \"pasnal\", \"passodico\", \"salvis\", \"sanipirol\", \"sodiopas\", \"sodium p.a.s\", \"sodium pas\", \"teebacin\", \"tubersan\")" 14 "g" 14 "g" "character(0)"
|
||||
"SOL" 25242512 "Solithromycin" "Macrolides/lincosamides" "" "" ""
|
||||
"SPX" "J01MA09" 60464 "Sparfloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"spar\")" "c(\"esparfloxacino\", \"sparfloxacin\", \"sparfloxacine\", \"sparfloxacinum\")" 0.2 "g" "character(0)"
|
||||
"SPX" "J01MA09" 60464 "Sparfloxacin" "Quinolones" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"spa\", \"spar\")" "c(\"esparfloxacino\", \"sparfloxacin\", \"sparfloxacine\", \"sparfloxacinum\")" 0.2 "g" "character(0)"
|
||||
"SPT" "J01XX04" 15541 "Spectinomycin" "Other antibacterials" "Other antibacterials" "Other antibacterials" "c(\"sc\", \"spe\", \"spec\", \"spt\")" "c(\"actinospectacina\", \"adspec\", \"espectinomicina\", \"prospec\", \"specitinomycin\", \"spectam\", \"spectinomicina\", \"spectinomycin\", \"spectinomycin di hcl\", \"spectinomycine\", \"spectinomycinum\", \"stanilo\", \"togamycin\", \"trobicin\")" 3 "g" "character(0)"
|
||||
"SPI" "J01FA02" 6419898 "Spiramycin" "Macrolides/lincosamides" "Macrolides, lincosamides and streptogramins" "Macrolides" "c(\"\", \"spir\")" "c(\"espiramicin\", \"provamycin\", \"rovamycin\", \"rovamycine\", \"sequamycin\", \"spiramycine\", \"spiramycinum\")" 3 "g" "character(0)"
|
||||
"SPM" "J01RA04" "Spiramycin/metronidazole" "Other antibacterials" "Combinations of antibacterials" "Combinations of antibacterials" "" "" ""
|
||||
"STR" "J01GA02" "Streptoduocin" "Aminoglycosides" "Aminoglycoside antibacterials" "Streptomycins" "" "" 1 "g" ""
|
||||
"STR1" "J01GA01" 19649 "Streptomycin" "Aminoglycosides" "Aminoglycoside antibacterials" "Streptomycins" "c(\"s\", \"str\", \"stre\")" "c(\"agrept\", \"agrimycin\", \"chemform\", \"estreptomicina\", \"neodiestreptopab\", \"strepcen\", \"streptomicina\", \"streptomycin\", \"streptomycin a\", \"streptomycin spx\", \"streptomycin sulfate\", \"streptomycine\", \"streptomyzin\", \"vetstrep\")" 1 "g" "4039-4"
|
||||
"STH" "Streptomycin-high" "Aminoglycosides" "c(\"sthl\", \"strepto high\", \"streptomycin high\")" "" ""
|
||||
"STR1" "J01GA01" 19649 "Streptomycin" "Aminoglycosides" "Aminoglycoside antibacterials" "Streptomycins" "c(\"s\", \"stm\", \"str\", \"stre\")" "c(\"agrept\", \"agrimycin\", \"chemform\", \"estreptomicina\", \"neodiestreptopab\", \"strepcen\", \"streptomicina\", \"streptomycin\", \"streptomycin a\", \"streptomycin spx\", \"streptomycin sulfate\", \"streptomycine\", \"streptomyzin\", \"vetstrep\")" 1 "g" "4039-4"
|
||||
"STH" "Streptomycin-high" "Aminoglycosides" "c(\"s_h\", \"sthl\", \"strepto high\", \"streptomycin high\")" "" ""
|
||||
"STI" "J04AM01" "Streptomycin/isoniazid" "Antimycobacterials" "Drugs for treatment of tuberculosis" "Combinations of drugs for treatment of tuberculosis" "" "" ""
|
||||
"SUL" "J01CG01" 130313 "Sulbactam" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Beta-lactamase inhibitors" "" "c(\"betamaze\", \"sulbactam\", \"sulbactam acid\", \"sulbactam free acid\", \"sulbactamum\")" 1 "g" "character(0)"
|
||||
"SBC" "J01CA16" 20055036 "Sulbenicillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Penicillins with extended spectrum" "" "c(\"kedacillina\", \"sulbenicilina\", \"sulbenicilline\", \"sulbenicillinum\")" 15 "g" "character(0)"
|
||||
@@ -478,7 +479,7 @@
|
||||
"TIA" 656958 "Tiamulin" "Other antibacterials" "" "c(\"denagard\", \"tiamulin\", \"tiamulin pamoate\", \"tiamulina\", \"tiamuline\", \"tiamulinum\")" "87589-8"
|
||||
"TIC" "J01CA13" 36921 "Ticarcillin" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Penicillins with extended spectrum" "c(\"tc\", \"ti\", \"tic\", \"tica\")" "c(\"ticarcilina\", \"ticarcillin\", \"ticarcilline\", \"ticarcillinum\", \"ticillin\")" 15 "g" "c(\"25254-4\", \"4054-3\", \"4055-0\")"
|
||||
"TCC" "J01CR03" 6437075 "Ticarcillin/clavulanic acid" "Beta-lactams/penicillins" "Beta-lactam antibacterials, penicillins" "Combinations of penicillins, incl. beta-lactamase inhibitors" "c(\"t/c\", \"tcc\", \"ticl\", \"tim\", \"tlc\")" "timentin" 15 "g" "character(0)"
|
||||
"TGC" "J01AA12" 54686904 "Tigecycline" "Tetracyclines" "Tetracyclines" "Tetracyclines" "c(\"tgc\", \"tige\")" "c(\"haizheng li xing\", \"tigeciclina\", \"tigecyclin\", \"tigecycline\", \"tigecycline hydrate\", \"tigecyclinum\", \"tigilcycline\", \"tygacil\")" 0.1 "g" "character(0)"
|
||||
"TGC" "J01AA12" 54686904 "Tigecycline" "Tetracyclines" "Tetracyclines" "Tetracyclines" "c(\"tgc\", \"tig\", \"tige\")" "c(\"haizheng li xing\", \"tigeciclina\", \"tigecyclin\", \"tigecycline\", \"tigecycline hydrate\", \"tigecyclinum\", \"tigilcycline\", \"tygacil\")" 0.1 "g" "character(0)"
|
||||
"TBQ" 65592 "Tilbroquinol" "Quinolones" "" "c(\"tilbroquinol\", \"tilbroquinolum\")" "character(0)"
|
||||
"TIP" 24860548 "Tildipirosin" "Macrolides/lincosamides" "" "c(\"tildipirosin\", \"zuprevo\")" "character(0)"
|
||||
"TIL" 5282521 "Tilmicosin" "Macrolides/lincosamides" "" "c(\"micotil\", \"pulmotil\", \"tilmicosin\", \"tilmicosina\", \"tilmicosine\", \"tilmicosinum\")" "87588-0"
|
||||
@@ -490,7 +491,7 @@
|
||||
"TOB" "J01GB01" 36294 "Tobramycin" "Aminoglycosides" "Aminoglycoside antibacterials" "Other aminoglycosides" "c(\"nn\", \"tm\", \"to\", \"tob\", \"tobr\")" "c(\"bethkis\", \"brulamycin\", \"deoxykanamycin b\", \"distobram\", \"gernebcin\", \"gotabiotic\", \"kitabis pak\", \"nebcin\", \"nebicin\", \"nebramycin\", \"nebramycin vi\", \"obramycin\", \"sybryx\", \"tenebrimycin\", \"tenemycin\", \"tobacin\", \"tobi podhaler\", \"tobracin\", \"tobradex\", \"tobradistin\", \"tobralex\", \"tobramaxin\", \"tobramicin\", \"tobramicina\", \"tobramitsetin\", \"tobramycetin\", \"tobramycin\", \"tobramycin base\", \"tobramycin sulfate\", \"tobramycine\", \"tobramycinum\", \"tobrased\", \"tobrasone\", \"tobrex\")" 0.24 "g" "c(\"13584-8\", \"17808-7\", \"22750-4\", \"22751-2\", \"22752-0\", \"31094-6\", \"31095-3\", \"31096-1\", \"35239-3\", \"35670-9\", \"4057-6\", \"4058-4\", \"4059-2\", \"50927-3\", \"52962-8\", \"59380-6\", \"80966-5\")"
|
||||
"TOH" "Tobramycin-high" "Aminoglycosides" "c(\"tobra high\", \"tobramycin high\", \"tohl\")" "" ""
|
||||
"TFX" 5517 "Tosufloxacin" "Quinolones" "" "tosufloxacin" "character(0)"
|
||||
"TMP" "J01EA01" 5578 "Trimethoprim" "Trimethoprims" "Sulfonamides and trimethoprim" "Trimethoprim and derivatives" "c(\"t\", \"tmp\", \"tr\", \"trim\", \"w\")" "c(\"abaprim\", \"alprim\", \"anitrim\", \"antrima\", \"antrimox\", \"bacdan\", \"bacidal\", \"bacide\", \"bacterial\", \"bacticel\", \"bactifor\", \"bactin\", \"bactoprim\", \"bactramin\", \"bactrim\", \"bencole\", \"bethaprim\", \"biosulten\", \"briscotrim\", \"chemotrin\", \"colizole\", \"colizole ds\", \"conprim\", \"cotrimel\", \"cotrimoxizole\", \"deprim\", \"dosulfin\", \"duocide\", \"esbesul\", \"espectrin\", \"euctrim\", \"exbesul\", \"fermagex\", \"fortrim\", \"idotrim\", \"ikaprim\", \"instalac\", \"kombinax\", \"lagatrim\", \"lagatrim forte\", \"lastrim\", \"lescot\",
|
||||
"TMP" "J01EA01" 5578 "Trimethoprim" "Trimethoprims" "Sulfonamides and trimethoprim" "Trimethoprim and derivatives" "c(\"t\", \"tmp\", \"tr\", \"tri\", \"trim\", \"w\")" "c(\"abaprim\", \"alprim\", \"anitrim\", \"antrima\", \"antrimox\", \"bacdan\", \"bacidal\", \"bacide\", \"bacterial\", \"bacticel\", \"bactifor\", \"bactin\", \"bactoprim\", \"bactramin\", \"bactrim\", \"bencole\", \"bethaprim\", \"biosulten\", \"briscotrim\", \"chemotrin\", \"colizole\", \"colizole ds\", \"conprim\", \"cotrimel\", \"cotrimoxizole\", \"deprim\", \"dosulfin\", \"duocide\", \"esbesul\", \"espectrin\", \"euctrim\", \"exbesul\", \"fermagex\", \"fortrim\", \"idotrim\", \"ikaprim\", \"instalac\", \"kombinax\", \"lagatrim\", \"lagatrim forte\", \"lastrim\", \"lescot\",
|
||||
\"methoprim\", \"metoprim\", \"monoprim\", \"monotrim\", \"monotrimin\", \"novotrimel\", \"omstat\", \"oraprim\", \"pancidim\", \"polytrim\", \"priloprim\", \"primosept\", \"primsol\", \"proloprim\", \"protrin\", \"purbal\", \"resprim\", \"resprim forte\", \"roubac\", \"roubal\", \"salvatrim\", \"septrin ds\", \"septrin forte\", \"septrin s\", \"setprin\", \"sinotrim\", \"stopan\", \"streptoplus\", \"sugaprim\", \"sulfamar\", \"sulfamethoprim\", \"sulfoxaprim\", \"sulthrim\", \"sultrex\", \"syraprim\", \"tiempe\", \"tmp smx\", \"toprim\", \"trimanyl\", \"trimethioprim\", \"trimethopim\",
|
||||
\"trimethoprim\", \"trimethoprime\", \"trimethoprimum\", \"trimethopriom\", \"trimetoprim\", \"trimetoprima\", \"trimexazole\", \"trimexol\", \"trimezol\", \"trimogal\", \"trimono\", \"trimopan\", \"trimpex\", \"triprim\", \"trisul\", \"trisulcom\", \"trisulfam\", \"trisural\", \"uretrim\", \"urobactrim\", \"utetrin\", \"velaten\", \"wellcoprim\", \"wellcoprin\", \"xeroprim\", \"zamboprim\")" 0.4 "g" 0.4 "g" "c(\"11005-6\", \"17747-7\", \"25273-4\", \"32342-8\", \"4079-0\", \"4080-8\", \"4081-6\", \"55584-7\", \"80552-3\", \"80973-1\")"
|
||||
"SXT" "J01EE01" 358641 "Trimethoprim/sulfamethoxazole" "Trimethoprims" "Sulfonamides and trimethoprim" "Combinations of sulfonamides and trimethoprim, incl. derivatives" "c(\"cot\", \"cotrim\", \"sxt\", \"t/s\", \"trsu\", \"trsx\", \"ts\")" "c(\"bactrim\", \"bactrimel\", \"belcomycine\", \"colimycin\", \"colimycin sulphate\", \"colisticin\", \"colistimethate\", \"colistimethate sodium\", \"colistin sulfate\", \"colistin sulphate\", \"colomycin\", \"coly-mycin\", \"cotrimazole\", \"cotrimoxazole\", \"polymyxin e\", \"polymyxin e. sulfate\", \"promixin\", \"septra\", \"totazina\")" "character(0)"
|
||||
@@ -505,6 +506,6 @@
|
||||
"VAM" "Vancomycin-macromethod" "Glycopeptides" "" "" ""
|
||||
"VIO" 135398671 "Viomycin" "Antimycobacterials" "" "c(\"celiomycin\", \"florimycin\", \"floromycin\", \"viomicina\", \"viomycin\", \"viomycine\", \"viomycinum\")" "character(0)"
|
||||
"VIR" 11979535 "Virginiamycine" "Other antibacterials" "" "c(\"eskalin v\", \"mikamycin\", \"mikamycine\", \"mikamycinum\", \"ostreogrycinum\", \"pristinamycine\", \"pristinamycinum\", \"stafac\", \"stafytracine\", \"staphylomycin\", \"starfac\", \"streptogramin\", \"vernamycin\", \"virgimycin\", \"virgimycine\", \"virginiamycina\", \"virginiamycine\", \"virginiamycinum\")" "character(0)"
|
||||
"VOR" "J02AC03" 71616 "Voriconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "vori" "c(\"pfizer\", \"vfend i.v.\", \"voriconazol\", \"voriconazole\", \"voriconazolum\", \"vorikonazole\")" 0.4 "g" 0.4 "g" "c(\"38370-3\", \"53902-3\", \"73676-9\", \"80553-1\", \"80651-3\")"
|
||||
"VOR" "J02AC03" 71616 "Voriconazole" "Antifungals/antimycotics" "Antimycotics for systemic use" "Triazole derivatives" "c(\"vori\", \"vrc\")" "c(\"pfizer\", \"vfend i.v.\", \"voriconazol\", \"voriconazole\", \"voriconazolum\", \"vorikonazole\")" 0.4 "g" 0.4 "g" "c(\"38370-3\", \"53902-3\", \"73676-9\", \"80553-1\", \"80651-3\")"
|
||||
"XBR" "J01XX02" 72144 "Xibornol" "Other antibacterials" "Other antibacterials" "Other antibacterials" "" "c(\"bactacine\", \"bracen\", \"nanbacine\", \"xibornol\", \"xibornolo\", \"xibornolum\")" "character(0)"
|
||||
"ZID" 77846445 "Zidebactam" "Other antibacterials" "" "zidebactam" "character(0)"
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -0,0 +1 @@
|
||||
58d6a0589aea598420e37045fb04a5ae
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -0,0 +1,170 @@
|
||||
"ab" "name" "type" "dose" "dose_times" "administration" "notes" "original_txt" "eucast_version"
|
||||
"AMK" "Amikacin" "standard_dosage" "25-30 mg/kg" 1 "iv" "" "25-30 mg/kg x 1 iv" 11
|
||||
"AMX" "Amoxicillin" "high_dosage" "2 g" 6 "iv" "" "2 g x 6 iv" 11
|
||||
"AMX" "Amoxicillin" "standard_dosage" "1 g" 3 "iv" "" "1 g x 3-4 iv" 11
|
||||
"AMX" "Amoxicillin" "high_dosage" "0.75-1 g" 3 "oral" "" "0.75-1 g x 3 oral" 11
|
||||
"AMX" "Amoxicillin" "standard_dosage" "0.5 g" 3 "oral" "" "0.5 g x 3 oral" 11
|
||||
"AMX" "Amoxicillin" "uncomplicated_uti" "0.5 g" 3 "oral" "" "0.5 g x 3 oral" 11
|
||||
"AMC" "Amoxicillin/clavulanic acid" "high_dosage" "2 g + 0.2 g" 3 "iv" "" "(2 g amoxicillin + 0.2 g clavulanic acid) x 3 iv" 11
|
||||
"AMC" "Amoxicillin/clavulanic acid" "standard_dosage" "1 g + 0.2 g" 3 "iv" "" "(1 g amoxicillin + 0.2 g clavulanic acid) x 3-4 iv" 11
|
||||
"AMC" "Amoxicillin/clavulanic acid" "high_dosage" "0.875 g + 0.125 g" 3 "oral" "" "(0.875 g amoxicillin + 0.125 g clavulanic acid) x 3 oral" 11
|
||||
"AMC" "Amoxicillin/clavulanic acid" "standard_dosage" "0.5 g + 0.125 g" 3 "oral" "" "(0.5 g amoxicillin + 0.125 g clavulanic acid) x 3 oral" 11
|
||||
"AMC" "Amoxicillin/clavulanic acid" "uncomplicated_uti" "0.5 g + 0.125 g" 3 "oral" "" "(0.5 g amoxicillin + 0.125 g clavulanic acid) x 3 oral" 11
|
||||
"AMP" "Ampicillin" "high_dosage" "2 g" 4 "iv" "" "2 g x 4 iv" 11
|
||||
"AMP" "Ampicillin" "standard_dosage" "2 g" 3 "iv" "" "2 g x 3 iv" 11
|
||||
"SAM" "Ampicillin/sulbactam" "high_dosage" "2 g + 1 g" 4 "iv" "" "(2 g ampicillin + 1 g sulbactam) x 4 iv" 11
|
||||
"SAM" "Ampicillin/sulbactam" "standard_dosage" "2 g + 1 g" 3 "iv" "" "(2 g ampicillin + 1 g sulbactam) x 3 iv" 11
|
||||
"AZM" "Azithromycin" "standard_dosage" "0.5 g" 1 "iv" "" "0.5 g x 1 iv" 11
|
||||
"AZM" "Azithromycin" "standard_dosage" "0.5 g" 1 "oral" "" "0.5 g x 1 oral" 11
|
||||
"ATM" "Aztreonam" "high_dosage" "2 g" 4 "iv" "" "2 g x 4 iv" 11
|
||||
"ATM" "Aztreonam" "standard_dosage" "1 g" 3 "iv" "" "1 g x 3 iv" 11
|
||||
"PEN" "Benzylpenicillin" "high_dosage" "1.2 g" 4 "iv" "" "1.2 g (2 MU) x 4-6 iv" 11
|
||||
"PEN" "Benzylpenicillin" "standard_dosage" "0.6 g" 4 "iv" "" "0.6 g (1 MU) x 4 iv" 11
|
||||
"CEC" "Cefaclor" "high_dosage" "1 g" 3 "oral" "" "1 g x 3 oral" 11
|
||||
"CEC" "Cefaclor" "standard_dosage" "0.25-0.5 g" 3 "oral" "" "0.25-0.5 g x 3 oral" 11
|
||||
"CFR" "Cefadroxil" "standard_dosage" "0.5-1 g" 2 "oral" "" "0.5-1 g x 2 oral" 11
|
||||
"CFR" "Cefadroxil" "uncomplicated_uti" "0.5-1 g" 2 "oral" "" "0.5-1 g x 2 oral" 11
|
||||
"CZO" "Cefazolin" "high_dosage" "2 g" 3 "iv" "" "2 g x 3 iv" 11
|
||||
"CZO" "Cefazolin" "standard_dosage" "1 g" 3 "iv" "" "1 g x 3 iv" 11
|
||||
"FEP" "Cefepime" "high_dosage" "2 g" 3 "iv" "" "2 g x 3 iv" 11
|
||||
"FEP" "Cefepime" "standard_dosage" "2 g" 2 "iv" "" "2 g x 2 iv" 11
|
||||
"FDC" "Cefiderocol" "standard_dosage" "2 g" 3 "iv" "over 3 hours" "2 g x 3 iv over 3 hours" 11
|
||||
"CFM" "Cefixime" "standard_dosage" "0.2-0.4 g" 2 "oral" "" "0.2-0.4 g x 2 oral" 11
|
||||
"CFM" "Cefixime" "uncomplicated_uti" "0.2-0.4 g" 2 "oral" "" "0.2-0.4 g x 2 oral" 11
|
||||
"CTX" "Cefotaxime" "high_dosage" "2 g" 3 "iv" "" "2 g x 3 iv" 11
|
||||
"CTX" "Cefotaxime" "standard_dosage" "1 g" 3 "iv" "" "1 g x 3 iv" 11
|
||||
"CPD" "Cefpodoxime" "standard_dosage" "0.1-0.2 g" 2 "oral" "" "0.1-0.2 g x 2 oral" 11
|
||||
"CPD" "Cefpodoxime" "uncomplicated_uti" "0.1-0.2 g" 2 "oral" "" "0.1-0.2 g x 2 oral" 11
|
||||
"CPT" "Ceftaroline" "high_dosage" "0.6 g" 3 "iv" "over 2 hours" "0.6 g x 3 iv over 2 hours" 11
|
||||
"CPT" "Ceftaroline" "standard_dosage" "0.6 g" 2 "iv" "over 1 hour" "0.6 g x 2 iv over 1 hour" 11
|
||||
"CAZ" "Ceftazidime" "high_dosage" "1 g" 6 "iv" "" "1 g x 6 iv" 11
|
||||
"CAZ" "Ceftazidime" "standard_dosage" "1 g" 3 "iv" "" "1 g x 3 iv" 11
|
||||
"CZA" "Ceftazidime/avibactam" "standard_dosage" "2 g + 0.5 g" 3 "iv" "over 2 hours" "(2 g ceftazidime + 0.5 g avibactam) x 3 iv over 2 hours" 11
|
||||
"CTB" "Ceftibuten" "standard_dosage" "0.4 g" 1 "oral" "" "0.4 g x 1 oral" 11
|
||||
"BPR" "Ceftobiprole" "standard_dosage" "0.5 g" 3 "iv" "over 2 hours" "0.5 g x 3 iv over 2 hours" 11
|
||||
"CZT" "Ceftolozane/tazobactam" "standard_dosage" "1 g + 0.5 g" 3 "iv" "over 1 hour" "(1 g ceftolozane + 0.5 g tazobactam) x 3 iv over 1 hour" 11
|
||||
"CZT" "Ceftolozane/tazobactam" "standard_dosage" "2 g + 1 g" 3 "iv" "over 1 hour" "(2 g ceftolozane + 1 g tazobactam) x 3 iv over 1 hour" 11
|
||||
"CRO" "Ceftriaxone" "high_dosage" "4 g" 1 "iv" "" "4 g x 1 iv" 11
|
||||
"CRO" "Ceftriaxone" "standard_dosage" "2 g" 1 "iv" "" "2 g x 1 iv" 11
|
||||
"CXM" "Cefuroxime" "high_dosage" "1.5 g" 3 "iv" "" "1.5 g x 3 iv" 11
|
||||
"CXM" "Cefuroxime" "standard_dosage" "0.75 g" 3 "iv" "" "0.75 g x 3 iv" 11
|
||||
"CXM" "Cefuroxime" "high_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2 oral" 11
|
||||
"CXM" "Cefuroxime" "standard_dosage" "0.25 g" 2 "oral" "" "0.25 g x 2 oral" 11
|
||||
"CXM" "Cefuroxime" "uncomplicated_uti" "0.25 g" 2 "oral" "" "0.25 g x 2 oral" 11
|
||||
"LEX" "Cephalexin" "standard_dosage" "0.25-1 g" 2 "oral" "" "0.25-1 g x 2-3 oral" 11
|
||||
"LEX" "Cephalexin" "uncomplicated_uti" "0.25-1 g" 2 "oral" "" "0.25-1 g x 2-3 oral" 11
|
||||
"CHL" "Chloramphenicol" "high_dosage" "2 g" 4 "iv" "" "2 g x 4 iv" 11
|
||||
"CHL" "Chloramphenicol" "standard_dosage" "1 g" 4 "iv" "" "1 g x 4 iv" 11
|
||||
"CHL" "Chloramphenicol" "high_dosage" "2 g" 4 "oral" "" "2 g x 4 oral" 11
|
||||
"CHL" "Chloramphenicol" "standard_dosage" "1 g" 4 "oral" "" "1 g x 4 oral" 11
|
||||
"CIP" "Ciprofloxacin" "high_dosage" "0.4 g" 3 "iv" "" "0.4 g x 3 iv" 11
|
||||
"CIP" "Ciprofloxacin" "standard_dosage" "0.4 g" 2 "iv" "" "0.4 g x 2 iv" 11
|
||||
"CIP" "Ciprofloxacin" "high_dosage" "0.75 g" 2 "oral" "" "0.75 g x 2 oral" 11
|
||||
"CIP" "Ciprofloxacin" "standard_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2 oral" 11
|
||||
"CLR" "Clarithromycin" "high_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2 oral" 11
|
||||
"CLR" "Clarithromycin" "standard_dosage" "0.25 g" 2 "oral" "" "0.25 g x 2 oral" 11
|
||||
"CLI" "Clindamycin" "high_dosage" "0.9 g" 3 "iv" "" "0.9 g x 3 iv" 11
|
||||
"CLI" "Clindamycin" "standard_dosage" "0.6 g" 3 "iv" "" "0.6 g x 3 iv" 11
|
||||
"CLI" "Clindamycin" "high_dosage" "0.3 g" 4 "oral" "" "0.3 g x 4 oral" 11
|
||||
"CLI" "Clindamycin" "standard_dosage" "0.3 g" 2 "oral" "" "0.3 g x 2 oral" 11
|
||||
"CLO" "Cloxacillin" "high_dosage" "2 g" 6 "iv" "" "2 g x 6 iv" 11
|
||||
"CLO" "Cloxacillin" "standard_dosage" "1 g" 4 "iv" "" "1 g x 4 iv" 11
|
||||
"CLO" "Cloxacillin" "high_dosage" "1 g" 4 "oral" "" "1 g x 4 oral" 11
|
||||
"CLO" "Cloxacillin" "standard_dosage" "0.5 g" 4 "oral" "" "0.5 g x 4 oral" 11
|
||||
"COL" "Colistin" "standard_dosage" "4.5 MU" 2 "iv" "loading dose of 9 MU" "4.5 MU x 2 iv with a loading dose of 9 MU" 11
|
||||
"DAL" "Dalbavancin" "standard_dosage" "1 g" 1 "iv" "over 30 minutes on day 8" "1 g x 1 iv over 30 minutes on day 1 If needed, 0.5 g x 1 iv over 30 minutes on day 8" 11
|
||||
"DAP" "Daptomycin" "standard_dosage" "4 mg/kg" 1 "iv" "" "4 mg/kg x 1 iv" 11
|
||||
"DAP" "Daptomycin" "standard_dosage" "6 mg/kg" 1 "iv" "" "6 mg/kg x 1 iv" 11
|
||||
"DFX" "Delafloxacin" "standard_dosage" "0.3 g" 2 "iv" "" "0.3 g x 2 iv" 11
|
||||
"DFX" "Delafloxacin" "standard_dosage" "0.45 g" 2 "oral" "" "0.45 g x 2 oral" 11
|
||||
"DIC" "Dicloxacillin" "high_dosage" "2 g" 6 "iv" "" "2 g x 6 iv" 11
|
||||
"DIC" "Dicloxacillin" "standard_dosage" "1 g" 4 "iv" "" "1 g x 4 iv" 11
|
||||
"DIC" "Dicloxacillin" "high_dosage" "2 g" 4 "oral" "" "2 g x 4 oral" 11
|
||||
"DIC" "Dicloxacillin" "standard_dosage" "0.5-1 g" 4 "oral" "" "0.5-1 g x 4 oral" 11
|
||||
"DOR" "Doripenem" "high_dosage" "1 g" 3 "iv" "over 1 hour" "1 g x 3 iv over 1 hour" 11
|
||||
"DOR" "Doripenem" "standard_dosage" "0.5 g" 3 "iv" "over 1 hour" "0.5 g x 3 iv over 1 hour" 11
|
||||
"DOX" "Doxycycline" "high_dosage" "0.2 g" 1 "oral" "" "0.2 g x 1 oral" 11
|
||||
"DOX" "Doxycycline" "standard_dosage" "0.1 g" 1 "oral" "" "0.1 g x 1 oral" 11
|
||||
"ERV" "Eravacycline" "standard_dosage" "1 mg/kg" 2 "iv" "" "1 mg/kg x 2 iv" 11
|
||||
"ETP" "Ertapenem" "standard_dosage" "1 g" 1 "iv" "over 30 minutes" "1 g x 1 iv over 30 minutes" 11
|
||||
"ERY" "Erythromycin" "high_dosage" "1 g" 4 "iv" "" "1 g x 4 iv" 11
|
||||
"ERY" "Erythromycin" "standard_dosage" "0.5 g" 2 "iv" "" "0.5 g x 2-4 iv" 11
|
||||
"ERY" "Erythromycin" "high_dosage" "1 g" 4 "oral" "" "1 g x 4 oral" 11
|
||||
"ERY" "Erythromycin" "standard_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2-4 oral" 11
|
||||
"FDX" "Fidaxomicin" "standard_dosage" "0.2 g" 2 "oral" "" "0.2 g x 2 oral" 11
|
||||
"FLC" "Flucloxacillin" "high_dosage" "2 g" 6 "iv" "" "2 g x 6 iv" 11
|
||||
"FLC" "Flucloxacillin" "standard_dosage" "2 g" 4 "iv" "" "2 g x 4 iv (or 1 g x 6 iv)" 11
|
||||
"FLC" "Flucloxacillin" "high_dosage" "1 g" 4 "oral" "" "1 g x 4 oral" 11
|
||||
"FLC" "Flucloxacillin" "standard_dosage" "1 g" 3 "oral" "" "1 g x 3 oral" 11
|
||||
"FOS" "Fosfomycin" "high_dosage" "8 g" 3 "iv" "" "8 g x 3 iv" 11
|
||||
"FOS" "Fosfomycin" "standard_dosage" "4 g" 3 "iv" "" "4 g x 3 iv" 11
|
||||
"FUS" "Fusidic acid" "high_dosage" "0.5 g" 3 "iv" "" "0.5 g x 3 iv" 11
|
||||
"FUS" "Fusidic acid" "standard_dosage" "0.5 g" 2 "iv" "" "0.5 g x 2 iv" 11
|
||||
"FUS" "Fusidic acid" "high_dosage" "0.5 g" 3 "oral" "" "0.5 g x 3 oral" 11
|
||||
"FUS" "Fusidic acid" "standard_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2 oral" 11
|
||||
"GEN" "Gentamicin" "standard_dosage" "6-7 mg/kg" 1 "iv" "" "6-7 mg/kg x 1 iv" 11
|
||||
"IPM" "Imipenem" "high_dosage" "1 g" 4 "iv" "over 30 minutes" "1 g x 4 iv over 30 minutes" 11
|
||||
"IPM" "Imipenem" "standard_dosage" "0.5 g" 4 "iv" "over 30 minutes" "0.5 g x 4 iv over 30 minutes" 11
|
||||
"IMR" "Imipenem/relebactam" "standard_dosage" "0.5 g + 0.25 g" 4 "iv" "over 30 minutes" "(0.5 g imipenem + 0.25 g relebactam) x 4 iv over 30 minutes" 11
|
||||
"IMR" "Imipenem/relebactam" "standard_dosage" "0.5 g + 0.25 g" 4 "iv" "over 30 minutes" "(0.5 g imipenem + 0.25 g relebactam) x 4 iv over 30 minutes" 11
|
||||
"LMU" "Lefamulin" "standard_dosage" "0.15 g" 2 "iv" "or 0.6 g x 2 oral" "0.15 g x 2 iv or 0.6 g x 2 oral" 11
|
||||
"LMU" "Lefamulin" "standard_dosage" "0.6 g" 2 "oral" "" "0.6 g x 2 oral" 11
|
||||
"LVX" "Levofloxacin" "high_dosage" "0.5 g" 2 "iv" "" "0.5 g x 2 iv" 11
|
||||
"LVX" "Levofloxacin" "standard_dosage" "0.5 g" 1 "iv" "" "0.5 g x 1 iv" 11
|
||||
"LVX" "Levofloxacin" "high_dosage" "0.5 g" 2 "oral" "" "0.5 g x 2 oral" 11
|
||||
"LVX" "Levofloxacin" "standard_dosage" "0.5 g" 1 "oral" "" "0.5 g x 1 oral" 11
|
||||
"LNZ" "Linezolid" "standard_dosage" "0.6 g" 2 "iv" "" "0.6 g x 2 iv" 11
|
||||
"LNZ" "Linezolid" "standard_dosage" "0.6 g" 2 "oral" "" "0.6 g x 2 oral" 11
|
||||
"MEM" "Meropenem" "high_dosage" "2 g" 3 "iv" "over 3 hours" "2 g x 3 iv over 3 hours" 11
|
||||
"MEM" "Meropenem" "standard_dosage" "1 g" 3 "iv" "over 30 minutes" "1 g x 3 iv over 30 minutes" 11
|
||||
"MEV" "Meropenem/vaborbactam" "standard_dosage" "2 g + 2 g" 3 "iv" "over 3 hours" "(2 g meropenem + 2 g vaborbactam) x 3 iv over 3 hours" 11
|
||||
"MTR" "Metronidazole" "high_dosage" "0.5 g" 3 "iv" "" "0.5 g x 3 iv" 11
|
||||
"MTR" "Metronidazole" "standard_dosage" "0.4 g" 3 "iv" "" "0.4 g x 3 iv" 11
|
||||
"MTR" "Metronidazole" "high_dosage" "0.5 g" 3 "oral" "" "0.5 g x 3 oral" 11
|
||||
"MTR" "Metronidazole" "standard_dosage" "0.4 g" 3 "oral" "" "0.4 g x 3 oral" 11
|
||||
"MNO" "Minocycline" "standard_dosage" "0.1 g" 2 "oral" "" "0.1 g x 2 oral" 11
|
||||
"MFX" "Moxifloxacin" "standard_dosage" "0.4 g" 1 "iv" "" "0.4 g x 1 iv" 11
|
||||
"MFX" "Moxifloxacin" "standard_dosage" "0.4 g" 1 "oral" "" "0.4 g x 1 oral" 11
|
||||
"OFX" "Ofloxacin" "high_dosage" "0.4 g" 2 "iv" "" "0.4 g x 2 iv" 11
|
||||
"OFX" "Ofloxacin" "standard_dosage" "0.2 g" 2 "iv" "" "0.2 g x 2 iv" 11
|
||||
"OFX" "Ofloxacin" "high_dosage" "0.4 g" 2 "oral" "" "0.4 g x 2 oral" 11
|
||||
"OFX" "Ofloxacin" "standard_dosage" "0.2 g" 2 "oral" "" "0.2 g x 2 oral" 11
|
||||
"ORI" "Oritavancin" "standard_dosage" "1.2 g" 1 "iv" "" "1.2 g x 1 (single dose) iv over 3 hours" 11
|
||||
"OXA" "Oxacillin" "high_dosage" "1 g" 6 "iv" "" "1 g x 6 iv" 11
|
||||
"OXA" "Oxacillin" "standard_dosage" "1 g" 4 "iv" "" "1 g x 4 iv" 11
|
||||
"PHN" "Phenoxymethylpenicillin" "standard_dosage" "0.5-2 g" 3 "oral" "" "0.5-2 g x 3-4 oral" 11
|
||||
"PIP" "Piperacillin" "high_dosage" "4 g" 4 "iv" "" "4 g x 4 iv by extended 3-hour infusion" 11
|
||||
"PIP" "Piperacillin" "standard_dosage" "4 g" 4 "iv" "" "4 g x 4 iv" 11
|
||||
"TZP" "Piperacillin/tazobactam" "high_dosage" "4 g + 0.5 g" 4 "iv" "" "(4 g piperacillin + 0.5 g tazobactam) x 4 iv by extended 3-hour infusion" 11
|
||||
"TZP" "Piperacillin/tazobactam" "standard_dosage" "4 g + 0.5 g" 4 "iv" "" "(4 g piperacillin + 0.5 g tazobactam) x 4 iv or x 3 by extended 4-hour infusion" 11
|
||||
"QDA" "Quinupristin/dalfopristin" "high_dosage" "7.5 mg/kg" 3 "iv" "" "7.5 mg/kg x 3 iv" 11
|
||||
"QDA" "Quinupristin/dalfopristin" "standard_dosage" "7.5 mg/kg" 2 "iv" "" "7.5 mg/kg x 2 iv" 11
|
||||
"RIF" "Rifampicin" "high_dosage" "0.6 g" 2 "iv" "" "0.6 g x 2 iv" 11
|
||||
"RIF" "Rifampicin" "standard_dosage" "0.6 g" 1 "iv" "" "0.6 g x 1 iv" 11
|
||||
"RIF" "Rifampicin" "high_dosage" "0.6 g" 2 "oral" "" "0.6 g x 2 oral" 11
|
||||
"RIF" "Rifampicin" "standard_dosage" "0.6 g" 1 "oral" "" "0.6 g x 1 oral" 11
|
||||
"RXT" "Roxithromycin" "standard_dosage" "0.15 g" 2 "oral" "" "0.15 g x 2 oral" 11
|
||||
"SPT" "Spectinomycin" "standard_dosage" "2 g" 1 "im" "" "2 g x 1 im" 11
|
||||
"TZD" "Tedizolid" "standard_dosage" "0.2 g" 1 "iv" "" "0.2 g x 1 iv" 11
|
||||
"TZD" "Tedizolid" "standard_dosage" "0.2 g" 1 "oral" "" "0.2 g x 1 oral" 11
|
||||
"TEC" "Teicoplanin" "high_dosage" "0.8 g" 1 "iv" "" "0.8 g x 1 iv" 11
|
||||
"TEC" "Teicoplanin" "standard_dosage" "0.4 g" 1 "iv" "" "0.4 g x 1 iv" 11
|
||||
"TLV" "Telavancin" "standard_dosage" "10 mg/kg" 1 "iv" "over 1 hour" "10 mg/kg x 1 iv over 1 hour" 11
|
||||
"TLT" "Telithromycin" "standard_dosage" "0.8 g" 1 "oral" "" "0.8 g x 1 oral" 11
|
||||
"TEM" "Temocillin" "high_dosage" "2 g" 3 "iv" "" "2 g x 3 iv" 11
|
||||
"TEM" "Temocillin" "standard_dosage" "2 g" 2 "iv" "" "2 g x 2 iv" 11
|
||||
"TCY" "Tetracycline" "high_dosage" "0.5 g" 4 "oral" "" "0.5 g x 4 oral" 11
|
||||
"TCY" "Tetracycline" "standard_dosage" "0.25 g" 4 "oral" "" "0.25 g x 4 oral" 11
|
||||
"TIC" "Ticarcillin" "high_dosage" "3 g" 6 "iv" "" "3 g x 6 iv" 11
|
||||
"TIC" "Ticarcillin" "standard_dosage" "3 g" 4 "iv" "" "3 g x 4 iv" 11
|
||||
"TCC" "Ticarcillin/clavulanic acid" "high_dosage" "3 g + 0.1 g" 6 "iv" "" "(3 g ticarcillin + 0.1 g clavulanic acid) x 6 iv" 11
|
||||
"TCC" "Ticarcillin/clavulanic acid" "standard_dosage" "3 g + 0.1-0.2 g" 4 "iv" "" "(3 g ticarcillin + 0.1-0.2 g clavulanic acid) x 4 iv" 11
|
||||
"TGC" "Tigecycline" "standard_dosage" "0.1 g" "loading dose followed by 50 mg x 2 iv" "0.1 g loading dose followed by 50 mg x 2 iv" 11
|
||||
"TOB" "Tobramycin" "standard_dosage" "6-7 mg/kg" 1 "iv" "" "6-7 mg/kg x 1 iv" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "high_dosage" "0.24 g + 1.2 g" 2 "oral" "" "(0.24 g trimethoprim + 1.2 g sulfamethoxazole) x 2 oral" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "high_dosage" "0.24 g + 1.2 g" 2 "oral" "" "(0.24 g trimethoprim + 1.2 g sulfamethoxazole) x 2 oral or (0.24 g trimethoprim + 1.2 g sulfamethoxazole) x 2 iv" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "standard_dosage" "0.16 g + 0.8 g" 2 "oral" "" "(0.16 g trimethoprim + 0.8 g sulfamethoxazole) x 2 oral" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "standard_dosage" "0.16 g + 0.8 g" 2 "oral" "" "(0.16 g trimethoprim + 0.8 g sulfamethoxazole) x 2 oral or (0.16 g trimethoprim + 0.8 g sulfamethoxazole) x 2 iv" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "uncomplicated_uti" "0.16 g + 0.8 g" 2 "oral" "" "(0.16 g trimethoprim + 0.8 g sulfamethoxazole) x 2 oral" 11
|
||||
"SXT" "Trimethoprim/sulfamethoxazole" "uncomplicated_uti" "0.16 g + 0.8 g" 2 "oral" "" "(0.16 g trimethoprim + 0.8 g sulfamethoxazole) x 2 oral" 11
|
||||
"VAN" "Vancomycin" "standard_dosage" "1 g" 2 "iv" "" "1 g x 2 iv or 2 g x 1 by continuous infusion" 11
|
||||
Binary file not shown.
+149
-37
@@ -1,7 +1,7 @@
|
||||
# -------------------------------------------------------------------------------------------------------------------------------
|
||||
# For editing this EUCAST reference file, these values can all be used for targeting antibiotics:
|
||||
# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_3rd', 'cephalosporins_except_CAZ',
|
||||
# 'fluoroquinolones', 'glycopeptides', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'ureidopenicillins',
|
||||
# 'betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_3rd', 'cephalosporins_except_CAZ',
|
||||
# 'fluoroquinolones', 'glycopeptides', 'glycopeptides_except_lipo', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'tetracyclines_except_TGC', 'ureidopenicillins',
|
||||
# and all separate EARS-Net letter codes like 'AMC'. They can be separated by comma: 'AMC, fluoroquinolones'.
|
||||
# The 'if_mo_property' column can be any column name from the AMR::microorganisms data set, or "genus_species" or "gramstain".
|
||||
# The like.is.one_of column must be 'like' or 'is' or 'one_of' ('like' will read the 'this_value' column as regular expression)
|
||||
@@ -14,7 +14,7 @@ order is Enterobacterales AMP I AMX I Enterobacterales (Order) Breakpoints 10
|
||||
order is Enterobacterales AMP R AMX R Enterobacterales (Order) Breakpoints 10
|
||||
genus is Staphylococcus PEN, FOX S AMP, AMX, PIP, TIC S Staphylococcus Breakpoints 10
|
||||
genus is Staphylococcus PEN, FOX R, S OXA, FLC S Staphylococcus Breakpoints 10
|
||||
genus is Staphylococcus FOX R all_betalactams R Staphylococcus Breakpoints 10
|
||||
genus is Staphylococcus FOX R betalactams R Staphylococcus Breakpoints 10
|
||||
genus_species is Staphylococcus saprophyticus AMP S AMX, AMC, PIP, TZP S Staphylococcus Breakpoints 10
|
||||
genus is Staphylococcus FOX S carbapenems, cephalosporins_except_CAZ S Staphylococcus Breakpoints 10
|
||||
genus is Staphylococcus FOX I carbapenems, cephalosporins_except_CAZ I Staphylococcus Breakpoints 10
|
||||
@@ -115,7 +115,116 @@ genus_species is Kingella kingae TCY R DOX R Kingella kingae Breakpoints 10
|
||||
genus_species is Burkholderia pseudomallei TCY S DOX S Burkholderia pseudomallei Breakpoints 10
|
||||
genus_species is Burkholderia pseudomallei TCY I DOX I Burkholderia pseudomallei Breakpoints 10
|
||||
genus_species is Burkholderia pseudomallei TCY R DOX R Burkholderia pseudomallei Breakpoints 10
|
||||
order is Enterobacterales PEN, glycopeptides, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
order is Enterobacterales AMP S AMX S Enterobacterales (Order) Breakpoints 11
|
||||
order is Enterobacterales AMP I AMX I Enterobacterales (Order) Breakpoints 11
|
||||
order is Enterobacterales AMP R AMX R Enterobacterales (Order) Breakpoints 11
|
||||
genus is Staphylococcus PEN, FOX S AMP, AMX, PIP, TIC S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus PEN, FOX R, S OXA, FLC S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus FOX R betalactams R Staphylococcus Breakpoints 11
|
||||
genus_species is Staphylococcus saprophyticus AMP S AMX, AMC, PIP, TZP S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus FOX S carbapenems, cephalosporins_except_CAZ S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus FOX I carbapenems, cephalosporins_except_CAZ I Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus FOX R carbapenems, cephalosporins_except_CAZ R Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus NOR S CIP, LVX, MFX, OFX S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus ERY S AZM, CLR, RXT S Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus ERY I AZM, CLR, RXT I Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus ERY R AZM, CLR, RXT R Staphylococcus Breakpoints 11
|
||||
genus is Staphylococcus TCY S DOX, MNO S Staphylococcus Breakpoints 11
|
||||
genus is Enterococcus AMP S AMX, AMC, PIP, TZP S Enterococcus Breakpoints 11
|
||||
genus is Enterococcus AMP I AMX, AMC, PIP, TZP I Enterococcus Breakpoints 11
|
||||
genus is Enterococcus AMP R AMX, AMC, PIP, TZP R Enterococcus Breakpoints 11
|
||||
genus is Enterococcus NOR S CIP, LVX S Enterococcus Breakpoints 11
|
||||
genus is Enterococcus NOR I CIP, LVX I Enterococcus Breakpoints 11
|
||||
genus is Enterococcus NOR R CIP, LVX R Enterococcus Breakpoints 11
|
||||
genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN S aminopenicillins, ureidopenicillins, cephalosporins_except_CAZ, carbapenems, FLC, AMC S Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN I aminopenicillins, ureidopenicillins, cephalosporins_except_CAZ, carbapenems, FLC, AMC I Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN R aminopenicillins, ureidopenicillins, cephalosporins_except_CAZ, carbapenems, FLC, AMC R Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G NOR S MFX S Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G NOR S LVX I Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G ERY S AZM, CLR, RXT S Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G ERY I AZM, CLR, RXT I Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G ERY R AZM, CLR, RXT R Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species like Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G TCY S DOX, MNO S Streptococcus groups A, B, C, G Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae PEN S AMP, AMX, AMC, PIP, TZP S Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae AMP S AMX, AMC, PIP, TZP S Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae AMP I AMX, AMC, PIP, TZP I Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae AMP R AMX, AMC, PIP, TZP R Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae NOR S MFX S Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae NOR S LVX I Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae ERY S AZM, CLR, RXT S Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae ERY I AZM, CLR, RXT I Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae ERY R AZM, CLR, RXT R Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species is Streptococcus pneumoniae TCY S DOX, MNO S Streptococcus pneumoniae Breakpoints 11
|
||||
genus_species like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ PEN S AMP, AMX, AMC, PIP, TZP S Viridans group streptococci Breakpoints 11
|
||||
genus_species like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ AMP S AMX, AMC, PIP, TZP S Viridans group streptococci Breakpoints 11
|
||||
genus_species like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ AMP I AMX, AMC, PIP, TZP I Viridans group streptococci Breakpoints 11
|
||||
genus_species like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ AMP R AMX, AMC, PIP, TZP R Viridans group streptococci Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMP S AMX, PIP S Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMP I AMX, PIP I Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMP R AMX, PIP R Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae PEN S AMP, AMX, AMC, PIP, TZP S Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMC S TZP S Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMC I TZP I Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae AMC R TZP R Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae NAL S CIP, LVX, MFX, OFX S Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Haemophilus influenzae TCY S DOX, MNO S Haemophilus influenzae Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis AMC S TZP S Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis AMC I TZP I Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis AMC R TZP R Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis NAL S CIP, LVX, MFX, OFX S Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis ERY S AZM, CLR, RXT S Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis ERY I AZM, CLR, RXT I Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis ERY R AZM, CLR, RXT R Moraxella catarrhalis Breakpoints 11
|
||||
genus_species is Moraxella catarrhalis TCY S DOX, MNO S Moraxella catarrhalis Breakpoints 11
|
||||
genus one_of Actinomyces, Bifidobacterium, Clostridium, Cutibacterium, Eggerthella, Eubacterium, Lactobacillus, Propionibacterium PEN S AMP, AMX, PIP, TZP, TIC S Anaerobic Gram-positives Breakpoints 11
|
||||
genus one_of Actinomyces, Bifidobacterium, Clostridium, Cutibacterium, Eggerthella, Eubacterium, Lactobacillus, Propionibacterium PEN I AMP, AMX, PIP, TZP, TIC I Anaerobic Gram-positives Breakpoints 11
|
||||
genus one_of Actinomyces, Bifidobacterium, Clostridium, Cutibacterium, Eggerthella, Eubacterium, Lactobacillus, Propionibacterium PEN R AMP, AMX, PIP, TZP, TIC R Anaerobic Gram-positives Breakpoints 11
|
||||
genus one_of Bacteroides, Bilophila , Fusobacterium, Mobiluncus, Porphyromonas, Prevotella PEN S AMP, AMX, PIP, TZP, TIC S Anaerobic Gram-negatives Breakpoints 11
|
||||
genus one_of Bacteroides, Bilophila , Fusobacterium, Mobiluncus, Porphyromonas, Prevotella PEN I AMP, AMX, PIP, TZP, TIC I Anaerobic Gram-negatives Breakpoints 11
|
||||
genus one_of Bacteroides, Bilophila , Fusobacterium, Mobiluncus, Porphyromonas, Prevotella PEN R AMP, AMX, PIP, TZP, TIC R Anaerobic Gram-negatives Breakpoints 11
|
||||
genus_species is Pasteurella multocida PEN S AMP, AMX S Pasteurella multocida Breakpoints 11
|
||||
genus_species is Pasteurella multocida PEN I AMP, AMX I Pasteurella multocida Breakpoints 11
|
||||
genus_species is Pasteurella multocida PEN R AMP, AMX R Pasteurella multocida Breakpoints 11
|
||||
genus_species is Campylobacter coli ERY S AZM, CLR S Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter coli ERY I AZM, CLR I Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter coli ERY R AZM, CLR R Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter coli TCY S DOX S Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter coli TCY I DOX I Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter coli TCY R DOX R Campylobacter coli Breakpoints 11
|
||||
genus_species is Campylobacter jejuni ERY S AZM, CLR S Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Campylobacter jejuni ERY I AZM, CLR I Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Campylobacter jejuni ERY R AZM, CLR R Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Campylobacter jejuni TCY S DOX S Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Campylobacter jejuni TCY I DOX I Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Campylobacter jejuni TCY R DOX R Campylobacter jejuni Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola NOR S fluoroquinolones S Aerococcus sanguinicola Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola NOR I fluoroquinolones I Aerococcus sanguinicola Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola NOR R fluoroquinolones R Aerococcus sanguinicola Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola CIP S LVX S Aerococcus sanguinicola Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola CIP I LVX I Aerococcus sanguinicola Breakpoints 11
|
||||
genus_species is Aerococcus sanguinicola CIP R LVX R Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae NOR S fluoroquinolones S Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae NOR I fluoroquinolones I Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae NOR R fluoroquinolones R Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae CIP S LVX S Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae CIP I LVX I Aerococcus urinae Breakpoints 11
|
||||
genus_species is Aerococcus urinae CIP R LVX R Aerococcus urinae Breakpoints 11
|
||||
genus_species is Kingella kingae PEN S AMP, AMX S Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae PEN I AMP, AMX I Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae PEN R AMP, AMX R Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae ERY S AZM, CLR S Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae ERY I AZM, CLR I Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae ERY R AZM, CLR R Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae TCY S DOX S Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae TCY I DOX I Kingella kingae Breakpoints 11
|
||||
genus_species is Kingella kingae TCY R DOX R Kingella kingae Breakpoints 11
|
||||
genus_species is Burkholderia pseudomallei TCY S DOX S Burkholderia pseudomallei Breakpoints 11
|
||||
genus_species is Burkholderia pseudomallei TCY I DOX I Burkholderia pseudomallei Breakpoints 11
|
||||
genus_species is Burkholderia pseudomallei TCY R DOX R Burkholderia pseudomallei Breakpoints 11
|
||||
genus is Bacillus NOR S fluoroquinolones S Bacillus Breakpoints 11 added in 11
|
||||
genus is Bacillus NOR I fluoroquinolones I Bacillus Breakpoints 11 added in 11
|
||||
genus is Bacillus NOR R fluoroquinolones R Bacillus Breakpoints 11 added in 11
|
||||
order is Enterobacterales PEN, glycopeptides_except_lipo, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
fullname like ^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium) aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
fullname like ^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae) aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Enterobacter cloacae aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
@@ -123,17 +232,17 @@ genus_species is Klebsiella aerogenes aminopenicillins, AMC, CZO, FOX R Table
|
||||
genus_species is Escherichia hermannii aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Hafnia alvei aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus is Klebsiella aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Morganella morganii aminopenicillins, AMC, CZO, tetracyclines, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus mirabilis tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus penneri aminopenicillins, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus vulgaris aminopenicillins, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Providencia rettgeri aminopenicillins, AMC, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Providencia stuartii aminopenicillins, AMC, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Morganella morganii aminopenicillins, AMC, CZO, DOX, MNO, TCY, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus mirabilis DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus penneri aminopenicillins, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Proteus vulgaris aminopenicillins, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Providencia rettgeri aminopenicillins, AMC, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Providencia stuartii aminopenicillins, AMC, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus is Raoultella aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Serratia marcescens aminopenicillins, AMC, CZO, FOX, CXM, DOX, TCY, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Yersinia enterocolitica aminopenicillins, AMC, TIC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus_species is Yersinia pseudotuberculosis PLB, COL R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1
|
||||
genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, FOX, CXM, glycopeptides, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, FOX, CXM, glycopeptides_except_lipo, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Acinetobacter baumannii aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Acinetobacter pittii aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Acinetobacter nosocomialis aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
@@ -141,10 +250,10 @@ genus_species is Acinetobacter calcoaceticus aminopenicillins, AMC, CZO, CTX,
|
||||
genus_species is Achromobacter xylosoxidans aminopenicillins, CZO, CTX, CRO, ETP R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, TIC, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Ochrobactrum anthropi aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, CZO, CTX, CRO, ETP, CHL, KAN, NEO, TMP, SXT, tetracyclines, TGC R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Brucella anthropi aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, CZO, CTX, CRO, ETP, CHL, KAN, NEO, TMP, SXT, DOX, MNO, TCY, TGC R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1
|
||||
genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides, LIN, DAP, LNZ R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1
|
||||
genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides_except_lipo, LIN, DAP, LNZ R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Haemophilus influenzae FUS, streptogramins R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1
|
||||
genus_species is Moraxella catarrhalis TMP R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1
|
||||
genus is Neisseria TMP R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1
|
||||
@@ -170,8 +279,8 @@ genus_species is Enterococcus casseliflavus FUS, CAZ, cephalosporins_except_CA
|
||||
genus_species is Enterococcus faecium FUS, CAZ, cephalosporins_except_CAZ, aminoglycosides, macrolides, TMP, SXT R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus is Corynebacterium FOS R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus_species is Listeria monocytogenes cephalosporins R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus one_of Leuconostoc, Pediococcus glycopeptides R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus is Lactobacillus glycopeptides R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus one_of Leuconostoc, Pediococcus glycopeptides_except_lipo R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus is Lactobacillus glycopeptides_except_lipo R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus_species is Clostridium ramosum VAN R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus_species is Clostridium innocuum VAN R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1
|
||||
genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN S aminopenicillins, cephalosporins_except_CAZ, carbapenems S Table 08: Interpretive rules for B-lactam agents and Gram-positive cocci Expert Rules 3.1
|
||||
@@ -189,7 +298,7 @@ genus is Staphylococcus MFX R fluoroquinolones R Table 13: Interpretive rules fo
|
||||
genus_species is Streptococcus pneumoniae MFX R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1
|
||||
order is Enterobacterales CIP R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1
|
||||
genus_species is Neisseria gonorrhoeae CIP R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1
|
||||
order is Enterobacterales PEN, glycopeptides, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
order is Enterobacterales PEN, glycopeptides_except_lipo, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
fullname like ^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium) aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
fullname like ^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae) aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Enterobacter cloacae aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
@@ -199,13 +308,13 @@ genus_species is Klebsiella aerogenes aminopenicillins, AMC, SAM, CZO, CEP, LE
|
||||
genus_species is Klebsiella oxytoca aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
fullname like ^Klebsiella( pneumoniae| quasipneumoniae| variicola)? aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Leclercia adecarboxylata FOS R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Morganella morganii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Morganella morganii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Plesiomonas shigelloides aminopenicillins, AMC, SAM R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus mirabilis tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus penneri aminopenicillins, CZO, CEP, LEX, CFR, CXM, tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus vulgaris aminopenicillins, CZO, CEP, LEX, CFR, CXM, tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Providencia rettgeri aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Providencia stuartii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus mirabilis DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus penneri aminopenicillins, CZO, CEP, LEX, CFR, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Proteus vulgaris aminopenicillins, CZO, CEP, LEX, CFR, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Providencia rettgeri aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Providencia stuartii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus is Raoultella aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Serratia marcescens aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX, CXM, DOX, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Yersinia enterocolitica aminopenicillins, AMC, SAM, TIC, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
@@ -215,20 +324,20 @@ genus_species is Aeromonas veronii aminopenicillins, AMC, SAM, FOX R Table 1:
|
||||
genus_species is Aeromonas dhakensis aminopenicillins, AMC, SAM, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Aeromonas caviae aminopenicillins, AMC, SAM, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus_species is Aeromonas jandaei aminopenicillins, AMC, SAM, TIC, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2
|
||||
genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, cephalosporins_1st, cephalosporins_2nd, glycopeptides, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2
|
||||
genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, cephalosporins_1st, cephalosporins_2nd, glycopeptides_except_lipo, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2
|
||||
fullname like ^Acinetobacter (baumannii|pittii|nosocomialis) aminopenicillins, AMC, CRO, CTX, ATM, ETP, TMP, FOS, DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus is Acinetobacter DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Achromobacter xylosoxidans aminopenicillins, CRO, CTX, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CRO, CTX, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, SAM, TIC, TCC, PIP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Ochrobactrum anthropi aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, KAN, NEO, TMP, tetracyclines, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Brucella anthropi aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, KAN, NEO, TMP, DOX, MNO, TCY, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, SAM, TIC, PIP, TZP, CRO, CTX, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…)
|
||||
genus_species is Haemophilus influenzae FUS, streptogramins, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus_species is Moraxella catarrhalis TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus is Neisseria TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae FUS, streptogramins, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus_species is Moraxella catarrhalis TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus is Neisseria TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2
|
||||
gramstain is Gram-positive ATM, TEM, polymyxins, NAL R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2
|
||||
genus_species is Staphylococcus saprophyticus FUS, CAZ, FOS, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2
|
||||
genus_species is Staphylococcus cohnii CAZ, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2
|
||||
@@ -263,8 +372,8 @@ fullname like ^(Serratia|Providencia|Morganella morganii) TGC R Expert Rules o
|
||||
genus is Salmonella cephalosporins_2nd R Expert Rules on Salmonella Expert Rules 3.2
|
||||
genus is Salmonella aminoglycosides R Expert Rules on Salmonella Expert Rules 3.2
|
||||
genus is Salmonella PEF R CIP R Expert Rules on Salmonella Expert Rules 3.2
|
||||
genus_species is Staphylococcus aureus FOX1 R all_betalactams R Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
genus_species is Staphylococcus aureus FOX1 S all_betalactams S Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
genus_species is Staphylococcus aureus FOX1 R betalactams R Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
genus_species is Staphylococcus aureus FOX1 S betalactams S Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
genus_species one_of Staphylococcus aureus, Staphylococcus lugdunensis PEN R AMP, AMX, AZL, BAM, CRB, CRN, EPC, HET, MEC, MEZ, MTM, PIP, PME, PVM, SBC, TAL, TEM, TIC R Expert Rules on Staphylococcus Expert Rules 3.2 all penicillins without beta-lactamse inhibitor
|
||||
genus is Staphylococcus ERY, CLI S macrolides, lincosamides S Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
genus is Staphylococcus NOR S CIP, LVX, MFX, OFX S Expert Rules on Staphylococcus Expert Rules 3.2
|
||||
@@ -291,7 +400,7 @@ genus_species is Streptococcus pneumoniae TCY S DOX, MNO S Expert Rules on Strep
|
||||
genus_species is Streptococcus pneumoniae TCY R DOX, MNO R Expert Rules on Streptococcus pneumoniae Expert Rules 3.2
|
||||
genus_species is Streptococcus pneumoniae VAN S lipoglycopeptides S Expert Rules on Streptococcus pneumoniae Expert Rules 3.2
|
||||
fullname like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ PEN S aminopenicillins, CTX, CRO S Expert Rules on Viridans Group Streptococci Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae PEN S all_betalactams S Expert Rules on Haemophilus influenzae Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae PEN S betalactams S Expert Rules on Haemophilus influenzae Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae NAL S fluoroquinolones S Expert Rules on Haemophilus influenzae Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae NAL R CIP, LVX, MFX R Expert Rules on Haemophilus influenzae Expert Rules 3.2
|
||||
genus_species is Haemophilus influenzae TCY S DOX, MNO S Expert Rules on Haemophilus influenzae Expert Rules 3.2
|
||||
@@ -300,6 +409,9 @@ genus_species is Moraxella catarrhalis NAL S fluoroquinolones S Expert Rules on
|
||||
genus_species is Moraxella catarrhalis NAL R fluoroquinolones R Expert Rules on Moraxella catarrhalis Expert Rules 3.2
|
||||
genus is Campylobacter ERY S CLR, AZM S Expert Rules on Campylobacter Expert Rules 3.2
|
||||
genus_species is Campylobacter ERY R CLR, AZM R Expert Rules on Campylobacter Expert Rules 3.2
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CTX S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CRO S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CAZ S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CTX S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CRO S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CAZ S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CTX I CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CRO I CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter braakii|Citrobacter freundii|Citrobacter gillenii|Citrobacter murliniae|Citrobacter rodenticum|Citrobacter sedlakii|Citrobacter werkmanii|Citrobacter youngae|Hafnia alvei|Serratia|Morganella morganii|Providencia) CAZ I CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument
|
||||
|
||||
|
Can't render this file because it contains an unexpected character in line 6 and column 96.
|
@@ -1,163 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# Run this file to update the package using: -------------------------------
|
||||
# source("data-raw/internals.R")
|
||||
# --------------------------------------------------------------------------
|
||||
|
||||
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
eucast_rules_file <- utils::read.delim(file = "data-raw/eucast_rules.tsv",
|
||||
skip = 10,
|
||||
sep = "\t",
|
||||
stringsAsFactors = FALSE,
|
||||
header = TRUE,
|
||||
strip.white = TRUE,
|
||||
na = c(NA, "", NULL)) %>%
|
||||
# take the order of the reference.rule_group column in the original data file
|
||||
mutate(reference.rule_group = factor(reference.rule_group,
|
||||
levels = unique(reference.rule_group),
|
||||
ordered = TRUE),
|
||||
sorting_rule = ifelse(grepl("^Table", reference.rule, ignore.case = TRUE), 1, 2)) %>%
|
||||
arrange(reference.rule_group,
|
||||
reference.version,
|
||||
sorting_rule,
|
||||
reference.rule) %>%
|
||||
mutate(reference.rule_group = as.character(reference.rule_group)) %>%
|
||||
select(-sorting_rule)
|
||||
|
||||
# Translations ----
|
||||
translations_file <- utils::read.delim(file = "data-raw/translations.tsv",
|
||||
sep = "\t",
|
||||
stringsAsFactors = FALSE,
|
||||
header = TRUE,
|
||||
blank.lines.skip = TRUE,
|
||||
fill = TRUE,
|
||||
strip.white = TRUE,
|
||||
encoding = "UTF-8",
|
||||
fileEncoding = "UTF-8",
|
||||
na.strings = c(NA, "", NULL),
|
||||
allowEscapes = TRUE, # else "\\1" will be imported as "\\\\1"
|
||||
quote = "")
|
||||
|
||||
# Old microorganism codes -------------------------------------------------
|
||||
|
||||
microorganisms.translation <- readRDS("data-raw/microorganisms.translation.rds")
|
||||
|
||||
# Export to package as internal data ----
|
||||
usethis::use_data(eucast_rules_file, translations_file, microorganisms.translation,
|
||||
internal = TRUE,
|
||||
overwrite = TRUE,
|
||||
version = 2,
|
||||
compress = "xz")
|
||||
|
||||
# Remove from global environment ----
|
||||
rm(eucast_rules_file)
|
||||
rm(translations_file)
|
||||
rm(microorganisms.translation)
|
||||
|
||||
# Save to raw data to repository ----
|
||||
write_md5 <- function(object) {
|
||||
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
|
||||
writeLines(digest::digest(object, "md5"), conn)
|
||||
close(conn)
|
||||
}
|
||||
changed_md5 <- function(object) {
|
||||
tryCatch({
|
||||
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
|
||||
compared <- digest::digest(object, "md5") != readLines(con = conn)
|
||||
close(conn)
|
||||
compared
|
||||
}, error = function(e) TRUE)
|
||||
}
|
||||
usethis::ui_done(paste0("Saving raw data to {usethis::ui_value('/data-raw/')}"))
|
||||
devtools::load_all(quiet = TRUE)
|
||||
# give official names to ABs and MOs
|
||||
rsi <- dplyr::mutate(rsi_translation, ab = ab_name(ab), mo = mo_name(mo))
|
||||
if (changed_md5(rsi)) {
|
||||
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)
|
||||
try(haven::write_sas(rsi, "data-raw/rsi_translation.sas"), silent = TRUE)
|
||||
try(haven::write_sav(rsi, "data-raw/rsi_translation.sav"), silent = TRUE)
|
||||
try(haven::write_dta(rsi, "data-raw/rsi_translation.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(rsi, "data-raw/rsi_translation.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
mo <- dplyr::mutate_if(microorganisms, ~!is.numeric(.), as.character)
|
||||
if (changed_md5(mo)) {
|
||||
write_md5(mo)
|
||||
try(saveRDS(mo, "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)
|
||||
try(haven::write_sas(mo, "data-raw/microorganisms.sas"), silent = TRUE)
|
||||
try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE)
|
||||
try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
if (changed_md5(microorganisms.old)) {
|
||||
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)
|
||||
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
|
||||
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
|
||||
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
ab <- dplyr::mutate_if(antibiotics, ~!is.numeric(.), as.character)
|
||||
if (changed_md5(ab)) {
|
||||
write_md5(ab)
|
||||
try(saveRDS(ab, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(ab, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_sas(ab, "data-raw/antibiotics.sas"), silent = TRUE)
|
||||
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
|
||||
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(ab, "data-raw/antibiotics.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
av <- dplyr::mutate_if(antivirals, ~!is.numeric(.), as.character)
|
||||
if (changed_md5(av)) {
|
||||
write_md5(av)
|
||||
try(saveRDS(av, "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)
|
||||
try(haven::write_sas(av, "data-raw/antivirals.sas"), silent = TRUE)
|
||||
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
|
||||
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(av, "data-raw/antivirals.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
if (changed_md5(intrinsic_resistant)) {
|
||||
write_md5(intrinsic_resistant)
|
||||
try(saveRDS(intrinsic_resistant, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(intrinsic_resistant, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_sas(intrinsic_resistant, "data-raw/intrinsic_resistant.sas"), silent = TRUE)
|
||||
try(haven::write_sav(intrinsic_resistant, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
|
||||
try(haven::write_dta(intrinsic_resistant, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(intrinsic_resistant, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
|
||||
}
|
||||
|
||||
rm(write_md5)
|
||||
rm(changed_md5)
|
||||
Binary file not shown.
@@ -1 +1 @@
|
||||
b6de75043ef27eabd6fff22f04638225
|
||||
9c58b2d894dbad7593cd44b78d04cd78
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
+4949
-4949
File diff suppressed because it is too large
Load Diff
Binary file not shown.
+2
-2
@@ -1,6 +1,6 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis for R #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
@@ -20,7 +20,7 @@
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# last updated: 20 January 2020 - Loinc_2.67
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1 +1 @@
|
||||
617b59b8ac3bd1aad7847aafc328f0f3
|
||||
8338ff5f079f4519fa3c44f8c5bace64
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
+2407
-1015
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user