P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 04:06:12 +01:00
Code Releases Activity

(v1.4.0.9039) more unit tests

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-12-13 20:44:32 +01:00
parent ac22b8d5c1
commit 203bc20eb0
27 changed files with 100 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.github/workflows/check.yaml vendored
View File

@ -120,16 +120,7 @@ jobs:
sessioninfo::session_info(pkgs, include_base = TRUE) sessioninfo::session_info(pkgs, include_base = TRUE)
shell: Rscript {0} shell: Rscript {0}
- name: Check on older R versions - name: Run Check
# 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'
env: env:
_R_CHECK_CRAN_INCOMING_: false _R_CHECK_CRAN_INCOMING_: false
run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")

2
.github/workflows/codecovr.yaml vendored
View File

@ -67,5 +67,5 @@ jobs:
shell: Rscript {0} shell: Rscript {0}
- name: Test coverage - 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} shell: Rscript {0}

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 1.4.0.9038 Version: 1.4.0.9039
Date: 2020-12-13 Date: 2020-12-13
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.4.0.9038 # AMR 1.4.0.9039
## <small>Last updated: 13 December 2020</small> ## <small>Last updated: 13 December 2020</small>
### New ### New

2
R/aa_helper_functions.R
View File

@ -187,7 +187,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
} }
if (!is.null(found) & 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")) { if (type %in% c("keyantibiotics", "specimen")) {
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.") msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
} }

1
R/random.R
View File

@ -130,4 +130,3 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
return(as.disk(out)) return(as.disk(out))
} }
} }

32
R/rsi.R
View File

@ -316,22 +316,21 @@ as.rsi.mic <- function(x,
# for auto-determining mo # for auto-determining mo
mo_var_found <- "" mo_var_found <- ""
if (is.null(mo)) { if (is.null(mo)) {
peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE) tryCatch({
if (!is.null(peek_mask_dplyr)) { df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
mo <- NULL
try({ try({
df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE)
mo <- suppressMessages(search_type_in_df(df, "mo")) mo <- suppressMessages(search_type_in_df(df, "mo"))
if (!is.null(mo)) { }, silent = TRUE)
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
mo_var_found <- paste0(" based on column `", font_bold(mo), "`") mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
mo <- df[, mo, drop = TRUE] mo <- df[, mo, drop = TRUE]
} }
}, silent = TRUE) }, error = function(e)
}
}
if (is.null(mo)) {
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', 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 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) "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") { if (length(ab) == 1 && ab %like% "as.mic") {
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) 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 # for auto-determining mo
mo_var_found <- "" mo_var_found <- ""
if (is.null(mo)) { if (is.null(mo)) {
peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE) tryCatch({
if (!is.null(peek_mask_dplyr)) { df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found
mo <- NULL
try({ try({
df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE)
mo <- suppressMessages(search_type_in_df(df, "mo")) mo <- suppressMessages(search_type_in_df(df, "mo"))
if (!is.null(mo)) { }, silent = TRUE)
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
mo_var_found <- paste0(" based on column `", font_bold(mo), "`") mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
mo <- df[, mo, drop = TRUE] mo <- df[, mo, drop = TRUE]
} }
}, silent = TRUE) }, error = function(e)
}
}
if (is.null(mo)) {
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', 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 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) "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") { if (length(ab) == 1 && ab %like% "as.disk") {
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE)

7
README.md
View File

