P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-10 23:01:58 +02:00
Code Releases Activity

(v2.1.1.9095) Python support

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2024-10-15 17:12:55 +02:00
parent 94501371cd
commit 5c4d8fcd2a
18 changed files with 513 additions and 435 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
R/aa_helper_functions.R
View File

@ -822,7 +822,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
is_positive = NULL,
is_positive_or_zero = NULL,
is_finite = NULL,
contains_column_class = NULL,
allow_NULL = FALSE,
allow_NA = FALSE,
ignore.case = FALSE,
@ -851,6 +850,11 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
stop_if(allow_NA == FALSE, "argument `", obj_name, "` must not be NA", call = call_depth)
return(invisible())
}
if (identical(class(object), "list") && !"list" %in% allow_class) {
# coming from Python, possibly - turn lists (not data.frame) to the underlying data type
object <- unlist(object)
}
if (!is.null(allow_class) && !(suppressWarnings(all(is.na(object))) && allow_NA == TRUE)) {
stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
@ -937,21 +941,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
call = call_depth
)
}
if (!is.null(contains_column_class)) {
stop_ifnot(
any(vapply(
FUN.VALUE = logical(1),
object,
function(col, columns_class = contains_column_class) {
inherits(col, columns_class)
}
), na.rm = TRUE),
"the data provided in argument `", obj_name,
"` must contain at least one column of class '", contains_column_class[1L], "'. ",
"See `?as.", contains_column_class[1L], "`.",
call = call_depth
)
}
if (!is.null(allow_arguments_from) && !is.null(names(object))) {
args_given <- names(object)
if (is.function(allow_arguments_from)) {
@ -973,6 +962,20 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
return(invisible())
}
ascertain_sir_classes <- function(x, obj_name) {
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
if (!any(sirs, na.rm = TRUE)) {
warning_("the data provided in argument `", obj_name,
"` should contain at least one column of class 'sir'. Eligible SIR column were now guessed. ",
"See `?as.sir`.")
sirs_eligible <- is_sir_eligible(x)
for (col in colnames(x)[sirs_eligible]) {
x[[col]] <- as.sir(x[[col]])
}
}
x
}
get_current_data <- function(arg_name, call) {
valid_df <- function(x) {
!is.null(x) && is.data.frame(x)

3
R/antibiogram.R
View File

@ -313,7 +313,8 @@ antibiogram <- function(x,
combine_SI = TRUE,
sep = " + ",
info = interactive()) {
meet_criteria(x, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
meet_criteria(x, allow_class = "data.frame")
x <- ascertain_sir_classes(x, "x")
meet_criteria(mo_transform, allow_class = "character", has_length = 1, is_in = c("name", "shortname", "gramstain", colnames(AMR::microorganisms)), allow_NULL = TRUE)
meet_criteria(ab_transform, allow_class = "character", has_length = 1, is_in = colnames(AMR::antibiotics), allow_NULL = TRUE)
meet_criteria(syndromic_group, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE)

3
R/bug_drug_combinations.R
View File

@ -71,7 +71,8 @@ bug_drug_combinations <- function(x,
col_mo = NULL,
FUN = mo_shortname,
...) {
meet_criteria(x, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
meet_criteria(x, allow_class = "data.frame")
x <- ascertain_sir_classes(x, "x")
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), has_length = 1, allow_NULL = TRUE)
meet_criteria(FUN, allow_class = "function", has_length = 1)

8
R/disk.R
View File

@ -29,13 +29,13 @@
#' Transform Input to Disk Diffusion Diameters
#'
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 0 and 50.
#' @rdname as.disk
#' @param x vector
#' @param na.rm a [logical] indicating whether missing values should be removed
#' @details Interpret disk values as SIR values with [as.sir()]. It supports guidelines from EUCAST and CLSI.
#'
#' Disk diffusion growth zone sizes must be between 6 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 6-50 range will return `NA`.
#' Disk diffusion growth zone sizes must be between 0 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 0-50 range will return `NA`.
#' @return An [integer] with additional class [`disk`]
#' @aliases disk
#' @export
@ -108,8 +108,8 @@ as.disk <- function(x, na.rm = FALSE) {
# round up and make it an integer
x <- as.integer(ceiling(clean_double2(x)))
# disks can never be less than 6 mm (size of smallest disk) or more than 50 mm
x[x < 6 | x > 99] <- NA_integer_
# disks can never be less than 0 mm or more than 50 mm
x[x < 0 | x > 99] <- NA_integer_
x[x > 50] <- 50L
na_after <- length(x[is.na(x)])

3
R/ggplot_sir.R
View File

@ -193,7 +193,8 @@ ggplot_sir <- function(data,
y.title = "Proportion",
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
meet_criteria(data, allow_class = "data.frame")
data <- ascertain_sir_classes(data, "data")
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
meet_criteria(x, allow_class = "character", has_length = 1)
meet_criteria(fill, allow_class = "character", has_length = 1)

8
R/proportion.R
View File

@ -292,14 +292,14 @@ sir_confidence_interval <- function(...,
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
)
# this applies the Clopper-Pearson method
if (x == 0) {
out <- c(NA_real_, NA_real_)
out <- c(0, 0)
} else {
# this applies the Clopper-Pearson method
out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
}
out <- set_clean_class(out, "numeric")
if (side %in% c("left", "l", "lower", "lowest", "less", "min")) {
out <- out[1]
} else if (side %in% c("right", "r", "higher", "highest", "greater", "g", "max")) {
@ -312,7 +312,7 @@ sir_confidence_interval <- function(...,
if (is.numeric(out)) {
out <- round(out, digits = 3)
}
out[is.na(out)] <- "??"
# out[is.na(out)] <- 0
out <- paste(out, collapse = ifelse(isTRUE(collapse), "-", collapse))
}

6
R/sir.R
View File

@ -1263,7 +1263,7 @@ as_sir_method <- function(method_short,
if (breakpoint_type == "animal" && !host_current %in% breakpoints_current$host) {
if (guideline_coerced %like% "CLSI") {
# VET09 says that staph/strep/enterococcus BP can be extrapolated to all Gr+ cocci except for intrinsic resistance, so take all Gr+ cocci:
all_gram_pos_genera <- c("B_STPHY", "B_STRPT", "B_ENTRC", "B_PPTST", "B_AERCC", "B_MCRCCC", "B_TRPRL")
all_gram_pos_genera <- c("B_STPHY", "B_STRPT", "B_PPTST", "B_AERCC", "B_MCRCCC", "B_TRPRL")
# HUMAN SUBSTITUTES
if (ab_current == "AZM" && mo_current_genus %in% all_gram_pos_genera && host_current %in% c("dogs", "cats", "horse")) {
@ -1310,9 +1310,9 @@ as_sir_method <- function(method_short,
# vancomycin can take human breakpoints in these hosts
breakpoints_current <- breakpoints_current %pm>% subset(host == "human")
notes_current <- c(notes_current, paste0("Using ", font_bold("human"), " breakpoints for ", ab_formatted, " based on CLSI VET09."))
} else if (host_current %in% c("dogs", "cats") && (mo_current_genus %in% c("B_AMYCS", "B_NOCRD", "B_CMPYL", "B_CRYNB", "B_ENTRC", "B_MYCBC", "B_PSDMN", "B_AERMN") | mo_current_class == "B_[CLS]_BTPRTBCT" | mo_current == "B_LISTR_MNCY")) {
# human breakpoints if no canine/feline
# dog breakpoints if no canine/feline
breakpoints_current <- breakpoints_current %pm>% subset(host == "human")
notes_current <- c(notes_current, paste0("Using ", font_bold("human"), " breakpoints for ", mo_formatted, " based on CLSI VET09."))

3
R/sir_calc.R
View File

@ -223,7 +223,8 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
combine_SI = TRUE,
confidence_level = 0.95) {
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
meet_criteria(data, allow_class = "data.frame", contains_column_class = "sir")
meet_criteria(data, allow_class = "data.frame")
data <- ascertain_sir_classes(data, "data")
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)