From 7c069145acc5e037345ae41fc2fb976c73965e34 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Tue, 20 Aug 2019 11:40:54 +0200 Subject: [PATCH] (v0.7.1.9058) as.mo() improvement --- DESCRIPTION | 4 +- NAMESPACE | 1 + NEWS.md | 2 +- R/eucast_rules.R | 25 +++--- R/mo.R | 172 +++++++++++++++++++++----------------- R/rsi_calc.R | 10 +-- docs/LICENSE-text.html | 2 +- docs/articles/index.html | 2 +- docs/authors.html | 2 +- docs/index.html | 2 +- docs/news/index.html | 8 +- docs/reference/index.html | 2 +- 12 files changed, 126 insertions(+), 106 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f7787964..08eff9b3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.7.1.9057 -Date: 2019-08-15 +Version: 0.7.1.9058 +Date: 2019-08-20 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 5c9db6c2..69aa40ef 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -233,6 +233,7 @@ importFrom(crayon,bold) importFrom(crayon,green) importFrom(crayon,italic) importFrom(crayon,magenta) +importFrom(crayon,make_style) importFrom(crayon,red) importFrom(crayon,silver) importFrom(crayon,strip_style) diff --git a/NEWS.md b/NEWS.md index c43f1c52..7ffdb24a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 0.7.1.9057 +# AMR 0.7.1.9058 ### Breaking * Function `freq()` has moved to a new package, [`clean`](https://github.com/msberends/clean) ([CRAN link](https://cran.r-project.org/package=clean)). Creating frequency tables is actually not the scope of this package (never was) and this function has matured a lot over the last two years. Therefore, a new package was created for data cleaning and checking and it perfectly fits the `freq()` function. The [`clean`](https://github.com/msberends/clean) package is available on CRAN and will be installed automatically when updating the `AMR` package, that now imports it. In a later stage, the `skewness()` and `kurtosis()` functions will be moved to the `clean` package too. diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 13b3283d..38386178 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -119,7 +119,7 @@ EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016" #' @rdname eucast_rules #' @export #' @importFrom dplyr %>% select pull mutate_at vars group_by summarise n -#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style white red +#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style white red make_style #' @importFrom utils menu #' @return The input of \code{x}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with all original and new values of the affected bug-drug combinations. #' @source @@ -197,7 +197,8 @@ eucast_rules <- function(x, q_continue <- menu(choices = c("OK", "Cancel"), graphics = TRUE, title = txt) } if (q_continue %in% c(FALSE, 2)) { - return(invisible()) + message("Cancelled, returning original data") + return(x) } } @@ -228,6 +229,8 @@ eucast_rules <- function(x, trimws(format(x, big.mark = big.mark, decimal.mark = decimal.mark)) } + grey <- make_style("grey") + warned <- FALSE txt_error <- function() { cat("", bgRed(white(" ERROR ")), "\n\n") } @@ -235,21 +238,21 @@ eucast_rules <- function(x, txt_ok <- function(no_added, no_changed) { if (warned == FALSE) { if (no_added + no_changed == 0) { - cat(green(" (no changes)\n")) + cat(pillar::style_subtle(" (no changes)\n")) } else { # opening - cat(blue(" (")) + cat(grey(" (")) # additions if (no_added > 0) { if (no_added == 1) { - cat(blue("1 value added")) + cat(green("1 value added")) } else { - cat(blue(formatnr(no_added), "values added")) + cat(green(formatnr(no_added), "values added")) } } # separator if (no_added > 0 & no_changed > 0) { - cat(blue(", ")) + cat(grey(", ")) } # changes if (no_changed > 0) { @@ -260,7 +263,7 @@ eucast_rules <- function(x, } } # closing - cat(blue(")\n")) + cat(grey(")\n")) } warned <<- FALSE } @@ -770,7 +773,7 @@ eucast_rules <- function(x, verbose_info <- verbose_info %>% arrange(row, rule_group, rule_name, col) - cat(paste0("\n", silver(strrep("-", options()$width - 1)), "\n")) + cat(paste0("\n", grey(strrep("-", options()$width - 1)), "\n")) cat(bold(paste('EUCAST rules', paste0(wouldve, 'affected'), formatnr(n_distinct(verbose_info$row)), 'out of', formatnr(nrow(x_original)), @@ -783,7 +786,7 @@ eucast_rules <- function(x, if (n_added == 0) { colour <- cat # is function } else { - colour <- blue # is function + colour <- green # is function } cat(colour(paste0("=> ", wouldve, "added ", bold(formatnr(verbose_info %>% @@ -828,7 +831,7 @@ eucast_rules <- function(x, cat() cat("\n") } - cat(paste0(silver(strrep("-", options()$width - 1)), "\n")) + cat(paste0(grey(strrep("-", options()$width - 1)), "\n")) if (verbose == FALSE & nrow(verbose_info) > 0) { cat(paste("\nUse", bold("eucast_rules(..., verbose = TRUE)"), "(on your original data) to get a data.frame with all specified edits instead.\n\n")) diff --git a/R/mo.R b/R/mo.R index 27078825..84640cd7 100755 --- a/R/mo.R +++ b/R/mo.R @@ -314,6 +314,7 @@ exec_as.mo <- function(x, options(mo_uncertainties = NULL) options(mo_renamed = NULL) } + options(mo_renamed_last_run = NULL) if (NCOL(x) == 2) { # support tidyverse selection like: df %>% select(colA, colB) @@ -336,9 +337,12 @@ exec_as.mo <- function(x, } notes <- character(0) - uncertainties <- data.frame(input = character(0), + uncertainties <- data.frame(uncertainty = integer(0), + input = character(0), fullname = character(0), - mo = character(0)) + renamed_to = character(0), + mo = character(0), + stringsAsFactors = FALSE) failures <- character(0) uncertainty_level <- translate_allow_uncertain(allow_uncertain) @@ -488,11 +492,13 @@ exec_as.mo <- function(x, # replace minus by a space x <- gsub("-+", " ", x) # replace hemolytic by haemolytic - x <- gsub("ha?emoly", "haemoly", x) + x <- gsub("ha?emoly", "haemoly", x, ignore.case = TRUE) # place minus back in streptococci - x <- gsub("(alpha|beta|gamma).?ha?emoly", "\\1-haemoly", x) + x <- gsub("(alpha|beta|gamma).?ha?emoly", "\\1-haemoly", x, ignore.case = TRUE) # remove genus as first word - x <- gsub("^Genus ", "", x) + x <- gsub("^genus ", "", x, ignore.case = TRUE) + # remove 'uncertain' like texts + x <- trimws(gsub("(uncertain|susp[ie]c[a-z]+|verdacht)", "", x, ignore.case = TRUE)) # allow characters that resemble others = dyslexia_mode ---- if (dyslexia_mode == TRUE) { x <- tolower(x) @@ -514,10 +520,11 @@ exec_as.mo <- function(x, x <- gsub("(.)\\1+", "\\1+", x) # allow ending in -en or -us x <- gsub("e\\+n(?![a-z[])", "(e+n|u+(c|k|q|qu|s|z|x|ks)+)", x, ignore.case = TRUE, perl = TRUE) - # if the input is longer than 10 characters, add a [.] between all characters, as some might have forgotten a character + # if the input is longer than 10 characters, allow any constant between all characters, as some might have forgotten a character # this will allow "Pasteurella damatis" to be correctly read as "Pasteurella dagmatis". - x[nchar(x_backup_without_spp) > 10] <- gsub("([a-z])([a-z])", "\\1.*\\2", x[nchar(x_backup_without_spp) > 10], ignore.case = TRUE) - x[nchar(x_backup_without_spp) > 10] <- gsub("[+]", "+.*", x[nchar(x_backup_without_spp) > 10]) + constants <- paste(letters[!letters %in% c("a", "e", "i", "o", "u")], collapse = "") + #x[nchar(x_backup_without_spp) > 10] <- gsub("([a-z])([a-z])", paste0("\\1[", constants, "]?\\2"), x[nchar(x_backup_without_spp) > 10], ignore.case = TRUE) + x[nchar(x_backup_without_spp) > 10] <- gsub("[+]", paste0("+[", constants, "]?"), x[nchar(x_backup_without_spp) > 10]) } x <- strip_whitespace(x) @@ -825,10 +832,9 @@ exec_as.mo <- function(x, set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history) } uncertainties <- rbind(uncertainties, - data.frame(uncertainty = 1, + data.frame(uncertainty_level = 1, input = x_backup_without_spp[i], - fullname = microorganismsDT[mo == "B_SLMNL_ENT", fullname][[1]], - mo = "B_SLMNL_ENT")) + result_mo = "B_SLMNL_ENT")) } next } @@ -1051,6 +1057,7 @@ exec_as.mo <- function(x, } else { x[i] <- microorganismsDT[col_id == found[1, col_id_new], ..property][[1]] } + options(mo_renamed_last_run = found[1, fullname]) was_renamed(name_old = found[1, fullname], name_new = microorganismsDT[col_id == found[1, col_id_new], fullname], ref_old = found[1, ref], @@ -1081,7 +1088,7 @@ exec_as.mo <- function(x, # (1) look again for old taxonomic names, now for G. species ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 1] (1) look again for old taxonomic names, now for G. species\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (1) look again for old taxonomic names, now for G. species\n") } if (isTRUE(debug)) { message("Running '", c.x_withspaces_start_end, "' and '", d.x_withspaces_start_only, "'") @@ -1102,11 +1109,11 @@ exec_as.mo <- function(x, ref_old = found[1, ref], ref_new = microorganismsDT[col_id == found[1, col_id_new], ref], mo = microorganismsDT[col_id == found[1, col_id_new], mo]) + options(mo_renamed_last_run = found[1, fullname]) uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = found[1, fullname], - mo = paste("CoL", found[1, col_id]))) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = microorganismsDT[col_id == found[1, col_id_new], mo])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(x, property), 1, force = force_mo_history) } @@ -1116,7 +1123,7 @@ exec_as.mo <- function(x, # (2) Try with misspelled input ---- # just rerun with dyslexia_mode = TRUE will used the extensive regex part above if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 1] (2) Try with misspelled input\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (2) Try with misspelled input\n") } if (isTRUE(debug)) { message("Running '", a.x_backup, "'") @@ -1131,10 +1138,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 1, force = force_mo_history) } @@ -1148,7 +1154,7 @@ exec_as.mo <- function(x, # (3) look for genus only, part of name ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (3) look for genus only, part of name\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (3) look for genus only, part of name\n") } if (nchar(g.x_backup_without_spp) > 4 & !b.x_trimmed %like% " ") { if (!grepl("^[A-Z][a-z]+", b.x_trimmed, ignore.case = FALSE)) { @@ -1160,10 +1166,9 @@ exec_as.mo <- function(x, if (length(found) > 0) { x[i] <- found[1L] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found[1L], fullname][[1]], - mo = found[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(x, property), 2, force = force_mo_history) } @@ -1174,7 +1179,7 @@ exec_as.mo <- function(x, # (4) strip values between brackets ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (4) strip values between brackets\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (4) strip values between brackets\n") } a.x_backup_stripped <- gsub("( *[(].*[)] *)", " ", a.x_backup) a.x_backup_stripped <- trimws(gsub(" +", " ", a.x_backup_stripped)) @@ -1191,10 +1196,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1203,7 +1207,7 @@ exec_as.mo <- function(x, # (5) inverse input ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (5) inverse input\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (5) inverse input\n") } a.x_backup_inversed <- paste(rev(unlist(strsplit(a.x_backup, split = " "))), collapse = " ") if (isTRUE(debug)) { @@ -1219,10 +1223,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1231,7 +1234,7 @@ exec_as.mo <- function(x, # (6) try to strip off half an element from end and check the remains ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (6) try to strip off half an element from end and check the remains\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (6) try to strip off half an element from end and check the remains\n") } x_strip <- a.x_backup %>% strsplit(" ") %>% unlist() if (length(x_strip) > 1) { @@ -1254,10 +1257,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1268,7 +1270,7 @@ exec_as.mo <- function(x, } # (7) try to strip off one element from end and check the remains ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (7) try to strip off one element from end and check the remains\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (7) try to strip off one element from end and check the remains\n") } if (length(x_strip) > 1) { for (i in 1:(length(x_strip) - 1)) { @@ -1287,10 +1289,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1301,17 +1302,16 @@ exec_as.mo <- function(x, } # (8) check for unknown yeasts/fungi ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (8) check for unknown yeasts/fungi\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (8) check for unknown yeasts/fungi\n") } if (b.x_trimmed %like% "yeast") { found <- "F_YEAST" found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1322,10 +1322,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1333,7 +1332,7 @@ exec_as.mo <- function(x, } # (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome) ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 2] (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome)\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome)\n") } x_strip <- a.x_backup %>% strsplit(" ") %>% unlist() if (length(x_strip) > 1 & nchar(g.x_backup_without_spp) >= 6) { @@ -1354,10 +1353,9 @@ exec_as.mo <- function(x, # uncertainty level 2 only if searched part contains a space (otherwise it will be found with lvl 3) if (x_strip_collapsed %like% " ") { uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1374,7 +1372,7 @@ exec_as.mo <- function(x, # (10) try to strip off one element from start and check the remains (any text size) ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 3] (10) try to strip off one element from start and check the remains (any text size)\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (10) try to strip off one element from start and check the remains (any text size)\n") } x_strip <- a.x_backup %>% strsplit(" ") %>% unlist() if (length(x_strip) > 1 & nchar(g.x_backup_without_spp) >= 6) { @@ -1393,10 +1391,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 3, force = force_mo_history) } @@ -1407,7 +1404,7 @@ exec_as.mo <- function(x, # (11) try to strip off one element from end and check the remains (any text size) ---- # (this is in fact 7 but without nchar limit of >=6) if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 3] (11) try to strip off one element from end and check the remains (any text size)\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (11) try to strip off one element from end and check the remains (any text size)\n") } if (length(x_strip) > 1) { for (i in 1:(length(x_strip) - 1)) { @@ -1425,10 +1422,9 @@ exec_as.mo <- function(x, found_result <- found found <- microorganismsDT[mo == found, ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 2, force = force_mo_history) } @@ -1439,7 +1435,7 @@ exec_as.mo <- function(x, # (12) part of a name (very unlikely match) ---- if (isTRUE(debug)) { - cat("\n[UNCERTAINLY LEVEL 3] (12) part of a name (very unlikely match)\n") + cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (12) part of a name (very unlikely match)\n") } if (isTRUE(debug)) { message("Running '", f.x_withspaces_end_only, "'") @@ -1450,10 +1446,9 @@ exec_as.mo <- function(x, if (!empty_result(found_result) & nchar(g.x_backup_without_spp) >= 6) { found <- microorganismsDT[mo == found_result[1L], ..property][[1]] uncertainties <<- rbind(uncertainties, - data.frame(uncertainty = now_checks_for_uncertainty_level, - input = a.x_backup, - fullname = microorganismsDT[mo == found_result[1L], fullname][[1]], - mo = found_result[1L])) + format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level, + input = a.x_backup, + result_mo = found_result[1L])) if (initial_search == TRUE) { set_mo_history(a.x_backup, get_mo_code(found[1L], property), 3, force = force_mo_history) } @@ -1654,6 +1649,29 @@ was_renamed <- function(name_old, name_new, ref_old = "", ref_new = "", mo = "") options(mo_renamed = total[order(names(total))]) } +format_uncertainty_as_df <- function(uncertainty_level, + input, + result_mo) { + if (!is.null(getOption("mo_renamed_last_run", default = NULL))) { + # was found as a renamed mo + df <- data.frame(uncertainty = uncertainty_level, + input = input, + fullname = getOption("mo_renamed_last_run"), + renamed_to = microorganismsDT[mo == result_mo, fullname][[1]], + mo = result_mo, + stringsAsFactors = FALSE) + options(mo_renamed_last_run = NULL) + } else { + df <- data.frame(uncertainty = uncertainty_level, + input = input, + fullname = microorganismsDT[mo == result_mo, fullname][[1]], + renamed_to = NA_character_, + mo = result_mo, + stringsAsFactors = FALSE) + } + df +} + #' @exportMethod print.mo #' @export #' @noRd @@ -1805,7 +1823,9 @@ print.mo_uncertainties <- function(x, ...) { } msg <- paste(msg, paste0(colour2(paste0(" [", x[i, "uncertainty"], "] ")), ' "', x[i, "input"], '" -> ', - colour1(paste0(italic(x[i, "fullname"]), " (", x[i, "mo"], ")"))), + colour1(paste0(italic(x[i, "fullname"]), + ifelse(!is.na(x[i, "renamed_to"]), paste(", renamed to", italic(x[i, "renamed_to"])), ""), + " (", x[i, "mo"], ")"))), sep = "\n") } cat(msg) diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 431adff3..e1617fb0 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -21,6 +21,8 @@ #' @importFrom rlang enquos as_label dots2vars <- function(...) { + # this function is to give more informative output about + # variable names in count_* and portion_* functions paste( unlist( lapply(enquos(...), @@ -109,20 +111,14 @@ rsi_calc <- function(..., x[, i] <- suppressWarnings(x %>% pull(i) %>% as.rsi()) # warning will be given later print_warning <- TRUE } - #x[, i] <- x %>% pull(i) } if (length(rsi_integrity_check) > 0) { # this will give a warning for invalid results, of all input columns (so only 1 warning) rsi_integrity_check <- as.rsi(rsi_integrity_check) } - # THE CHANCE THAT AT LEAST ONE RESULT IS ab_result - #numerator <- x %>% filter_all(any_vars(. %in% ab_result)) %>% nrow() if (only_all_tested == TRUE) { # THE NUMBER OF ISOLATES WHERE *ALL* ABx ARE S/I/R - # x_filtered <- x %>% filter_all(all_vars(!is.na(.))) - # numerator <- x_filtered %>% filter_all(any_vars(. %in% ab_result)) %>% nrow() - # denominator <- x_filtered %>% nrow() x <- apply(X = x %>% mutate_all(as.integer), MARGIN = 1, FUN = base::min) @@ -159,7 +155,7 @@ rsi_calc <- function(..., if (data_vars != "") { data_vars <- paste(" for", data_vars) } - warning("Introducing NA: only ", denominator, " results available", data_vars, " (minimum set to ", minimum, ").", call. = FALSE) + warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` was set to ", minimum, ").", call. = FALSE) fraction <- NA } else { fraction <- numerator / denominator diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 2c74e00c..2d2fe6c5 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -78,7 +78,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058 diff --git a/docs/articles/index.html b/docs/articles/index.html index a47c52ae..0ab00eda 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058 diff --git a/docs/authors.html b/docs/authors.html index dd7017a8..1b328999 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -78,7 +78,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058 diff --git a/docs/index.html b/docs/index.html index 11e54661..b3fd9b29 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058 diff --git a/docs/news/index.html b/docs/news/index.html index 601160b1..2cb5c0b6 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058 @@ -225,9 +225,9 @@ -
+

-AMR 0.7.1.9057 Unreleased +AMR 0.7.1.9058 Unreleased

@@ -1238,7 +1238,7 @@ Using as.mo(..., allow_uncertain = 3)

Contents

    -
  • 0.7.1.9057
    • +
  • 0.7.1.9058
  • 0.7.1
  • 0.7.0
  • 0.6.1
    • diff --git a/docs/reference/index.html b/docs/reference/index.html index 3fd0c745..e9032982 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.7.1.9057 + 0.7.1.9058