diff --git a/DESCRIPTION b/DESCRIPTION index 58fe84c04..83141de83 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.3.0.9006 -Date: 2020-08-21 +Version: 1.3.0.9007 +Date: 2020-08-26 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index d189314fa..d66e8ebb3 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,10 @@ S3method(format,bug_drug_combinations) S3method(kurtosis,data.frame) S3method(kurtosis,default) S3method(kurtosis,matrix) +S3method(pillar_shaft,disk) +S3method(pillar_shaft,mic) +S3method(pillar_shaft,mo) +S3method(pillar_shaft,rsi) S3method(plot,mic) S3method(plot,resistance_predict) S3method(plot,rsi) @@ -58,6 +62,10 @@ S3method(skewness,matrix) S3method(summary,mic) S3method(summary,mo) S3method(summary,rsi) +S3method(type_sum,disk) +S3method(type_sum,mic) +S3method(type_sum,mo) +S3method(type_sum,rsi) export("%like%") export("%like_case%") export(ab_atc) diff --git a/NEWS.md b/NEWS.md index c415c0ef8..41a517919 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.3.0.9006 -## Last updated: 21 August 2020 +# AMR 1.3.0.9007 +## Last updated: 26 August 2020 ### New * Data set `intrinsic_resistant`. This data set contains all bug-drug combinations where the 'bug' is intrinsic resistant to the 'drug' according to the latest EUCAST insights. It contains just two columns: `microorganism` and `antibiotic`. @@ -34,7 +34,11 @@ #> Class #> [1] 24 24 ``` +* Speed improvement for `eucast_rules()` * Overall speed improvement by tweaking joining functions +* Function `mo_shortname()` now return the genus for input where the species is unknown +* BORSA is now recognised as an abbreviation for a *Staphylococcus aureus*, meaning that e.g. `mo_genus("BORSA")` will return "Staphylococcus" +* Support for coloured `tibble` printing of classes `mo`, `rsi`, `mic` and `disk` # AMR 1.3.0 diff --git a/R/disk.R b/R/disk.R index 004f0f901..fadbabcea 100644 --- a/R/disk.R +++ b/R/disk.R @@ -114,6 +114,22 @@ is.disk <- function(x) { inherits(x, "disk") } +#' @method pillar_shaft disk +#' @export +pillar_shaft.disk <- function(x, ...) { + style_na <- import_fn("style_na", "pillar", error_on_fail = FALSE) + new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE) + out <- trimws(format(x)) + out[is.na(x)] <- style_na(NA) + new_pillar_shaft_simple(out, align = "right", min_width = 3) +} + +#' @method type_sum disk +#' @export +type_sum.disk <- function(x, ...) { + "disk" +} + #' @method print disk #' @export #' @noRd diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 08adceef7..acda0d52d 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -350,6 +350,9 @@ eucast_rules <- function(x, verbose = verbose, ...) + # data preparation ---- + message(font_blue("NOTE: Preparing data..."), appendLF = FALSE) + AMC <- cols_ab["AMC"] AMK <- cols_ab["AMK"] AMP <- cols_ab["AMP"] @@ -429,7 +432,7 @@ eucast_rules <- function(x, rule_name = character(0), stringsAsFactors = FALSE) - # helper function for editing the table + # helper function for editing the table ---- edit_rsi <- function(to, rule, rows, cols) { cols <- unique(cols[!is.na(cols) & !is.null(cols)]) if (length(rows) > 0 & length(cols) > 0) { @@ -508,10 +511,21 @@ eucast_rules <- function(x, changed = 0)) } - # save original table + + old_cols <- colnames(x) + old_attributes <- attributes(x) + x <- as.data.frame(x, stringsAsFactors = FALSE) # no tibbles, data.tables, etc. + # create unique row IDs - combination of the MO and all ABx columns (so they will only run once per unique combination) + x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]))), function(x) { + x[is.na(x)] <- "." + paste0(x, collapse = "") + }) + + # save original table, with the new .rowid column + x_original.bak <- x + # keep only unique rows for MO and ABx + x <- x %>% distinct(`.rowid`, .keep_all = TRUE) x_original <- x - x_original_attr <- attributes(x) - x_original <- as.data.frame(x_original, stringsAsFactors = FALSE) # no tibbles, data.tables, etc. # join to microorganisms data set x <- as.data.frame(x, stringsAsFactors = FALSE) @@ -520,6 +534,7 @@ eucast_rules <- function(x, left_join_microorganisms(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) + message(font_blue("OK.")) if (ab_missing(AMP) & !ab_missing(AMX)) { # ampicillin column is missing, but amoxicillin is available @@ -528,7 +543,7 @@ eucast_rules <- function(x, } # nolint start - # antibiotic classes + # antibiotic classes ---- aminoglycosides <- c(TOB, GEN, KAN, NEO, NET, SIS) tetracyclines <- c(DOX, MNO, TCY) # since EUCAST v3.1 tigecycline (TGC) is set apart polymyxins <- c(PLB, COL) @@ -544,7 +559,7 @@ eucast_rules <- function(x, fluoroquinolones <- c(OFX, CIP, NOR, LVX, MFX) # nolint end - # Help function to get available antibiotic column names ------------------ + # help function to get available antibiotic column names ------------------ get_antibiotic_columns <- function(x, df) { x <- trimws(unlist(strsplit(x, ",", fixed = TRUE))) y <- character(0) @@ -923,7 +938,12 @@ eucast_rules <- function(x, verbose_info } else { # reset original attributes - attributes(x_original) <- x_original_attr - x_original + x_original <- x_original[, c(col_mo, cols_ab, ".rowid"), drop = FALSE] + x_original.bak <- x_original.bak[, setdiff(colnames(x_original.bak), c(col_mo, cols_ab)), drop = FALSE] + x_original.bak <- x_original.bak %>% + left_join(x_original, by = ".rowid") + x_original.bak <- x_original.bak[, old_cols, drop = FALSE] + attributes(x_original.bak) <- old_attributes + x_original.bak } } diff --git a/R/mic.R b/R/mic.R index 1243e89c9..daa796354 100755 --- a/R/mic.R +++ b/R/mic.R @@ -171,6 +171,22 @@ droplevels.mic <- function(x, exclude = ifelse(anyNA(levels(x)), NULL, NA), ...) x } +#' @method pillar_shaft mic +#' @export +pillar_shaft.mic <- function(x, ...) { + style_na <- import_fn("style_na", "pillar", error_on_fail = FALSE) + new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE) + out <- trimws(format(x)) + out[is.na(x)] <- style_na(NA) + new_pillar_shaft_simple(out, align = "right", min_width = 4) +} + +#' @method type_sum mic +#' @export +type_sum.mic <- function(x, ...) { + "mic" +} + #' @method print mic #' @export #' @noRd diff --git a/R/mo.R b/R/mo.R index e8e373610..0a0486548 100755 --- a/R/mo.R +++ b/R/mo.R @@ -159,7 +159,8 @@ #' select(microorganism_name) %>% #' as.mo() #' -#' # and can even contain 2 columns, which is convenient for genus/species combinations: +#' # and can even contain 2 columns, which is convenient +#' # for genus/species combinations: #' df$mo <- df %>% #' select(genus, species) %>% #' as.mo() @@ -459,13 +460,15 @@ exec_as.mo <- function(x, x <- gsub("(th|ht|t)+", "(th|ht|t)+", x) x <- gsub("a+", "a+", x) x <- gsub("u+", "u+", x) - # allow any ending of -um, -us, -ium, -icum, -ius, -icus, -ica and -a (needs perl for the negative backward lookup): + # allow any ending of -um, -us, -ium, -icum, -ius, -icus, -ica, -ia and -a (needs perl for the negative backward lookup): x <- gsub("(u\\+\\(c\\|k\\|q\\|qu\\+\\|s\\|z\\|x\\|ks\\)\\+)(?![a-z])", "(u[s|m]|[iy][ck]?u[ms]|[iy]?[ck]?a)", x, perl = TRUE) x <- gsub("(\\[iy\\]\\+\\(c\\|k\\|q\\|qu\\+\\|s\\|z\\|x\\|ks\\)\\+a\\+)(?![a-z])", "(u[s|m]|[iy][ck]?u[ms]|[iy]?[ck]?a)", x, perl = TRUE) x <- gsub("(\\[iy\\]\\+u\\+m)(?![a-z])", "(u[s|m]|[iy][ck]?u[ms]|[iy]?[ck]?a)", x, perl = TRUE) + x <- gsub("(\\[iy\\]\\+a\\+)(?![a-z])", + "([iy]*a+|[iy]+a*)", x, perl = TRUE) x <- gsub("e+", "e+", x) x <- gsub("o+", "o+", x) x <- gsub("(.)\\1+", "\\1+", x) @@ -636,7 +639,7 @@ exec_as.mo <- function(x, } # translate known trivial abbreviations to genus + species ---- - if (toupper(x_backup_without_spp[i]) %in% c("MRSA", "MSSA", "VISA", "VRSA") + if (toupper(x_backup_without_spp[i]) %in% c("MRSA", "MSSA", "VISA", "VRSA", "BORSA") | x_backup_without_spp[i] %like_case% " (mrsa|mssa|visa|vrsa) ") { x[i] <- lookup(fullname == "Staphylococcus aureus") next @@ -1523,12 +1526,50 @@ format_uncertainty_as_df <- function(uncertainty_level, df } +#' @method pillar_shaft mo +#' @export +pillar_shaft.mo <- function(x, ...) { + # import from the pillar package, without being dependent on it! + style_na <- import_fn("style_na", "pillar", error_on_fail = FALSE) + style_subtle <- import_fn("style_subtle", "pillar", error_on_fail = FALSE) + new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE) + if (is.null(style_na) | is.null(style_subtle) | is.null(new_pillar_shaft_simple)) { + return(x) + } + + out <- format(x) + # grey out the kingdom (part until first "_") + out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(style_subtle("\\1"), "\\2"), out[!is.na(x)]) + # and grey out every _ + out[!is.na(x)] <- gsub("_", style_subtle("_"), out[!is.na(x)]) + + # markup NA and UNKNOWN + out[is.na(x)] <- style_na(" NA") + out[x == "UNKNOWN"] <- style_na(" UNKNOWN") + + # make it always fit exactly + new_pillar_shaft_simple(out, + align = "left", + width = max(nchar(x)) + ifelse(length(x[x %in% c(NA, "UNKNOWN")]) > 0, + 2, + 0)) +} + +#' @method type_sum mo +#' @export +type_sum.mo <- function(x, ...) { + "mo" +} + #' @method print mo #' @export #' @noRd -print.mo <- function(x, ...) { +print.mo <- function(x, print.shortnames = FALSE, ...) { cat("Class \n") x_names <- names(x) + if (is.null(x_names) & print.shortnames == TRUE) { + x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL) + } x <- as.character(x) names(x) <- x_names print.default(x, quote = FALSE) diff --git a/R/mo_property.R b/R/mo_property.R index 5b079e595..bae87e835 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -161,13 +161,18 @@ mo_shortname <- function(x, language = get_locale(), ...) { } # get first char of genus and complete species in English - shortnames <- paste0(substr(mo_genus(x.mo, language = NULL), 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL))) + genera <- mo_genus(x.mo, language = NULL) + shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL))) + # exceptions for where no species is known + shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"] # exceptions for Staphylococci shortnames[shortnames == "S. coagulase-negative"] <- "CoNS" shortnames[shortnames == "S. coagulase-positive"] <- "CoPS" # exceptions for Streptococci: Streptococcus Group A -> GAS shortnames[shortnames %like% "S. group [ABCDFGHK]"] <- paste0("G", gsub("S. group ([ABCDFGHK])", "\\1", shortnames[shortnames %like% "S. group [ABCDFGHK]"]), "S") + # unknown species etc. + shortnames[shortnames %like% "unknown"] <- paste0("(", trimws(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"])), ")") load_mo_failures_uncertainties_renamed(metadata) translate_AMR(shortnames, language = language, only_unknown = FALSE) diff --git a/R/rsi.R b/R/rsi.R index f8bf46f76..5af30b38f 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -670,6 +670,24 @@ exec_as.rsi <- function(method, class = c("rsi", "ordered", "factor")) } +#' @method pillar_shaft rsi +#' @export +pillar_shaft.rsi <- function(x, ...) { + out <- trimws(format(x)) + out[is.na(x)] <- font_grey(" NA") + out[x == "S"] <- font_green_bg(font_white(" S ")) + out[x == "I"] <- font_yellow_bg(font_black(" I ")) + out[x == "R"] <- font_red_bg(font_white(" R ")) + new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE) + new_pillar_shaft_simple(out, align = "left", width = 3) +} + +#' @method type_sum rsi +#' @export +type_sum.rsi <- function(x, ...) { + "rsi" +} + #' @method print rsi #' @export #' @noRd diff --git a/R/zzz.R b/R/zzz.R index 053213b1b..574f5bb44 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -27,7 +27,19 @@ assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR")) + + # support for tibble headers (type_sum) and tibble columns content (pillar_shaft) + s3_register("pillar::pillar_shaft", "mo") + s3_register("tibble::type_sum", "mo") + s3_register("pillar::pillar_shaft", "rsi") + s3_register("tibble::type_sum", "rsi") + s3_register("pillar::pillar_shaft", "mic") + s3_register("tibble::type_sum", "mic") + s3_register("pillar::pillar_shaft", "disk") + s3_register("tibble::type_sum", "disk") } +pillar_shaft <- import_fn("pillar_shaft", "pillar", error_on_fail = FALSE) +type_sum <- import_fn("type_sum", "tibble", error_on_fail = FALSE) .onAttach <- function(...) { if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(Sys.getenv("AMR_silentstart", FALSE)))) { @@ -73,3 +85,46 @@ create_MO.old_lookup <- function() { # so arrange data on prevalence first, then full name MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), ] } + +# copied from vctrs::s3_register +s3_register <- function (generic, class, method = NULL) { + stopifnot(is.character(generic), length(generic) == 1) + stopifnot(is.character(class), length(class) == 1) + pieces <- strsplit(generic, "::")[[1]] + stopifnot(length(pieces) == 2) + package <- pieces[[1]] + generic <- pieces[[2]] + caller <- parent.frame() + get_method_env <- function() { + top <- topenv(caller) + if (isNamespace(top)) { + asNamespace(environmentName(top)) + } + else { + caller + } + } + get_method <- function(method, env) { + if (is.null(method)) { + get(paste0(generic, ".", class), envir = get_method_env()) + } + else { + method + } + } + method_fn <- get_method(method) + stopifnot(is.function(method_fn)) + setHook(packageEvent(package, "onLoad"), function(...) { + ns <- asNamespace(package) + method_fn <- get_method(method) + registerS3method(generic, class, method_fn, envir = ns) + }) + if (!isNamespaceLoaded(package)) { + return(invisible()) + } + envir <- asNamespace(package) + if (exists(generic, envir)) { + registerS3method(generic, class, method_fn, envir = envir) + } + invisible() +} diff --git a/data-raw/antibiotics.dta b/data-raw/antibiotics.dta index 21cd1dc29..18d7005ab 100644 Binary files a/data-raw/antibiotics.dta and b/data-raw/antibiotics.dta differ diff --git a/data-raw/antibiotics.sas b/data-raw/antibiotics.sas index 87263432b..9950b6efc 100644 Binary files a/data-raw/antibiotics.sas and b/data-raw/antibiotics.sas differ diff --git a/data-raw/antibiotics.sav b/data-raw/antibiotics.sav index 271bcf19f..c6f4a0996 100644 Binary files a/data-raw/antibiotics.sav and b/data-raw/antibiotics.sav differ diff --git a/data-raw/antibiotics.xlsx b/data-raw/antibiotics.xlsx index 24c9b77fb..d7a6a8da9 100644 Binary files a/data-raw/antibiotics.xlsx and b/data-raw/antibiotics.xlsx differ diff --git a/data-raw/antivirals.dta b/data-raw/antivirals.dta index 4059b94c3..809ba3cfd 100644 Binary files a/data-raw/antivirals.dta and b/data-raw/antivirals.dta differ diff --git a/data-raw/antivirals.sas b/data-raw/antivirals.sas index a55afcc66..d12212310 100644 Binary files a/data-raw/antivirals.sas and b/data-raw/antivirals.sas differ diff --git a/data-raw/antivirals.sav b/data-raw/antivirals.sav index 1510b1871..4ba9e8852 100644 Binary files a/data-raw/antivirals.sav and b/data-raw/antivirals.sav differ diff --git a/data-raw/antivirals.xlsx b/data-raw/antivirals.xlsx index 7e8f1f1b7..9a47392cf 100644 Binary files a/data-raw/antivirals.xlsx and b/data-raw/antivirals.xlsx differ diff --git a/data-raw/intrinsic_resistant.dta b/data-raw/intrinsic_resistant.dta index 483606940..6be0a3960 100644 Binary files a/data-raw/intrinsic_resistant.dta and b/data-raw/intrinsic_resistant.dta differ diff --git a/data-raw/intrinsic_resistant.sas b/data-raw/intrinsic_resistant.sas index f6ea015c5..f3a19afde 100644 Binary files a/data-raw/intrinsic_resistant.sas and b/data-raw/intrinsic_resistant.sas differ diff --git a/data-raw/intrinsic_resistant.sav b/data-raw/intrinsic_resistant.sav index 4275e95c5..c9baa1072 100644 Binary files a/data-raw/intrinsic_resistant.sav and b/data-raw/intrinsic_resistant.sav differ diff --git a/data-raw/intrinsic_resistant.xlsx b/data-raw/intrinsic_resistant.xlsx index 65d688d6d..88a869f59 100644 Binary files a/data-raw/intrinsic_resistant.xlsx and b/data-raw/intrinsic_resistant.xlsx differ diff --git a/data-raw/microorganisms.dta b/data-raw/microorganisms.dta index eaa24d29a..478b99179 100644 Binary files a/data-raw/microorganisms.dta and b/data-raw/microorganisms.dta differ diff --git a/data-raw/microorganisms.old.dta b/data-raw/microorganisms.old.dta index cbb221ec5..eeec94b21 100644 Binary files a/data-raw/microorganisms.old.dta and b/data-raw/microorganisms.old.dta differ diff --git a/data-raw/microorganisms.old.sas b/data-raw/microorganisms.old.sas index b85a96518..0d6080ed6 100644 Binary files a/data-raw/microorganisms.old.sas and b/data-raw/microorganisms.old.sas differ diff --git a/data-raw/microorganisms.old.sav b/data-raw/microorganisms.old.sav index ccaf0cc62..7569d9ca7 100644 Binary files a/data-raw/microorganisms.old.sav and b/data-raw/microorganisms.old.sav differ diff --git a/data-raw/microorganisms.old.xlsx b/data-raw/microorganisms.old.xlsx index 9f3949008..47b09d06b 100644 Binary files a/data-raw/microorganisms.old.xlsx and b/data-raw/microorganisms.old.xlsx differ diff --git a/data-raw/microorganisms.sas b/data-raw/microorganisms.sas index bb1ca52ac..ae64b298c 100644 Binary files a/data-raw/microorganisms.sas and b/data-raw/microorganisms.sas differ diff --git a/data-raw/microorganisms.sav b/data-raw/microorganisms.sav index 20c36ca4f..089a5a750 100644 Binary files a/data-raw/microorganisms.sav and b/data-raw/microorganisms.sav differ diff --git a/data-raw/microorganisms.xlsx b/data-raw/microorganisms.xlsx index 0fa17005c..f6a3f80c5 100644 Binary files a/data-raw/microorganisms.xlsx and b/data-raw/microorganisms.xlsx differ diff --git a/data-raw/rsi_translation.dta b/data-raw/rsi_translation.dta index 4d3e132aa..91b9b34f3 100644 Binary files a/data-raw/rsi_translation.dta and b/data-raw/rsi_translation.dta differ diff --git a/data-raw/rsi_translation.sas b/data-raw/rsi_translation.sas index a38102ab9..c707b95a9 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 d648d14ee..2cea4cf83 100644 Binary files a/data-raw/rsi_translation.sav and b/data-raw/rsi_translation.sav differ diff --git a/data-raw/rsi_translation.xlsx b/data-raw/rsi_translation.xlsx index c32fa7cdb..12573e17c 100644 Binary files a/data-raw/rsi_translation.xlsx and b/data-raw/rsi_translation.xlsx differ diff --git a/data/microorganisms.codes.rda b/data/microorganisms.codes.rda index 04f3fe5a8..5fecdf03a 100644 Binary files a/data/microorganisms.codes.rda and b/data/microorganisms.codes.rda differ diff --git a/docs/404.html b/docs/404.html index 28f4cb776..ad154d90f 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index c589dfccd..37c046d98 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/articles/datasets.html b/docs/articles/datasets.html index 6535e2e92..547c91f3c 100644 --- a/docs/articles/datasets.html +++ b/docs/articles/datasets.html @@ -39,7 +39,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/articles/index.html b/docs/articles/index.html index 3acfe2d11..7879e8c50 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/authors.html b/docs/authors.html index b27109563..c05ee22ee 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/index.html b/docs/index.html index b6cf25f14..05ddf3403 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/news/index.html b/docs/news/index.html index 40765d3e4..a8db57fed 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.3.0.9006 Unreleased +
+

