mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 18:06:12 +01:00
new verbose
This commit is contained in:
parent
5727800b9a
commit
b464dd524a
2
NEWS.md
2
NEWS.md
@ -11,6 +11,8 @@
|
||||
* Better error handling when rules cannot be applied (i.e. new values could not be inserted)
|
||||
* The amount of affected values will now only be measured once per row/column combination
|
||||
* Data set `septic_patients` now reflects these changes
|
||||
* Empty values as input for `as.mo` will be processed faster
|
||||
* Fewer than 3 characters as input for `as.mo` will return NA
|
||||
* Added parameter `combine_IR` (TRUE/FALSE) to functions `portion_df` and `count_df`, to indicate that all values of I and R must be merged into one, so the output only consists of S vs. IR (susceptible vs. non-susceptible)
|
||||
* Fix for `portion_*(..., as_percent = TRUE)` when minimal amount of isolates would not be met
|
||||
* Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum`
|
||||
|
33
R/eucast.R
33
R/eucast.R
@ -25,7 +25,7 @@
|
||||
#' @param rules a character vector that specifies which rules should be applied - one or more of \code{c("breakpoints", "expert", "other", "all")}
|
||||
#' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,oxac,peni,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column name of an antibiotic, see Details
|
||||
#' @param col_bactid Deprecated. Use \code{col_mo} instead.
|
||||
#' @param verbose a logical to indicate whether extensive info should be printed to the console about which rows and columns are effected with their old and new values
|
||||
#' @param verbose a logical to indicate whether extensive info should be returned as a \code{data.frame} with info about which rows and columns are effected
|
||||
#' @param ... parameters that are passed on to \code{EUCAST_rules}
|
||||
#' @details To define antibiotics column names, input a text or use \code{NA} to skip a column (e.g. \code{tica = NA}). Non-existing columns will anyway be skipped with a warning. See the Antibiotics section for an explanation of the abbreviations.
|
||||
#' @section Antibiotics:
|
||||
@ -97,7 +97,7 @@
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% select pull mutate_at vars
|
||||
#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue
|
||||
#' @return Value of parameter \code{tbl}, possibly with edited values of antibiotics.
|
||||
#' @return The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info.
|
||||
#' @source
|
||||
#' \itemize{
|
||||
#' \item{
|
||||
@ -325,7 +325,14 @@ EUCAST_rules <- function(tbl,
|
||||
|
||||
amount_changed <- 0
|
||||
amount_affected_rows <- integer(0)
|
||||
verbose_info <- ""
|
||||
verbose_info <- data.frame(rule_type = character(0),
|
||||
rule_set = character(0),
|
||||
force_to = character(0),
|
||||
found = integer(0),
|
||||
changed = integer(0),
|
||||
target_columns = integer(0),
|
||||
target_rows = integer(0),
|
||||
stringsAsFactors = FALSE)
|
||||
|
||||
# helper function for editing the table
|
||||
edit_rsi <- function(to, rule, rows, cols) {
|
||||
@ -354,13 +361,15 @@ EUCAST_rules <- function(tbl,
|
||||
changed_results <<- changed_results + sum(before != after, na.rm = TRUE) # will be reset at start of every rule
|
||||
|
||||
if (verbose == TRUE) {
|
||||
verbose_info <<- paste0(verbose_info,
|
||||
"\n\nRule Type: ", rule[1],
|
||||
"\nRule Set: ", rule[2],
|
||||
"\nEffect: Set to '", to, "' (",
|
||||
length(before), " found, ", sum(before != after, na.rm = TRUE), " changed): ",
|
||||
"cols '", paste(cols, collapse = "', '"),
|
||||
"' of rows ", paste(rows, collapse = ", "))
|
||||
verbose_new <- data.frame(rule_type = rule[1],
|
||||
rule_set = rule[2],
|
||||
force_to = to,
|
||||
found = length(before),
|
||||
changed = sum(before != after, na.rm = TRUE),
|
||||
stringsAsFactors = FALSE)
|
||||
verbose_new$target_columns <- list(unname(cols))
|
||||
verbose_new$target_rows <- list(unname(rows))
|
||||
verbose_info <<- rbind(verbose_info, verbose_new)
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1649,8 +1658,8 @@ EUCAST_rules <- function(tbl,
|
||||
amount_changed %>% format(big.mark = ","), 'test results.\n\n'))
|
||||
}
|
||||
|
||||
if (verbose_info != "") {
|
||||
message("Verbose information:", verbose_info)
|
||||
if (verbose == TRUE) {
|
||||
return(verbose_info)
|
||||
}
|
||||
|
||||
tbl_original
|
||||
|
20
R/mo.R
20
R/mo.R
@ -173,6 +173,8 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
|
||||
x_input <- x
|
||||
# only check the uniques, which is way faster
|
||||
x <- unique(x)
|
||||
# remove empty values (to later fill them in again)
|
||||
x <- x[!is.na(x) & !is.null(x) & !identical(x, "")]
|
||||
|
||||
MOs <- NULL # will be set later, if needed
|
||||
MOs_mostprevalent <- NULL # will be set later, if needed
|
||||
@ -263,9 +265,15 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
|
||||
# cat(paste0('x_trimmed_species "', x_trimmed_species, '"\n'))
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
if (identical(x_trimmed[i], "") | is.na(x_trimmed[i])) {
|
||||
if (identical(x_trimmed[i], "")) {
|
||||
# empty values
|
||||
x[i] <- NA
|
||||
x[i] <- NA_character_
|
||||
next
|
||||
}
|
||||
if (nchar(x_trimmed[i]) < 3) {
|
||||
# fewer than 3 chars, add as failure
|
||||
x[i] <- NA_character_
|
||||
failures <- c(failures, x_backup[i])
|
||||
next
|
||||
}
|
||||
|
||||
@ -586,7 +594,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
|
||||
|
||||
failures <- failures[!failures %in% c(NA, NULL, NaN)]
|
||||
if (length(failures) > 0) {
|
||||
warning("These ", length(failures) , " values could not be coerced (try again with allow_uncertain = TRUE): ",
|
||||
warning("These ", length(failures) , " values could not be coerced: ",
|
||||
paste('"', unique(failures), '"', sep = "", collapse = ', '),
|
||||
".",
|
||||
call. = FALSE)
|
||||
@ -653,8 +661,12 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
|
||||
x[x == MOs[mo == 'B_STRPTC_SAL', ..property][[1]][1L]] <- MOs[mo == 'B_STRPTC_GRK', ..property][[1]][1L]
|
||||
}
|
||||
|
||||
x_input_unique <- unique(x_input)
|
||||
# fill in empty values again
|
||||
x[is.na(x_input_unique) | is.null(x_input_unique) | identical(x_input_unique, "")] <- NA
|
||||
|
||||
# left join the found results to the original input values (x_input)
|
||||
df_found <- data.frame(input = as.character(unique(x_input)),
|
||||
df_found <- data.frame(input = as.character(x_input_unique),
|
||||
found = x,
|
||||
stringsAsFactors = FALSE)
|
||||
df_input <- data.frame(input = as.character(x_input),
|
||||
|
@ -56,12 +56,12 @@ interpretive_reading(...)
|
||||
|
||||
\item{col_bactid}{Deprecated. Use \code{col_mo} instead.}
|
||||
|
||||
\item{verbose}{a logical to indicate whether extensive info should be printed to the console about which rows and columns are effected with their old and new values}
|
||||
\item{verbose}{a logical to indicate whether extensive info should be returned as a \code{data.frame} with info about which rows and columns are effected}
|
||||
|
||||
\item{...}{parameters that are passed on to \code{EUCAST_rules}}
|
||||
}
|
||||
\value{
|
||||
Value of parameter \code{tbl}, possibly with edited values of antibiotics.
|
||||
The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info.
|
||||
}
|
||||
\description{
|
||||
Apply susceptibility rules as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. This includes (1) expert rules, (2) intrinsic resistance and (3) inferred resistance as defined in their breakpoint tables.
|
||||
|
@ -73,6 +73,6 @@ test_that("EUCAST rules work", {
|
||||
, info = FALSE))$amox,
|
||||
"S")
|
||||
|
||||
expect_message(suppressWarnings(EUCAST_rules(septic_patients, verbose = TRUE)))
|
||||
expect_output(suppressWarnings(EUCAST_rules(septic_patients, verbose = TRUE)))
|
||||
|
||||
})
|
||||
|
Loading…
Reference in New Issue
Block a user