@ -2,9 +2,8 @@
# `AMR` (for R) # `AMR` (for R)
<img src="https://www.r-pkg.org/badges/version-ago/AMR" /> [![CRAN_Badge](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.R-project.org/package=AMR) [![CRAN_Downloads](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.R-project.org/package=AMR)
<img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" /> [![CodeCov](https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg)](https://codecov.io/gh/msberends/AMR/branch/master)
<img src="https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg" />
<img src="https://msberends.github.io/AMR/works_great_on.png" align="center" height="150px" /> <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 ### How to get this package
Please see [our website](https://msberends.github.io/AMR/#get-this-package). Please see [our website](https://msberends.github.io/AMR/#get-this-package).
Bottom line: `install.packages("AMR")`
### Copyright ### 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: 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:

2
docs/404.html
View File

@ -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.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> </span>
</div> </div>

2
docs/LICENSE-text.html
View File

@ -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.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> </span>
</div> </div>

2
docs/articles/index.html
View File

@ -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.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> </span>
</div> </div>

2
docs/authors.html
View File

@ -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.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> </span>
</div> </div>

2
docs/index.html
View File

@ -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.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> </span>
</div> </div>

8
docs/news/index.html
View File

@ -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.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> </span>
</div> </div>
@ -236,9 +236,9 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small> <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div> </div>
<div id="amr-1409038" class="section level1"> <div id="amr-1409039" class="section level1">
<h1 class="page-header" data-toc-text="1.4.0.9038"> <h1 class="page-header" data-toc-text="1.4.0.9039">
<a href="#amr-1409038" class="anchor"></a>AMR 1.4.0.9038<small> Unreleased </small> <a href="#amr-1409039" class="anchor"></a>AMR 1.4.0.9039<small> Unreleased </small>
</h1> </h1>
<div id="last-updated-13-december-2020" class="section level2"> <div id="last-updated-13-december-2020" class="section level2">
<h2 class="hasAnchor"> <h2 class="hasAnchor">

2
docs/pkgdown.yml
View File

@ -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: 2020-12-13T12:43Z last_built: 2020-12-13T19:44Z
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

2
docs/reference/index.html
View File

@ -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.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> </span>
</div> </div>

2
docs/reference/is_new_episode.html
View File

@ -82,7 +82,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.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> </span>
</div> </div>

2
docs/reference/plot.html
View File

@ -82,7 +82,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.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> </span>
</div> </div>

2
docs/reference/random.html
View File

@ -82,7 +82,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.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> </span>
</div> </div>

2
docs/survey.html
View File

@ -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.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> </span>
</div> </div>

7
tests/testthat/test-count.R
View File

@ -92,4 +92,11 @@ test_that("counts work", {
expect_error(count_df(c("A", "B", "C"))) expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"])) 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()))
}) })

5
tests/testthat/test-disk.R
View File

@ -39,6 +39,11 @@ test_that("disk works", {
expect_s3_class(c(x[1], x[9]), "disk") expect_s3_class(c(x[1], x[9]), "disk")
expect_s3_class(unique(x[1], x[9]), "disk") expect_s3_class(unique(x[1], x[9]), "disk")
expect_warning(as.disk("INVALID VALUE")) 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))) expect_output(print(as.disk(12)))
library(dplyr, warn.conflicts = FALSE) library(dplyr, warn.conflicts = FALSE)

15
tests/testthat/test-first_isolate.R
View File

@ -150,6 +150,8 @@ test_that("first isolates work", {
col_date = "non-existing col", col_date = "non-existing col",
col_mo = "mo")) col_mo = "mo"))
require("dplyr")
# look for columns itself # look for columns itself
expect_message(first_isolate(example_isolates)) expect_message(first_isolate(example_isolates))
expect_message(first_isolate(example_isolates %>% expect_message(first_isolate(example_isolates %>%
@ -167,6 +169,14 @@ test_that("first isolates work", {
col_mo = "mo", col_mo = "mo",
col_patient_id = "patient_id")) 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 # missing dates should be no problem
df <- example_isolates df <- example_isolates
df[1:100, "date"] <- NA df[1:100, "date"] <- NA
@ -203,6 +213,9 @@ test_that("first isolates work", {
# notice that all mo's are distinct, so all are TRUE # notice that all mo's are distinct, so all are TRUE
expect_true(all(example_isolates %pm>% expect_true(all(example_isolates %pm>%
pm_distinct(mo, .keep_all = TRUE) %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))
}) })

7
tests/testthat/test-like.R
View File

@ -31,8 +31,15 @@ test_that("`like` works", {
expect_true("test" %like% "test") expect_true("test" %like% "test")
expect_false("test" %like_case% "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_true(as.factor("test") %like% "TEST")
expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"), expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
c(TRUE, TRUE, TRUE)) 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))
}) })

7
tests/testthat/test-mic.R
View File

@ -43,9 +43,11 @@ test_that("mic works", {
expect_s3_class(x[[1]], "mic") expect_s3_class(x[[1]], "mic")
expect_s3_class(c(x[1], x[9]), "mic") expect_s3_class(c(x[1], x[9]), "mic")
expect_s3_class(unique(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")) expect_warning(as.mic("INVALID VALUE"))
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8)))) expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(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", "<NA>" = "0",
"Min." = "2", "Min." = "2",
"Max." = "8"), class = c("summaryDefault", "table"))) "Max." = "8"), class = c("summaryDefault", "table")))
library(dplyr, warn.conflicts = FALSE)
expect_output(print(tibble(m = as.mic(2:4))))
}) })

13
tests/testthat/test-pca.R
View File

@ -49,7 +49,18 @@ test_that("PCA works", {
expect_s3_class(pca_model, "pca") expect_s3_class(pca_model, "pca")
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
ggplot_pca(pca_model, ellipse = TRUE) ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE) 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)
}
}) })