From b464dd524ae46a37e6b48c0020853f22e0cc0cfe Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 19 Oct 2018 00:17:03 +0200 Subject: [PATCH] new verbose --- NEWS.md | 2 ++ R/eucast.R | 33 +++++++++++++++++++++------------ R/mo.R | 20 ++++++++++++++++---- man/EUCAST.Rd | 4 ++-- tests/testthat/test-eucast.R | 2 +- 5 files changed, 42 insertions(+), 19 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6d8aefa5..6cc75700 100755 --- a/NEWS.md +++ b/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` diff --git a/R/eucast.R b/R/eucast.R index 8fae0609..484956b4 100755 --- a/R/eucast.R +++ b/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 diff --git a/R/mo.R b/R/mo.R index 270fa0bf..6f3990e7 100644 --- a/R/mo.R +++ b/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), diff --git a/man/EUCAST.Rd b/man/EUCAST.Rd index 17da179f..70b05c4a 100755 --- a/man/EUCAST.Rd +++ b/man/EUCAST.Rd @@ -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. diff --git a/tests/testthat/test-eucast.R b/tests/testthat/test-eucast.R index cd05f7d1..6c60bdd9 100755 --- a/tests/testthat/test-eucast.R +++ b/tests/testthat/test-eucast.R @@ -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))) })