mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 17:26:12 +01:00
update dependencies
This commit is contained in:
parent
cee64ef050
commit
07bdd61241
15
DESCRIPTION
15
DESCRIPTION
@ -24,10 +24,17 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR
|
||||
of microbial isolates, by using new S3 classes and applying EUCAST expert rules
|
||||
on antibiograms according to Leclercq (2013)
|
||||
<doi:10.1111/j.1469-0691.2011.03703.x>.
|
||||
Depends: R (>= 3.0)
|
||||
Imports: dplyr (>= 0.7.0), reshape2 (>= 1.4.0), xml2, rvest
|
||||
Suggests: testthat
|
||||
URL: https://cran.r-project.org/package=AMR
|
||||
Depends:
|
||||
R (>= 3.2.0)
|
||||
Imports:
|
||||
dplyr (>= 0.7.0),
|
||||
reshape2 (>= 1.4.0),
|
||||
xml2 (>= 1.0.0),
|
||||
rvest (>= 0.3.2)
|
||||
Suggests:
|
||||
testthat (>= 2.0.0),
|
||||
covr (>= 3.0.1)
|
||||
URL: https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
License: GPL-2 | file LICENSE
|
||||
Encoding: UTF-8
|
||||
|
25
NEWS
25
NEWS
@ -1,14 +1,19 @@
|
||||
## 0.1.2
|
||||
- NEW: Function `guess_bactid` to determine the ID of a microorganism based on genus/species
|
||||
- NEW: Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
|
||||
- NEW: New algorithm to determine weighted isolates, can now be `"points"` or `"keyantibiotics"`, see `?first_isolate`
|
||||
- EDIT: Renamed dataset `ablist` to `antibiotics`
|
||||
- EDIT: Renamed dataset `bactlist` to `microorganisms`
|
||||
- EDIT: Added support for character vector in join functions
|
||||
- EDIT: Altered `%like%` to make it case insensitive
|
||||
- EDIT: Functions `first_isolate`, `EUCAST_rules` and `rsi_predict` supports tidyverse-like evaluation of parameters (no need to quote columns them anymore)
|
||||
- EDIT: For functions `first_isolate`, `EUCAST_rules` the antibiotic column names are case-insensitive
|
||||
- EDIT: Functions `as.rsi` and `as.mic` now add the package name and version as attribute
|
||||
- Added full support for Windows, Linux and macOS; this package now works everywhere :)
|
||||
- New function `guess_bactid` to determine the ID of a microorganism based on genus/species
|
||||
- New functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
|
||||
- New algorithm to determine weighted isolates, can now be `"points"` or `"keyantibiotics"`, see `?first_isolate`
|
||||
- Renamed dataset `ablist` to `antibiotics`
|
||||
- Renamed dataset `bactlist` to `microorganisms`
|
||||
- Added analysis examples on help page of dataset `septic_patients`
|
||||
- Added support for character vector in join functions
|
||||
- Added warnings when applying a join results in more rows after than before the join
|
||||
- Altered `%like%` to make it case insensitive
|
||||
- For parameters of functions `first_isolate`, `EUCAST_rules` the column names are now case-insensitive
|
||||
- Functions `as.rsi` and `as.mic` now add the package name and version as attribute
|
||||
- Expanded README.md
|
||||
- Added unit testing with Travis CI (https://travis-ci.org/msberends/AMR)
|
||||
- Added code coverage checking with Codecov (https://codecov.io/gh/msberends/AMR/tree/master/R)
|
||||
|
||||
## 0.1.1
|
||||
- `EUCAST_rules` applies for amoxicillin even if ampicillin is missing
|
||||
|
60
R/EUCAST.R
60
R/EUCAST.R
@ -115,66 +115,6 @@ EUCAST_rules <- function(tbl,
|
||||
|
||||
EUCAST_VERSION <- "3.1"
|
||||
|
||||
# support using columns as objects; the tidyverse way
|
||||
amcl <- quasiquotate(deparse(substitute(amcl)), amcl)
|
||||
amik <- quasiquotate(deparse(substitute(amik)), amik)
|
||||
amox <- quasiquotate(deparse(substitute(amox)), amox)
|
||||
ampi <- quasiquotate(deparse(substitute(ampi)), ampi)
|
||||
azit <- quasiquotate(deparse(substitute(azit)), azit)
|
||||
aztr <- quasiquotate(deparse(substitute(aztr)), aztr)
|
||||
cefa <- quasiquotate(deparse(substitute(cefa)), cefa)
|
||||
cfra <- quasiquotate(deparse(substitute(cfra)), cfra)
|
||||
cfep <- quasiquotate(deparse(substitute(cfep)), cfep)
|
||||
cfot <- quasiquotate(deparse(substitute(cfot)), cfot)
|
||||
cfox <- quasiquotate(deparse(substitute(cfox)), cfox)
|
||||
cfta <- quasiquotate(deparse(substitute(cfta)), cfta)
|
||||
cftr <- quasiquotate(deparse(substitute(cftr)), cftr)
|
||||
cfur <- quasiquotate(deparse(substitute(cfur)), cfur)
|
||||
chlo <- quasiquotate(deparse(substitute(chlo)), chlo)
|
||||
cipr <- quasiquotate(deparse(substitute(cipr)), cipr)
|
||||
clar <- quasiquotate(deparse(substitute(clar)), clar)
|
||||
clin <- quasiquotate(deparse(substitute(clin)), clin)
|
||||
clox <- quasiquotate(deparse(substitute(clox)), clox)
|
||||
coli <- quasiquotate(deparse(substitute(coli)), coli)
|
||||
czol <- quasiquotate(deparse(substitute(czol)), czol)
|
||||
dapt <- quasiquotate(deparse(substitute(dapt)), dapt)
|
||||
doxy <- quasiquotate(deparse(substitute(doxy)), doxy)
|
||||
erta <- quasiquotate(deparse(substitute(erta)), erta)
|
||||
eryt <- quasiquotate(deparse(substitute(eryt)), eryt)
|
||||
fosf <- quasiquotate(deparse(substitute(fosf)), fosf)
|
||||
fusi <- quasiquotate(deparse(substitute(fusi)), fusi)
|
||||
gent <- quasiquotate(deparse(substitute(gent)), gent)
|
||||
imip <- quasiquotate(deparse(substitute(imip)), imip)
|
||||
kana <- quasiquotate(deparse(substitute(kana)), kana)
|
||||
levo <- quasiquotate(deparse(substitute(levo)), levo)
|
||||
linc <- quasiquotate(deparse(substitute(linc)), linc)
|
||||
line <- quasiquotate(deparse(substitute(line)), line)
|
||||
mero <- quasiquotate(deparse(substitute(mero)), mero)
|
||||
mino <- quasiquotate(deparse(substitute(mino)), mino)
|
||||
moxi <- quasiquotate(deparse(substitute(moxi)), moxi)
|
||||
nali <- quasiquotate(deparse(substitute(nali)), nali)
|
||||
neom <- quasiquotate(deparse(substitute(neom)), neom)
|
||||
neti <- quasiquotate(deparse(substitute(neti)), neti)
|
||||
nitr <- quasiquotate(deparse(substitute(nitr)), nitr)
|
||||
novo <- quasiquotate(deparse(substitute(novo)), novo)
|
||||
norf <- quasiquotate(deparse(substitute(norf)), norf)
|
||||
oflo <- quasiquotate(deparse(substitute(oflo)), oflo)
|
||||
peni <- quasiquotate(deparse(substitute(peni)), peni)
|
||||
pita <- quasiquotate(deparse(substitute(pita)), pita)
|
||||
poly <- quasiquotate(deparse(substitute(poly)), poly)
|
||||
qida <- quasiquotate(deparse(substitute(qida)), qida)
|
||||
rifa <- quasiquotate(deparse(substitute(rifa)), rifa)
|
||||
roxi <- quasiquotate(deparse(substitute(roxi)), roxi)
|
||||
siso <- quasiquotate(deparse(substitute(siso)), siso)
|
||||
teic <- quasiquotate(deparse(substitute(teic)), teic)
|
||||
tetr <- quasiquotate(deparse(substitute(tetr)), tetr)
|
||||
tica <- quasiquotate(deparse(substitute(tica)), tica)
|
||||
tige <- quasiquotate(deparse(substitute(tige)), tige)
|
||||
tobr <- quasiquotate(deparse(substitute(tobr)), tobr)
|
||||
trim <- quasiquotate(deparse(substitute(trim)), trim)
|
||||
trsu <- quasiquotate(deparse(substitute(trsu)), trsu)
|
||||
vanc <- quasiquotate(deparse(substitute(vanc)), vanc)
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.')
|
||||
}
|
||||
|
@ -41,6 +41,11 @@ as.rsi <- function(x) {
|
||||
x.bak <- x
|
||||
|
||||
na_before <- x[is.na(x) | x == ''] %>% length()
|
||||
# remove all spaces
|
||||
x <- gsub(' {2,55}', '', x)
|
||||
# disallow more than 3 characters
|
||||
x[nchar(x) > 3] <- NA
|
||||
# remove all invalid characters
|
||||
x <- gsub('[^RSI]+', '', x %>% toupper())
|
||||
# needed for UMCG in cases of "S;S" but also "S;I"; the latter will be NA:
|
||||
x <- gsub('^S+$', 'S', x)
|
||||
|
19
R/misc.R
19
R/misc.R
@ -31,22 +31,3 @@
|
||||
percent <- function(x, round = 1, ...) {
|
||||
base::paste0(base::round(x * 100, digits = round), "%")
|
||||
}
|
||||
|
||||
# No export, no Rd
|
||||
quasiquotate <- function(deparsed, parsed) {
|
||||
# when text: remove first and last "
|
||||
if (any(deparsed %like% '^".+"$' | deparsed %like% "^'.+'$")) {
|
||||
deparsed <- deparsed %>% substr(2, nchar(.) - 1)
|
||||
}
|
||||
# apply if needed
|
||||
if (any(!deparsed %like% '[[$:()]'
|
||||
& !deparsed %in% c('""', "''", "", # empty text
|
||||
".", ".data", # dplyr references
|
||||
"TRUE", "FALSE", # logicals
|
||||
"NA", "NaN", "NULL", # empty values
|
||||
ls(.GlobalEnv)))) {
|
||||
deparsed
|
||||
} else {
|
||||
parsed
|
||||
}
|
||||
}
|
||||
|
@ -288,8 +288,8 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
|
||||
#' species == "coli",
|
||||
#' first_isolate == TRUE) %>%
|
||||
#' # predict resistance of cefotaxime for next years
|
||||
#' rsi_predict(col_ab = cfot,
|
||||
#' col_date = date,
|
||||
#' rsi_predict(col_ab = "cfot",
|
||||
#' col_date = "date",
|
||||
#' year_max = 2025,
|
||||
#' preserve_measurements = FALSE)
|
||||
#'
|
||||
@ -307,11 +307,10 @@ rsi_predict <- function(tbl,
|
||||
stop('This table does not contain any observations.')
|
||||
}
|
||||
|
||||
col_ab <- quasiquotate(deparse(substitute(col_ab)), col_ab)
|
||||
if (!col_ab %in% colnames(tbl)) {
|
||||
stop('Column ', col_ab, ' not found.')
|
||||
}
|
||||
col_date <- quasiquotate(deparse(substitute(col_date)), col_date)
|
||||
|
||||
if (!col_date %in% colnames(tbl)) {
|
||||
stop('Column ', col_date, ' not found.')
|
||||
}
|
||||
|
@ -30,7 +30,7 @@ This package is available on CRAN and also here on GitHub.
|
||||
- `install.packages("AMR")`
|
||||
|
||||
- <img src="https://exploratory.io/favicon.ico" alt="Exploratory favicon" height="20px"> In [Exploratory.io](https://exploratory.io):
|
||||
- (Exploratory.io costs $40/month but is free for students and teachers; if you have an `@umcg.nl` or `@rug.nl` email address, [click here to enroll](https://exploratory.io/plan?plan=Community))
|
||||
- (Exploratory.io costs $40/month, but is free for students and teachers; if you have an `@umcg.nl` or `@rug.nl` email address, [click here to enroll](https://exploratory.io/plan?plan=Community))
|
||||
- Start the software and log in
|
||||
- Click on your username at the right hand side top
|
||||
- Click on `R Packages`
|
||||
|
@ -67,8 +67,8 @@ septic_patients \%>\%
|
||||
species == "coli",
|
||||
first_isolate == TRUE) \%>\%
|
||||
# predict resistance of cefotaxime for next years
|
||||
rsi_predict(col_ab = cfot,
|
||||
col_date = date,
|
||||
rsi_predict(col_ab = "cfot",
|
||||
col_date = "date",
|
||||
year_max = 2025,
|
||||
preserve_measurements = FALSE)
|
||||
|
||||
|
@ -9,6 +9,7 @@ test_that("atc_property works", {
|
||||
test_that("abname works", {
|
||||
expect_equal(abname("AMOX"), "Amoxicillin")
|
||||
expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin"))
|
||||
expect_equal(abname(c("AMOX+GENT")), "Amoxicillin + gentamicin")
|
||||
expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin")
|
||||
expect_equal(abname("amox", from = 'molis'), "Amoxicillin")
|
||||
expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin")
|
||||
|
@ -6,9 +6,12 @@ test_that("rsi works", {
|
||||
expect_true(as.rsi("R") > as.rsi("S"))
|
||||
expect_true(is.rsi(as.rsi("S")))
|
||||
|
||||
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
|
||||
# print plots, should not raise errors
|
||||
barplot(as.rsi(c("S", "I", "R")))
|
||||
plot(as.rsi(c("S", "I", "R")))
|
||||
print(as.rsi(c("S", "I", "R")))
|
||||
|
||||
expect_equal(class(barplot(as.rsi(c("S", "I", "R")))), "numeric")
|
||||
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
|
||||
|
||||
expect_equal(summary(as.rsi(c("S", "R"))), c("Mode" = 'rsi',
|
||||
"<NA>" = "0",
|
||||
@ -28,7 +31,10 @@ test_that("mic works", {
|
||||
expect_equal(as.integer(as.mic(">=32")), 32)
|
||||
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA)
|
||||
|
||||
expect_equal(class(plot(as.mic(c(1, 2, 4, 8)))), "numeric")
|
||||
# print plots, should not raise errors
|
||||
barplot(as.mic(c(1, 2, 4, 8)))
|
||||
plot(as.mic(c(1, 2, 4, 8)))
|
||||
print(as.mic(c(1, 2, 4, 8)))
|
||||
|
||||
expect_equal(summary(as.mic(c(2, 8))), c("Mode" = 'mic',
|
||||
"<NA>" = "0",
|
||||
|
@ -12,7 +12,7 @@ test_that("EUCAST rules work", {
|
||||
amox = "R", # Amoxicillin
|
||||
stringsAsFactors = FALSE)
|
||||
expect_equal(EUCAST_rules(a, info = FALSE), b)
|
||||
expect_equal(interpretive_reading(a, info = FALSE), b)
|
||||
expect_equal(suppressWarnings(interpretive_reading(a, info = TRUE)), b)
|
||||
|
||||
a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
|
||||
"STCGRA"), # Streptococcus pyognenes (Lancefield Group A)
|
||||
|
@ -7,7 +7,6 @@ test_that("keyantibiotics work", {
|
||||
expect_false(key_antibiotics_equal("SSS", "SIS", ignore_I = FALSE))
|
||||
})
|
||||
|
||||
|
||||
test_that("guess_bactid works", {
|
||||
expect_equal(guess_bactid("E. coli"), "ESCCOL")
|
||||
expect_equal(guess_bactid("Escherichia coli"), "ESCCOL")
|
||||
@ -15,9 +14,23 @@ test_that("guess_bactid works", {
|
||||
|
||||
test_that("first isolates work", {
|
||||
# septic_patients contains 1960 out of 2000 first isolates
|
||||
expect_equal(sum(first_isolate(septic_patients,
|
||||
"date",
|
||||
"patient_id",
|
||||
"bactid",
|
||||
septic_ptns <- septic_patients
|
||||
expect_equal(sum(first_isolate(tbl = septic_ptns,
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
info = FALSE)), 1960)
|
||||
|
||||
# septic_patients contains 1962 out of 2000 first weighted isolates
|
||||
septic_ptns$keyab <- suppressWarnings(key_antibiotics(septic_ptns))
|
||||
expect_equal(
|
||||
suppressWarnings(sum(
|
||||
first_isolate(tbl = septic_ptns,
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
col_keyantibiotics = "keyab",
|
||||
type = "keyantibiotics",
|
||||
info = TRUE))),
|
||||
1962)
|
||||
})
|
||||
|
@ -12,9 +12,3 @@ test_that("percentages works", {
|
||||
expect_equal(percent(0.5), "50%")
|
||||
expect_equal(percent(0.1234), "12.3%")
|
||||
})
|
||||
|
||||
test_that("quasiquotation works", {
|
||||
expect_equal(quasiquotate(deparse(substitute("test")), "test"), "test")
|
||||
expect_equal(quasiquotate(deparse(substitute('test')), "'test'"), "test")
|
||||
expect_equal(quasiquotate(deparse(substitute(test)), test), "test")
|
||||
})
|
||||
|
Loading…
Reference in New Issue
Block a user