1
0
mirror of https://github.com/msberends/AMR.git synced 2025-09-15 13:09:38 +02:00

(v3.0.0.9027) skimr update and as.ab warning - fixes #234, fixes #232

This commit is contained in:
2025-09-10 13:32:52 +02:00
parent d5a568318b
commit 4d7c4ca52c
13 changed files with 92 additions and 58 deletions

View File

@@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 3.0.0.9026 Version: 3.0.0.9027
Date: 2025-09-04 Date: 2025-09-10
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

View File

@@ -388,6 +388,7 @@ if(getRversion() >= "3.0.0") S3method(pillar::type_sum, av)
if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic) if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic)
if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo) if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo)
if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir) if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir)
if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab)
if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk) if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic) if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic)
if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo) if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)

View File

@@ -1,4 +1,4 @@
# AMR 3.0.0.9026 # AMR 3.0.0.9027
This is a bugfix release following the release of v3.0.0 in June 2025. This is a bugfix release following the release of v3.0.0 in June 2025.
@@ -13,8 +13,10 @@ This is a bugfix release following the release of v3.0.0 in June 2025.
* Fixed a bug the `antimicrobials` data set to remove statins (#229) * Fixed a bug the `antimicrobials` data set to remove statins (#229)
* Fixed a bug in `mdro()` to make sure all genes specified in arguments are acknowledged * Fixed a bug in `mdro()` to make sure all genes specified in arguments are acknowledged
* Fixed ATC J01CR05 to map to piperacillin/tazobactam rather than piperacillin/sulbactam (#230) * Fixed ATC J01CR05 to map to piperacillin/tazobactam rather than piperacillin/sulbactam (#230)
* Fixed skimmers (`skimr` package) of class `ab`, `sir`, and `disk` (#234)
* Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223) * Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223)
* Fixed some specific Dutch translations for antimicrobials * Fixed some specific Dutch translations for antimicrobials
* Added a warning to `as.ab()` if input resembles antiviral codes or names (#232)
* Added all reasons in verbose output of `mdro()` (#227) * Added all reasons in verbose output of `mdro()` (#227)
* Added `names` to `age_groups()` so that custom names can be given (#215) * Added `names` to `age_groups()` so that custom names can be given (#215)
* Added note to `as.sir()` to make it explicit when higher-level taxonomic breakpoints are used (#218) * Added note to `as.sir()` to make it explicit when higher-level taxonomic breakpoints are used (#218)

19
R/ab.R
View File

@@ -202,6 +202,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
if (sum(already_known) < length(x)) { if (sum(already_known) < length(x)) {
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25 progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
on.exit(close(progress)) on.exit(close(progress))
if (any(x_new[!already_known] %in% unlist(AMR_env$AV_lookup$generalised_all, use.names = FALSE), na.rm = TRUE)) {
warning_("in `as.ab()`: some input seem to resemble antiviral drugs - use `as.av()` or e.g. `av_name()` for these, not `as.ab()` or e.g. `ab_name()`.")
}
} }
for (i in which(!already_known)) { for (i in which(!already_known)) {
@@ -448,7 +451,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
x_unknown <- x_unknown[!x_unknown %in% c("", NA)] x_unknown <- x_unknown[!x_unknown %in% c("", NA)]
if (length(x_unknown) > 0 && fast_mode == FALSE) { if (length(x_unknown) > 0 && fast_mode == FALSE) {
warning_( warning_(
"in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ", "in `as.ab()`: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
vector_and(x_unknown), "." vector_and(x_unknown), "."
) )
} }
@@ -627,6 +630,20 @@ rep.ab <- function(x, ...) {
out out
} }
# this prevents the requirement for putting the dependency in Imports:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab)
get_skimmers.ab <- function(column) {
ab <- as.ab(column, info = FALSE)
ab <- ab[!is.na(ab)]
skimr::sfl(
skim_type = "ab",
n_unique = ~ length(unique(ab)),
top_ab = ~ names(sort(-table(ab)))[1L],
top_ab_name = ~ names(sort(-table(ab_name(ab, info = FALSE))))[1L],
top_group = ~ names(sort(-table(ab_group(ab, info = FALSE))))[1L]
)
}
generalise_antibiotic_name <- function(x) { generalise_antibiotic_name <- function(x) {
x <- toupper(x) x <- toupper(x)
# remove suffices # remove suffices

View File

@@ -236,12 +236,14 @@ rep.disk <- function(x, ...) {
# this prevents the requirement for putting the dependency in Imports: # this prevents the requirement for putting the dependency in Imports:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk) #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
get_skimmers.disk <- function(column) { get_skimmers.disk <- function(column) {
column <- as.integer(column)
skimr::sfl( skimr::sfl(
skim_type = "disk", skim_type = "disk",
min = ~ min(as.double(.), na.rm = TRUE), p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
max = ~ max(as.double(.), na.rm = TRUE), p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
median = ~ stats::median(as.double(.), na.rm = TRUE), p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
n_unique = ~ length(unique(stats::na.omit(.))), p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
hist = ~ skimr::inline_hist(stats::na.omit(as.double(.))) p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE),
hist = ~ skimr::inline_hist(stats::na.omit(column), 10)
) )
} }

12
R/mic.R
View File

@@ -596,12 +596,12 @@ get_skimmers.mic <- function(column) {
column <- as.mic(column) # make sure that currently implemented MIC levels are used column <- as.mic(column) # make sure that currently implemented MIC levels are used
skimr::sfl( skimr::sfl(
skim_type = "mic", skim_type = "mic",
p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE), p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
p25 = ~ stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE), p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
p50 = ~ stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE), p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
p75 = ~ stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE), p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE), p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE),
hist = ~ skimr::inline_hist(log2(stats::na.omit(.)), 5) hist = ~ skimr::inline_hist(log2(stats::na.omit(column)), 10)
) )
} }

14
R/mo.R
View File

@@ -747,13 +747,17 @@ freq.mo <- function(x, ...) {
# this prevents the requirement for putting the dependency in Imports: # this prevents the requirement for putting the dependency in Imports:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo) #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
get_skimmers.mo <- function(column) { get_skimmers.mo <- function(column) {
mo <- as.mo(column, keep_synonyms = TRUE, language = NULL, info = FALSE)
mo <- mo[!is.na(mo)]
spp <- mo[mo_species(mo, keep_synonyms = TRUE, language = NULL, info = FALSE) != ""]
skimr::sfl( skimr::sfl(
skim_type = "mo", skim_type = "mo",
unique_total = ~ length(unique(stats::na.omit(.))), n_unique = ~ length(unique(mo)),
gram_negative = ~ sum(mo_is_gram_negative(.), na.rm = TRUE), gram_negative = ~ sum(mo_is_gram_negative(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
gram_positive = ~ sum(mo_is_gram_positive(.), na.rm = TRUE), gram_positive = ~ sum(mo_is_gram_positive(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
top_genus = ~ names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L], yeast = ~ sum(mo_is_yeast(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
top_species = ~ names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L] top_genus = ~ names(sort(-table(mo_genus(mo, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L],
top_species = ~ names(sort(-table(mo_name(spp, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L],
) )
} }

33
R/sir.R
View File

@@ -1974,33 +1974,18 @@ freq.sir <- function(x, ...) {
# this prevents the requirement for putting the dependency in Imports: # this prevents the requirement for putting the dependency in Imports:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir) #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
get_skimmers.sir <- function(column) { get_skimmers.sir <- function(column) {
# get the variable name 'skim_variable' # TODO add here in AMR 3.1.0 details about guideline
name_call <- function(.data) {
calls <- sys.calls()
frms <- sys.frames()
calls_txt <- vapply(calls, function(x) paste(deparse(x), collapse = ""), FUN.VALUE = character(1))
if (any(calls_txt %like% "skim_variable", na.rm = TRUE)) {
ind <- which(calls_txt %like% "skim_variable")[1L]
vars <- tryCatch(eval(parse(text = ".data$skim_variable$sir"), envir = frms[[ind]]),
error = function(e) NULL
)
tryCatch(ab_name(as.character(calls[[length(calls)]][[2]]), language = NULL, info = FALSE),
error = function(e) NA_character_
)
} else {
NA_character_
}
}
skimr::sfl( skimr::sfl(
skim_type = "sir", skim_type = "sir",
ab_name = name_call, # guideline = function(x) "EUCAST 2025", # or "Multiple"
count_R = count_R, # origin = function(x) "MIC", # or "Multiple"
count_S = count_susceptible, count_S = count_S,
count_I = count_I, count_I = count_I,
prop_R = ~ proportion_R(., minimum = 0), count_R = count_R,
prop_S = ~ susceptibility(., minimum = 0), prop_S = ~ round(proportion_S(., minimum = 0) * 100, 1),
prop_I = ~ proportion_I(., minimum = 0) prop_I = ~ round(proportion_I(., minimum = 0) * 100, 1),
prop_R = ~ round(proportion_R(., minimum = 0) * 100, 1),
hist = ~ skimr::inline_hist(as.double(stats::na.omit(.)), 3)
) )
} }

View File

@@ -96,6 +96,14 @@ test_that("test-ab.R", {
rep("GEH", 8) rep("GEH", 8)
) )
# skimr
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_named(
skim(clinical_breakpoints$ab),
c("skim_type", "skim_variable", "n_missing", "complete_rate", "ab.n_unique", "ab.top_ab", "ab.top_ab_name", "ab.top_group")
)
}
# assigning and subsetting # assigning and subsetting
x <- AMR::antimicrobials$ab x <- AMR::antimicrobials$ab
expect_inherits(x[1], "ab") expect_inherits(x[1], "ab")

View File

@@ -60,4 +60,12 @@ test_that("test-disk.R", {
if (AMR:::pkg_is_available("tibble")) { if (AMR:::pkg_is_available("tibble")) {
expect_output(print(tibble::tibble(d = as.disk(12)))) expect_output(print(tibble::tibble(d = as.disk(12))))
} }
# skimr
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_named(
skim(random_disk(100)),
c("skim_type", "skim_variable", "n_missing", "complete_rate", "disk.p0", "disk.p25", "disk.p50", "disk.p75", "disk.p100", "disk.hist")
)
}
}) })

View File

@@ -81,6 +81,14 @@ test_that("test-mic.R", {
expect_output(print(tibble::tibble(m = as.mic(2:4)))) expect_output(print(tibble::tibble(m = as.mic(2:4))))
} }
# skimr
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_named(
skim(random_mic(100)),
c("skim_type", "skim_variable", "n_missing", "complete_rate", "mic.p0", "mic.p25", "mic.p50", "mic.p75", "mic.p100", "mic.hist")
)
}
# all mathematical operations # all mathematical operations
x <- random_mic(50) x <- random_mic(50)
x_double <- as.double(gsub("[<=>]+", "", as.character(x))) x_double <- as.double(gsub("[<=>]+", "", as.character(x)))

View File

@@ -321,4 +321,12 @@ test_that("test-mo.R", {
if (AMR:::pkg_is_available("cleaner")) { if (AMR:::pkg_is_available("cleaner")) {
expect_inherits(cleaner::freq(example_isolates$mo), "freq") expect_inherits(cleaner::freq(example_isolates$mo), "freq")
} }
# skimr
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_named(
skim(example_isolates$mo),
c("skim_type", "skim_variable", "n_missing", "complete_rate", "mo.n_unique", "mo.gram_negative", "mo.gram_positive", "mo.yeast", "mo.top_genus", "mo.top_species")
)
}
}) })

View File

@@ -103,22 +103,13 @@ test_that("test-sir.R", {
pull(MEM) %>% pull(MEM) %>%
is.sir()) is.sir())
} }
# skimr
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_inherits( expect_named(
skim(example_isolates), skim(example_isolates$PEN),
"data.frame" c("skim_type", "skim_variable", "n_missing", "complete_rate", "sir.count_S", "sir.count_I", "sir.count_R", "sir.prop_S", "sir.prop_I", "sir.prop_R", "sir.hist")
) )
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_inherits(
example_isolates %>%
mutate(
m = as.mic(2),
d = as.disk(20)
) %>%
skim(),
"data.frame"
)
}
} }
expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_)) expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_))