mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 06:46:11 +01:00
new unit tests for ggplot, small fixes
This commit is contained in:
parent
1ba7d883fe
commit
e5d32cafe0
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 0.2.0.9023
|
||||
Date: 2018-08-11
|
||||
Date: 2018-08-12
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
person(
|
||||
@ -57,14 +57,14 @@ Imports:
|
||||
Rcpp (>= 0.12.14),
|
||||
readr,
|
||||
rvest (>= 0.3.2),
|
||||
tibble,
|
||||
ggplot2
|
||||
tibble
|
||||
Suggests:
|
||||
testthat (>= 1.0.2),
|
||||
covr (>= 3.0.1),
|
||||
rmarkdown,
|
||||
rstudioapi,
|
||||
tidyr
|
||||
tidyr,
|
||||
ggplot2
|
||||
VignetteBuilder: knitr
|
||||
URL: https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
|
11
R/classes.R
11
R/classes.R
@ -102,9 +102,14 @@ print.rsi <- function(x, ...) {
|
||||
#' @noRd
|
||||
summary.rsi <- function(object, ...) {
|
||||
x <- object
|
||||
lst <- c('rsi', sum(is.na(x)), sum(x == "S"), sum(x %in% c("I", "R")), sum(x == "R"), sum(x == "I"))
|
||||
names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "-Sum R", "-Sum I")
|
||||
lst
|
||||
c(
|
||||
"Mode" = 'rsi',
|
||||
"<NA>" = sum(is.na(x)),
|
||||
"Sum S" = sum(x == "S", na.rm = TRUE),
|
||||
"Sum IR" = sum(x %in% c("I", "R"), na.rm = TRUE),
|
||||
"-Sum R" = sum(x == "R", na.rm = TRUE),
|
||||
"-Sum I" = sum(x == "I", na.rm = TRUE)
|
||||
)
|
||||
}
|
||||
|
||||
#' @exportMethod plot.rsi
|
||||
|
@ -18,7 +18,7 @@
|
||||
|
||||
#' AMR bar plots with \code{ggplot}
|
||||
#'
|
||||
#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link{ggplot}} functions.
|
||||
#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions.
|
||||
#' @param data a \code{data.frame} with column(s) of class \code{"rsi"} (see \code{\link{as.rsi}})
|
||||
#' @param position position adjustment of bars, either \code{"stack"} (default) or \code{"dodge"}
|
||||
#' @param x parameter to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"}
|
||||
@ -28,13 +28,13 @@
|
||||
#' \strong{The functions}\cr
|
||||
#' \code{geom_rsi} will take any variable from the data that has an \code{rsi} class (created with \code{\link{as.rsi}}) using \code{\link{portion_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.
|
||||
#'
|
||||
#' \code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link{facet_wrap}}.
|
||||
#' \code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link[ggplot2]{facet_wrap}}.
|
||||
#'
|
||||
#' \code{scale_y_percent} transforms the y axis to a 0 to 100% range.
|
||||
#'
|
||||
#' \code{scale_rsi_colours} sets colours to the bars: green for S, yellow for I and red for R.
|
||||
#'
|
||||
#' \code{theme_rsi} is a \code{\link{theme}} with minimal distraction.
|
||||
#' \code{theme_rsi} is a \code{\link[ggplot2]{theme}} with minimal distraction.
|
||||
#'
|
||||
#' \code{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 (\code{\%>\%}). See Examples.
|
||||
#' @rdname ggplot_rsi
|
||||
@ -67,6 +67,11 @@
|
||||
ggplot_rsi <- function(data,
|
||||
x = "Antibiotic",
|
||||
facet = NULL) {
|
||||
|
||||
if (!"ggplot2" %in% rownames(installed.packages())) {
|
||||
stop('this function requires the ggplot2 package.', call. = FALSE)
|
||||
}
|
||||
|
||||
p <- ggplot2::ggplot(data = data) +
|
||||
geom_rsi(x = x) +
|
||||
scale_y_percent() +
|
||||
|
@ -35,7 +35,7 @@
|
||||
#' combination_n = n_rsi(cipr, gent))
|
||||
n_rsi <- function(ab1, ab2 = NULL) {
|
||||
if (NCOL(ab1) > 1) {
|
||||
stop('`ab` must be a vector of antimicrobial interpretations', call. = FALSE)
|
||||
stop('`ab1` must be a vector of antimicrobial interpretations', call. = FALSE)
|
||||
}
|
||||
if (!is.rsi(ab1)) {
|
||||
ab1 <- as.rsi(ab1)
|
||||
|
52
R/portion.R
52
R/portion.R
@ -176,6 +176,32 @@ portion_S <- function(ab1,
|
||||
as_percent = as_percent)
|
||||
}
|
||||
|
||||
#' @rdname portion
|
||||
#' @importFrom dplyr bind_cols summarise_if mutate
|
||||
#' @export
|
||||
portion_df <- function(data, translate = getOption("get_antibiotic_names", TRUE)) {
|
||||
resS <- bind_cols(data.frame(Interpretation = "S", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_S))
|
||||
resI <- bind_cols(data.frame(Interpretation = "I", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_I))
|
||||
resR <- bind_cols(data.frame(Interpretation = "R", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_R))
|
||||
|
||||
res <- bind_rows(resS, resI, resR) %>%
|
||||
mutate(Interpretation = factor(Interpretation, levels = c("R", "I", "S"), ordered = TRUE)) %>%
|
||||
tidyr::gather(Antibiotic, Percentage, -Interpretation)
|
||||
if (translate == TRUE) {
|
||||
res <- res %>% mutate(Antibiotic = abname(Antibiotic, from = "guess", to = "official"))
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
rsi_calc <- function(type,
|
||||
ab1,
|
||||
ab2,
|
||||
@ -244,29 +270,3 @@ rsi_calc <- function(type,
|
||||
found / total
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname portion
|
||||
#' @importFrom dplyr bind_cols summarise_if mutate
|
||||
#' @export
|
||||
portion_df <- function(data, translate = getOption("get_antibiotic_names", TRUE)) {
|
||||
resS <- bind_cols(data.frame(Interpretation = "S", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_S))
|
||||
resI <- bind_cols(data.frame(Interpretation = "I", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_I))
|
||||
resR <- bind_cols(data.frame(Interpretation = "R", stringsAsFactors = FALSE),
|
||||
summarise_if(.tbl = data,
|
||||
.predicate = is.rsi,
|
||||
.funs = portion_R))
|
||||
|
||||
res <- bind_rows(resS, resI, resR) %>%
|
||||
mutate(Interpretation = factor(Interpretation, levels = c("R", "I", "S"), ordered = TRUE)) %>%
|
||||
tidyr::gather(Antibiotic, Percentage, -Interpretation)
|
||||
if (translate == TRUE) {
|
||||
res <- res %>% mutate(Antibiotic = abname(Antibiotic, from = "guess", to = "official"))
|
||||
}
|
||||
res
|
||||
}
|
||||
|
68
README.md
68
README.md
@ -136,43 +136,61 @@ guess_bactid("VRSA") # Vancomycin Resistant S. aureus
|
||||
This package contains two new S3 classes: `mic` for MIC values (e.g. from Vitek or Phoenix) and `rsi` for antimicrobial drug interpretations (i.e. S, I and R). Both are actually ordered factors under the hood (an MIC of `2` being higher than `<=1` but lower than `>=32`, and for class `rsi` factors are ordered as `S < I < R`).
|
||||
Both classes have extensions for existing generic functions like `print`, `summary` and `plot`.
|
||||
|
||||
```r
|
||||
# Transform values to new classes
|
||||
mic_data <- as.mic(c(">=32", "1.0", "8", "<=0.128", "8", "16", "16"))
|
||||
rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
|
||||
```
|
||||
These functions also try to coerce valid values.
|
||||
|
||||
Quick overviews with `summary`:
|
||||
#### RSI
|
||||
The `septic_patients` data set comes with antimicrobial results of more than 40 different drugs. For example, columns `amox` and `cipr` contain results of amoxicillin and ciprofloxacin, respectively.
|
||||
```r
|
||||
summary(rsi_data)
|
||||
# Mode :rsi
|
||||
# <NA> :0
|
||||
# Sum S :474
|
||||
# Sum IR:406
|
||||
# -Sum R:370
|
||||
# -Sum I:36
|
||||
summary(septic_patients[, c("amox", "cipr")])
|
||||
# amox cipr
|
||||
# Mode :rsi Mode :rsi
|
||||
# <NA> :1002 <NA> :596
|
||||
# Sum S :336 Sum S :1108
|
||||
# Sum IR:662 Sum IR:296
|
||||
# -Sum R:659 -Sum R:227
|
||||
# -Sum I:3 -Sum I:69
|
||||
```
|
||||
|
||||
You can use the `plot` function from base R:
|
||||
```r
|
||||
plot(septic_patients$cipr)
|
||||
```
|
||||
|
||||
![example_1_rsi](man/figures/rsi_example1.png)
|
||||
|
||||
Or use the `ggplot2` and `dplyr` packages to create more appealing plots:
|
||||
```r
|
||||
septic_patients %>%
|
||||
select(amox, cipr) %>%
|
||||
ggplot_rsi()
|
||||
```
|
||||
|
||||
![example_2_rsi](man/figures/rsi_example2.png)
|
||||
|
||||
```r
|
||||
septic_patients %>%
|
||||
select(amox, cipr) %>%
|
||||
ggplot_rsi(x = "Interpretation", facet = "Antibiotic")
|
||||
```
|
||||
|
||||
![example_3_rsi](man/figures/rsi_example3.png)
|
||||
|
||||
|
||||
#### MIC
|
||||
|
||||
```r
|
||||
# Transform values to new class
|
||||
mic_data <- as.mic(c(">=32", "1.0", "8", "<=0.128", "8", "16", "16"))
|
||||
|
||||
summary(mic_data)
|
||||
# Mode:mic
|
||||
# <NA>:0
|
||||
# Min.:<=0.128
|
||||
# Max.:>=32
|
||||
```
|
||||
|
||||
A plot of `rsi_data`:
|
||||
```r
|
||||
plot(rsi_data)
|
||||
```
|
||||
|
||||
![example1](man/figures/rsi_example.png)
|
||||
|
||||
A plot of `mic_data` (defaults to bar plot):
|
||||
```r
|
||||
plot(mic_data)
|
||||
```
|
||||
|
||||
![example2](man/figures/mic_example.png)
|
||||
![example_mic](man/figures/mic_example.png)
|
||||
|
||||
Other epidemiological functions:
|
||||
|
||||
|
Binary file not shown.
Before Width: | Height: | Size: 12 KiB |
BIN
man/figures/rsi_example1.png
Normal file
BIN
man/figures/rsi_example1.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 9.4 KiB |
BIN
man/figures/rsi_example2.png
Normal file
BIN
man/figures/rsi_example2.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 7.7 KiB |
BIN
man/figures/rsi_example3.png
Normal file
BIN
man/figures/rsi_example3.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 7.0 KiB |
@ -31,7 +31,7 @@ theme_rsi()
|
||||
\item{position}{position adjustment of bars, either \code{"stack"} (default) or \code{"dodge"}}
|
||||
}
|
||||
\description{
|
||||
Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link{ggplot}} functions.
|
||||
Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions.
|
||||
}
|
||||
\details{
|
||||
At default, the names of antibiotics will be shown on the plots using \code{\link{abname}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}.
|
||||
@ -39,13 +39,13 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin
|
||||
\strong{The functions}\cr
|
||||
\code{geom_rsi} will take any variable from the data that has an \code{rsi} class (created with \code{\link{as.rsi}}) using \code{\link{portion_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.
|
||||
|
||||
\code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link{facet_wrap}}.
|
||||
\code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link[ggplot2]{facet_wrap}}.
|
||||
|
||||
\code{scale_y_percent} transforms the y axis to a 0 to 100% range.
|
||||
|
||||
\code{scale_rsi_colours} sets colours to the bars: green for S, yellow for I and red for R.
|
||||
|
||||
\code{theme_rsi} is a \code{\link{theme}} with minimal distraction.
|
||||
\code{theme_rsi} is a \code{\link[ggplot2]{theme}} with minimal distraction.
|
||||
|
||||
\code{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 (\code{\%>\%}). See Examples.
|
||||
}
|
||||
|
35
tests/testthat/test-ggplot_rsi.R
Normal file
35
tests/testthat/test-ggplot_rsi.R
Normal file
@ -0,0 +1,35 @@
|
||||
context("ggplot_rsi.R")
|
||||
|
||||
test_that("ggplot_rsi works", {
|
||||
|
||||
skip_if_not("ggplot2" %in% rownames(installed.packages()))
|
||||
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
|
||||
# data should be equal
|
||||
expect_equal(
|
||||
(septic_patients %>% select(amcl, cipr) %>% ggplot_rsi())$data %>%
|
||||
summarise_all(portion_IR) %>% as.double(),
|
||||
septic_patients %>% select(amcl, cipr) %>%
|
||||
summarise_all(portion_IR) %>% as.double()
|
||||
)
|
||||
|
||||
expect_equal(
|
||||
(septic_patients %>% select(amcl, cipr) %>% ggplot_rsi(x = "Interpretation", facet = "Antibiotic"))$data %>%
|
||||
summarise_all(portion_IR) %>% as.double(),
|
||||
septic_patients %>% select(amcl, cipr) %>%
|
||||
summarise_all(portion_IR) %>% as.double()
|
||||
)
|
||||
|
||||
expect_equal(
|
||||
(septic_patients %>% select(amcl, cipr) %>% ggplot_rsi(x = "Antibiotic", facet = "Interpretation"))$data %>%
|
||||
summarise_all(portion_IR) %>% as.double(),
|
||||
septic_patients %>% select(amcl, cipr) %>%
|
||||
summarise_all(portion_IR) %>% as.double()
|
||||
)
|
||||
|
||||
expect_error(geom_rsi(x = "test"))
|
||||
expect_error(facet_rsi(facet = "test"))
|
||||
|
||||
})
|
@ -1,6 +1,6 @@
|
||||
context("portion.R")
|
||||
|
||||
test_that("resistance works", {
|
||||
test_that("portions works", {
|
||||
# amox resistance in `septic_patients`
|
||||
expect_equal(portion_R(septic_patients$amox), 0.6603, tolerance = 0.0001)
|
||||
expect_equal(portion_I(septic_patients$amox), 0.0030, tolerance = 0.0001)
|
||||
@ -46,6 +46,9 @@ test_that("resistance works", {
|
||||
expect_warning(portion_S(as.character(septic_patients$amcl)))
|
||||
expect_warning(portion_S(as.character(septic_patients$amcl,
|
||||
septic_patients$gent)))
|
||||
expect_equal(n_rsi(as.character(septic_patients$amcl,
|
||||
septic_patients$gent)),
|
||||
1570)
|
||||
|
||||
|
||||
# check for errors
|
||||
@ -59,6 +62,9 @@ test_that("resistance works", {
|
||||
expect_error(portion_S("test", as_percent = "test"))
|
||||
expect_error(portion_S(septic_patients %>% select(amox, amcl)))
|
||||
expect_error(portion_S("R", septic_patients %>% select(amox, amcl)))
|
||||
expect_error(n_rsi(septic_patients %>% select(amox, amcl)))
|
||||
expect_error(n_rsi(septic_patients$amox, septic_patients %>% select(amox, amcl)))
|
||||
|
||||
|
||||
# check too low amount of isolates
|
||||
expect_identical(portion_R(septic_patients$amox, minimum = nrow(septic_patients) + 1),
|
||||
@ -102,6 +108,15 @@ test_that("old rsi works", {
|
||||
combination_n = n_rsi(cipr, gent)) %>%
|
||||
pull(combination_n),
|
||||
c(202, 482, 201, 499))
|
||||
|
||||
# portion_df
|
||||
expect_equal(
|
||||
septic_patients %>% select(amox) %>% portion_df(TRUE) %>% pull(Percentage),
|
||||
c(septic_patients$amox %>% portion_S(),
|
||||
septic_patients$amox %>% portion_I(),
|
||||
septic_patients$amox %>% portion_R())
|
||||
)
|
||||
|
||||
})
|
||||
|
||||
test_that("prediction of rsi works", {
|
||||
|
Loading…
Reference in New Issue
Block a user