mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 04:06: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)
|
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
2
.github/workflows/codecovr.yaml
vendored
@ -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}
|
||||||
|
@ -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
2
NEWS.md
@ -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
|
||||||
|
@ -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.")
|
||||||
}
|
}
|
||||||
|
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 <- 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
|
x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs
|
||||||
|
|
||||||
pca_data <- x[, which(sapply(x, function(x) is.numeric(x)))]
|
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))
|
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
|
# 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)) {
|
|
||||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
|
||||||
mo <- df[, mo, drop = TRUE]
|
|
||||||
}
|
|
||||||
}, silent = TRUE)
|
}, silent = TRUE)
|
||||||
}
|
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||||
}
|
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||||
if (is.null(mo)) {
|
mo <- df[, mo, drop = TRUE]
|
||||||
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",
|
}, error = function(e)
|
||||||
"To tranform all MIC values in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.mic, as.rsi).", call = FALSE)
|
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") {
|
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)) {
|
|
||||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
|
||||||
mo <- df[, mo, drop = TRUE]
|
|
||||||
}
|
|
||||||
}, silent = TRUE)
|
}, silent = TRUE)
|
||||||
}
|
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||||
}
|
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||||
if (is.null(mo)) {
|
mo <- df[, mo, drop = TRUE]
|
||||||
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",
|
}, error = function(e)
|
||||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
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") {
|
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)
|
||||||
|
@ -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:
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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">
|
||||||
|
@ -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
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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>
|
||||||
|
|
||||||
|
@ -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()))
|
||||||
|
|
||||||
})
|
})
|
||||||
|
@ -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)
|
||||||
|
@ -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))
|
||||||
|
|
||||||
})
|
})
|
||||||
|
@ -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))
|
||||||
})
|
})
|
||||||
|
@ -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))))
|
||||||
})
|
})
|
||||||
|
@ -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)
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
Loading…
Reference in New Issue
Block a user