mirror of
https://github.com/msberends/AMR.git
synced 2024-12-24 19:26:12 +01:00
add tests using testthat
This commit is contained in:
parent
c26839b08e
commit
6f7730dcaa
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 0.1.2
|
||||
Date: 2018-03-23
|
||||
Date: 2018-03-27
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
person(
|
||||
@ -26,6 +26,7 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR
|
||||
<doi:10.1111/j.1469-0691.2011.03703.x>.
|
||||
Depends: R (>= 3.0)
|
||||
Imports: dplyr (>= 0.7.0), knitr, reshape2 (>= 1.4.0), xml2, rvest
|
||||
Suggests: testthat
|
||||
URL: https://cran.r-project.org/package=AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
License: GPL-2 | file LICENSE
|
||||
|
@ -188,7 +188,7 @@ EUCAST_rules <- function(tbl,
|
||||
teic, tetr, tica, tige, tobr, trim, trsu, vanc)
|
||||
col.list <- col.list[!is.na(col.list)]
|
||||
col.list.bak <- col.list
|
||||
# are they available as upper case then?
|
||||
# are they available as upper case or lower case then?
|
||||
for (i in 1:length(col.list)) {
|
||||
if (toupper(col.list[i]) %in% colnames(tbl)) {
|
||||
col.list[i] <- toupper(col.list[i])
|
||||
@ -708,7 +708,7 @@ mo_property <- function(bactid, property = 'fullname') {
|
||||
result = tryCatch({
|
||||
mocode[i] <-
|
||||
AMR::microorganisms %>%
|
||||
filter(bactid == bactid) %>%
|
||||
filter(bactid == bug) %>%
|
||||
select(property) %>%
|
||||
unlist() %>%
|
||||
as.character()
|
||||
|
@ -364,7 +364,7 @@ summary.mic <- function(object, ...) {
|
||||
x <- x[!is.na(x)]
|
||||
n <- x %>% length()
|
||||
return(c("Mode" = 'mic',
|
||||
"NA" = n_total - n,
|
||||
"<NA>" = n_total - n,
|
||||
"Min." = sort(x)[1] %>% as.character(),
|
||||
"Max." = sort(x)[n] %>% as.character()
|
||||
))
|
||||
|
@ -7,6 +7,7 @@
|
||||
#' @inheritParams utils::write.table
|
||||
#' @param startrow \emph{n}th row to start importing from. For \code{clipboard_import}, when \code{header = TRUE} the import will start on row \code{startrow} \emph{below} the header.
|
||||
#' @param as_vector a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.
|
||||
#' @param info print info about copying
|
||||
#' @keywords clipboard clipboard_import clipboard_export import export
|
||||
#' @importFrom dplyr %>% pull as_tibble
|
||||
#' @importFrom utils read.delim write.table object.size
|
||||
@ -54,7 +55,8 @@ clipboard_export <- function(x,
|
||||
sep = '\t',
|
||||
dec = ".",
|
||||
na = "",
|
||||
header = TRUE) {
|
||||
header = TRUE,
|
||||
info = TRUE) {
|
||||
|
||||
x <- deparse(substitute(x))
|
||||
size <- x %>%
|
||||
@ -75,6 +77,7 @@ clipboard_export <- function(x,
|
||||
dec = dec,
|
||||
quote = FALSE)
|
||||
|
||||
if (info == TRUE) {
|
||||
cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n")
|
||||
|
||||
}
|
||||
}
|
||||
|
@ -448,6 +448,8 @@ key_antibiotics <- function(tbl,
|
||||
clin, clox, doxy, gent, line, mero, peni,
|
||||
pita, rifa, teic, trsu, vanc)
|
||||
col.list <- col.list[!is.na(col.list)]
|
||||
col.list.bak <- col.list
|
||||
# are they available as upper case or lower case then?
|
||||
for (i in 1:length(col.list)) {
|
||||
if (toupper(col.list[i]) %in% colnames(tbl)) {
|
||||
col.list[i] <- toupper(col.list[i])
|
||||
@ -459,8 +461,8 @@ key_antibiotics <- function(tbl,
|
||||
}
|
||||
if (!all(col.list %in% colnames(tbl))) {
|
||||
if (info == TRUE) {
|
||||
warning('These columns do not exist and will be ignored:\n',
|
||||
col.list[!(col.list %in% colnames(tbl))] %>% toString(),
|
||||
warning('These columns do not exist and will be ignored: ',
|
||||
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
}
|
||||
@ -647,9 +649,13 @@ guess_bactid <- function(x) {
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
if (tolower(x[i]) == '^e.*coli$') {
|
||||
# avoid detection of Entamoeba coli in case of Escherichia coli
|
||||
# avoid detection of Entamoeba coli in case of E. coli
|
||||
x[i] <- 'Escherichia coli'
|
||||
}
|
||||
if (tolower(x[i]) == '^h.*influenzae$') {
|
||||
# avoid detection of Haematobacter influenzae in case of H. influenzae
|
||||
x[i] <- 'Haemophilus influenzae'
|
||||
}
|
||||
if (tolower(x[i]) == '^st.*au$'
|
||||
| tolower(x[i]) == '^stau$'
|
||||
| tolower(x[i]) == '^staaur$') {
|
||||
|
6
R/join.R
6
R/join.R
@ -96,7 +96,11 @@ full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...)
|
||||
} else {
|
||||
joinby <- by
|
||||
}
|
||||
dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
|
||||
join <- dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
|
||||
if (nrow(join) > nrow(x)) {
|
||||
warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original')
|
||||
}
|
||||
join
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
|
@ -67,7 +67,7 @@ rsi_df <- function(tbl,
|
||||
stop('Invalid `interpretation`; must be "S", "SI", "I", "IR", or "R".')
|
||||
}
|
||||
if ('is_ic' %in% colnames(tbl)) {
|
||||
if (n_distinct(tbl$is_ic) > 1) {
|
||||
if (n_distinct(tbl$is_ic) > 1 & warning == TRUE) {
|
||||
warning('Dataset contains isolates from the Intensive Care. Exclude them from proper epidemiological analysis.')
|
||||
}
|
||||
}
|
||||
@ -280,8 +280,7 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
|
||||
#' first_isolate(.,
|
||||
#' "date",
|
||||
#' "patient_id",
|
||||
#' "genus",
|
||||
#' "species",
|
||||
#' "bactid",
|
||||
#' col_specimen = NA,
|
||||
#' col_icu = NA)) %>%
|
||||
#' # filter on first E. coli isolates
|
||||
@ -304,6 +303,10 @@ rsi_predict <- function(tbl,
|
||||
preserve_measurements = TRUE,
|
||||
info = TRUE) {
|
||||
|
||||
if (nrow(tbl) == 0) {
|
||||
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.')
|
||||
|
@ -9,7 +9,8 @@
|
||||
clipboard_import(sep = "\\t", header = TRUE, dec = ".", na = c("", "NA",
|
||||
"NULL"), startrow = 1, as_vector = TRUE)
|
||||
|
||||
clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE)
|
||||
clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE,
|
||||
info = TRUE)
|
||||
}
|
||||
\arguments{
|
||||
\item{sep}{the field separator character. Values on each line of the
|
||||
@ -33,6 +34,8 @@ clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE)
|
||||
|
||||
\item{x}{the object to be written, preferably a matrix or data frame.
|
||||
If not, it is attempted to coerce \code{x} to a data frame.}
|
||||
|
||||
\item{info}{print info about copying}
|
||||
}
|
||||
\value{
|
||||
data.frame
|
||||
|
@ -59,8 +59,7 @@ septic_patients \%>\%
|
||||
first_isolate(.,
|
||||
"date",
|
||||
"patient_id",
|
||||
"genus",
|
||||
"species",
|
||||
"bactid",
|
||||
col_specimen = NA,
|
||||
col_icu = NA)) \%>\%
|
||||
# filter on first E. coli isolates
|
||||
|
4
tests/testthat.R
Normal file
4
tests/testthat.R
Normal file
@ -0,0 +1,4 @@
|
||||
library(testthat)
|
||||
library(AMR)
|
||||
|
||||
test_check("AMR")
|
BIN
tests/testthat/Rplots.pdf
Normal file
BIN
tests/testthat/Rplots.pdf
Normal file
Binary file not shown.
15
tests/testthat/test-atc.R
Normal file
15
tests/testthat/test-atc.R
Normal file
@ -0,0 +1,15 @@
|
||||
context("atc.R")
|
||||
|
||||
|
||||
test_that("atc_property works", {
|
||||
expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
|
||||
expect_equivalent(atc_property("J01CA04", "DDD"), 1)
|
||||
})
|
||||
|
||||
test_that("abname works", {
|
||||
expect_equal(abname("AMOX"), "Amoxicillin")
|
||||
expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin"))
|
||||
expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin")
|
||||
expect_equal(abname("amox", from = 'molis'), "Amoxicillin")
|
||||
expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin")
|
||||
})
|
37
tests/testthat/test-classes.R
Normal file
37
tests/testthat/test-classes.R
Normal file
@ -0,0 +1,37 @@
|
||||
context("classes.R")
|
||||
|
||||
test_that("rsi works", {
|
||||
expect_true(as.rsi("S") < as.rsi("I"))
|
||||
expect_true(as.rsi("I") < as.rsi("R"))
|
||||
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)
|
||||
|
||||
expect_equal(class(barplot(as.rsi(c("S", "I", "R")))), "numeric")
|
||||
|
||||
expect_equal(summary(as.rsi(c("S", "R"))), c("Mode" = 'rsi',
|
||||
"<NA>" = "0",
|
||||
"Sum S" = "1",
|
||||
"Sum IR" = "1",
|
||||
"Sum R" = "1",
|
||||
"Sum I" = "0"))
|
||||
})
|
||||
|
||||
test_that("mic works", {
|
||||
expect_true(as.mic(8) == as.mic("8"))
|
||||
expect_true(as.mic("1") > as.mic("<=0.0625"))
|
||||
expect_true(as.mic("1") < as.mic(">=32"))
|
||||
expect_true(is.mic(as.mic(8)))
|
||||
|
||||
expect_equal(as.double(as.mic(">=32")), 32)
|
||||
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")
|
||||
|
||||
expect_equal(summary(as.mic(c(2, 8))), c("Mode" = 'mic',
|
||||
"<NA>" = "0",
|
||||
"Min." = "2",
|
||||
"Max." = "8"))
|
||||
})
|
9
tests/testthat/test-clipboard.R
Normal file
9
tests/testthat/test-clipboard.R
Normal file
@ -0,0 +1,9 @@
|
||||
context("clipboard.R")
|
||||
|
||||
test_that("clipboard works", {
|
||||
# why is the <<- needed? Won't work without it...
|
||||
t1 <<- AMR::antibiotics
|
||||
clipboard_export(t1, info = FALSE)
|
||||
t2 <- clipboard_import()
|
||||
expect_equal(t1, t2)
|
||||
})
|
31
tests/testthat/test-eucast.R
Normal file
31
tests/testthat/test-eucast.R
Normal file
@ -0,0 +1,31 @@
|
||||
context("EUCAST.R")
|
||||
|
||||
test_that("EUCAST rules work", {
|
||||
a <- data.frame(bactid = c("KLEPNE", # Klebsiella pneumoniae
|
||||
"PSEAER", # Pseudomonas aeruginosa
|
||||
"ENTAER"), # Enterobacter aerogenes
|
||||
amox = "-", # Amoxicillin
|
||||
stringsAsFactors = FALSE)
|
||||
b <- data.frame(bactid = c("KLEPNE", # Klebsiella pneumoniae
|
||||
"PSEAER", # Pseudomonas aeruginosa
|
||||
"ENTAER"), # Enterobacter aerogenes
|
||||
amox = "R", # Amoxicillin
|
||||
stringsAsFactors = FALSE)
|
||||
expect_equal(EUCAST_rules(a, info = FALSE), b)
|
||||
expect_equal(interpretive_reading(a, info = FALSE), b)
|
||||
|
||||
a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
|
||||
"STCGRA"), # Streptococcus pyognenes (Lancefield Group A)
|
||||
coli = "-", # Colistin
|
||||
stringsAsFactors = FALSE)
|
||||
b <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
|
||||
"STCGRA"), # Streptococcus pyognenes (Lancefield Group A)
|
||||
coli = "R", # Colistin
|
||||
stringsAsFactors = FALSE)
|
||||
expect_equal(EUCAST_rules(a, info = FALSE), b)
|
||||
})
|
||||
|
||||
test_that("MO properties work", {
|
||||
expect_equal(mo_property("ESCCOL"), "Escherichia coli")
|
||||
expect_equal(mo_property("STAAUR"), "Staphylococcus aureus")
|
||||
})
|
23
tests/testthat/test-first_isolates.R
Normal file
23
tests/testthat/test-first_isolates.R
Normal file
@ -0,0 +1,23 @@
|
||||
context("first_isolates.R")
|
||||
|
||||
test_that("keyantibiotics work", {
|
||||
expect_equal(length(key_antibiotics(septic_patients, info = FALSE)), nrow(septic_patients))
|
||||
expect_true(key_antibiotics_equal("SSS", "SSS"))
|
||||
expect_true(key_antibiotics_equal("SSS", "SIS", ignore_I = TRUE))
|
||||
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")
|
||||
})
|
||||
|
||||
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",
|
||||
info = FALSE)), 1960)
|
||||
})
|
18
tests/testthat/test-joins.R
Normal file
18
tests/testthat/test-joins.R
Normal file
@ -0,0 +1,18 @@
|
||||
context("joins.R")
|
||||
|
||||
test_that("joins work", {
|
||||
unjoined <- septic_patients
|
||||
inner <- septic_patients %>% inner_join_microorganisms()
|
||||
left <- septic_patients %>% left_join_microorganisms()
|
||||
suppressWarnings(right <- septic_patients %>% right_join_microorganisms())
|
||||
suppressWarnings(full <- septic_patients %>% full_join_microorganisms())
|
||||
|
||||
expect_true(ncol(unjoined) < ncol(inner))
|
||||
expect_true(nrow(unjoined) == nrow(inner))
|
||||
|
||||
expect_true(ncol(unjoined) < ncol(left))
|
||||
expect_true(nrow(unjoined) == nrow(left))
|
||||
|
||||
expect_true(nrow(unjoined) < nrow(right))
|
||||
expect_true(nrow(unjoined) < nrow(full))
|
||||
})
|
20
tests/testthat/test-misc.R
Normal file
20
tests/testthat/test-misc.R
Normal file
@ -0,0 +1,20 @@
|
||||
context("misc.R")
|
||||
|
||||
test_that("`like` works", {
|
||||
expect_true("test" %like% "^t")
|
||||
expect_true("test" %like% "test")
|
||||
expect_true("test" %like% "TEST")
|
||||
expect_true(as.factor("test") %like% "TEST")
|
||||
})
|
||||
|
||||
test_that("percentages works", {
|
||||
expect_equal(percent(0.25), "25%")
|
||||
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")
|
||||
})
|
38
tests/testthat/test-rsi_analysis.R
Normal file
38
tests/testthat/test-rsi_analysis.R
Normal file
@ -0,0 +1,38 @@
|
||||
context("rsi_analysis.R")
|
||||
|
||||
test_that("rsi works", {
|
||||
# amox resistance in `septic_patients` should be around 53.86%
|
||||
amox_R <- septic_patients %>% summarise(amox = rsi(amox)) %>% pull(amox)
|
||||
expect_equal(amox_R, 0.5386, tolerance = 0.0001)
|
||||
expect_equal(rsi_df(septic_patients,
|
||||
ab = "amox",
|
||||
info = FALSE), 0.5386, tolerance = 0.0001)
|
||||
# and pita+genta susceptibility around 98.09%
|
||||
expect_equal(rsi_df(septic_patients,
|
||||
ab = c("pita", "gent"),
|
||||
interpretation = "S",
|
||||
info = FALSE), 0.9809, tolerance = 0.0001)
|
||||
})
|
||||
|
||||
test_that("prediction of rsi works", {
|
||||
amox_R <- rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),],
|
||||
col_ab = "amox",
|
||||
col_date = "date",
|
||||
info = FALSE)
|
||||
amox_R <- amox_R %>% pull("probR")
|
||||
# amox resistance will decrease according to `septic_patients`
|
||||
expect_true(amox_R[2] > amox_R[20])
|
||||
expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),],
|
||||
model = "INVALID MODEL",
|
||||
col_ab = "amox",
|
||||
col_date = "date",
|
||||
info = FALSE))
|
||||
expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),],
|
||||
col_ab = "NOT EXISTING COLUMN",
|
||||
col_date = "date",
|
||||
info = FALSE))
|
||||
expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),],
|
||||
col_ab = "amox",
|
||||
col_date = "NOT EXISTING COLUMN",
|
||||
info = FALSE))
|
||||
})
|
Loading…
Reference in New Issue
Block a user