mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 06:02:01 +02:00
eucast rules fix, 1st isolate fix, website update
This commit is contained in:
@ -348,7 +348,7 @@ eucast_rules <- function(tbl,
|
||||
|
||||
# helper function for editing the table
|
||||
edit_rsi <- function(to, rule, rows, cols) {
|
||||
cols <- cols[!is.na(cols)]
|
||||
cols <- unique(cols[!is.na(cols)])
|
||||
if (length(rows) > 0 & length(cols) > 0) {
|
||||
before <- as.character(unlist(as.list(tbl_original[rows, cols])))
|
||||
tryCatch(
|
||||
@ -367,6 +367,10 @@ eucast_rules <- function(tbl,
|
||||
stop(e, call. = FALSE)
|
||||
}
|
||||
)
|
||||
suppressMessages(
|
||||
suppressWarnings(
|
||||
tbl[rows, cols] <<- to
|
||||
))
|
||||
after <- as.character(unlist(as.list(tbl_original[rows, cols])))
|
||||
amount_changed <<- amount_changed + sum(before != after, na.rm = TRUE)
|
||||
amount_affected_rows <<- unique(c(amount_affected_rows, rows))
|
||||
@ -404,27 +408,14 @@ eucast_rules <- function(tbl,
|
||||
# join to microorganisms data set
|
||||
tbl <- tbl %>%
|
||||
mutate_at(vars(col_mo), as.mo) %>%
|
||||
left_join_microorganisms(by = col_mo, suffix = c("_oldcols", ""))
|
||||
|
||||
# antibiotic classes
|
||||
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)
|
||||
tetracyclines <- c(doxy, mino, tetr) # since EUCAST v3.1 tige(cycline) is set apart
|
||||
polymyxins <- c(poly, coli)
|
||||
macrolides <- c(eryt, azit, roxi, clar) # since EUCAST v3.1 clinda is set apart
|
||||
glycopeptides <- c(vanc, teic)
|
||||
streptogramins <- c(qida, pris) # should officially also be quinupristin/dalfopristin
|
||||
cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
|
||||
carbapenems <- c(erta, imip, mero)
|
||||
aminopenicillins <- c(ampi, amox)
|
||||
ureidopenicillins <- c(pipe, pita, azlo, mezl)
|
||||
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
|
||||
all_betalactam <- c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, amcl, oxac, clox, peni)
|
||||
left_join_microorganisms(by = col_mo, suffix = c("_oldcols", "")) %>%
|
||||
as.data.frame(stringsAsFactors = FALSE)
|
||||
|
||||
if (info == TRUE) {
|
||||
cat("Rules by the European Committee on Antimicrobial Susceptibility Testing (EUCAST)\n")
|
||||
cat("\nRules by the European Committee on Antimicrobial Susceptibility Testing (EUCAST)\n")
|
||||
}
|
||||
|
||||
# since ampicillin ^= amoxicillin, get the first from the latter (not in original table)
|
||||
# since ampicillin ^= amoxicillin, get the first from the latter (not in original EUCAST table)
|
||||
if (!is.na(ampi) & !is.na(amox)) {
|
||||
if (verbose == TRUE) {
|
||||
cat(bgGreen("\n VERBOSE: transforming",
|
||||
@ -440,8 +431,26 @@ eucast_rules <- function(tbl,
|
||||
tbl[which(tbl[, amox] == "S" & !tbl[, ampi] %in% c("S", "I", "R")), ampi] <- "S"
|
||||
tbl[which(tbl[, amox] == "I" & !tbl[, ampi] %in% c("S", "I", "R")), ampi] <- "I"
|
||||
tbl[which(tbl[, amox] == "R" & !tbl[, ampi] %in% c("S", "I", "R")), ampi] <- "R"
|
||||
} else if (is.na(ampi) & !is.na(amox)) {
|
||||
# ampicillin column is missing, but amoxicillin is available
|
||||
message(blue(paste0("NOTE: Using column `", bold(amox), "` as input for ampicillin (J01CA01) since many EUCAST rules depend on it.")))
|
||||
ampi <- amox
|
||||
}
|
||||
|
||||
# antibiotic classes
|
||||
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)
|
||||
tetracyclines <- c(doxy, mino, tetr) # since EUCAST v3.1 tige(cycline) is set apart
|
||||
polymyxins <- c(poly, coli)
|
||||
macrolides <- c(eryt, azit, roxi, clar) # since EUCAST v3.1 clinda is set apart
|
||||
glycopeptides <- c(vanc, teic)
|
||||
streptogramins <- c(qida, pris) # should officially also be quinupristin/dalfopristin
|
||||
cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
|
||||
carbapenems <- c(erta, imip, mero)
|
||||
aminopenicillins <- c(ampi, amox)
|
||||
ureidopenicillins <- c(pipe, pita, azlo, mezl)
|
||||
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
|
||||
all_betalactam <- c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, amcl, oxac, clox, peni)
|
||||
|
||||
if (any(c("all", "breakpoints") %in% rules)) {
|
||||
# BREAKPOINTS -------------------------------------------------------------
|
||||
|
||||
|
||||
@ -380,7 +380,7 @@ first_isolate <- function(tbl,
|
||||
)
|
||||
}
|
||||
|
||||
# suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number())
|
||||
# suppress warnings because dplyr wants us to use library(dplyr) when using filter(row_number())
|
||||
suppressWarnings(
|
||||
scope.size <- tbl %>%
|
||||
filter(
|
||||
@ -391,17 +391,46 @@ first_isolate <- function(tbl,
|
||||
nrow()
|
||||
)
|
||||
|
||||
identify_new_year = function(x, episode_days) {
|
||||
# I asked on StackOverflow:
|
||||
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
|
||||
if (length(x) == 1) {
|
||||
return(TRUE)
|
||||
}
|
||||
indices = integer(0)
|
||||
start = x[1]
|
||||
ind = 1
|
||||
indices[ind] = ind
|
||||
for (i in 2:length(x)) {
|
||||
if (as.numeric(x[i] - start >= episode_days)) {
|
||||
ind = ind + 1
|
||||
indices[ind] = i
|
||||
start = x[i]
|
||||
}
|
||||
}
|
||||
result <- rep(FALSE, length(x))
|
||||
result[indices] <- TRUE
|
||||
return(result)
|
||||
}
|
||||
|
||||
# Analysis of first isolate ----
|
||||
all_first <- tbl %>%
|
||||
mutate(other_pat_or_mo = if_else(patient_id == lag(patient_id)
|
||||
& genus == lag(genus)
|
||||
& species == lag(species),
|
||||
FALSE,
|
||||
TRUE),
|
||||
days_diff = 0) %>%
|
||||
mutate(days_diff = if_else(other_pat_or_mo == FALSE,
|
||||
(date_lab - lag(date_lab)) + lag(days_diff),
|
||||
0))
|
||||
TRUE)) %>% #,
|
||||
# days_diff = 0) %>%
|
||||
# mutate(days_diff = if_else(other_pat_or_mo == FALSE,
|
||||
# as.integer((date_lab - lag(date_lab)) + lag(days_diff)),
|
||||
# as.integer(0))) %>%
|
||||
# mutate(r = days_diff) %>%
|
||||
group_by_at(vars(patient_id,
|
||||
genus,
|
||||
species)) %>%
|
||||
mutate(more_than_episode_ago = identify_new_year(x = date_lab,
|
||||
episode_days = episode_days)) %>%
|
||||
ungroup()
|
||||
|
||||
weighted.notice <- ''
|
||||
if (!is.null(col_keyantibiotics)) {
|
||||
@ -436,13 +465,12 @@ first_isolate <- function(tbl,
|
||||
between(row_number(), row.start, row.end)
|
||||
& genus != ""
|
||||
& species != ""
|
||||
& (other_pat_or_mo
|
||||
| days_diff >= episode_days
|
||||
| key_ab_other),
|
||||
& (other_pat_or_mo | more_than_episode_ago | key_ab_other),
|
||||
TRUE,
|
||||
FALSE))
|
||||
)
|
||||
} else {
|
||||
# no key antibiotics
|
||||
# suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number())
|
||||
suppressWarnings(
|
||||
all_first <- all_first %>%
|
||||
@ -452,8 +480,7 @@ first_isolate <- function(tbl,
|
||||
between(row_number(), row.start, row.end)
|
||||
& genus != ""
|
||||
& species != ""
|
||||
& (other_pat_or_mo
|
||||
| days_diff >= episode_days),
|
||||
& (other_pat_or_mo | more_than_episode_ago),
|
||||
TRUE,
|
||||
FALSE))
|
||||
)
|
||||
|
||||
6
R/freq.R
6
R/freq.R
@ -573,9 +573,9 @@ format_header <- function(x, markdown = FALSE, decimal.mark = ".", big.mark = ",
|
||||
n_levels_list <- c(n_levels_list[1:5], "...")
|
||||
}
|
||||
if (header$ordered == TRUE) {
|
||||
n_levels_list <- paste0(header$levels, collapse = " < ")
|
||||
n_levels_list <- paste0(n_levels_list, collapse = " < ")
|
||||
} else {
|
||||
n_levels_list <- paste0(header$levels, collapse = ", ")
|
||||
n_levels_list <- paste0(n_levels_list, collapse = ", ")
|
||||
}
|
||||
header$levels <- n_levels_list
|
||||
header <- header[names(header) != "ordered"]
|
||||
@ -824,7 +824,7 @@ print.frequency_tbl <- function(x,
|
||||
}
|
||||
} else if (opt$tbl_format == "markdown") {
|
||||
# do print title as caption in markdown
|
||||
cat("\n", title, sep = "")
|
||||
cat("\n", title, " ", sep = "") # two trailing spaces for markdown
|
||||
}
|
||||
|
||||
if (NROW(x) == 0) {
|
||||
|
||||
Reference in New Issue
Block a user