diff --git a/DESCRIPTION b/DESCRIPTION index 081d73633..30ceb5e15 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.7.1.9009 -Date: 2021-07-03 +Version: 1.7.1.9010 +Date: 2021-07-04 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 9ccd455a0..50e584a22 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,20 +20,24 @@ S3method("[",ab) S3method("[",disk) S3method("[",mic) S3method("[",mo) +S3method("[",taxonomic_name) S3method("[<-",ab) S3method("[<-",disk) S3method("[<-",mic) S3method("[<-",mo) S3method("[<-",rsi) +S3method("[<-",taxonomic_name) S3method("[[",ab) S3method("[[",disk) S3method("[[",mic) S3method("[[",mo) +S3method("[[",taxonomic_name) S3method("[[<-",ab) S3method("[[<-",disk) S3method("[[<-",mic) S3method("[[<-",mo) S3method("[[<-",rsi) +S3method("[[<-",taxonomic_name) S3method("^",mic) S3method("|",mic) S3method(abs,mic) @@ -47,6 +51,7 @@ S3method(any,ab_selector_any_all) S3method(any,mic) S3method(as.data.frame,ab) S3method(as.data.frame,mo) +S3method(as.data.frame,taxonomic_name) S3method(as.double,mic) S3method(as.integer,mic) S3method(as.list,custom_eucast_rules) @@ -72,6 +77,7 @@ S3method(c,disk) S3method(c,mic) S3method(c,mo) S3method(c,rsi) +S3method(c,taxonomic_name) S3method(ceiling,mic) S3method(cos,mic) S3method(cosh,mic) @@ -117,6 +123,7 @@ S3method(print,mo_renamed) S3method(print,mo_uncertainties) S3method(print,pca) S3method(print,rsi) +S3method(print,taxonomic_name) S3method(prod,mic) S3method(quantile,mic) S3method(range,mic) @@ -147,6 +154,7 @@ S3method(unique,disk) S3method(unique,mic) S3method(unique,mo) S3method(unique,rsi) +S3method(unique,taxonomic_name) export("%like%") export("%like_case%") export("%unlike%") diff --git a/NEWS.md b/NEWS.md index 622048ba5..d9dd7b7ee 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,12 @@ -# `AMR` 1.7.1.9009 -## Last updated: 3 July 2021 +# `AMR` 1.7.1.9010 +## Last updated: 4 July 2021 ### Changed * Antibiotic class selectors (see `ab_class()`) * They now finally also work in R-3.0 and R-3.1, supporting every version of R since 2013 * Added more selectors: `aminopenicillins()`, `lincosamides()`, `lipoglycopeptides()`, `polymyxins()`, `quinolones()`, `streptogramins()` and `ureidopenicillins()` * Fix for using selectors multiple times in one call (e.g., using them in `dplyr::filter()` and immediately after in `dplyr::select()`) -* Fixed duplicate ATC codes in the `antibiotics` data set +* Fix for duplicate ATC codes in the `antibiotics` data set * Added `ggplot2::autoplot()` generic for classes ``, ``, `` and `` * Fix to prevent introducing `NA`s for old MO codes when running `as.mo()` on them * Added more informative error messages when any of the `proportion_*()` and `count_*()` functions fail @@ -14,7 +14,8 @@ * Improved automatic column selector when `col_*` arguments are left blank, e.g. in `first_isolate()` * The right input types for `random_mic()`, `random_disk()` and `random_rsi()` are now enforced * `as.rsi()` can now correct for textual input (such as "Susceptible", "Resistant") in Dutch, English, French, German, Italian, Portuguese and Spanish -* More informative warnings for all `count_*()`, `proportion_*()` functions (and `resistant()` and `susceptible()`) when they return NA because of too few test results. The warnings now include the official drug name and if used, the `dplyr` group name. +* When warnings are throws because of too few isolates in any `count_*()`, `proportion_*()` function (or `resistant()` or `susceptible()`), the `dplyr` group will be shown, if available +* Taxonomic names now print in italic in tibbles, if created with `mo_name()`, `mo_fullname()`, `mo_shortname()`, `mo_genus()` or `mo_family()` # `AMR` 1.7.1 diff --git a/R/ab_class_selectors.R b/R/ab_class_selectors.R index 5cb264155..c9fdbb996 100644 --- a/R/ab_class_selectors.R +++ b/R/ab_class_selectors.R @@ -266,12 +266,13 @@ ab_selector <- function(function_name, meet_criteria(function_name, allow_class = "character", has_length = 1, allow_NULL = TRUE, .call_depth = 1) meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = 1) meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE, .call_depth = 1) - + # get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call + # but it only takes a couple of milliseconds vars_df <- get_current_data(arg_name = NA, call = -3) # to improve speed, get_column_abx() will only run once when e.g. in a select or group call ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE) - + if (length(ab_in_data) == 0) { message_("No antimicrobial agents found in the data.") return(NULL) @@ -312,7 +313,7 @@ ab_selector <- function(function_name, paste0("\"", ab_class, "\""), ""), ")` using ", - ifelse(length(agents) == 1, "column: ", "columns: "), + ifelse(length(agents) == 1, "column ", "columns "), vector_and(agents_formatted, quotes = FALSE, sort = FALSE)) } remember_thrown_message(paste0(function_name, ".", paste(pkg_env$get_column_abx.out, collapse = "|"))) diff --git a/R/mo_property.R b/R/mo_property.R index 02484cf90..d2e428faa 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -222,9 +222,12 @@ mo_shortname <- function(x, language = get_locale(), ...) { shortnames[is.na(x.mo)] <- NA_character_ load_mo_failures_uncertainties_renamed(metadata) - translate_AMR(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE) + out <- translate_AMR(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE) + set_clean_class(out, new_class = c("taxonomic_name", "character")) } + + #' @rdname mo_property #' @export mo_subspecies <- function(x, language = get_locale(), ...) { @@ -723,20 +726,24 @@ mo_validate <- function(x, property, language, ...) { if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & !has_Becker_or_Lancefield, error = function(e) FALSE)) { # special case for mo_* functions where class is already - return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]) - } - - # try to catch an error when inputting an invalid argument - # so the 'call.' can be set to FALSE - tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE], - error = function(e) stop(e$message, call. = FALSE)) + x <- MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE] - if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) { - x <- exec_as.mo(x, property = property, language = language, ...) + } else { + # try to catch an error when inputting an invalid argument + # so the 'call.' can be set to FALSE + tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE], + error = function(e) stop(e$message, call. = FALSE)) + + if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) { + x <- exec_as.mo(x, property = property, language = language, ...) + } } if (property == "mo") { return(set_clean_class(x, new_class = c("mo", "character"))) + } else if (property %in% c("fullname", "genus", "family")) { + # shortname is considered in mo_shortname() + return(set_clean_class(x, new_class = c("taxonomic_name", "character"))) } else if (property == "snomed") { return(as.double(eval(parse(text = x)))) } else { @@ -762,3 +769,87 @@ find_mo_col <- function(fn) { stop_("argument `x` is missing and no column with info about microorganisms could be found.", call = -2) } } + +#' @method print taxonomic_name +#' @export +#' @noRd +print.taxonomic_name <- function(x, ...) { + print(unclass(x), ...) +} + +#' @method as.data.frame taxonomic_name +#' @export +#' @noRd +as.data.frame.taxonomic_name <- function(x, ...) { + nm <- deparse1(substitute(x)) + if (!"nm" %in% names(list(...))) { + as.data.frame.vector(x, ..., nm = nm) + } else { + as.data.frame.vector(x, ...) + } +} + +# will be exported using s3_register() in R/zzz.R +type_sum.taxonomic_name <- function(x, ...) { + "chr" +} + +# will be exported using s3_register() in R/zzz.R +pillar_shaft.taxonomic_name <- function(x, ...) { + out <- format(x) + hits <- tolower(x) %in% MO_lookup$fullname_lower | tolower(gsub("[^a-zA-Z ]", "", x)) %in% c(MO_lookup$g_species) + # grey out the kingdom (part until first "_") + out[hits] <- font_italic(x[hits], collapse = NULL) + out[is.na(x)] <- font_na(out[is.na(x)], collapse = NULL) + create_pillar_column(out, align = "left") +} + +#' @method [ taxonomic_name +#' @export +#' @noRd +"[.taxonomic_name" <- function(x, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} +#' @method [[ taxonomic_name +#' @export +#' @noRd +"[[.taxonomic_name" <- function(x, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} +#' @method [<- taxonomic_name +#' @export +#' @noRd +"[<-.taxonomic_name" <- function(i, j, ..., value) { + value <- set_clean_class(value, c("taxonomic_name", "character")) + y <- NextMethod() + attributes(y) <- attributes(i) + y +} +#' @method [[<- taxonomic_name +#' @export +#' @noRd +"[[<-.taxonomic_name" <- function(i, j, ..., value) { + value <- set_clean_class(value, c("taxonomic_name", "character")) + y <- NextMethod() + attributes(y) <- attributes(i) + y +} +#' @method c taxonomic_name +#' @export +#' @noRd +c.taxonomic_name <- function(...) { + set_clean_class(unlist(lapply(list(...), as.character)), c("taxonomic_name", "character")) +} + +#' @method unique taxonomic_name +#' @export +#' @noRd +unique.taxonomic_name <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} diff --git a/R/rsi_calc.R b/R/rsi_calc.R index fdcddde83..8ee539df1 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -27,12 +27,7 @@ dots2vars <- function(...) { # this function is to give more informative output about # variable names in count_* and proportion_* functions dots <- substitute(list(...)) - agents <- as.character(dots)[2:length(dots)] - agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'") - agents_names <- ab_name(agents, tolower = TRUE, language = NULL) - need_name <- generalise_antibiotic_name(agents) != agents_names - agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")") - vector_and(agents_formatted, quotes = FALSE) + as.character(dots)[2:length(dots)] } rsi_calc <- function(..., diff --git a/R/zzz.R b/R/zzz.R index da6e8ce02..8ddfaa06e 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -48,11 +48,13 @@ if (utf8_supported && !is_latex) { s3_register("pillar::pillar_shaft", "rsi") s3_register("pillar::pillar_shaft", "mic") s3_register("pillar::pillar_shaft", "disk") + s3_register("pillar::pillar_shaft", "taxonomic_name") s3_register("tibble::type_sum", "ab") s3_register("tibble::type_sum", "mo") s3_register("tibble::type_sum", "rsi") s3_register("tibble::type_sum", "mic") s3_register("tibble::type_sum", "disk") + s3_register("tibble::type_sum", "taxonomic_name") # Support for frequency tables from the cleaner package s3_register("cleaner::freq", "mo") s3_register("cleaner::freq", "rsi") diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index 905a430a4..40476a134 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/rsi.md5 b/data-raw/rsi.md5 index ee35a9079..695e1d8bd 100644 --- a/data-raw/rsi.md5 +++ b/data-raw/rsi.md5 @@ -1 +1 @@ -1a7fe52f8185c9bb2c470712863d1887 +7c7f6a0ecfc2e122c4547c0ebed09346 diff --git a/data-raw/rsi_translation.dta b/data-raw/rsi_translation.dta index 4cc6fa64d..3221763e2 100644 Binary files a/data-raw/rsi_translation.dta and b/data-raw/rsi_translation.dta differ diff --git a/data-raw/rsi_translation.rds b/data-raw/rsi_translation.rds index 7c32865da..84fc44e8e 100644 Binary files a/data-raw/rsi_translation.rds and b/data-raw/rsi_translation.rds differ diff --git a/data-raw/rsi_translation.sas b/data-raw/rsi_translation.sas index 4df1e0812..4249c0024 100644 Binary files a/data-raw/rsi_translation.sas and b/data-raw/rsi_translation.sas differ diff --git a/data-raw/rsi_translation.sav b/data-raw/rsi_translation.sav index 7d7661d6c..7f9e7c4b4 100644 Binary files a/data-raw/rsi_translation.sav and b/data-raw/rsi_translation.sav differ diff --git a/docs/404.html b/docs/404.html index d716e6cb7..b5f0192a7 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 37e1ba18c..1f646d8f2 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 diff --git a/docs/articles/datasets.html b/docs/articles/datasets.html index 325f2bcc0..cab789ed3 100644 --- a/docs/articles/datasets.html +++ b/docs/articles/datasets.html @@ -39,7 +39,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 @@ -192,7 +192,7 @@

