1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 05:26:13 +01:00

update dependencies

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-04-02 16:05:09 +02:00
parent cee64ef050
commit 07bdd61241
15 changed files with 172 additions and 221 deletions

View File

@ -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 of microbial isolates, by using new S3 classes and applying EUCAST expert rules
on antibiograms according to Leclercq (2013) on antibiograms according to Leclercq (2013)
<doi:10.1111/j.1469-0691.2011.03703.x>. <doi:10.1111/j.1469-0691.2011.03703.x>.
Depends: R (>= 3.0) Depends:
Imports: dplyr (>= 0.7.0), reshape2 (>= 1.4.0), xml2, rvest R (>= 3.2.0)
Suggests: testthat Imports:
URL: https://cran.r-project.org/package=AMR 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 BugReports: https://github.com/msberends/AMR/issues
License: GPL-2 | file LICENSE License: GPL-2 | file LICENSE
Encoding: UTF-8 Encoding: UTF-8

25
NEWS
View File

@ -1,14 +1,19 @@
## 0.1.2 ## 0.1.2
- NEW: Function `guess_bactid` to determine the ID of a microorganism based on genus/species - Added full support for Windows, Linux and macOS; this package now works everywhere :)
- NEW: Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS - New function `guess_bactid` to determine the ID of a microorganism based on genus/species
- NEW: New algorithm to determine weighted isolates, can now be `"points"` or `"keyantibiotics"`, see `?first_isolate` - New functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
- EDIT: Renamed dataset `ablist` to `antibiotics` - New algorithm to determine weighted isolates, can now be `"points"` or `"keyantibiotics"`, see `?first_isolate`
- EDIT: Renamed dataset `bactlist` to `microorganisms` - Renamed dataset `ablist` to `antibiotics`
- EDIT: Added support for character vector in join functions - Renamed dataset `bactlist` to `microorganisms`
- EDIT: Altered `%like%` to make it case insensitive - Added analysis examples on help page of dataset `septic_patients`
- EDIT: Functions `first_isolate`, `EUCAST_rules` and `rsi_predict` supports tidyverse-like evaluation of parameters (no need to quote columns them anymore) - Added support for character vector in join functions
- EDIT: For functions `first_isolate`, `EUCAST_rules` the antibiotic column names are case-insensitive - Added warnings when applying a join results in more rows after than before the join
- EDIT: Functions `as.rsi` and `as.mic` now add the package name and version as attribute - 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 ## 0.1.1
- `EUCAST_rules` applies for amoxicillin even if ampicillin is missing - `EUCAST_rules` applies for amoxicillin even if ampicillin is missing

View File

@ -115,66 +115,6 @@ EUCAST_rules <- function(tbl,
EUCAST_VERSION <- "3.1" 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)) { if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.') stop('Column ', col_bactid, ' not found.')
} }

View File

@ -41,6 +41,11 @@ as.rsi <- function(x) {
x.bak <- x x.bak <- x
na_before <- x[is.na(x) | x == ''] %>% length() 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()) x <- gsub('[^RSI]+', '', x %>% toupper())
# needed for UMCG in cases of "S;S" but also "S;I"; the latter will be NA: # needed for UMCG in cases of "S;S" but also "S;I"; the latter will be NA:
x <- gsub('^S+$', 'S', x) x <- gsub('^S+$', 'S', x)

View File

@ -31,22 +31,3 @@
percent <- function(x, round = 1, ...) { percent <- function(x, round = 1, ...) {
base::paste0(base::round(x * 100, digits = round), "%") 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
}
}

View File

@ -288,8 +288,8 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
#' species == "coli", #' species == "coli",
#' first_isolate == TRUE) %>% #' first_isolate == TRUE) %>%
#' # predict resistance of cefotaxime for next years #' # predict resistance of cefotaxime for next years
#' rsi_predict(col_ab = cfot, #' rsi_predict(col_ab = "cfot",
#' col_date = date, #' col_date = "date",
#' year_max = 2025, #' year_max = 2025,
#' preserve_measurements = FALSE) #' preserve_measurements = FALSE)
#' #'
@ -307,11 +307,10 @@ rsi_predict <- function(tbl,
stop('This table does not contain any observations.') stop('This table does not contain any observations.')
} }
col_ab <- quasiquotate(deparse(substitute(col_ab)), col_ab)
if (!col_ab %in% colnames(tbl)) { if (!col_ab %in% colnames(tbl)) {
stop('Column ', col_ab, ' not found.') stop('Column ', col_ab, ' not found.')
} }
col_date <- quasiquotate(deparse(substitute(col_date)), col_date)
if (!col_date %in% colnames(tbl)) { if (!col_date %in% colnames(tbl)) {
stop('Column ', col_date, ' not found.') stop('Column ', col_date, ' not found.')
} }

