Browse Source

(v1.4.0.9039) more unit tests

new-mo-algorithm
parent
commit
203bc20eb0
  1. 11
      .github/workflows/check.yaml
  2. 2
      .github/workflows/codecovr.yaml
  3. 2
      DESCRIPTION
  4. 2
      NEWS.md
  5. 2
      R/aa_helper_functions.R
  6. 2
      R/pca.R
  7. 1
      R/random.R
  8. 50
      R/rsi.R
  9. 7
      README.md
  10. 2
      docs/404.html
  11. 2
      docs/LICENSE-text.html
  12. 2
      docs/articles/index.html
  13. 2
      docs/authors.html
  14. 2
      docs/index.html
  15. 8
      docs/news/index.html
  16. 2
      docs/pkgdown.yml
  17. 2
      docs/reference/index.html
  18. 2
      docs/reference/is_new_episode.html
  19. 2
      docs/reference/plot.html
  20. 2
      docs/reference/random.html
  21. 2
      docs/survey.html
  22. 7
      tests/testthat/test-count.R
  23. 5
      tests/testthat/test-disk.R
  24. 15
      tests/testthat/test-first_isolate.R
  25. 7
      tests/testthat/test-like.R
  26. 7
      tests/testthat/test-mic.R
  27. 13
      tests/testthat/test-pca.R

11
.github/workflows/check.yaml

@ -120,16 +120,7 @@ jobs: @@ -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

@ -67,5 +67,5 @@ jobs: @@ -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}

2
DESCRIPTION

@ -1,5 +1,5 @@ @@ -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

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

2
R/aa_helper_functions.R

@ -187,7 +187,7 @@ search_type_in_df <- function(x, type, info = TRUE) { @@ -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

@ -111,7 +111,7 @@ pca <- function(x, @@ -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)))]

1
R/random.R

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

50
R/rsi.R

@ -316,22 +316,21 @@ as.rsi.mic <- function(x, @@ -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, @@ -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)

7
README.md

@ -2,9 +2,8 @@ @@ -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" />
[![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)
[![CodeCov](https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg)](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 @@ -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:

2
docs/404.html

@ -81,7 +81,7 @@ @@ -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>

2
docs/LICENSE-text.html

@ -81,7 +81,7 @@ @@ -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>

2
docs/articles/index.html

@ -81,7 +81,7 @@ @@ -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>

2
docs/authors.html

@ -81,7 +81,7 @@ @@ -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>

2
docs/index.html

@ -43,7 +43,7 @@ @@ -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>

8
docs/news/index.html

@ -81,7 +81,7 @@ @@ -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 @@ @@ -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">

2
docs/pkgdown.yml

@ -12,7 +12,7 @@ articles: @@ -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

2
docs/reference/index.html

@ -81,7 +81,7 @@ @@ -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>

2
docs/reference/is_new_episode.html

@ -82,7 +82,7 @@ @@ -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>

2
docs/reference/plot.html

@ -82,7 +82,7 @@ @@ -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>

2
docs/reference/random.html

@ -82,7 +82,7 @@ @@ -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>

2
docs/survey.html

@ -81,7 +81,7 @@ @@ -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>

7
tests/testthat/test-count.R

@ -92,4 +92,11 @@ test_that("counts work", { @@ -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()))
})

5
tests/testthat/test-disk.R

@ -39,7 +39,12 @@ test_that("disk works", { @@ -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))))

15
tests/testthat/test-first_isolate.R

@ -150,6 +150,8 @@ test_that("first isolates work", { @@ -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", { @@ -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", { @@ -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))
})

7
tests/testthat/test-like.R

@ -31,8 +31,15 @@ test_that("`like` works", { @@ -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))
})

7
tests/testthat/test-mic.R

@ -43,9 +43,11 @@ test_that("mic works", { @@ -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", { @@ -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))))
})

13
tests/testthat/test-pca.R

@ -49,7 +49,18 @@ test_that("PCA works", { @@ -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…
Cancel
Save