diff --git a/DESCRIPTION b/DESCRIPTION index b316f4dd..82ed124a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.6.0.9021 -Date: 2021-05-12 +Version: 1.6.0.9022 +Date: 2021-05-13 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 51ece48d..7407e568 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# `AMR` 1.6.0.9021 -## Last updated: 12 May 2021 +# `AMR` 1.6.0.9022 +## Last updated: 13 May 2021 ### New * Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()` diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 34b6054a..1060823d 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -240,7 +240,13 @@ eucast_rules <- function(x, cat(font_subtle(" (no changes)\n")) } else { # opening - cat(font_grey(" (")) + if (n_added > 0 & n_changed == 0) { + cat(font_green(" (")) + } else if (n_added == 0 & n_changed > 0) { + cat(font_blue(" (")) + } else { + cat(font_grey(" (")) + } # additions if (n_added > 0) { if (n_added == 1) { @@ -262,7 +268,13 @@ eucast_rules <- function(x, } } # closing - cat(font_grey(")\n")) + if (n_added > 0 & n_changed == 0) { + cat(font_green(")\n")) + } else if (n_added == 0 & n_changed > 0) { + cat(font_blue(")\n")) + } else { + cat(font_grey(")\n")) + } } warned <<- FALSE } @@ -398,7 +410,7 @@ eucast_rules <- function(x, paste0(x, collapse = "") }) - # save original [table], with the new .rowid column + # save original table, with the new .rowid column x.bak <- x # keep only unique rows for MO and ABx x <- x %pm>% @@ -413,7 +425,7 @@ eucast_rules <- function(x, # join to microorganisms data set x <- left_join_microorganisms(x, by = col_mo, suffix = c("_oldcols", "")) x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL) - x$genus_species <- paste(x$genus, x$species) + x$genus_species <- trimws(paste(x$genus, x$species)) if (info == TRUE & NROW(x) > 10000) { message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE) } @@ -902,21 +914,23 @@ eucast_rules <- function(x, cat(paste0(font_grey(strrep("-", 0.95 * options()$width)), "\n")) if (verbose == FALSE & total_n_added + total_n_changed > 0) { - cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a [data.frame] with all specified edits instead."), "\n\n", sep = "") + cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a data.frame with all specified edits instead."), "\n\n", sep = "") } else if (verbose == TRUE) { - cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a [data.frame] with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "") + cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a data.frame with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "") } } if (length(warn_lacking_rsi_class) > 0) { warn_lacking_rsi_class <- unique(warn_lacking_rsi_class) + # take order from original data set + warn_lacking_rsi_class <- warn_lacking_rsi_class[order(colnames(x.bak))] + warn_lacking_rsi_class <- warn_lacking_rsi_class[!is.na(warn_lacking_rsi_class)] warning_("Not all columns with antimicrobial results are of class . Transform them on beforehand, with e.g.:\n", - " ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n", - " ", x_deparsed, " %>% mutate(across((is.rsi.eligible), as.rsi))\n", - " ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1, + " - ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1, warn_lacking_rsi_class, - paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])), - ")", + paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])), ")\n", + " - ", x_deparsed, " %>% mutate_if(is.rsi.eligible, as.rsi)\n", + " - ", x_deparsed, " %>% mutate(across(where(is.rsi.eligible), as.rsi))", call = FALSE) } @@ -936,7 +950,7 @@ eucast_rules <- function(x, } } -# helper function for editing the [table] ---- +# helper function for editing the table ---- edit_rsi <- function(x, to, rule, @@ -961,7 +975,7 @@ edit_rsi <- function(x, } txt_warning <- function() { if (warned == FALSE) { - if (info == TRUE) cat("", font_yellow_bg(font_black(" WARNING "))) + if (info == TRUE) cat(" ", font_rsi_I_bg(" WARNING "), sep = "") } warned <<- TRUE } @@ -975,20 +989,22 @@ edit_rsi <- function(x, # insert into original table new_edits[rows, cols] <- to, warning = function(w) { - if (w$message %like% "invalid [factor] level") { + if (w$message %like% "invalid factor level") { xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) { new_edits[, col] <<- factor(x = as.character(pm_pull(new_edits, col)), levels = unique(c(to, levels(pm_pull(new_edits, col))))) TRUE }) suppressWarnings(new_edits[rows, cols] <<- to) - warning_('Value "', to, '" added to the [factor] levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing [factor] level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE) + warning_("Value \"", to, "\" added to the factor levels of column", ifelse(length(cols) == 1, "", "s"), + " ", vector_and(cols, quotes = "`", sort = FALSE), + " because this value was not an existing factor level.", + call = FALSE) txt_warning() warned <- FALSE } else { warning_(w$message, call = FALSE) txt_warning() - cat("\n") # txt_warning() does not append a "\n" on itself } }, error = function(e) { diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index 23bec40f..21975d42 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -105,7 +105,7 @@ semi_join_microorganisms <- function(x, by = NULL, ...) { meet_criteria(x, allow_class = c("data.frame", "character")) meet_criteria(by, allow_class = "character", allow_NULL = TRUE) - join_microorganisms(type = "semi_join", x = x, by = by, suffix = suffix, ...) + join_microorganisms(type = "semi_join", x = x, by = by, ...) } #' @rdname join @@ -114,7 +114,7 @@ anti_join_microorganisms <- function(x, by = NULL, ...) { meet_criteria(x, allow_class = c("data.frame", "character")) meet_criteria(by, allow_class = "character", allow_NULL = TRUE) - join_microorganisms(type = "anti_join", x = x, by = by, suffix = suffix, ...) + join_microorganisms(type = "anti_join", x = x, by = by, ...) } join_microorganisms <- function(type, x, by, suffix, ...) { @@ -126,8 +126,12 @@ join_microorganisms <- function(type, x, by, suffix, ...) { } if (is.null(by)) { by <- search_type_in_df(x, "mo", info = FALSE) - stop_if(is.null(by), "cannot join - no column with microorganism names or codes found") - # message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions + if (is.null(by) && NCOL(x) == 1) { + by <- colnames(x)[1L] + } else { + stop_if(is.null(by), "no column with microorganism names or codes found, set this column with `by`", call = -2) + } + message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions } if (!all(x[, by, drop = TRUE] %in% MO_lookup$mo, na.rm = TRUE)) { x$join.mo <- as.mo(x[, by, drop = TRUE]) @@ -166,7 +170,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) { } if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) { - warning_("The newly joined tbl contains ", nrow(joined) - nrow(x), " rows more that its original.", call = FALSE) + warning_("The newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.", call = FALSE) } joined diff --git a/R/rsi.R b/R/rsi.R index 5560e64b..1cf473b7 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -135,7 +135,7 @@ #' if (require("dplyr")) { #' df %>% mutate_if(is.mic, as.rsi) #' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.rsi) -#' df %>% mutate(across((is.mic), as.rsi)) +#' df %>% mutate(across(where(is.mic), as.rsi)) #' df %>% mutate_at(vars(AMP:TOB), as.rsi) #' df %>% mutate(across(AMP:TOB, as.rsi)) #' @@ -181,7 +181,7 @@ #' #' # note: from dplyr 1.0.0 on, this will be: #' # example_isolates %>% -#' # mutate(across((is.rsi.eligible), as.rsi)) +#' # mutate(across(where(is.rsi.eligible), as.rsi)) #' } #' } as.rsi <- function(x, ...) { diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 5e0c81e3..30203020 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -150,7 +150,7 @@ rsi_calc <- function(..., if (message_not_thrown_before("rsi_calc")) { warning_("Increase speed by transforming to class on beforehand:\n", " your_data %>% mutate_if(is.rsi.eligible, as.rsi)\n", - " your_data %>% mutate(across((is.rsi.eligible), as.rsi))", + " your_data %>% mutate(across(where(is.rsi.eligible), as.rsi))", call = FALSE) remember_thrown_message("rsi_calc") } diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index 21c51bf0..493341ea 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/docs/404.html b/docs/404.html index c5eeea2c..3ff24366 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 76277778..24dbfdc7 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 diff --git a/docs/articles/index.html b/docs/articles/index.html index 54017f1c..6c6aba65 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 diff --git a/docs/authors.html b/docs/authors.html index 1163c614..7afcb0de 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 diff --git a/docs/index.html b/docs/index.html index 8109baf5..97af1c2f 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 diff --git a/docs/news/index.html b/docs/news/index.html index cc5eda2d..c1be87cf 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022 @@ -236,12 +236,12 @@ Source: NEWS.md -
-

