mirror of
https://github.com/msberends/AMR.git
synced 2025-09-15 11:49:41 +02:00
@@ -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
|
||||||
|
@@ -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)
|
||||||
|
4
NEWS.md
4
NEWS.md
@@ -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
19
R/ab.R
@@ -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
|
||||||
|
12
R/disk.R
12
R/disk.R
@@ -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
12
R/mic.R
@@ -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
14
R/mo.R
@@ -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
33
R/sir.R
@@ -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)
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@@ -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")
|
||||||
|
@@ -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")
|
||||||
|
)
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
@@ -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)))
|
||||||
|
@@ -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")
|
||||||
|
)
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
@@ -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_))
|
||||||
|
Reference in New Issue
Block a user