P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-09-15 15:09:41 +02:00
Code Releases Activity

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

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-09-10 13:32:52 +02:00
parent d5a568318b
commit 4d7c4ca52c
13 changed files with 92 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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)) {
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
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)) {
@@ -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)]
if (length(x_unknown) > 0 && fast_mode == FALSE) {
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), "."
)
}
@@ -627,6 +630,20 @@ rep.ab <- function(x, ...) {
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) {
x <- toupper(x)
# remove suffices

12
R/disk.R
View File

@@ -236,12 +236,14 @@ rep.disk <- function(x, ...) {
# this prevents the requirement for putting the dependency in Imports:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
get_skimmers.disk <- function(column) {
column <- as.integer(column)
skimr::sfl(
skim_type = "disk",
min = ~ min(as.double(.), na.rm = TRUE),
max = ~ max(as.double(.), na.rm = TRUE),
median = ~ stats::median(as.double(.), na.rm = TRUE),
n_unique = ~ length(unique(stats::na.omit(.))),
hist = ~ skimr::inline_hist(stats::na.omit(as.double(.)))
p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
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
skimr::sfl(
skim_type = "mic",
p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
p25 = ~ stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE),
p50 = ~ stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE),
p75 = ~ stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE),
p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
hist = ~ skimr::inline_hist(log2(stats::na.omit(.)), 5)
p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE),
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:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
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(
skim_type = "mo",
unique_total = ~ length(unique(stats::na.omit(.))),
gram_negative = ~ sum(mo_is_gram_negative(.), na.rm = TRUE),
gram_positive = ~ sum(mo_is_gram_positive(.), na.rm = TRUE),
top_genus = ~ names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L],
top_species = ~ names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L]
n_unique = ~ length(unique(mo)),
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(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
yeast = ~ sum(mo_is_yeast(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
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:
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
get_skimmers.sir <- function(column) {
# get the variable name 'skim_variable'
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_
}
}
# TODO add here in AMR 3.1.0 details about guideline
skimr::sfl(
skim_type = "sir",
ab_name = name_call,
count_R = count_R,
count_S = count_susceptible,
# guideline = function(x) "EUCAST 2025", # or "Multiple"
# origin = function(x) "MIC", # or "Multiple"
count_S = count_S,
count_I = count_I,
prop_R = ~ proportion_R(., minimum = 0),
prop_S = ~ susceptibility(., minimum = 0),
prop_I = ~ proportion_I(., minimum = 0)
count_R = count_R,
prop_S = ~ round(proportion_S(., minimum = 0) * 100, 1),
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)
)
}