1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 20:02:04 +02:00

(v2.1.1.9252) fix MIC for >= and <=

This commit is contained in:
2025-04-25 10:19:40 +02:00
parent 6135805455
commit abee2a954e
11 changed files with 40 additions and 26 deletions

View File

@ -32,7 +32,7 @@
#' @description
#' Welcome to the `AMR` package.
#'
#' The `AMR` package is a [free and open-source](https://amr-for-r.org/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://amr-for-r.org/authors.html) from around the globe are continually helping us to make this a successful and durable project!
#' The `AMR` package is a peer-reviewed, [free and open-source](https://amr-for-r.org/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://amr-for-r.org/authors.html) from around the globe are continually helping us to make this a successful and durable project!
#'
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
#'

View File

@ -47,7 +47,6 @@
#' guess_ab_col(df, "J01AA07") # ATC code of tetracycline
#'
#' guess_ab_col(df, "J01AA07", verbose = TRUE)
#' # NOTE: Using column 'tetr' as input for J01AA07 (tetracycline).
#'
#' # WHONET codes
#' df <- data.frame(
@ -56,7 +55,7 @@
#' )
#' guess_ab_col(df, "ampicillin")
#' guess_ab_col(df, "J01CR02")
#' guess_ab_col(df, as.ab("augmentin"))
#' guess_ab_col(df, "augmentin")
guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_sir_columns = FALSE) {
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = TRUE)

View File

@ -412,7 +412,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
x[x == "I"] <- "(I) Intermediate"
}
x[x == "R"] <- "(R) Resistant"
x[x == "NI"] <- "(NI) Not interpretable"
x[x == "NI"] <- "(NI) Non-interpretable"
x <- translate_AMR(x, language = language)
}
x
@ -685,7 +685,8 @@ autoplot.mic <- function(object,
"(SDD) Susceptible dose-dependent" = colours_SIR[2],
"(I) Susceptible, incr. exp." = colours_SIR[2],
"(I) Intermediate" = colours_SIR[2],
"(R) Resistant" = colours_SIR[3]
"(R) Resistant" = colours_SIR[3],
"(NI) Non-interpretable" = "grey"
)
names(vals) <- translate_into_language(names(vals), language = language)
p <- p +
@ -918,7 +919,8 @@ autoplot.disk <- function(object,
"(SDD) Susceptible dose-dependent" = colours_SIR[2],
"(I) Susceptible, incr. exp." = colours_SIR[2],
"(I) Intermediate" = colours_SIR[2],
"(R) Resistant" = colours_SIR[3]
"(R) Resistant" = colours_SIR[3],
"(NI) Non-interpretable" = "grey"
)
names(vals) <- translate_into_language(names(vals), language = language)
p <- p +

38
R/sir.R
View File

@ -323,7 +323,7 @@
#' )
#'
#'
#' # For CLEANING existing SIR values ------------------------------------
#' # For CLEANING existing SIR values -------------------------------------
#'
#' as.sir(c("S", "SDD", "I", "R", "NI", "A", "B", "C"))
#' as.sir("<= 0.002; S") # will return "S"
@ -1263,11 +1263,16 @@ as_sir_method <- function(method_short,
)
if (method == "mic") {
if (any(guideline_coerced %like% "CLSI")) {
# CLSI in log 2 ----
# CLSI says: if MIC is not a log2 value it must be rounded up to the nearest log2 value
log2_levels <- 2^c(-9:12)
df$values[which(df$guideline %like% "CLSI")] <- vapply(
FUN.VALUE = character(1),
df$values[which(df$guideline %like% "CLSI")],
log2_levels <- as.double(VALID_MIC_LEVELS[which(VALID_MIC_LEVELS %in% 2^c(-20:20))])
test_values <- df$values[which(df$guideline %like% "CLSI")]
test_values_dbl <- as.double(test_values)
test_values_dbl[test_values %like% "^>[0-9]"] <- test_values_dbl[test_values %like% "^>[0-9]"] + 0.0000001
test_values_dbl[test_values %like% "^<[0-9]"] <- test_values_dbl[test_values %like% "^>[0-9]"] - 0.0000001
test_outcome <- vapply(
FUN.VALUE = double(1),
test_values_dbl,
function(mic_val) {
if (is.na(mic_val)) {
return(NA_character_)
@ -1278,13 +1283,14 @@ as_sir_method <- function(method_short,
if (message_not_thrown_before("as.sir", "CLSI", "MICupscaling")) {
warning_("Some MICs were converted to the nearest higher log2 level, following the CLSI interpretation guideline.")
}
return(as.character(log2_val)) # will be MIC later
return(as.double(log2_val)) # will be MIC later
} else {
return(as.character(mic_val))
return(as.double(mic_val))
}
}
}
)
df$values[which(df$guideline %like% "CLSI" & test_values != test_outcome)] <- test_outcome[which(test_values != test_outcome)]
}
df$values <- as.mic(df$values)
} else if (method == "disk") {
@ -1430,10 +1436,6 @@ as_sir_method <- function(method_short,
mo_current_other
))
# TODO are operators considered??
# This seems to not work well: as.sir(as.mic(c(4, ">4", ">=4", 8, ">8", ">=8")), ab = "AMC", mo = "E. coli", breakpoint_type = "animal", host = "dogs", guideline = "CLSI 2024")
if (breakpoint_type == "animal") {
# 2025-03-13 for now, only strictly follow guideline for current host, no extrapolation
breakpoints_current <- breakpoints_current[which(breakpoints_current$host == host_current), , drop = FALSE]
@ -1619,7 +1621,17 @@ as_sir_method <- function(method_short,
),
"\n",
ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R,
paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' since capped_mic_handling = \"", capped_mic_handling, "\""),
paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
""
),
"\n",
ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^<=[0-9]" & as.double(values) == breakpoints_current$breakpoint_R,
paste0("MIC values at the R breakpoint with the operator '<=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
""
),
"\n",
ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^>=[0-9]" & as.double(values) == breakpoints_current$breakpoint_S,
paste0("MIC values at the S breakpoint with the operator '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
""
)
)
@ -1642,6 +1654,8 @@ as_sir_method <- function(method_short,
capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[<][0-9]" ~ as.sir("S"),
capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]" ~ as.sir("R"),
capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R ~ as.sir("NI"),
capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^<=[0-9]" & as.double(values) == breakpoints_current$breakpoint_R ~ as.sir("NI"),
capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^>=[0-9]" & as.double(values) == breakpoints_current$breakpoint_S ~ as.sir("NI"),
values <= breakpoints_current$breakpoint_S ~ as.sir("S"),
guideline_current %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"),
guideline_current %like% "CLSI" & values >= breakpoints_current$breakpoint_R ~ as.sir("R"),

Binary file not shown.