mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 19:26:13 +01:00
(v1.5.0.9017) unit testing
This commit is contained in:
parent
4a84894f79
commit
cb404492b2
@ -1,5 +1,5 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 1.5.0.9016
|
Version: 1.5.0.9017
|
||||||
Date: 2021-02-08
|
Date: 2021-02-08
|
||||||
Title: Antimicrobial Resistance Data Analysis
|
Title: Antimicrobial Resistance Data Analysis
|
||||||
Authors@R: c(
|
Authors@R: c(
|
||||||
|
6
NEWS.md
6
NEWS.md
@ -1,4 +1,4 @@
|
|||||||
# AMR 1.5.0.9016
|
# AMR 1.5.0.9017
|
||||||
## <small>Last updated: 8 February 2021</small>
|
## <small>Last updated: 8 February 2021</small>
|
||||||
|
|
||||||
### New
|
### New
|
||||||
@ -52,11 +52,11 @@
|
|||||||
* WHONET code `"PNV"` will now correctly be interpreted as `PHN`, the antibiotic code for phenoxymethylpenicillin ('peni V')
|
* 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*)
|
* 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.
|
* `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)
|
* 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")
|
* Argument `ampc_cephalosporin_resistance` in `eucast_rules()` now also applies to value "I" (not only "S")
|
||||||
* Updated colours of values R, S and I in tibble printing
|
* Updated colours of values R, S and I in tibble printing
|
||||||
* 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()`
|
* 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 of `guess_ab_col()`
|
* 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.
|
||||||
|
|
||||||
### Other
|
### Other
|
||||||
* Big documentation updates
|
* Big documentation updates
|
||||||
|
@ -734,7 +734,7 @@ get_current_column <- function() {
|
|||||||
|
|
||||||
is_null_or_grouped_tbl <- function(x) {
|
is_null_or_grouped_tbl <- function(x) {
|
||||||
# attribute "grouped_df" might change at one point, so only set in one place; here.
|
# attribute "grouped_df" might change at one point, so only set in one place; here.
|
||||||
is.null(x) || inherits(x, "grouped_tbl")
|
is.null(x) || inherits(x, "grouped_df")
|
||||||
}
|
}
|
||||||
|
|
||||||
unique_call_id <- function(entire_session = FALSE) {
|
unique_call_id <- function(entire_session = FALSE) {
|
||||||
|
@ -147,9 +147,6 @@ filter_ab_class <- function(x,
|
|||||||
} else {
|
} else {
|
||||||
scope_txt <- " and "
|
scope_txt <- " and "
|
||||||
scope_fn <- all
|
scope_fn <- all
|
||||||
if (length(agents) > 1) {
|
|
||||||
operator <- gsub("is", "are", operator)
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
if (length(agents) > 1) {
|
if (length(agents) > 1) {
|
||||||
operator <- " are"
|
operator <- " are"
|
||||||
|
@ -187,7 +187,8 @@ first_isolate <- function(x = NULL,
|
|||||||
if (is_null_or_grouped_tbl(x)) {
|
if (is_null_or_grouped_tbl(x)) {
|
||||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
# 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)
|
# is also fix for using a grouped df as input (a dot as first argument)
|
||||||
x <- get_current_data(arg_name = "x", call = -2)
|
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||||
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
}
|
}
|
||||||
# remove data.table, grouping from tibbles, etc.
|
# remove data.table, grouping from tibbles, etc.
|
||||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||||
@ -518,7 +519,8 @@ filter_first_isolate <- function(x = NULL,
|
|||||||
if (is_null_or_grouped_tbl(x)) {
|
if (is_null_or_grouped_tbl(x)) {
|
||||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
# 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)
|
# is also fix for using a grouped df as input (a dot as first argument)
|
||||||
x <- get_current_data(arg_name = "x", call = -2)
|
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||||
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
}
|
}
|
||||||
subset(x, first_isolate(x = x,
|
subset(x, first_isolate(x = x,
|
||||||
col_date = col_date,
|
col_date = col_date,
|
||||||
@ -543,7 +545,8 @@ filter_first_weighted_isolate <- function(x = NULL,
|
|||||||
if (is_null_or_grouped_tbl(x)) {
|
if (is_null_or_grouped_tbl(x)) {
|
||||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
# 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)
|
# is also fix for using a grouped df as input (a dot as first argument)
|
||||||
x <- get_current_data(arg_name = "x", call = -2)
|
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||||
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
}
|
}
|
||||||
y <- x
|
y <- x
|
||||||
if (is.null(col_keyantibiotics)) {
|
if (is.null(col_keyantibiotics)) {
|
||||||
|
@ -155,7 +155,8 @@ key_antibiotics <- function(x = NULL,
|
|||||||
if (is_null_or_grouped_tbl(x)) {
|
if (is_null_or_grouped_tbl(x)) {
|
||||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
# 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)
|
# is also fix for using a grouped df as input (a dot as first argument)
|
||||||
x <- get_current_data(arg_name = "x", call = -2)
|
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||||
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
}
|
}
|
||||||
# force regular data.frame, not a tibble or data.table
|
# force regular data.frame, not a tibble or data.table
|
||||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||||
|
3
R/mdro.R
3
R/mdro.R
@ -218,7 +218,8 @@ mdro <- function(x = NULL,
|
|||||||
if (is_null_or_grouped_tbl(x)) {
|
if (is_null_or_grouped_tbl(x)) {
|
||||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
# 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)
|
# is also fix for using a grouped df as input (a dot as first argument)
|
||||||
x <- get_current_data(arg_name = "x", call = -2)
|
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||||
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
}
|
}
|
||||||
|
|
||||||
# force regular data.frame, not a tibble or data.table
|
# force regular data.frame, not a tibble or data.table
|
||||||
|
Binary file not shown.
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
|
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="../index.html">AMR (for R)</a>
|
<a class="navbar-link" href="../index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -43,7 +43,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -12,7 +12,7 @@ articles:
|
|||||||
datasets: datasets.html
|
datasets: datasets.html
|
||||||
resistance_predict: resistance_predict.html
|
resistance_predict: resistance_predict.html
|
||||||
welcome_to_AMR: welcome_to_AMR.html
|
welcome_to_AMR: welcome_to_AMR.html
|
||||||
last_built: 2021-02-08T12:50Z
|
last_built: 2021-02-08T19:58Z
|
||||||
urls:
|
urls:
|
||||||
reference: https://msberends.github.io/AMR//reference
|
reference: https://msberends.github.io/AMR//reference
|
||||||
article: https://msberends.github.io/AMR//articles
|
article: https://msberends.github.io/AMR//articles
|
||||||
|
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="../index.html">AMR (for R)</a>
|
<a class="navbar-link" href="../index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -81,7 +81,7 @@
|
|||||||
</button>
|
</button>
|
||||||
<span class="navbar-brand">
|
<span class="navbar-brand">
|
||||||
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
<a class="navbar-link" href="index.html">AMR (for R)</a>
|
||||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9016</span>
|
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9017</span>
|
||||||
</span>
|
</span>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
|
@ -39,6 +39,7 @@ test_that("Antibiotic class selectors work", {
|
|||||||
expect_lt(example_isolates %>% dplyr::select(fluoroquinolones()) %>% ncol(), ncol(example_isolates))
|
expect_lt(example_isolates %>% dplyr::select(fluoroquinolones()) %>% ncol(), ncol(example_isolates))
|
||||||
expect_lt(example_isolates %>% dplyr::select(glycopeptides()) %>% ncol(), ncol(example_isolates))
|
expect_lt(example_isolates %>% dplyr::select(glycopeptides()) %>% ncol(), ncol(example_isolates))
|
||||||
expect_lt(example_isolates %>% dplyr::select(macrolides()) %>% ncol(), ncol(example_isolates))
|
expect_lt(example_isolates %>% dplyr::select(macrolides()) %>% ncol(), ncol(example_isolates))
|
||||||
|
expect_lt(example_isolates %>% dplyr::select(oxazolidinones()) %>% ncol(), ncol(example_isolates))
|
||||||
expect_lt(example_isolates %>% dplyr::select(penicillins()) %>% ncol(), ncol(example_isolates))
|
expect_lt(example_isolates %>% dplyr::select(penicillins()) %>% ncol(), ncol(example_isolates))
|
||||||
expect_lt(example_isolates %>% dplyr::select(tetracyclines()) %>% ncol(), ncol(example_isolates))
|
expect_lt(example_isolates %>% dplyr::select(tetracyclines()) %>% ncol(), ncol(example_isolates))
|
||||||
|
|
@ -30,17 +30,20 @@ test_that("ATC-group filtering works", {
|
|||||||
|
|
||||||
library(dplyr)
|
library(dplyr)
|
||||||
expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0)
|
||||||
expect_gt(example_isolates %>% filter_aminoglycosides() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_aminoglycosides() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_carbapenems() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_carbapenems() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_cephalosporins() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_1st_cephalosporins() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_1st_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_2nd_cephalosporins() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_2nd_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_3rd_cephalosporins() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_3rd_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_4th_cephalosporins() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_4th_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_fluoroquinolones() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_5th_cephalosporins() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_glycopeptides() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_fluoroquinolones() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_macrolides() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_glycopeptides() %>% ncol(), 0)
|
||||||
expect_gt(example_isolates %>% filter_tetracyclines() %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_macrolides() %>% ncol(), 0)
|
||||||
|
expect_gt(example_isolates %>% filter_oxazolidinones() %>% ncol(), 0)
|
||||||
|
expect_gt(example_isolates %>% filter_penicillins() %>% ncol(), 0)
|
||||||
|
expect_gt(example_isolates %>% filter_tetracyclines() %>% ncol(), 0)
|
||||||
|
|
||||||
expect_gt(example_isolates %>% filter_carbapenems("R", "all") %>% nrow(), 0)
|
expect_gt(example_isolates %>% filter_carbapenems("R", "all") %>% nrow(), 0)
|
||||||
|
|
||||||
|
@ -50,7 +50,7 @@ test_that("first isolates work", {
|
|||||||
type = "keyantibiotics",
|
type = "keyantibiotics",
|
||||||
info = TRUE),
|
info = TRUE),
|
||||||
na.rm = TRUE)),
|
na.rm = TRUE)),
|
||||||
1396)
|
1395)
|
||||||
|
|
||||||
# when not ignoring I
|
# when not ignoring I
|
||||||
expect_equal(
|
expect_equal(
|
||||||
@ -65,7 +65,7 @@ test_that("first isolates work", {
|
|||||||
type = "keyantibiotics",
|
type = "keyantibiotics",
|
||||||
info = TRUE),
|
info = TRUE),
|
||||||
na.rm = TRUE)),
|
na.rm = TRUE)),
|
||||||
1419)
|
1418)
|
||||||
# when using points
|
# when using points
|
||||||
expect_equal(
|
expect_equal(
|
||||||
suppressWarnings(
|
suppressWarnings(
|
||||||
@ -78,7 +78,7 @@ test_that("first isolates work", {
|
|||||||
type = "points",
|
type = "points",
|
||||||
info = TRUE),
|
info = TRUE),
|
||||||
na.rm = TRUE)),
|
na.rm = TRUE)),
|
||||||
1399)
|
1398)
|
||||||
|
|
||||||
# first non-ICU isolates
|
# first non-ICU isolates
|
||||||
expect_equal(
|
expect_equal(
|
||||||
|
@ -47,7 +47,7 @@ test_that("mdro works", {
|
|||||||
library(dplyr)
|
library(dplyr)
|
||||||
# example_isolates should have these finding using Dutch guidelines
|
# example_isolates should have these finding using Dutch guidelines
|
||||||
expect_equal(as.double(table(outcome)),
|
expect_equal(as.double(table(outcome)),
|
||||||
c(1969, 25, 6)) # 1969 neg, 25 unconfirmed, 6 pos
|
c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos
|
||||||
|
|
||||||
expect_equal(brmo(example_isolates, info = FALSE),
|
expect_equal(brmo(example_isolates, info = FALSE),
|
||||||
mdro(example_isolates, guideline = "BRMO", info = FALSE))
|
mdro(example_isolates, guideline = "BRMO", info = FALSE))
|
||||||
@ -241,4 +241,9 @@ test_that("mdro works", {
|
|||||||
guideline = custom_mdro_guideline(test ~ "A"),
|
guideline = custom_mdro_guideline(test ~ "A"),
|
||||||
info = FALSE))
|
info = FALSE))
|
||||||
|
|
||||||
|
# print groups
|
||||||
|
library(dplyr)
|
||||||
|
expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE))
|
||||||
|
expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
|
||||||
|
|
||||||
})
|
})
|
||||||
|
Loading…
Reference in New Issue
Block a user