(v2.1.1.9045) fix host in animal guidelines

This commit is contained in:
dr. M.S. (Matthijs) Berends 2024-06-12 10:32:43 +02:00
parent 3a54711dfe
commit c753afcd76
6 changed files with 42 additions and 30 deletions

View File

@ -1,6 +1,6 @@
Package: AMR
Version: 2.1.1.9044
Date: 2024-06-10
Version: 2.1.1.9045
Date: 2024-06-12
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

View File

@ -1,4 +1,4 @@
# AMR 2.1.1.9044
# AMR 2.1.1.9045
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*

38
R/sir.R
View File

@ -545,6 +545,13 @@ as.sir.data.frame <- function(x,
}
# -- host
if (missing(breakpoint_type) && any(host %in% AMR_env$host_preferred_order, na.rm = TRUE)) {
message_("Assuming `breakpoint_type = \"animal\"` since `host` contains animal species.")
breakpoint_type <- "animal"
} else if (any(!convert_host(host) %in% c("human", "ECOFF"), na.rm = TRUE)) {
message_("Assuming `breakpoint_type = \"animal\"`.")
breakpoint_type <- "animal"
}
if (breakpoint_type == "animal") {
if (is.null(host)) {
host <- search_type_in_df(x = x, type = "host", add_col_prefix = FALSE)
@ -936,6 +943,7 @@ as_sir_method <- function(method_short,
}
if (length(ab) == 1) {
ab <- rep(ab, length(x))
ab.bak <- rep(ab.bak, length(ab))
}
if (length(host) == 1) {
host <- rep(host, length(x))
@ -952,7 +960,7 @@ as_sir_method <- function(method_short,
warning_("in `as.sir()`: using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
}
}
agent_formatted <- paste0("'", font_bold(ab.bak, collapse = NULL), "'")
agent_name <- ab_name(ab, tolower = TRUE, language = NULL)
same_ab <- generalise_antibiotic_name(ab) == generalise_antibiotic_name(agent_name)
@ -966,7 +974,7 @@ as_sir_method <- function(method_short,
")")
# this intro text will also be printed in the progress bar if the `progress` package is installed
intro_txt <- paste0("Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0("for ", vector_and(ab, quotes = FALSE, sort = FALSE))),
ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))),
mo_var_found,
ifelse(identical(reference_data, AMR::clinical_breakpoints),
paste0(", ", font_bold(guideline_coerced)),
@ -1042,17 +1050,6 @@ as_sir_method <- function(method_short,
}
msgs <- character(0)
if (nrow(breakpoints) == 0) {
# apparently no breakpoints found
message(
paste0(font_rose_bg(" WARNING "), "\n"),
font_black(paste0(" ", AMR_env$bullet_icon, " No ", guideline_coerced, " ", method_coerced, " breakpoints available for ",
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
" (", ab_coerced, ").")))
load_mo_uncertainties(metadata_mo)
return(rep(NA_sir_, nrow(df)))
}
if (guideline_coerced %like% "EUCAST") {
any_is_intrinsic_resistant <- FALSE
@ -1067,6 +1064,18 @@ as_sir_method <- function(method_short,
has_progress_bar <- !is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE)) && nrow(df_unique) >= 10
on.exit(close(p))
if (nrow(breakpoints) == 0) {
# apparently no breakpoints found
message(
paste0(font_rose_bg(" WARNING "), "\n"),
font_black(paste0(" ", AMR_env$bullet_icon, " No ", guideline_coerced, " ", method_coerced, " breakpoints available for ",
suppressMessages(suppressWarnings(ab_name(unique(ab_coerced), language = NULL, tolower = TRUE))),
" (", unique(ab_coerced), ")."), collapse = "\n"))
load_mo_uncertainties(metadata_mo)
return(rep(NA_sir_, nrow(df)))
}
# run the rules (df_unique is a row combination per mo/ab/uti/host)
for (i in seq_len(nrow(df_unique))) {
p$tick()
@ -1106,7 +1115,6 @@ as_sir_method <- function(method_short,
suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))),
" (", ab_current, ")"
)
# gather all available breakpoints for current MO
breakpoints_current <- breakpoints %pm>%
@ -1151,7 +1159,7 @@ as_sir_method <- function(method_short,
subset(host_match == TRUE)
} else {
# no breakpoint found for this host, so sort on mostly available guidelines
msgs <- c(msgs, paste0("No ", guideline_coerced, " breakpoints for ", font_bold(host_current), " available for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " breakpoints instead."))
msgs <- c(msgs, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
}
}

View File

@ -1,7 +1,5 @@
# The `AMR` Package for R <a href="https://msberends.github.io/AMR/"><img src="./logo.svg" align="right" height="139" /></a>
<img src="./endorsement_clsi_eucast.jpg" class="endorse_img" align="right" height="120" />
* Provides an **all-in-one solution** for AMR data analysis in a One Health approach
* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA
* Provides the **full microbiological taxonomy** and extensive info on **all antimicrobial drugs**
@ -15,6 +13,8 @@
<p style="text-align:right; width: 50%;"><small><a href="https://doi.org/10.18637/jss.v104.i03" target="_blank">https://doi.org/10.18637/jss.v104.i03</a></small></p>
</div>
<a href="./reference/clinical_breakpoints.html#response-from-clsi-and-eucast"><img src="./endorsement_clsi_eucast.jpg" class="endorse_img" align="right" height="120" /></a>
----
### Introduction

View File

@ -292,6 +292,7 @@ expect_message(as.sir(data.frame(
sir_history <- sir_interpretation_history(clean = TRUE)
mics <- as.mic(2 ^ c(-4:6)) # 0.0625 to 64 in factors of 2
vet <- data.frame(animal = c(rep("cat", 3), rep("dogs", 3), "canine", "equine", "horse", "cattle", "bird"),
PRA = mics,
FLR = mics,
@ -313,12 +314,9 @@ expect_identical(out_vet$FLR, as.sir(c("S", "S", NA, "S", "S", NA, "I", "R", NA,
sir_history <- sir_interpretation_history()
expect_identical(sir_history$host,
c("cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle",
"cattle", "cattle", "cattle", "cattle", "cattle", "cats" , "cats" , "cats" , "cattle", "cattle", "cattle",
"cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle",
"cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle",
"cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle",
"cats" , "cats" , "cats" , "dogs" , "dogs" , "dogs" , "cattle", "cattle", "cattle", "cattle", "cats",
"cats" , "cats" , "cats" , "cats" , "cats" , "cats"))
"cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "dogs", "dogs", "cattle", "cattle", "cats",
"cats", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "dogs",
"dogs", "cattle", "cattle", "cats", "cats"))
# ECOFF -------------------------------------------------------------------

View File

@ -89,13 +89,19 @@
box-shadow: none !important;
}
.endorse_img {
width: 0% !important;
}
.template-home img.logo {
width: 200px;
}
.template-home .endorse_img {
width: 150px;
}
.template-reference-index .section-desc {
font-style: italic;
text-align: justify;
font-size: 16px;
}
@media (max-width: 575.98px) {
.template-home img.logo {
width: 140px;