View File

@ -30,7 +30,7 @@ This package is available on CRAN and also here on GitHub.
- `install.packages("AMR")` - `install.packages("AMR")`
- <img src="https://exploratory.io/favicon.ico" alt="Exploratory favicon" height="20px"> In [Exploratory.io](https://exploratory.io): - <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 - Start the software and log in
- Click on your username at the right hand side top - Click on your username at the right hand side top
- Click on `R Packages` - Click on `R Packages`

View File

@ -67,8 +67,8 @@ septic_patients \%>\%
species == "coli", species == "coli",
first_isolate == TRUE) \%>\% first_isolate == TRUE) \%>\%
# predict resistance of cefotaxime for next years # predict resistance of cefotaxime for next years
rsi_predict(col_ab = cfot, rsi_predict(col_ab = "cfot",
col_date = date, col_date = "date",
year_max = 2025, year_max = 2025,
preserve_measurements = FALSE) preserve_measurements = FALSE)

View File

@ -9,6 +9,7 @@ test_that("atc_property works", {
test_that("abname works", { test_that("abname works", {
expect_equal(abname("AMOX"), "Amoxicillin") expect_equal(abname("AMOX"), "Amoxicillin")
expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin")) 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 = 'umcg'), "Amoxicillin")
expect_equal(abname("amox", from = 'molis'), "Amoxicillin") expect_equal(abname("amox", from = 'molis'), "Amoxicillin")
expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin") expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin")

View File

@ -6,9 +6,12 @@ test_that("rsi works", {
expect_true(as.rsi("R") > as.rsi("S")) expect_true(as.rsi("R") > as.rsi("S"))
expect_true(is.rsi(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', expect_equal(summary(as.rsi(c("S", "R"))), c("Mode" = 'rsi',
"<NA>" = "0", "<NA>" = "0",
@ -28,7 +31,10 @@ test_that("mic works", {
expect_equal(as.integer(as.mic(">=32")), 32) expect_equal(as.integer(as.mic(">=32")), 32)
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA) 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', expect_equal(summary(as.mic(c(2, 8))), c("Mode" = 'mic',
"<NA>" = "0", "<NA>" = "0",

View File

@ -12,7 +12,7 @@ test_that("EUCAST rules work", {
amox = "R", # Amoxicillin amox = "R", # Amoxicillin
stringsAsFactors = FALSE) stringsAsFactors = FALSE)
expect_equal(EUCAST_rules(a, info = FALSE), b) 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 a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
"STCGRA"), # Streptococcus pyognenes (Lancefield Group A) "STCGRA"), # Streptococcus pyognenes (Lancefield Group A)

View File

@ -7,7 +7,6 @@ test_that("keyantibiotics work", {
expect_false(key_antibiotics_equal("SSS", "SIS", ignore_I = FALSE)) expect_false(key_antibiotics_equal("SSS", "SIS", ignore_I = FALSE))
}) })
test_that("guess_bactid works", { test_that("guess_bactid works", {
expect_equal(guess_bactid("E. coli"), "ESCCOL") expect_equal(guess_bactid("E. coli"), "ESCCOL")
expect_equal(guess_bactid("Escherichia coli"), "ESCCOL") expect_equal(guess_bactid("Escherichia coli"), "ESCCOL")
@ -15,9 +14,23 @@ test_that("guess_bactid works", {
test_that("first isolates work", { test_that("first isolates work", {
# septic_patients contains 1960 out of 2000 first isolates # septic_patients contains 1960 out of 2000 first isolates
expect_equal(sum(first_isolate(septic_patients, septic_ptns <- septic_patients
"date", expect_equal(sum(first_isolate(tbl = septic_ptns,
"patient_id", col_date = "date",
"bactid", col_patient_id = "patient_id",
col_bactid = "bactid",
info = FALSE)), 1960) 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)
}) })

View File

@ -12,9 +12,3 @@ test_that("percentages works", {
expect_equal(percent(0.5), "50%") expect_equal(percent(0.5), "50%")
expect_equal(percent(0.1234), "12.3%") 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")
})