P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 07:26:13 +01:00
Code Releases Activity

breakpoints UTI interpretation fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-07-10 13:41:52 +02:00
parent 3829311dd3
commit 70c601ca11
28 changed files with 605 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 2.0.0.9028 Version: 2.0.0.9029
Date: 2023-07-08 Date: 2023-07-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

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 2.0.0.9028 # AMR 2.0.0.9029
## New ## 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 * 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

10
R/aa_helper_functions.R
View File

@ -1241,20 +1241,20 @@ font_red_bg <- function(..., collapse = " ") {
} }
font_orange_bg <- function(..., collapse = " ") { font_orange_bg <- function(..., collapse = " ") {
# this is #f6d55c (picked to be colourblind-safe with other SIR colours) # 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 = " ") { 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 = " ") { font_green_bg <- function(..., collapse = " ") {
# this is #3caea3 (picked to be colourblind-safe with other SIR colours) # 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 = " ") { 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 = " ") { 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_na <- function(..., collapse = " ") {
font_red(..., collapse = collapse) font_red(..., collapse = collapse)

2
R/data.R
View File

@ -176,7 +176,7 @@
#' Data Set with `r format(nrow(microorganisms.groups), big.mark = " ")` Microorganisms In Species Groups #' 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: #' @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_group`\cr ID of the species group / microbiological complex
#' - `mo`\cr ID of the microorganism belonging in the species group / microbiological complex #' - `mo`\cr ID of the microorganism belonging in the species group / microbiological complex

35
R/mo.R
View File

@ -134,6 +134,10 @@
#' "Ureaplasmium urealytica", #' "Ureaplasmium urealytica",
#' "Ureaplazma urealitycium" #' "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("Streptococcus group A")
#' #'
@ -561,14 +565,17 @@ mo_reset_session <- function() {
#' @rdname as.mo #' @rdname as.mo
#' @export #' @export
mo_cleaning_regex <- function() { 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( paste0(
"(", "(",
"[^A-Za-z- \\(\\)\\[\\]{}]+", "[^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 ---------------------------------------------------- # UNDOCUMENTED METHODS ----------------------------------------------------
@ -832,10 +839,10 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
add_MO_lookup_to_AMR_env() add_MO_lookup_to_AMR_env()
col_red <- function(x) font_rose_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(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL) col_orange <- function(x) font_orange_bg(x, collapse = NULL)
col_yellow <- function(x) font_yellow_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL) col_yellow <- function(x) font_yellow_bg(x, collapse = NULL)
col_green <- function(x) font_green_bg(font_black(x, collapse = NULL, adapt = FALSE), collapse = NULL) col_green <- function(x) font_green_bg(x, collapse = NULL)
if (has_colour()) { if (has_colour()) {
cat(word_wrap("Colour keys: ", cat(word_wrap("Colour keys: ",
@ -978,9 +985,9 @@ convert_colloquial_input <- function(x) {
perl = TRUE perl = TRUE
) )
# Streptococci in different languages, like "estreptococos grupo B" # Streptococci in different languages, like "estreptococos grupo B"
out[x %like_case% "strepto[ck]o[ck][a-zA-Z]* [abcdefghijkl]$"] <- gsub(".*e?strepto[ck]o[ck].* ([abcdefghijkl])$", out[x %like_case% "strepto[ck]o[ck][a-zA-Z ]* [abcdefghijkl]$"] <- gsub(".*e?strepto[ck]o[ck].* ([abcdefghijkl])$",
"B_STRPT_GRP\\U\\1", "B_STRPT_GRP\\U\\1",
x[x %like_case% "strepto[ck]o[ck][a-zA-Z]* [abcdefghijkl]$"], x[x %like_case% "strepto[ck]o[ck][a-zA-Z ]* [abcdefghijkl]$"],
perl = TRUE perl = TRUE
) )
out[x %like_case% "strep[a-z]* group [abcdefghijkl]$"] <- gsub(".* ([abcdefghijkl])$", out[x %like_case% "strep[a-z]* group [abcdefghijkl]$"] <- gsub(".* ([abcdefghijkl])$",
@ -994,6 +1001,7 @@ convert_colloquial_input <- function(x) {
perl = TRUE perl = TRUE
) )
out[x %like_case% "ha?emoly.*strep"] <- "B_STRPT_HAEM" 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% "(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% "mil+er+i gr"] <- "B_STRPT_MILL"
out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI" 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[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" 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 # yeasts and fungi
out[x %like_case% "^yeast?"] <- "F_YEAST" out[x %like_case% "^yeast?"] <- "F_YEAST"
out[x %like_case% "^fung(us|i)"] <- "F_FUNGUS" out[x %like_case% "^fung(us|i)"] <- "F_FUNGUS"
@ -1032,7 +1043,11 @@ convert_colloquial_input <- function(x) {
out[x %like_case% "meningo[ck]o[ck]"] <- "B_NESSR_MNNG" 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% "gono[ck]o[ck]"] <- "B_NESSR_GNRR"
out[x %like_case% "pneumo[ck]o[ck]"] <- "B_STRPT_PNMN" 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) # unexisting names (con is the WHONET code for contamination)
out[x %in% c("con", "other", "none", "unknown") | x %like_case% "virus"] <- "UNKNOWN" out[x %in% c("con", "other", "none", "unknown") | x %like_case% "virus"] <- "UNKNOWN"

23
R/mo_property.R
View File

@ -427,22 +427,13 @@ 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)] 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)] rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
out <- factor( out <- factor(case_when_AMR(prev == 1 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus", (prev < 2 & kngd == "Fungi") ~ "Potentially pathogenic",
"Pathogenic", prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
ifelse(prev < 2 & kngd == "Fungi", kngd == "Bacteria" ~ "Potentially pathogenic",
"Potentially pathogenic", TRUE ~ "Unknown"),
ifelse(prev == 2 & kngd == "Bacteria", levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
"Non-pathogenic", ordered = TRUE
ifelse(kngd == "Bacteria",
"Potentially pathogenic",
"Unknown"
)
)
)
),
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
ordered = TRUE
) )
load_mo_uncertainties(metadata) load_mo_uncertainties(metadata)

95
R/sir.R
View File

@ -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. #' 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: #' @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 #' - **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. #' 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]) messages[i] <- word_wrap(extra_indent = 5, messages[i])
} }
message( 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") 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 # when as.sir.disk is called directly
df$values <- as.disk(df$values) df$values <- as.disk(df$values)
} }
df_unique <- unique(df[ , c("mo", "uti"), drop = FALSE])
rise_warning <- FALSE rise_warning <- FALSE
rise_note <- FALSE rise_note <- FALSE
@ -906,15 +907,6 @@ as_sir_method <- function(method_short,
breakpoints <- breakpoints %pm>% breakpoints <- breakpoints %pm>%
subset(mo != "UNKNOWN" & ref_tbl %unlike% "PK.*PD") 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) msgs <- character(0)
if (nrow(breakpoints) == 0) { if (nrow(breakpoints) == 0) {
@ -933,32 +925,39 @@ as_sir_method <- function(method_short,
add_intrinsic_resistance_to_AMR_env() 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)) on.exit(close(p))
# run the rules # run the rules
for (mo_currrent in unique(df$mo)) { for (i in seq_len(nrow(df_unique))) {
p$tick() 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] values <- df[rows, "values", drop = TRUE]
uti <- df[rows, "uti", drop = TRUE]
new_sir <- rep(NA_sir_, length(rows)) new_sir <- rep(NA_sir_, length(rows))
# find different mo properties # find different mo properties
mo_current_genus <- as.mo(mo_genus(mo_currrent, language = NULL)) mo_current_genus <- as.mo(mo_genus(mo_current, language = NULL))
mo_current_family <- as.mo(mo_family(mo_currrent, language = NULL)) mo_current_family <- as.mo(mo_family(mo_current, language = NULL))
mo_current_order <- as.mo(mo_order(mo_currrent, language = NULL)) mo_current_order <- as.mo(mo_order(mo_current, language = NULL))
mo_current_class <- as.mo(mo_class(mo_currrent, language = NULL)) mo_current_class <- as.mo(mo_class(mo_current, language = NULL))
if (mo_currrent %in% AMR::microorganisms.groups$mo) { if (mo_current %in% AMR::microorganisms.groups$mo) {
# get the species group # 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 { } else {
mo_current_species_group <- mo_currrent mo_current_species_group <- mo_current
} }
mo_current_other <- as.mo("UNKNOWN") mo_current_other <- as.mo("UNKNOWN")
# formatted for notes # formatted for notes
mo_formatted <- suppressMessages(suppressWarnings(mo_fullname(mo_currrent, language = NULL, keep_synonyms = FALSE))) mo_formatted <- suppressMessages(suppressWarnings(mo_fullname(mo_current, language = NULL, keep_synonyms = FALSE)))
if (!mo_rank(mo_currrent) %in% c("kingdom", "phylum", "class", "order")) { if (!mo_rank(mo_current) %in% c("kingdom", "phylum", "class", "order")) {
mo_formatted <- font_italic(mo_formatted) mo_formatted <- font_italic(mo_formatted)
} }
ab_formatted <- paste0( ab_formatted <- paste0(
@ -976,40 +975,45 @@ as_sir_method <- function(method_short,
mo_current_other mo_current_other
)) ))
if (any(uti, na.rm = TRUE)) { if (is.na(unique(uti_current))) {
breakpoints_current <- breakpoints_current %pm>% 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): # 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_arrange(rank_index, pm_desc(uti)) # 'uti' is a column in data set 'clinical_breakpoints' } else if (unique(uti_current) == FALSE) {
} else {
breakpoints_current <- breakpoints_current %pm>% breakpoints_current <- breakpoints_current %pm>%
# sort UTI = FALSE first, then UTI = TRUE subset(uti == FALSE) %pm>%
pm_arrange(rank_index, uti) # be as specific as possible (i.e. prefer species over genus):
pm_arrange(rank_index)
} }
# throw notes for different body sites # 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)) { 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 # 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`.") 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 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)) { } 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 # 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`.")) 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>% breakpoints_current <- breakpoints_current %pm>%
pm_filter(uti == FALSE) 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)) { } 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 # 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, "'")
}
msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ".")) msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, "."))
} }
# first check if mo is intrinsic resistant # 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, "")) msgs <- c(msgs, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ""))
new_sir <- rep(as.sir("R"), length(rows)) new_sir <- rep(as.sir("R"), length(rows))
} else if (nrow(breakpoints_current) == 0) { } else if (nrow(breakpoints_current) == 0) {
@ -1059,10 +1063,11 @@ as_sir_method <- function(method_short,
index = rows, index = rows,
ab_input = rep(ab.bak, length(rows)), ab_input = rep(ab.bak, length(rows)),
ab_guideline = rep(ab_coerced, 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)), mo_guideline = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
guideline = rep(guideline_coerced, length(rows)), guideline = rep(guideline_coerced, length(rows)),
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], 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)), method = rep(method_coerced, length(rows)),
input = as.double(values), input = as.double(values),
outcome = as.sir(new_sir), outcome = as.sir(new_sir),
@ -1078,14 +1083,14 @@ as_sir_method <- function(method_short,
close(p) close(p)
# printing messages # 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: # the progress bar has overwritten the intro text, so:
message_(intro_txt, appendLF = FALSE, as_note = FALSE) message_(intro_txt, appendLF = FALSE, as_note = FALSE)
} }
if (isTRUE(rise_warning)) { if (isTRUE(rise_warning)) {
message(font_yellow(font_bold(" * WARNING *"))) message(font_rose_bg(" * WARNING *"))
} else if (length(msgs) == 0) { } else if (length(msgs) == 0) {
message(font_green(" OK.")) message(font_green_bg(" OK "))
} else { } else {
msg_note(sort(msgs)) msg_note(sort(msgs))
} }

