mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 07:26:13 +01:00
breakpoints UTI interpretation fix
This commit is contained in:
parent
3829311dd3
commit
70c601ca11
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 2.0.0.9028
|
||||
Date: 2023-07-08
|
||||
Version: 2.0.0.9029
|
||||
Date: 2023-07-10
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
data analysis and to work with microbial and antimicrobial properties by
|
||||
|
||||
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 2.0.0.9028
|
||||
# AMR 2.0.0.9029
|
||||
|
||||
## New
|
||||
* Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations
|
||||
|
||||
@ -1241,20 +1241,20 @@ font_red_bg <- function(..., collapse = " ") {
|
||||
}
|
||||
font_orange_bg <- function(..., collapse = " ") {
|
||||
# this is #f6d55c (picked to be colourblind-safe with other SIR colours)
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_yellow_bg <- function(..., collapse = " ") {
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;228m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;228m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_green_bg <- function(..., collapse = " ") {
|
||||
# this is #3caea3 (picked to be colourblind-safe with other SIR colours)
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_purple_bg <- function(..., collapse = " ") {
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_rose_bg <- function(..., collapse = " ") {
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;217m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;217m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_na <- function(..., collapse = " ") {
|
||||
font_red(..., collapse = collapse)
|
||||
|
||||
2
R/data.R
2
R/data.R
@ -176,7 +176,7 @@
|
||||
|
||||
#' Data Set with `r format(nrow(microorganisms.groups), big.mark = " ")` Microorganisms In Species Groups
|
||||
#'
|
||||
#' A data set containing species groups and microbiological complexes, which are used in [the clinical breakpoints table][clinial_breakpoints].
|
||||
#' A data set containing species groups and microbiological complexes, which are used in [the clinical breakpoints table][clinical_breakpoints].
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.groups), big.mark = " ")` observations and `r ncol(microorganisms.groups)` variables:
|
||||
#' - `mo_group`\cr ID of the species group / microbiological complex
|
||||
#' - `mo`\cr ID of the microorganism belonging in the species group / microbiological complex
|
||||
|
||||
29
R/mo.R
29
R/mo.R
@ -135,6 +135,10 @@
|
||||
#' "Ureaplazma urealitycium"
|
||||
#' ))
|
||||
#'
|
||||
#' # input will get cleaned up with the input given in the `cleaning_regex` argument,
|
||||
#' # which defaults to `mo_cleaning_regex()`:
|
||||
#' cat(mo_cleaning_regex(), "\n")
|
||||
#'
|
||||
#' as.mo("Streptococcus group A")
|
||||
#'
|
||||
#' as.mo("S. epidermidis") # will remain species: B_STPHY_EPDR
|
||||
@ -561,14 +565,17 @@ mo_reset_session <- function() {
|
||||
#' @rdname as.mo
|
||||
#' @export
|
||||
mo_cleaning_regex <- function() {
|
||||
parts_to_remove <- c("e?spp([^a-z]+|$)", "e?ssp([^a-z]+|$)", "e?ss([^a-z]+|$)", "e?sp([^a-z]+|$)", "e?subsp", "sube?species", "e?species",
|
||||
"biovar[a-z]*", "biotype", "serovar[a-z]*", "var([^a-z]+|$)", "serogr.?up[a-z]*",
|
||||
"titer", "dummy", "Ig[ADEGM]")
|
||||
paste0(
|
||||
"(",
|
||||
"[^A-Za-z- \\(\\)\\[\\]{}]+",
|
||||
"|",
|
||||
"([({]|\\[).+([})]|\\])",
|
||||
"|",
|
||||
"(^| )(e?spp|e?ssp|e?ss|e?sp|e?subsp|sube?species|biovar|biotype|serovar|var|serogr.?up|e?species|titer|dummy)[.]*|( Ig[ADEGM])( |$))"
|
||||
)
|
||||
"|(^| )(",
|
||||
paste0(parts_to_remove[order(1 - nchar(parts_to_remove))], collapse = "|"),
|
||||
"))")
|
||||
}
|
||||
|
||||
# UNDOCUMENTED METHODS ----------------------------------------------------
|
||||
@ -832,10 +839,10 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
col_red <- function(x) font_rose_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL)
|
||||
col_orange <- function(x) font_orange_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL)
|
||||
col_yellow <- function(x) font_yellow_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL)
|
||||
col_green <- function(x) font_green_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL)
|
||||
col_red <- function(x) font_rose_bg(x, collapse = NULL)
|
||||
col_orange <- function(x) font_orange_bg(x, collapse = NULL)
|
||||
col_yellow <- function(x) font_yellow_bg(x, collapse = NULL)
|
||||
col_green <- function(x) font_green_bg(x, collapse = NULL)
|
||||
|
||||
if (has_colour()) {
|
||||
cat(word_wrap("Colour keys: ",
|
||||
@ -994,6 +1001,7 @@ convert_colloquial_input <- function(x) {
|
||||
perl = TRUE
|
||||
)
|
||||
out[x %like_case% "ha?emoly.*strep"] <- "B_STRPT_HAEM"
|
||||
out[x %like_case% "(strepto.* [abcg, ]{2,4}$)"] <- "B_STRPT_ABCG"
|
||||
out[x %like_case% "(strepto.* mil+er+i|^mgs[^a-z]*$)"] <- "B_STRPT_MILL"
|
||||
out[x %like_case% "mil+er+i gr"] <- "B_STRPT_MILL"
|
||||
out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
|
||||
@ -1024,6 +1032,9 @@ convert_colloquial_input <- function(x) {
|
||||
out[x %like_case% "anaerob[a-z]+ .*gram[ -]?pos.*"] <- "B_ANAER-POS"
|
||||
out[is.na(out) & x %like_case% "anaerob[a-z]+ (micro)?.*organism"] <- "B_ANAER"
|
||||
|
||||
# coryneform bacteria
|
||||
out[x %like_case% "^coryneform"] <- "B_CORYNF"
|
||||
|
||||
# yeasts and fungi
|
||||
out[x %like_case% "^yeast?"] <- "F_YEAST"
|
||||
out[x %like_case% "^fung(us|i)"] <- "F_FUNGUS"
|
||||
@ -1032,6 +1043,10 @@ convert_colloquial_input <- function(x) {
|
||||
out[x %like_case% "meningo[ck]o[ck]"] <- "B_NESSR_MNNG"
|
||||
out[x %like_case% "gono[ck]o[ck]"] <- "B_NESSR_GNRR"
|
||||
out[x %like_case% "pneumo[ck]o[ck]"] <- "B_STRPT_PNMN"
|
||||
out[x %like_case% "hacek"] <- "B_HACEK"
|
||||
out[x %like_case% "haemophilus" & x %like_case% "aggregatibacter" & x %like_case% "cardiobacterium" & x %like_case% "eikenella" & x %like_case% "kingella"] <- "B_HACEK"
|
||||
out[x %like_case% "slow.* grow.* mycobact"] <- "B_MYCBC_SGM"
|
||||
out[x %like_case% "rapid.* grow.* mycobact"] <- "B_MYCBC_RGM"
|
||||
|
||||
# unexisting names (con is the WHONET code for contamination)
|
||||
out[x %in% c("con", "other", "none", "unknown") | x %like_case% "virus"] <- "UNKNOWN"
|
||||
|
||||
@ -427,20 +427,11 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
||||
kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
|
||||
out <- factor(
|
||||
ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
|
||||
"Pathogenic",
|
||||
ifelse(prev < 2 & kngd == "Fungi",
|
||||
"Potentially pathogenic",
|
||||
ifelse(prev == 2 & kngd == "Bacteria",
|
||||
"Non-pathogenic",
|
||||
ifelse(kngd == "Bacteria",
|
||||
"Potentially pathogenic",
|
||||
"Unknown"
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
out <- factor(case_when_AMR(prev == 1 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
|
||||
(prev < 2 & kngd == "Fungi") ~ "Potentially pathogenic",
|
||||
prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
|
||||
kngd == "Bacteria" ~ "Potentially pathogenic",
|
||||
TRUE ~ "Unknown"),
|
||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||
ordered = TRUE
|
||||
)
|
||||
|
||||
97
R/sir.R
97
R/sir.R
@ -105,7 +105,7 @@
|
||||
#'
|
||||
#' The function [is_sir_eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#' @section Interpretation of SIR:
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (<https://www.eucast.org/newsiandr/>):
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (<https://www.eucast.org/newsiandr>):
|
||||
#'
|
||||
#' - **S - Susceptible, standard dosing regimen**\cr
|
||||
#' A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
@ -850,7 +850,7 @@ as_sir_method <- function(method_short,
|
||||
messages[i] <- word_wrap(extra_indent = 5, messages[i])
|
||||
}
|
||||
message(
|
||||
font_yellow(font_bold(paste0(" Note", ifelse(length(messages) > 1, "s", ""), ":\n"))),
|
||||
font_yellow_bg(paste0(" NOTE", ifelse(length(messages) > 1, "S", ""), " \n")),
|
||||
paste0(" ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n")
|
||||
)
|
||||
}
|
||||
@ -873,6 +873,7 @@ as_sir_method <- function(method_short,
|
||||
# when as.sir.disk is called directly
|
||||
df$values <- as.disk(df$values)
|
||||
}
|
||||
df_unique <- unique(df[ , c("mo", "uti"), drop = FALSE])
|
||||
|
||||
rise_warning <- FALSE
|
||||
rise_note <- FALSE
|
||||
@ -906,15 +907,6 @@ as_sir_method <- function(method_short,
|
||||
breakpoints <- breakpoints %pm>%
|
||||
subset(mo != "UNKNOWN" & ref_tbl %unlike% "PK.*PD")
|
||||
}
|
||||
if (all(uti == FALSE, na.rm = TRUE)) {
|
||||
# remove UTI breakpoints
|
||||
breakpoints <- breakpoints %pm>%
|
||||
subset(is.na(uti) | uti == FALSE)
|
||||
} else if (all(uti == TRUE, na.rm = TRUE)) {
|
||||
# remove UTI breakpoints
|
||||
breakpoints <- breakpoints %pm>%
|
||||
subset(uti == TRUE)
|
||||
}
|
||||
|
||||
msgs <- character(0)
|
||||
if (nrow(breakpoints) == 0) {
|
||||
@ -933,32 +925,39 @@ as_sir_method <- function(method_short,
|
||||
add_intrinsic_resistance_to_AMR_env()
|
||||
}
|
||||
|
||||
p <- progress_ticker(n = length(unique(df$mo)), n_min = 10, title = font_blue(intro_txt), only_bar_percent = TRUE)
|
||||
p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = font_blue(intro_txt), only_bar_percent = TRUE)
|
||||
has_progress_bar <- !is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE)) && nrow(df_unique) >= 10
|
||||
on.exit(close(p))
|
||||
|
||||
# run the rules
|
||||
for (mo_currrent in unique(df$mo)) {
|
||||
for (i in seq_len(nrow(df_unique))) {
|
||||
p$tick()
|
||||
rows <- which(df$mo == mo_currrent)
|
||||
mo_current <- df_unique[i, "mo", drop = TRUE]
|
||||
uti_current <- df_unique[i, "uti", drop = TRUE]
|
||||
if (is.na(uti_current)) {
|
||||
# preference, so no filter on UTIs
|
||||
rows <- which(df$mo == mo_current)
|
||||
} else {
|
||||
rows <- which(df$mo == mo_current & df$uti == uti_current)
|
||||
}
|
||||
values <- df[rows, "values", drop = TRUE]
|
||||
uti <- df[rows, "uti", drop = TRUE]
|
||||
new_sir <- rep(NA_sir_, length(rows))
|
||||
|
||||
# find different mo properties
|
||||
mo_current_genus <- as.mo(mo_genus(mo_currrent, language = NULL))
|
||||
mo_current_family <- as.mo(mo_family(mo_currrent, language = NULL))
|
||||
mo_current_order <- as.mo(mo_order(mo_currrent, language = NULL))
|
||||
mo_current_class <- as.mo(mo_class(mo_currrent, language = NULL))
|
||||
if (mo_currrent %in% AMR::microorganisms.groups$mo) {
|
||||
mo_current_genus <- as.mo(mo_genus(mo_current, language = NULL))
|
||||
mo_current_family <- as.mo(mo_family(mo_current, language = NULL))
|
||||
mo_current_order <- as.mo(mo_order(mo_current, language = NULL))
|
||||
mo_current_class <- as.mo(mo_class(mo_current, language = NULL))
|
||||
if (mo_current %in% AMR::microorganisms.groups$mo) {
|
||||
# get the species group
|
||||
mo_current_species_group <- AMR::microorganisms.groups$mo_group[match(mo_currrent, AMR::microorganisms.groups$mo)]
|
||||
mo_current_species_group <- AMR::microorganisms.groups$mo_group[match(mo_current, AMR::microorganisms.groups$mo)]
|
||||
} else {
|
||||
mo_current_species_group <- mo_currrent
|
||||
mo_current_species_group <- mo_current
|
||||
}
|
||||
mo_current_other <- as.mo("UNKNOWN")
|
||||
# formatted for notes
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_fullname(mo_currrent, language = NULL, keep_synonyms = FALSE)))
|
||||
if (!mo_rank(mo_currrent) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_fullname(mo_current, language = NULL, keep_synonyms = FALSE)))
|
||||
if (!mo_rank(mo_current) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- font_italic(mo_formatted)
|
||||
}
|
||||
ab_formatted <- paste0(
|
||||
@ -976,40 +975,45 @@ as_sir_method <- function(method_short,
|
||||
mo_current_other
|
||||
))
|
||||
|
||||
if (any(uti, na.rm = TRUE)) {
|
||||
if (is.na(unique(uti_current))) {
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
# this will put UTI = FALSE first, then UTI = TRUE, then UTI = NA
|
||||
pm_arrange(rank_index, uti) # 'uti' is a column in data set 'clinical_breakpoints'
|
||||
} else if (unique(uti_current) == TRUE) {
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
subset(uti == TRUE) %pm>%
|
||||
# be as specific as possible (i.e. prefer species over genus):
|
||||
# the below `pm_desc(uti)` will put `TRUE` on top and FALSE on bottom
|
||||
pm_arrange(rank_index, pm_desc(uti)) # 'uti' is a column in data set 'clinical_breakpoints'
|
||||
} else {
|
||||
pm_arrange(rank_index)
|
||||
} else if (unique(uti_current) == FALSE) {
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
# sort UTI = FALSE first, then UTI = TRUE
|
||||
pm_arrange(rank_index, uti)
|
||||
subset(uti == FALSE) %pm>%
|
||||
# be as specific as possible (i.e. prefer species over genus):
|
||||
pm_arrange(rank_index)
|
||||
}
|
||||
|
||||
# throw notes for different body sites
|
||||
if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && any(uti %in% c(FALSE, NA)) && message_not_thrown_before("as.sir", "uti", ab_coerced)) {
|
||||
# only UTI breakpoints available
|
||||
warning_("in `as.sir()`: interpretation of ", font_bold(ab_formatted), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms, thus assuming `uti = TRUE`. See `?as.sir`.")
|
||||
rise_warning <- TRUE
|
||||
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_currrent, ab_coerced)) {
|
||||
# both UTI and Non-UTI breakpoints available
|
||||
msgs <- c(msgs, paste0("Breakpoints for UTI ", font_underline("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See `?as.sir`."))
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
pm_filter(uti == FALSE)
|
||||
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_currrent, ab_coerced)) {
|
||||
# breakpoints for multiple body sites available
|
||||
site <- breakpoints_current[1L, "site", drop = FALSE] # this is the one we'll take
|
||||
if (is.na(site)) {
|
||||
site <- paste0("an unspecified body site")
|
||||
} else {
|
||||
site <- paste0("body site '", site, "'")
|
||||
}
|
||||
if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && any(uti_current %in% c(FALSE, NA)) && message_not_thrown_before("as.sir", "uti", ab_coerced)) {
|
||||
# only UTI breakpoints available
|
||||
warning_("in `as.sir()`: interpretation of ", font_bold(ab_formatted), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms, thus assuming `uti = TRUE`. See `?as.sir`.")
|
||||
rise_warning <- TRUE
|
||||
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti_current)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_current, ab_coerced)) {
|
||||
# both UTI and Non-UTI breakpoints available
|
||||
msgs <- c(msgs, paste0("Breakpoints for UTI ", font_underline("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument `uti` to set which isolates are from urine. See `?as.sir`."))
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
pm_filter(uti == FALSE)
|
||||
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_coerced)) {
|
||||
# breakpoints for multiple body sites available
|
||||
msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, "."))
|
||||
}
|
||||
|
||||
# first check if mo is intrinsic resistant
|
||||
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %like% "EUCAST" && paste(mo_currrent, ab_coerced) %in% AMR_env$intrinsic_resistant) {
|
||||
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %like% "EUCAST" && paste(mo_current, ab_coerced) %in% AMR_env$intrinsic_resistant) {
|
||||
msgs <- c(msgs, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ""))
|
||||
new_sir <- rep(as.sir("R"), length(rows))
|
||||
} else if (nrow(breakpoints_current) == 0) {
|
||||
@ -1059,10 +1063,11 @@ as_sir_method <- function(method_short,
|
||||
index = rows,
|
||||
ab_input = rep(ab.bak, length(rows)),
|
||||
ab_guideline = rep(ab_coerced, length(rows)),
|
||||
mo_input = rep(mo.bak[match(mo_currrent, df$mo)][1], length(rows)),
|
||||
mo_input = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
|
||||
mo_guideline = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
|
||||
guideline = rep(guideline_coerced, length(rows)),
|
||||
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
|
||||
uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)),
|
||||
method = rep(method_coerced, length(rows)),
|
||||
input = as.double(values),
|
||||
outcome = as.sir(new_sir),
|
||||
@ -1078,14 +1083,14 @@ as_sir_method <- function(method_short,
|
||||
close(p)
|
||||
|
||||
# printing messages
|
||||
if (!is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE))) {
|
||||
if (has_progress_bar == TRUE) {
|
||||
# the progress bar has overwritten the intro text, so:
|
||||
message_(intro_txt, appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
if (isTRUE(rise_warning)) {
|
||||
message(font_yellow(font_bold(" * WARNING *")))
|
||||
message(font_rose_bg(" * WARNING *"))
|
||||
} else if (length(msgs) == 0) {
|
||||
message(font_green(" OK."))
|
||||
message(font_green_bg(" OK "))
|
||||
} else {
|
||||
msg_note(sort(msgs))
|
||||
}
|
||||
|
||||
@ -1 +1 @@
|
||||
87c6c20d117acd06c37bab6d93966a0b
|
||||
7aeceefb444830af010fcc16f5ba4705
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -133,8 +133,11 @@ organisms <- organisms %>%
|
||||
select(-group) %>%
|
||||
distinct()
|
||||
|
||||
# 2023-07-08 SGM must be Slowly-growing Mycobacterium, not Strep Gamma, not sure why this went wrong
|
||||
|
||||
# 2023-07-08 SGM is also Strep gamma in WHONET, must only be Slowly-growing Mycobacterium
|
||||
organisms <- organisms %>%
|
||||
filter(!(code == "SGM" & name %like% "Streptococcus"))
|
||||
# this must be empty:
|
||||
organisms$code[organisms$code %>% duplicated()]
|
||||
|
||||
saveRDS(organisms, "data-raw/organisms.rds", version = 2)
|
||||
|
||||
@ -223,7 +226,7 @@ breakpoints %>%
|
||||
filter(!WHONET_ABX_CODE %in% whonet_antibiotics$WHONET_ABX_CODE) %>%
|
||||
pull(WHONET_ABX_CODE) %>%
|
||||
unique()
|
||||
# they are at the moment all old codes that have right replacements in `antibiotics`, so we can use as.ab()
|
||||
# they are at the moment all old codes that have the right replacements in `antibiotics`, so we can use as.ab()
|
||||
|
||||
|
||||
## Build new breakpoints table ----
|
||||
@ -260,7 +263,7 @@ breakpoints_new <- breakpoints %>%
|
||||
gsub("–", "-", ., fixed = TRUE)) %>%
|
||||
arrange(desc(guideline), mo, ab, type, method) %>%
|
||||
filter(!(is.na(breakpoint_S) & is.na(breakpoint_R)) & !is.na(mo) & !is.na(ab)) %>%
|
||||
distinct(guideline, ab, mo, method, site, breakpoint_S, .keep_all = TRUE)
|
||||
distinct(guideline, type, ab, mo, method, site, breakpoint_S, .keep_all = TRUE)
|
||||
|
||||
# check the strange duplicates
|
||||
breakpoints_new %>%
|
||||
@ -268,7 +271,7 @@ breakpoints_new %>%
|
||||
filter(id %in% .$id[which(duplicated(id))])
|
||||
# remove duplicates
|
||||
breakpoints_new <- breakpoints_new %>%
|
||||
distinct(guideline, ab, mo, method, site, .keep_all = TRUE)
|
||||
distinct(guideline, type, ab, mo, method, site, .keep_all = TRUE)
|
||||
|
||||
# fix reference table names
|
||||
breakpoints_new %>% filter(guideline %like% "EUCAST", is.na(ref_tbl)) %>% View()
|
||||
@ -289,10 +292,10 @@ breakpoints_new[which(breakpoints_new$method == "MIC" &
|
||||
breakpoints_new[which(breakpoints_new$method == "MIC" &
|
||||
is.na(breakpoints_new$breakpoint_R)), "breakpoint_R"] <- max(m)
|
||||
# raise these one higher valid MIC factor level:
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 129), "breakpoint_R"] <- m[which(m == 128) + 1]
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 257), "breakpoint_R"] <- m[which(m == 256) + 1]
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 513), "breakpoint_R"] <- m[which(m == 512) + 1]
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 1025), "breakpoint_R"] <- m[which(m == 1024) + 1]
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 129), "breakpoint_R"] <- 128
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 257), "breakpoint_R"] <- 256
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 513), "breakpoint_R"] <- 513
|
||||
breakpoints_new[which(breakpoints_new$breakpoint_R == 1025), "breakpoint_R"] <- 1024
|
||||
|
||||
# WHONET adds one log2 level to the R breakpoint for their software, e.g. in AMC in Enterobacterales:
|
||||
# EUCAST 2022 guideline: S <= 8 and R > 8
|
||||
@ -319,6 +322,9 @@ breakpoints_new %>% filter(guideline == "EUCAST 2023", ab == "AMC", mo == "B_[OR
|
||||
# compare with current version
|
||||
clinical_breakpoints %>% filter(guideline == "EUCAST 2022", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC")
|
||||
|
||||
# must have "human" and "ECOFF"
|
||||
breakpoints_new %>% filter(mo == "B_STRPT_PNMN", ab == "AMP", guideline == "EUCAST 2020", method == "MIC")
|
||||
|
||||
# check dimensions
|
||||
dim(breakpoints_new)
|
||||
dim(clinical_breakpoints)
|
||||
|
||||
Binary file not shown.
@ -106,7 +106,7 @@ expect_identical(mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides
|
||||
c("aerobe", "anaerobe"))
|
||||
|
||||
expect_equal(as.character(table(mo_pathogenicity(example_isolates$mo))),
|
||||
c("1561", "422", "1", "16"))
|
||||
c("1874", "109", "1", "16"))
|
||||
|
||||
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
|
||||
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
|
||||
@ -129,9 +129,12 @@ for (l in AMR:::LANGUAGES_SUPPORTED[-1]) {
|
||||
|
||||
# test languages
|
||||
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
|
||||
dutch <- suppressWarnings(mo_name(microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")], language = "nl", keep_synonyms = TRUE)) # should be transformable to English again
|
||||
expect_identical(suppressWarnings(mo_name(dutch, language = NULL, keep_synonyms = TRUE)),
|
||||
microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]) # gigantic test - will run ALL names
|
||||
fullnames <- microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]
|
||||
to_dutch <- suppressWarnings(mo_name(fullnames, language = "nl", keep_synonyms = TRUE))
|
||||
back_to_english <- suppressWarnings(mo_name(dutch, language = NULL, keep_synonyms = TRUE))
|
||||
diffs <- paste0('"', fullnames[fullnames != back_to_english], '"', collapse = ", ")
|
||||
expect_identical(fullnames, back_to_english, info = diffs) # gigantic test - will run ALL names
|
||||
|
||||
|
||||
# manual property function
|
||||
expect_error(mo_property("Escherichia coli", property = c("genus", "fullname")))
|
||||
|
||||
@ -201,6 +201,10 @@ as.mo(c(
|
||||
"Ureaplazma urealitycium"
|
||||
))
|
||||
|
||||
# input will get cleaned up with the input given in the `cleaning_regex` argument,
|
||||
# which defaults to `mo_cleaning_regex()`:
|
||||
cat(mo_cleaning_regex(), "\n")
|
||||
|
||||
as.mo("Streptococcus group A")
|
||||
|
||||
as.mo("S. epidermidis") # will remain species: B_STPHY_EPDR
|
||||
|
||||
@ -171,7 +171,7 @@ After using \code{\link[=as.sir]{as.sir()}}, you can use the \code{\link[=eucast
|
||||
|
||||
\subsection{Machine-Readable Clinical Breakpoints}{
|
||||
|
||||
The repository of this package \href{https://github.com/msberends/AMR/blob/main/data-raw/clinical_breakpoints.txt}{contains a machine-readable version} of all guidelines. This is a CSV file consisting of 28 454 rows and 12 columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial drug and the microorganism. \strong{This allows for easy implementation of these rules in laboratory information systems (LIS)}. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed.
|
||||
The repository of this package \href{https://github.com/msberends/AMR/blob/main/data-raw/clinical_breakpoints.txt}{contains a machine-readable version} of all guidelines. This is a CSV file consisting of 28 885 rows and 12 columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial drug and the microorganism. \strong{This allows for easy implementation of these rules in laboratory information systems (LIS)}. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed.
|
||||
}
|
||||
|
||||
\subsection{Other}{
|
||||
@ -185,7 +185,7 @@ The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRU
|
||||
}
|
||||
\section{Interpretation of SIR}{
|
||||
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr/}):
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}):
|
||||
\itemize{
|
||||
\item \strong{S - Susceptible, standard dosing regimen}\cr
|
||||
A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
\alias{clinical_breakpoints}
|
||||
\title{Data Set with Clinical Breakpoints for SIR Interpretation}
|
||||
\format{
|
||||
A \link[tibble:tibble]{tibble} with 28 454 observations and 12 variables:
|
||||
A \link[tibble:tibble]{tibble} with 28 885 observations and 12 variables:
|
||||
\itemize{
|
||||
\item \code{guideline}\cr Name of the guideline
|
||||
\item \code{type}\cr Breakpoint type, either "ECOFF", "animal", or "human"
|
||||
|
||||
@ -71,7 +71,7 @@ The function \code{\link[=count_df]{count_df()}} takes any variable from \code{d
|
||||
}
|
||||
\section{Interpretation of SIR}{
|
||||
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr/}):
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}):
|
||||
\itemize{
|
||||
\item \strong{S - Susceptible, standard dosing regimen}\cr
|
||||
A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
|
||||
@ -174,7 +174,7 @@ Amikacin (\code{AMK}, \href{https://www.whocc.no/atc_ddd_index/?code=J01GB06&sho
|
||||
|
||||
\section{Interpretation of SIR}{
|
||||
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr/}):
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}):
|
||||
\itemize{
|
||||
\item \strong{S - Susceptible, standard dosing regimen}\cr
|
||||
A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
|
||||
@ -17,7 +17,7 @@ A \link[tibble:tibble]{tibble} with 444 observations and 4 variables:
|
||||
microorganisms.groups
|
||||
}
|
||||
\description{
|
||||
A data set containing species groups and microbiological complexes, which are used in \link[=clinial_breakpoints]{the clinical breakpoints table}.
|
||||
A data set containing species groups and microbiological complexes, which are used in \link[=clinical_breakpoints]{the clinical breakpoints table}.
|
||||
}
|
||||
\details{
|
||||
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
|
||||
|
||||
@ -146,7 +146,7 @@ Using \code{only_all_tested} has no impact when only using one antibiotic as inp
|
||||
|
||||
\section{Interpretation of SIR}{
|
||||
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr/}):
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}):
|
||||
\itemize{
|
||||
\item \strong{S - Susceptible, standard dosing regimen}\cr
|
||||
A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
|
||||
@ -112,7 +112,7 @@ Valid options for the statistical model (argument \code{model}) are:
|
||||
}
|
||||
\section{Interpretation of SIR}{
|
||||
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr/}):
|
||||
In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}):
|
||||
\itemize{
|
||||
\item \strong{S - Susceptible, standard dosing regimen}\cr
|
||||
A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user