- Unreleased AMR 1.6.0.9021

-
+
+

+ Unreleased AMR 1.6.0.9022

+

-Last updated: 12 May 2021 +Last updated: 13 May 2021

@@ -346,7 +346,7 @@ #> Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"

  • Support for custom MDRO guidelines, using the new custom_mdro_guideline() function, please see mdro() for additional info

    • -

  • ggplot() generics for classes <mic> and <disk>

    • +

  • ggplot() generics for classes <mic> and <disk>

  • Function mo_is_yeast(), which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:

    @@ -403,7 +403,7 @@
 
  • Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent
    • 
 
  • All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)
    • 
 
  • Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see translate)
    • 
-
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
    • 
+
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
    •
  • Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the microorganisms data set
    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index dc09372c..36ac5e84 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -12,7 +12,7 @@ articles: datasets: datasets.html resistance_predict: resistance_predict.html welcome_to_AMR: welcome_to_AMR.html -last_built: 2021-05-12T16:13Z +last_built: 2021-05-13T13:55Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index 53d8f1f7..6da02b6e 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022
    @@ -453,7 +453,7 @@ The lifecycle of this function is stableif (require("dplyr")) { df %>% mutate_if(is.mic, as.rsi) df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.rsi) - df %>% mutate(across((is.mic), as.rsi)) + df %>% mutate(across(where(is.mic), as.rsi)) df %>% mutate_at(vars(AMP:TOB), as.rsi) df %>% mutate(across(AMP:TOB, as.rsi)) @@ -498,7 +498,7 @@ The lifecycle of this function is stable# note: from dplyr 1.0.0 on, this will be: # example_isolates %>% - # mutate(across((is.rsi.eligible), as.rsi)) + # mutate(across(where(is.rsi.eligible), as.rsi)) } # } diff --git a/docs/reference/index.html b/docs/reference/index.html index 0b86bfe7..292064ef 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022
    diff --git a/docs/survey.html b/docs/survey.html index 0a88a3ee..f15ab302 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9021 + 1.6.0.9022
    diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index f1eedd34..53e270e8 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -195,7 +195,7 @@ as.rsi(x = as.disk(18), if (require("dplyr")) { df \%>\% mutate_if(is.mic, as.rsi) df \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.rsi) - df \%>\% mutate(across((is.mic), as.rsi)) + df \%>\% mutate(across(where(is.mic), as.rsi)) df \%>\% mutate_at(vars(AMP:TOB), as.rsi) df \%>\% mutate(across(AMP:TOB, as.rsi)) @@ -240,7 +240,7 @@ if (require("dplyr")) { # note: from dplyr 1.0.0 on, this will be: # example_isolates \%>\% - # mutate(across((is.rsi.eligible), as.rsi)) + # mutate(across(where(is.rsi.eligible), as.rsi)) } } } diff --git a/tests/testthat/test-eucast_rules.R b/tests/testthat/test-eucast_rules.R index d798cf08..d9aaaf4d 100755 --- a/tests/testthat/test-eucast_rules.R +++ b/tests/testthat/test-eucast_rules.R @@ -77,17 +77,18 @@ test_that("EUCAST rules work", { expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) # piperacillin must be R in Enterobacteriaceae when tica is R - library(dplyr, warn.conflicts = FALSE) - expect_equal(suppressWarnings( - example_isolates %>% - filter(mo_family(mo) == "Enterobacteriaceae") %>% - mutate(TIC = as.rsi("R"), - PIP = as.rsi("S")) %>% - eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>% - pull(PIP) %>% - unique() %>% - as.character()), - "R") + if (require("dplyr")) { + expect_equal(suppressWarnings( + example_isolates %>% + filter(mo_family(mo) == "Enterobacteriaceae") %>% + mutate(TIC = as.rsi("R"), + PIP = as.rsi("S")) %>% + eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>% + pull(PIP) %>% + unique() %>% + as.character()), + "R") + } # Azithromycin and Clarythromycin must be equal to Erythromycin a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo, @@ -114,7 +115,9 @@ test_that("EUCAST rules work", { "S") # also test norf - expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) + if (require("dplyr")) { + expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) + } # check verbose output expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))