P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 11:11:54 +02:00
Code Releases Activity

(v1.3.0.9034) eucast_rules summary fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-09-29 10:40:25 +02:00
parent 36ec8b0d81
commit 68e6e1e329
20 changed files with 83 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/atc_online.R
View File

@ -94,7 +94,7 @@ atc_online_property <- function(atc_code,
}
if (!has_internet()) {
message("There appears to be no internet connection.")
message("There appears to be no internet connection, returning NA.")
return(rep(NA, length(atc_code)))
}

37
R/eucast_rules.R
View File

@ -475,7 +475,6 @@ eucast_rules <- function(x,
all_betalactams <- c(aminopenicillins, cephalosporins, carbapenems, ureidopenicillins, AMC, OXA, FLC, PEN)
# nolint end
# Some helper functions ---------------------------------------------------
get_antibiotic_columns <- function(x, df) {
x <- trimws(unlist(strsplit(x, ",", fixed = TRUE)))
@ -547,6 +546,8 @@ eucast_rules <- function(x,
suppressWarnings(as.rsi(x))
}
# Preparing the data ------------------------------------------------------
verbose_info <- data.frame(rowid = character(0),
col = character(0),
mo_fullname = character(0),
@ -884,18 +885,16 @@ eucast_rules <- function(x,
# Print overview ----------------------------------------------------------
if (info == TRUE) {
rownames(verbose_info) <- NULL
affected <- x.bak[which(x.bak$`.rowid` %in% x$`.rowid`), , drop = FALSE]
rows_affected <- as.integer(rownames(affected))
verbose_info <- verbose_info %pm>%
pm_left_join(data.frame(row = rows_affected,
rowid = affected[, ".rowid", drop = TRUE],
stringsAsFactors = FALSE),
by = "rowid") %pm>%
pm_select(-rowid) %pm>%
verbose_info <- x.bak %pm>%
pm_mutate(row = pm_row_number()) %pm>%
pm_select(`.rowid`, row) %pm>%
pm_right_join(verbose_info,
by = c(".rowid" = "rowid")) %pm>%
pm_select(-`.rowid`) %pm>%
pm_select(row, pm_everything()) %pm>%
pm_filter(!is.na(new)) %pm>%
pm_arrange(row, rule_group, rule_name, col)
rownames(verbose_info) <- NULL
if (verbose == TRUE) {
wouldve <- "would have "
@ -904,15 +903,17 @@ eucast_rules <- function(x,
}
cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n"))
cat(font_bold(paste("The rules", paste0(wouldve, "affected"),
formatnr(pm_n_distinct(verbose_info$row)),
cat(paste0("The rules ", paste0(wouldve, "affected "),
font_bold(formatnr(pm_n_distinct(verbose_info$row)),
"out of", formatnr(nrow(x.bak)),
"rows, making a total of", formatnr(nrow(verbose_info)), "edits\n")))
total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow()
total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow()
# print added values
"rows"),
", making a total of ",
font_bold(formatnr(nrow(verbose_info)), "edits\n")))
total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow()
total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow()
# print added values
if (total_n_added == 0) {
colour <- cat # is function
} else {

6
R/rsi.R
View File

@ -657,7 +657,7 @@ exec_as.rsi <- function(method,
pm_filter(uti == FALSE) %pm>% # 'uti' is a column in rsi_translation
pm_arrange(pm_desc(nchar(mo)))
}
get_record <- get_record[1L, ]
get_record <- get_record[1L, , drop = FALSE]
if (NROW(get_record) > 0) {
if (is.na(x[i])) {
@ -670,7 +670,7 @@ exec_as.rsi <- function(method,
isTRUE(conserve_capped_values) & mic_input %like% "^>[0-9]" ~ "R",
# start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R
isTRUE(which(levels(mic_input) == mic_input) <= which(levels(mic_S) == mic_S)) ~ "S",
guideline_coerced %like% "ECUAST" &
guideline_coerced %like% "EUCAST" &
isTRUE(which(levels(mic_input) == mic_input) > which(levels(mic_R) == mic_R)) ~ "R",
guideline_coerced %like% "CLSI" &
isTRUE(which(levels(mic_input) == mic_input) >= which(levels(mic_R) == mic_R)) ~ "R",
@ -681,7 +681,7 @@ exec_as.rsi <- function(method,
} else if (method == "disk") {
new_rsi[i] <- quick_case_when(isTRUE(as.double(x[i]) >= as.double(get_record$breakpoint_S)) ~ "S",
# start interpreting: EUCAST uses >= S and < R, CLSI uses >=S and <= R
guideline_coerced %like% "ECUAST" &
guideline_coerced %like% "EUCAST" &
isTRUE(as.double(x[i]) < as.double(get_record$breakpoint_R)) ~ "R",
guideline_coerced %like% "CLSI" &
isTRUE(as.double(x[i]) <= as.double(get_record$breakpoint_R)) ~ "R",