2
data-raw/clin_break.md5
View File

@ -1 +1 @@
87c6c20d117acd06c37bab6d93966a0b 7aeceefb444830af010fcc16f5ba4705

BIN
data-raw/clinical_breakpoints.dta
View File

Binary file not shown.

BIN
data-raw/clinical_breakpoints.feather
View File

Binary file not shown.

BIN
data-raw/clinical_breakpoints.parquet
View File

Binary file not shown.

BIN
data-raw/clinical_breakpoints.rds
View File

Binary file not shown.

BIN
data-raw/clinical_breakpoints.sav
View File

Binary file not shown.

527
data-raw/clinical_breakpoints.txt
View File

File diff suppressed because it is too large Load Diff

BIN
data-raw/clinical_breakpoints.xlsx
View File

Binary file not shown.

BIN
data-raw/clinical_breakpoints.xpt
View File

Binary file not shown.

BIN
data-raw/organisms.rds
View File

Binary file not shown.

24
data-raw/reproduction_of_clinical_breakpoints.R
View File

@ -133,8 +133,11 @@ organisms <- organisms %>%
select(-group) %>% select(-group) %>%
distinct() 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) saveRDS(organisms, "data-raw/organisms.rds", version = 2)
@ -223,7 +226,7 @@ breakpoints %>%
filter(!WHONET_ABX_CODE %in% whonet_antibiotics$WHONET_ABX_CODE) %>% filter(!WHONET_ABX_CODE %in% whonet_antibiotics$WHONET_ABX_CODE) %>%
pull(WHONET_ABX_CODE) %>% pull(WHONET_ABX_CODE) %>%
unique() 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 ---- ## Build new breakpoints table ----
@ -260,7 +263,7 @@ breakpoints_new <- breakpoints %>%
gsub("–", "-", ., fixed = TRUE)) %>% gsub("–", "-", ., fixed = TRUE)) %>%
arrange(desc(guideline), mo, ab, type, method) %>% arrange(desc(guideline), mo, ab, type, method) %>%
filter(!(is.na(breakpoint_S) & is.na(breakpoint_R)) & !is.na(mo) & !is.na(ab)) %>% 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 # check the strange duplicates
breakpoints_new %>% breakpoints_new %>%
@ -268,7 +271,7 @@ breakpoints_new %>%
filter(id %in% .$id[which(duplicated(id))]) filter(id %in% .$id[which(duplicated(id))])
# remove duplicates # remove duplicates
breakpoints_new <- breakpoints_new %>% 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 # fix reference table names
breakpoints_new %>% filter(guideline %like% "EUCAST", is.na(ref_tbl)) %>% View() 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" & breakpoints_new[which(breakpoints_new$method == "MIC" &
is.na(breakpoints_new$breakpoint_R)), "breakpoint_R"] <- max(m) is.na(breakpoints_new$breakpoint_R)), "breakpoint_R"] <- max(m)
# raise these one higher valid MIC factor level: # 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 == 129), "breakpoint_R"] <- 128
breakpoints_new[which(breakpoints_new$breakpoint_R == 257), "breakpoint_R"] <- m[which(m == 256) + 1] breakpoints_new[which(breakpoints_new$breakpoint_R == 257), "breakpoint_R"] <- 256
breakpoints_new[which(breakpoints_new$breakpoint_R == 513), "breakpoint_R"] <- m[which(m == 512) + 1] breakpoints_new[which(breakpoints_new$breakpoint_R == 513), "breakpoint_R"] <- 513
breakpoints_new[which(breakpoints_new$breakpoint_R == 1025), "breakpoint_R"] <- m[which(m == 1024) + 1] 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: # 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 # 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 # compare with current version
clinical_breakpoints %>% filter(guideline == "EUCAST 2022", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC") 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 # check dimensions
dim(breakpoints_new) dim(breakpoints_new)
dim(clinical_breakpoints) dim(clinical_breakpoints)

BIN
data/clinical_breakpoints.rda
View File

Binary file not shown.

11
inst/tinytest/test-mo_property.R
View File

@ -106,7 +106,7 @@ expect_identical(mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides
c("aerobe", "anaerobe")) c("aerobe", "anaerobe"))
expect_equal(as.character(table(mo_pathogenicity(example_isolates$mo))), 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_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.") expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
@ -129,9 +129,12 @@ for (l in AMR:::LANGUAGES_SUPPORTED[-1]) {
# test languages # test languages
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN")) 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 fullnames <- microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]
expect_identical(suppressWarnings(mo_name(dutch, language = NULL, keep_synonyms = TRUE)), to_dutch <- suppressWarnings(mo_name(fullnames, language = "nl", keep_synonyms = TRUE))
microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]) # gigantic test - will run ALL names 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 # manual property function
expect_error(mo_property("Escherichia coli", property = c("genus", "fullname"))) expect_error(mo_property("Escherichia coli", property = c("genus", "fullname")))

4
man/as.mo.Rd
View File

@ -201,6 +201,10 @@ as.mo(c(
"Ureaplazma urealitycium" "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("Streptococcus group A")
as.mo("S. epidermidis") # will remain species: B_STPHY_EPDR as.mo("S. epidermidis") # will remain species: B_STPHY_EPDR

4
man/as.sir.Rd
View File

@ -171,7 +171,7 @@ After using \code{\link[=as.sir]{as.sir()}}, you can use the \code{\link[=eucast
\subsection{Machine-Readable Clinical Breakpoints}{ \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}{ \subsection{Other}{
@ -185,7 +185,7 @@ The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRU
} }
\section{Interpretation of SIR}{ \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{ \itemize{
\item \strong{S - Susceptible, standard dosing regimen}\cr \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. 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.

2
man/clinical_breakpoints.Rd
View File

@ -5,7 +5,7 @@
\alias{clinical_breakpoints} \alias{clinical_breakpoints}
\title{Data Set with Clinical Breakpoints for SIR Interpretation} \title{Data Set with Clinical Breakpoints for SIR Interpretation}
\format{ \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{ \itemize{
\item \code{guideline}\cr Name of the guideline \item \code{guideline}\cr Name of the guideline
\item \code{type}\cr Breakpoint type, either "ECOFF", "animal", or "human" \item \code{type}\cr Breakpoint type, either "ECOFF", "animal", or "human"

2
man/count.Rd
View File

@ -71,7 +71,7 @@ The function \code{\link[=count_df]{count_df()}} takes any variable from \code{d
} }
\section{Interpretation of SIR}{ \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{ \itemize{
\item \strong{S - Susceptible, standard dosing regimen}\cr \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. 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.

2
man/mdro.Rd
View File

@ -174,7 +174,7 @@ Amikacin (\code{AMK}, \href{https://www.whocc.no/atc_ddd_index/?code=J01GB06&sho
\section{Interpretation of SIR}{ \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{ \itemize{
\item \strong{S - Susceptible, standard dosing regimen}\cr \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. 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.

2
man/microorganisms.groups.Rd
View File

@ -17,7 +17,7 @@ A \link[tibble:tibble]{tibble} with 444 observations and 4 variables:
microorganisms.groups microorganisms.groups
} }
\description{ \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{ \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}. 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}.

2
man/proportion.Rd
View File

@ -146,7 +146,7 @@ Using \code{only_all_tested} has no impact when only using one antibiotic as inp
\section{Interpretation of SIR}{ \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{ \itemize{
\item \strong{S - Susceptible, standard dosing regimen}\cr \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. 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.

2
man/resistance_predict.Rd
View File

@ -112,7 +112,7 @@ Valid options for the statistical model (argument \code{model}) are:
} }
\section{Interpretation of SIR}{ \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{ \itemize{
\item \strong{S - Susceptible, standard dosing regimen}\cr \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. 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.