mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 17:26:12 +01:00
(v1.4.0.9039) more unit tests
This commit is contained in:
parent
ac22b8d5c1
commit
203bc20eb0
11
.github/workflows/check.yaml
vendored
11
.github/workflows/check.yaml
vendored
@ -120,16 +120,7 @@ jobs:
|
||||
sessioninfo::session_info(pkgs, include_base = TRUE)
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Check on older R versions
|
||||
# no vignettes here, since they rely on R 3.3 and higher
|
||||
if: matrix.config.r == '3.2'
|
||||
env:
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--ignore-vignettes"), build_args = "--no-build-vignettes" , error_on = "warning", check_dir = "check")
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Check on newer R versions
|
||||
if: matrix.config.r != '3.2'
|
||||
- name: Run Check
|
||||
env:
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
|
||||
|
||||
2
.github/workflows/codecovr.yaml
vendored
2
.github/workflows/codecovr.yaml
vendored
@ -67,5 +67,5 @@ jobs:
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Test coverage
|
||||
run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/resistance_predict.R", "R/aa_helper_functions.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE)
|
||||
run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/translate.R", "R/resistance_predict.R", "R/aa_helper_functions.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE)
|
||||
shell: Rscript {0}
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 1.4.0.9038
|
||||
Version: 1.4.0.9039
|
||||
Date: 2020-12-13
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
|
||||
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 1.4.0.9038
|
||||
# AMR 1.4.0.9039
|
||||
## <small>Last updated: 13 December 2020</small>
|
||||
|
||||
### New
|
||||
|
||||
@ -187,7 +187,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
}
|
||||
|
||||
if (!is.null(found) & info == TRUE) {
|
||||
msg <- paste0("Using column '", found, "' as input for `col_", type, "`.")
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.")
|
||||
if (type %in% c("keyantibiotics", "specimen")) {
|
||||
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
|
||||
}
|
||||
|
||||
2
R/pca.R
2
R/pca.R
@ -111,7 +111,7 @@ pca <- function(x,
|
||||
x <- cbind(x.bak[, sapply(x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x)
|
||||
}
|
||||
|
||||
x <- pm_ungroup(x) # would otherwise select the grouping vars
|
||||
x <- pm_ungroup(x) # would otherwise select the grouping vars
|
||||
x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs
|
||||
|
||||
pca_data <- x[, which(sapply(x, function(x) is.numeric(x)))]
|
||||
|
||||
@ -130,4 +130,3 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
||||
return(as.disk(out))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
50
R/rsi.R
50
R/rsi.R
@ -316,22 +316,21 @@ as.rsi.mic <- function(x,
|
||||
# for auto-determining mo
|
||||
mo_var_found <- ""
|
||||
if (is.null(mo)) {
|
||||
peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(peek_mask_dplyr)) {
|
||||
tryCatch({
|
||||
df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
|
||||
mo <- NULL
|
||||
try({
|
||||
df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE)
|
||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||
if (!is.null(mo)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, silent = TRUE)
|
||||
}
|
||||
}
|
||||
if (is.null(mo)) {
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all MIC values in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.mic, as.rsi).", call = FALSE)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, error = function(e)
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
||||
)
|
||||
}
|
||||
if (length(ab) == 1 && ab %like% "as.mic") {
|
||||
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE)
|
||||
@ -406,22 +405,21 @@ as.rsi.disk <- function(x,
|
||||
# for auto-determining mo
|
||||
mo_var_found <- ""
|
||||
if (is.null(mo)) {
|
||||
peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(peek_mask_dplyr)) {
|
||||
tryCatch({
|
||||
df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
|
||||
mo <- NULL
|
||||
try({
|
||||
df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE)
|
||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||
if (!is.null(mo)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, silent = TRUE)
|
||||
}
|
||||
}
|
||||
if (is.null(mo)) {
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, error = function(e)
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
||||
)
|
||||
}
|
||||
if (length(ab) == 1 && ab %like% "as.disk") {
|
||||
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE)
|
||||
|
||||
@ -2,9 +2,8 @@
|
||||
|
||||
# `AMR` (for R)
|
||||
|
||||
<img src="https://www.r-pkg.org/badges/version-ago/AMR" />
|
||||
<img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" />
|
||||
<img src="https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg" />
|
||||
[](https://cran.R-project.org/package=AMR) [](https://cran.R-project.org/package=AMR)
|
||||
[](https://codecov.io/gh/msberends/AMR/branch/master)
|
||||
|
||||
<img src="https://msberends.github.io/AMR/works_great_on.png" align="center" height="150px" />
|
||||
|
||||
@ -21,6 +20,8 @@ This is the development source of the `AMR` package for R. Not a developer? Then
|
||||
### How to get this package
|
||||
Please see [our website](https://msberends.github.io/AMR/#get-this-package).
|
||||
|
||||
Bottom line: `install.packages("AMR")`
|
||||
|
||||
### Copyright
|
||||
|
||||
This R package is licensed under the [GNU General Public License (GPL) v2.0](https://github.com/msberends/AMR/blob/master/LICENSE). In a nutshell, this means that this package:
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
@ -236,9 +236,9 @@
|
||||
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
|
||||
</div>
|
||||
|
||||
<div id="amr-1409038" class="section level1">
|
||||
<h1 class="page-header" data-toc-text="1.4.0.9038">
|
||||
<a href="#amr-1409038" class="anchor"></a>AMR 1.4.0.9038<small> Unreleased </small>
|
||||
<div id="amr-1409039" class="section level1">
|
||||
<h1 class="page-header" data-toc-text="1.4.0.9039">
|
||||
<a href="#amr-1409039" class="anchor"></a>AMR 1.4.0.9039<small> Unreleased </small>
|
||||
</h1>
|
||||
<div id="last-updated-13-december-2020" class="section level2">
|
||||
<h2 class="hasAnchor">
|
||||
|
||||
@ -12,7 +12,7 @@ articles:
|
||||
datasets: datasets.html
|
||||
resistance_predict: resistance_predict.html
|
||||
welcome_to_AMR: welcome_to_AMR.html
|
||||
last_built: 2020-12-13T12:43Z
|
||||
last_built: 2020-12-13T19:44Z
|
||||
urls:
|
||||
reference: https://msberends.github.io/AMR//reference
|
||||
article: https://msberends.github.io/AMR//articles
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9037</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9037</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9037</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -81,7 +81,7 @@
|
||||
</button>
|
||||
<span class="navbar-brand">
|
||||
<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.4.0.9038</span>
|
||||
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9039</span>
|
||||
</span>
|
||||
</div>
|
||||
|
||||
|
||||
@ -92,4 +92,11 @@ test_that("counts work", {
|
||||
expect_error(count_df(c("A", "B", "C")))
|
||||
expect_error(count_df(example_isolates[, "date"]))
|
||||
|
||||
# grouping in rsi_calc_df() (= backbone of rsi_df())
|
||||
expect_true("hospital_id" %in% (example_isolates %>%
|
||||
group_by(hospital_id) %>%
|
||||
select(hospital_id, AMX, CIP, gender) %>%
|
||||
rsi_df() %>%
|
||||
colnames()))
|
||||
|
||||
})
|
||||
|
||||
@ -39,7 +39,12 @@ test_that("disk works", {
|
||||
expect_s3_class(c(x[1], x[9]), "disk")
|
||||
expect_s3_class(unique(x[1], x[9]), "disk")
|
||||
expect_warning(as.disk("INVALID VALUE"))
|
||||
x[2] <- 32
|
||||
expect_s3_class(x, "disk")
|
||||
|
||||
pdf(NULL) # prevent Rplots.pdf being created
|
||||
expect_silent(plot(as.disk(c(10, 20, 40))))
|
||||
|
||||
expect_output(print(as.disk(12)))
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
expect_output(print(tibble(d = as.disk(12))))
|
||||
|
||||
@ -150,6 +150,8 @@ test_that("first isolates work", {
|
||||
col_date = "non-existing col",
|
||||
col_mo = "mo"))
|
||||
|
||||
require("dplyr")
|
||||
|
||||
# look for columns itself
|
||||
expect_message(first_isolate(example_isolates))
|
||||
expect_message(first_isolate(example_isolates %>%
|
||||
@ -166,6 +168,14 @@ test_that("first isolates work", {
|
||||
first_isolate(col_date = "date",
|
||||
col_mo = "mo",
|
||||
col_patient_id = "patient_id"))
|
||||
|
||||
# support for WHONET
|
||||
expect_message(example_isolates %>%
|
||||
select(-patient_id) %>%
|
||||
mutate(`First name` = "test",
|
||||
`Last name` = "test",
|
||||
Sex = "Female") %>%
|
||||
first_isolate(info = TRUE))
|
||||
|
||||
# missing dates should be no problem
|
||||
df <- example_isolates
|
||||
@ -203,6 +213,9 @@ test_that("first isolates work", {
|
||||
# notice that all mo's are distinct, so all are TRUE
|
||||
expect_true(all(example_isolates %pm>%
|
||||
pm_distinct(mo, .keep_all = TRUE) %pm>%
|
||||
first_isolate() == TRUE))
|
||||
first_isolate(info = TRUE) == TRUE))
|
||||
|
||||
# only one isolate, so return fast
|
||||
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))
|
||||
|
||||
})
|
||||
|
||||
@ -31,8 +31,15 @@ test_that("`like` works", {
|
||||
|
||||
expect_true("test" %like% "test")
|
||||
expect_false("test" %like_case% "TEST")
|
||||
expect_true(factor("test") %like% factor("t"))
|
||||
expect_true(factor("test") %like% "t")
|
||||
expect_true("test" %like% factor("t"))
|
||||
|
||||
expect_true(as.factor("test") %like% "TEST")
|
||||
expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
|
||||
c(TRUE, TRUE, TRUE))
|
||||
expect_identical("test" %like% c("t", "e", "s", "t"),
|
||||
c(TRUE, TRUE, TRUE, TRUE))
|
||||
expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")),
|
||||
c(TRUE, TRUE, TRUE, TRUE))
|
||||
})
|
||||
|
||||
@ -43,9 +43,11 @@ test_that("mic works", {
|
||||
expect_s3_class(x[[1]], "mic")
|
||||
expect_s3_class(c(x[1], x[9]), "mic")
|
||||
expect_s3_class(unique(x[1], x[9]), "mic")
|
||||
expect_s3_class(droplevels(c(x[1], x[9])), "mic")
|
||||
x[2] <- 32
|
||||
expect_s3_class(x, "mic")
|
||||
expect_warning(as.mic("INVALID VALUE"))
|
||||
|
||||
|
||||
pdf(NULL) # prevent Rplots.pdf being created
|
||||
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
|
||||
expect_silent(plot(as.mic(c(1, 2, 4, 8))))
|
||||
@ -56,4 +58,7 @@ test_that("mic works", {
|
||||
"<NA>" = "0",
|
||||
"Min." = "2",
|
||||
"Max." = "8"), class = c("summaryDefault", "table")))
|
||||
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
expect_output(print(tibble(m = as.mic(2:4))))
|
||||
})
|
||||
|
||||
@ -49,7 +49,18 @@ test_that("PCA works", {
|
||||
expect_s3_class(pca_model, "pca")
|
||||
|
||||
pdf(NULL) # prevent Rplots.pdf being created
|
||||
|
||||
ggplot_pca(pca_model, ellipse = TRUE)
|
||||
ggplot_pca(pca_model, arrows_textangled = FALSE)
|
||||
|
||||
if (require("dplyr")) {
|
||||
resistance_data <- example_isolates %>%
|
||||
group_by(order = mo_order(mo),
|
||||
genus = mo_genus(mo)) %>%
|
||||
summarise_if(is.rsi, resistance, minimum = 0)
|
||||
pca_result <- resistance_data %>%
|
||||
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
|
||||
expect_s3_class(pca_result, "prcomp")
|
||||
ggplot_pca(pca_result, ellipse = TRUE)
|
||||
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
Loading…
Reference in New Issue
Block a user