+AMR 1.3.0.9007 Unreleased

-
+

-Last updated: 21 August 2020 +Last updated: 26 August 2020

@@ -293,7 +293,11 @@ #> [1] 24 24

+
  • Speed improvement for eucast_rules()

  • Overall speed improvement by tweaking joining functions

  • +
  • Function mo_shortname() now return the genus for input where the species is unknown

  • +
  • BORSA is now recognised as an abbreviation for a Staphylococcus aureus, meaning that e.g. mo_genus("BORSA") will return “Staphylococcus”

  • +
  • Support for coloured tibble printing of classes mo, rsi, mic and disk

  • @@ -394,7 +398,7 @@

    Making this package independent of especially the tidyverse (e.g. packages dplyr and tidyr) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Good for users, but hard for package maintainers. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. Another upside it that this package can now be used with all versions of R since R-3.0.0 (April 2013). Our package is being used in settings where the resources are very limited. Fewer dependencies on newer software is helpful for such settings.

    Negative effects of this change are:

      -
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
    • +
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
    • Printing values of class mo or rsi in a tibble will no longer be in colour and printing rsi in a tibble will show the class <ord>, not <rsi> anymore. This is purely a visual effect.
    • All functions from the mo_* family (like mo_name() and mo_gramstain()) are noticeably slower when running on hundreds of thousands of rows.
    • For developers: classes mo and ab now both also inherit class character, to support any data transformation. This change invalidates code that checks for class length == 1.
    • @@ -731,7 +735,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

    This is important, because a value like "testvalue" could never be understood by e.g. mo_name(), although the class would suggest a valid microbial code.

    -
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • +
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • Renamed data set septic_patients to example_isolates

  • @@ -1000,7 +1004,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • The age() function gained a new parameter exact to determine ages with decimals
  • Removed deprecated functions guess_mo(), guess_atc(), EUCAST_rules(), interpretive_reading(), rsi()
  • -
  • Frequency tables (freq()): +
  • Frequency tables (freq()):
    • speed improvement for microbial IDs

    • fixed factor level names for R Markdown

    • @@ -1009,12 +1013,12 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

      support for boxplots:

       septic_patients %>% 
      -  freq(age) %>% 
      +  freq(age) %>% 
         boxplot()
       # grouped boxplots:
       septic_patients %>% 
         group_by(hospital_id) %>% 
      -  freq(age) %>%
      +  freq(age) %>%
         boxplot()
       
      @@ -1025,7 +1029,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • Added ceftazidim intrinsic resistance to Streptococci
    • Changed default settings for age_groups(), to let groups of fives and tens end with 100+ instead of 120+
    • -
    • Fix for freq() for when all values are NA +
    • Fix for freq() for when all values are NA
    • Fix for first_isolate() for when dates are missing
    • Improved speed of guess_ab_col() @@ -1266,7 +1270,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • -
  • Frequency tables (freq() function): +
  • Frequency tables (freq() function):
    • Support for tidyverse quasiquotation! Now you can create frequency tables of function outcomes:

      @@ -1275,15 +1279,15 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ # OLD WAY septic_patients %>% mutate(genus = mo_genus(mo)) %>% - freq(genus) + freq(genus) # NEW WAY septic_patients %>% - freq(mo_genus(mo)) + freq(mo_genus(mo)) # Even supports grouping variables: septic_patients %>% group_by(gender) %>% - freq(mo_genus(mo)) + freq(mo_genus(mo))
    • Header info is now available as a list, with the header function

    • @@ -1367,21 +1371,21 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • Using portion_* functions now throws a warning when total available isolate is below parameter minimum

    • Functions as.mo, as.rsi, as.mic, as.atc and freq will not set package name as attribute anymore

    • -

      Frequency tables - freq():

      +

      Frequency tables - freq():

      • Support for grouping variables, test with:

         septic_patients %>% 
           group_by(hospital_id) %>% 
        -  freq(gender)
        +  freq(gender)
         
      • Support for (un)selecting columns:

         septic_patients %>% 
        -  freq(hospital_id) %>% 
        +  freq(hospital_id) %>% 
           select(-count, -cum_count) # only get item, percent, cum_percent
         
      • @@ -1400,7 +1404,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
      • Removed diacritics from all authors (columns microorganisms$ref and microorganisms.old$ref) to comply with CRAN policy to only allow ASCII characters

      • Fix for mo_property not working properly

      • Fix for eucast_rules where some Streptococci would become ceftazidime R in EUCAST rule 4.5

      • -
      • Support for named vectors of class mo, useful for top_freq()

      • +
      • Support for named vectors of class mo, useful for top_freq()

      • ggplot_rsi and scale_y_percent have breaks parameter

      • AI improvements for as.mo:

        @@ -1567,13 +1571,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

        Support for types (classes) list and matrix for freq

         my_matrix = with(septic_patients, matrix(c(age, gender), ncol = 2))
        -freq(my_matrix)
        +freq(my_matrix)
         

        For lists, subsetting is possible:

         my_list = list(age = septic_patients$age, gender = septic_patients$gender)
        -my_list %>% freq(age)
        -my_list %>% freq(gender)
        +my_list %>% freq(age)
        +my_list %>% freq(gender)
         
      @@ -1648,13 +1652,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
      • A vignette to explain its usage
      • Support for rsi (antimicrobial resistance) to use as input
      • -
      • Support for table to use as input: freq(table(x, y)) +
      • Support for table to use as input: freq(table(x, y))
      • Support for existing functions hist and plot to use a frequency table as input: hist(freq(df$age))
      • Support for as.vector, as.data.frame, as_tibble and format
      • -
      • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn) +
      • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn)
      • Function top_freq function to return the top/below n items as vector
      • Header of frequency tables now also show Mean Absolute Deviaton (MAD) and Interquartile Range (IQR)
      • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index bb42e8f4d..6eccbc84b 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 2.7.3 pkgdown: 1.5.1.9000 pkgdown_sha: eae56f08694abebf93cdfc0dd8e9ede06d8c815f articles: [] -last_built: 2020-08-21T09:34Z +last_built: 2020-08-26T09:09Z urls: reference: https://msberends.github.io/AMR/reference article: https://msberends.github.io/AMR/articles diff --git a/docs/reference/AMR.html b/docs/reference/AMR.html index e415b85dc..7b5f5a987 100644 --- a/docs/reference/AMR.html +++ b/docs/reference/AMR.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/WHONET.html b/docs/reference/WHONET.html index a3159984c..a2ba65932 100644 --- a/docs/reference/WHONET.html +++ b/docs/reference/WHONET.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/ab_property.html b/docs/reference/ab_property.html index 8264c0cdb..f7012182f 100644 --- a/docs/reference/ab_property.html +++ b/docs/reference/ab_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/antibiotic_class_selectors.html b/docs/reference/antibiotic_class_selectors.html index fd545e448..2965a5a04 100644 --- a/docs/reference/antibiotic_class_selectors.html +++ b/docs/reference/antibiotic_class_selectors.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/antibiotics.html b/docs/reference/antibiotics.html index b58b97e1c..ccdac4703 100644 --- a/docs/reference/antibiotics.html +++ b/docs/reference/antibiotics.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/as.ab.html b/docs/reference/as.ab.html index f6c78ea9a..8e0b035d4 100644 --- a/docs/reference/as.ab.html +++ b/docs/reference/as.ab.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/as.mo.html b/docs/reference/as.mo.html index 80ce7b38c..221077b32 100644 --- a/docs/reference/as.mo.html +++ b/docs/reference/as.mo.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 @@ -443,7 +443,8 @@ This package contains the complete taxonomic tree of almost all microorganisms ( select(microorganism_name) %>% as.mo() -# and can even contain 2 columns, which is convenient for genus/species combinations: +# and can even contain 2 columns, which is convenient +# for genus/species combinations: df$mo <- df %>% select(genus, species) %>% as.mo() diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index c1b7bde9c..f40dcb3e4 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index d33f6c3a2..37cecdd0f 100644 --- a/docs/reference/eucast_rules.html +++ b/docs/reference/eucast_rules.html @@ -83,7 +83,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/example_isolates.html b/docs/reference/example_isolates.html index f61030df3..7305b1ef4 100644 --- a/docs/reference/example_isolates.html +++ b/docs/reference/example_isolates.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/example_isolates_unclean.html b/docs/reference/example_isolates_unclean.html index 6bf854451..c3df06d3c 100644 --- a/docs/reference/example_isolates_unclean.html +++ b/docs/reference/example_isolates_unclean.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/index.html b/docs/reference/index.html index 5027368ee..24667a88d 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 @@ -527,7 +527,7 @@

        microorganisms.codes

        -

        Translation table with 5,582 common microorganism codes

        +

        Translation table with 5,583 common microorganism codes

        diff --git a/docs/reference/intrinsic_resistant.html b/docs/reference/intrinsic_resistant.html index a0d04a8ed..e3427d168 100644 --- a/docs/reference/intrinsic_resistant.html +++ b/docs/reference/intrinsic_resistant.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/microorganisms.codes.html b/docs/reference/microorganisms.codes.html index 515360bd6..1656464f8 100644 --- a/docs/reference/microorganisms.codes.html +++ b/docs/reference/microorganisms.codes.html @@ -6,7 +6,7 @@ -Translation table with 5,582 common microorganism codes — microorganisms.codes • AMR (for R) +Translation table with 5,583 common microorganism codes — microorganisms.codes • AMR (for R) @@ -48,7 +48,7 @@ - + @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 @@ -233,7 +233,7 @@
        @@ -247,7 +247,7 @@

        Format

        -

        A data.frame with 5,582 observations and 2 variables:

          +

          A data.frame with 5,583 observations and 2 variables:

          • code
            Commonly used code of a microorganism

          • mo
            ID of the microorganism in the microorganisms data set

          diff --git a/docs/reference/microorganisms.html b/docs/reference/microorganisms.html index 7068a1712..5bc2e2ae5 100644 --- a/docs/reference/microorganisms.html +++ b/docs/reference/microorganisms.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007
        diff --git a/docs/reference/microorganisms.old.html b/docs/reference/microorganisms.old.html index 07cb42bb3..e7d09bd52 100644 --- a/docs/reference/microorganisms.old.html +++ b/docs/reference/microorganisms.old.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007
        diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index 40b490136..8b9b175f4 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/reference/rsi_translation.html b/docs/reference/rsi_translation.html index 87de2770f..f73ed4bfa 100644 --- a/docs/reference/rsi_translation.html +++ b/docs/reference/rsi_translation.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/docs/survey.html b/docs/survey.html index 910af8440..b04f90ffe 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9006 + 1.3.0.9007 diff --git a/man/as.mo.Rd b/man/as.mo.Rd index 694911c07..c39ce545f 100644 --- a/man/as.mo.Rd +++ b/man/as.mo.Rd @@ -203,7 +203,8 @@ df$mo <- df \%>\% select(microorganism_name) \%>\% as.mo() -# and can even contain 2 columns, which is convenient for genus/species combinations: +# and can even contain 2 columns, which is convenient +# for genus/species combinations: df$mo <- df \%>\% select(genus, species) \%>\% as.mo() diff --git a/man/microorganisms.codes.Rd b/man/microorganisms.codes.Rd index d0c5314cb..5a23c10a5 100644 --- a/man/microorganisms.codes.Rd +++ b/man/microorganisms.codes.Rd @@ -3,9 +3,9 @@ \docType{data} \name{microorganisms.codes} \alias{microorganisms.codes} -\title{Translation table with 5,582 common microorganism codes} +\title{Translation table with 5,583 common microorganism codes} \format{ -A \code{\link{data.frame}} with 5,582 observations and 2 variables: +A \code{\link{data.frame}} with 5,583 observations and 2 variables: \itemize{ \item \code{code}\cr Commonly used code of a microorganism \item \code{mo}\cr ID of the microorganism in the \link{microorganisms} data set