Data sets for download / own use

-

03 July 2021

+

04 July 2021

Source: vignettes/datasets.Rmd diff --git a/docs/articles/index.html b/docs/articles/index.html index 28b73740c..050fc1886 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010
diff --git a/docs/authors.html b/docs/authors.html index f1c520a36..b11f3d7ce 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 diff --git a/docs/index.html b/docs/index.html index c76c2b899..b7ecdd4f4 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 diff --git a/docs/news/index.html b/docs/news/index.html index 9e9392c3c..bb8f6830a 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010 @@ -236,12 +236,12 @@ Source: NEWS.md -
-

- Unreleased AMR 1.7.1.9009

-
+
+

+ Unreleased AMR 1.7.1.9010

+

-Last updated: 3 July 2021 +Last updated: 4 July 2021

@@ -255,7 +255,7 @@
  • Fix for using selectors multiple times in one call (e.g., using them in dplyr::filter() and immediately after in dplyr::select())
    • -
  • Fixed duplicate ATC codes in the antibiotics data set
    • +
  • Fix for duplicate ATC codes in the antibiotics data set
  • Added ggplot2::autoplot() generic for classes <mic>, <disk>, <rsi> and <resistance_predict>
  • Fix to prevent introducing NAs for old MO codes when running as.mo() on them
    • @@ -267,7 +267,9 @@
  • The right input types for random_mic(), random_disk() and random_rsi() are now enforced
  • as.rsi() can now correct for textual input (such as “Susceptible”, “Resistant”) in Dutch, English, French, German, Italian, Portuguese and Spanish
    • -
  • More informative warnings for all count_*(), proportion_*() functions (and resistant() and susceptible()) when they return NA because of too few test results. The warnings now include the official drug name and if used, the dplyr group name.
    • +
  • When warnings are throws because of too few isolates in any count_*(), proportion_*() function (or resistant() or susceptible()), the dplyr group will be shown, if available
    • +
  • Taxonomic names now print in italic in tibbles, if created with mo_name(), mo_fullname(), mo_shortname(), mo_genus() or mo_family() +

    • @@ -321,7 +323,7 @@
  • Function betalactams() as additional antbiotic column selector and function filter_betalactams() as additional antbiotic column filter. The group of betalactams consists of all carbapenems, cephalosporins and penicillins.
    • -
  • A ggplot() method for resistance_predict() +
  • A ggplot() method for resistance_predict()
    • @@ -422,7 +424,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:

    @@ -479,7 +481,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 2b95d16c1..10a6fda89 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-07-03T19:56Z +last_built: 2021-07-04T09:59Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/index.html b/docs/reference/index.html index 88d55c414..9a5d6a287 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010
    diff --git a/docs/survey.html b/docs/survey.html index 66aad4806..fee6bafd6 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9009 + 1.7.1.9010