P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

new verbose

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-10-19 00:17:03 +02:00
parent 5727800b9a
commit b464dd524a
5 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NEWS.md
View File

@ -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
View File

@ -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
View File

@ -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),

4
man/EUCAST.Rd
View File

@ -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.

2
tests/testthat/test-eucast.R
View File

@ -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)))
})