P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2026-05-31 11:01:42 +02:00
Code Releases Activity

unit tedts

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2026-04-30 09:22:24 +02:00
parent cd70349e8c
commit 95a32a5994
3 changed files with 21 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
R/antibiogram.R
View File

@@ -1206,7 +1206,7 @@ retrieve_wisca_parameters <- function(wisca_model, ...) {
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_sum, antibiogram) #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_sum, antibiogram)
tbl_sum.antibiogram <- function(x, ...) { tbl_sum.antibiogram <- function(x, ...) {
dims <- paste(format(NROW(x), big.mark = ","), AMR_env$cross_icon, format(NCOL(x), big.mark = ",")) dims <- paste(format(NROW(x), big.mark = ","), AMR_env$cross_icon, format(NCOL(x), big.mark = ","))
names(dims) <- "An Antibiogram" names(dims) <- "An antibiogram"
if (isTRUE(attributes(x)$wisca)) { if (isTRUE(attributes(x)$wisca)) {
dims <- c(dims, Type = paste0("WISCA with ", attributes(x)$conf_interval * 100, "% CI")) dims <- c(dims, Type = paste0("WISCA with ", attributes(x)$conf_interval * 100, "% CI"))
} else if (isTRUE(attributes(x)$formatting_type >= 13)) { } else if (isTRUE(attributes(x)$formatting_type >= 13)) {
@@ -1226,8 +1226,7 @@ tbl_format_footer.antibiogram <- function(x, ...) {
} }
c(footer, font_subtle(paste0( c(footer, font_subtle(paste0(
"# Use `ggplot2::autoplot()` or base R `plot()` to create a plot of this antibiogram,\n", "# Use `ggplot2::autoplot()` or base R `plot()` to create a plot of this antibiogram,\n",
"# or use it directly in R Markdown or ", "# or use it directly in R Markdown or Quarto, see ", word_wrap("?antibiogram")
font_url("https://quarto.org", "Quarto"), ", see ", word_wrap("?antibiogram")
))) )))
} }

23
R/bug_drug_combinations.R
View File

@@ -129,16 +129,21 @@ bug_drug_combinations <- function(x,
# turn and merge everything # turn and merge everything
pivot <- lapply(x_mo_filter, function(x) { pivot <- lapply(x_mo_filter, function(x) {
m <- as.matrix(table(as.sir(x), useNA = "always")) m <- as.matrix(table(as.sir(x), useNA = "always"))
na_idx <- which(is.na(rownames(m)))
get_row <- function(lbl) {
idx <- which(rownames(m) == lbl)
if (length(idx) == 1L) unname(m[idx, ]) else rep(0L, ncol(m))
}
data.frame( data.frame(
S = m["S", ], S = get_row("S"),
SDD = m["SDD", ], SDD = get_row("SDD"),
I = m["I", ], I = get_row("I"),
R = m["R", ], R = get_row("R"),
NI = m["NI", ], NI = get_row("NI"),
WT = m["WT", ], WT = get_row("WT"),
NWT = m["NWT", ], NWT = get_row("NWT"),
NS = m["NS", ], NS = get_row("NS"),
na = m[which(is.na(rownames(m))), ], na = if (length(na_idx) == 1L) unname(m[na_idx, ]) else rep(0L, ncol(m)),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
}) })

10
tests/testthat/test-sir.R
View File

@@ -491,13 +491,13 @@ test_that("test-sir.R", {
expect_identical(sir_par[["AMC"]], sir_par2[["AMC"]]) expect_identical(sir_par[["AMC"]], sir_par2[["AMC"]])
expect_identical(sir_par[["GEN"]], sir_par2[["GEN"]]) expect_identical(sir_par[["GEN"]], sir_par2[["GEN"]])
# 5. max_cores = 1 gives same results as default sequential # 5. used cores = 1 gives same results as default sequential
future::plan(future::multicore, workers = 1) future::plan(future::multicore, workers = 1)
sir_mc1 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE)) sir_mc1 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
expect_identical(sir_seq[["AMC"]], sir_mc1[["AMC"]]) expect_identical(sir_seq[["AMC"]], sir_mc1[["AMC"]])
expect_identical(sir_seq[["GEN"]], sir_mc1[["GEN"]]) expect_identical(sir_seq[["GEN"]], sir_mc1[["GEN"]])
# 6. max_cores = 2 and max_cores = 3 give same results as sequential # 6. used cores = 2 and used cores = 3 give same results as sequential
if (n_max_workers >= 3) { if (n_max_workers >= 3) {
future::plan(future::multicore, workers = 2) future::plan(future::multicore, workers = 2)
sir_mc2 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE)) sir_mc2 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
@@ -515,9 +515,9 @@ test_that("test-sir.R", {
sir_single_par <- suppressMessages(as.sir(df_single, col_mo = "mo", info = FALSE, parallel = TRUE)) sir_single_par <- suppressMessages(as.sir(df_single, col_mo = "mo", info = FALSE, parallel = TRUE))
expect_identical(sir_single_seq[["AMC"]], sir_single_par[["AMC"]]) expect_identical(sir_single_seq[["AMC"]], sir_single_par[["AMC"]])
# 8. row-batch mode (n_cols < n_cores): force row splitting via max_cores and # 8. row-batch mode (n_cols < n_cores): force row splitting via used cores and
# verify identical output to sequential for a dataset with 2 AB columns so # verify identical output to sequential for a dataset with 2 AB columns so
# pieces_per_col = ceiling(max_cores / 2) >= 2 and row batching activates # pieces_per_col = ceiling(used cores / 2) >= 2 and row batching activates
df_wide <- data.frame( df_wide <- data.frame(
mo = "B_ESCHR_COLI", mo = "B_ESCHR_COLI",
AMC = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)), AMC = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)),
@@ -529,7 +529,7 @@ test_that("test-sir.R", {
future::plan(future::multicore) future::plan(future::multicore)
sir_wide_par <- suppressMessages(as.sir(df_wide, sir_wide_par <- suppressMessages(as.sir(df_wide,
col_mo = "mo", info = FALSE, col_mo = "mo", info = FALSE,
parallel = TRUE, max_cores = 8L parallel = TRUE
)) ))
expect_identical(sir_wide_seq[["AMC"]], sir_wide_par[["AMC"]]) expect_identical(sir_wide_seq[["AMC"]], sir_wide_par[["AMC"]])
expect_identical(sir_wide_seq[["GEN"]], sir_wide_par[["GEN"]]) expect_identical(sir_wide_seq[["GEN"]], sir_wide_par[["GEN"]])