diff --git a/DESCRIPTION b/DESCRIPTION index 6c9cfd679..0e8e560ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 1.6.0.9015 +Version: 1.6.0.9016 Date: 2021-05-03 Title: Antimicrobial Resistance Data Analysis Authors@R: c( diff --git a/NEWS.md b/NEWS.md index 2fb43deeb..5a816928a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# `AMR` 1.6.0.9015 +# `AMR` 1.6.0.9016 ## Last updated: 3 May 2021 ### New diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index ee8fac86a..f14e55312 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -458,7 +458,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) { ifelse(!is.na(y), y, NA)) } -class_integrity_check <- function(value, type, check_vector) { +return_after_integrity_check <- function(value, type, check_vector) { if (!all(value[!is.na(value)] %in% check_vector)) { warning_(paste0("invalid ", type, ", NA generated"), call = FALSE) value[!value %in% check_vector] <- NA diff --git a/R/ab.R b/R/ab.R index fe4fc61b0..18bb1ab55 100755 --- a/R/ab.R +++ b/R/ab.R @@ -551,7 +551,7 @@ as.data.frame.ab <- function(x, ...) { "[<-.ab" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - class_integrity_check(y, "antimicrobial code", antibiotics$ab) + return_after_integrity_check(y, "antimicrobial code", antibiotics$ab) } #' @method [[<- ab #' @export @@ -559,15 +559,16 @@ as.data.frame.ab <- function(x, ...) { "[[<-.ab" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - class_integrity_check(y, "antimicrobial code", antibiotics$ab) + return_after_integrity_check(y, "antimicrobial code", antibiotics$ab) } #' @method c ab #' @export #' @noRd -c.ab <- function(x, ...) { +c.ab <- function(...) { + x <- list(...)[[1L]] y <- NextMethod() attributes(y) <- attributes(x) - class_integrity_check(y, "antimicrobial code", antibiotics$ab) + return_after_integrity_check(y, "antimicrobial code", antibiotics$ab) } #' @method unique ab diff --git a/R/disk.R b/R/disk.R index 5a9f188b1..013c3b48d 100644 --- a/R/disk.R +++ b/R/disk.R @@ -182,11 +182,8 @@ print.disk <- function(x, ...) { #' @method c disk #' @export #' @noRd -c.disk <- function(x, ...) { - y <- NextMethod() - y <- as.disk(y) - attributes(y) <- attributes(x) - y +c.disk <- function(...) { + as.disk(unlist(lapply(list(...), as.character))) } #' @method unique disk diff --git a/R/italicise_taxonomy.R b/R/italicise_taxonomy.R index c549b3de5..4f76a03f3 100644 --- a/R/italicise_taxonomy.R +++ b/R/italicise_taxonomy.R @@ -115,5 +115,8 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) { #' @rdname italicise_taxonomy #' @export italicize_taxonomy <- function(string, type = c("markdown", "ansi")) { - italicise(string = string, type = type) + if (missing(type)) { + type <- "markdown" + } + italicise_taxonomy(string = string, type = type) } diff --git a/R/mic.R b/R/mic.R index 3dff87fb6..7defae521 100755 --- a/R/mic.R +++ b/R/mic.R @@ -307,10 +307,8 @@ as.matrix.mic <- function(x, ...) { #' @method c mic #' @export #' @noRd -c.mic <- function(x, ...) { - y <- unlist(lapply(list(...), as.character)) - x <- as.character(x) - as.mic(c(x, y)) +c.mic <- function(...) { + as.mic(unlist(lapply(list(...), as.character))) } #' @method unique mic diff --git a/R/mo.R b/R/mo.R index cf6c12725..f5048b5fd 100755 --- a/R/mo.R +++ b/R/mo.R @@ -1677,7 +1677,7 @@ pillar_shaft.mo <- function(x, ...) { } else { col <- "The data" } - warning_(col, " contains old microbial codes (from a previous AMR package version). ", + warning_(col, " contains old MO codes (from a previous AMR package version). ", "Please update your MO codes with `as.mo()`.", call = FALSE) } @@ -1751,6 +1751,11 @@ print.mo <- function(x, print.shortnames = FALSE, ...) { } x <- as.character(x) names(x) <- x_names + if (!all(x[!is.na(x)] %in% MO_lookup$mo)) { + warning_("Some MO codes are from a previous AMR package version. ", + "Please update these MO codes with `as.mo()`.", + call = FALSE) + } print.default(x, quote = FALSE) } @@ -1777,7 +1782,7 @@ summary.mo <- function(object, ...) { #' @noRd as.data.frame.mo <- function(x, ...) { if (!all(x[!is.na(x)] %in% MO_lookup$mo)) { - warning_("The data contains old microbial codes (from a previous AMR package version). ", + warning_("The data contains old MO codes (from a previous AMR package version). ", "Please update your MO codes with `as.mo()`.", call = FALSE) } @@ -1812,8 +1817,8 @@ as.data.frame.mo <- function(x, ...) { y <- NextMethod() attributes(y) <- attributes(i) # must only contain valid MOs - class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), - as.character(microorganisms.translation$mo_old))) + return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), + as.character(microorganisms.translation$mo_old))) } #' @method [[<- mo #' @export @@ -1822,18 +1827,18 @@ as.data.frame.mo <- function(x, ...) { y <- NextMethod() attributes(y) <- attributes(i) # must only contain valid MOs - class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), - as.character(microorganisms.translation$mo_old))) + return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), + as.character(microorganisms.translation$mo_old))) } #' @method c mo #' @export #' @noRd -c.mo <- function(x, ...) { +c.mo <- function(...) { + x <- list(...)[[1L]] y <- NextMethod() attributes(y) <- attributes(x) - # must only contain valid MOs - class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), - as.character(microorganisms.translation$mo_old))) + return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo), + as.character(microorganisms.translation$mo_old))) } #' @method unique mo @@ -2058,10 +2063,10 @@ replace_old_mo_codes <- function(x, property) { n_matched <- length(matched[!is.na(matched)]) if (property != "mo") { message_(font_blue(paste0("The input contained ", n_matched, - " old microbial code", ifelse(n_matched == 1, "", "s"), + " old MO code", ifelse(n_matched == 1, "", "s"), " (from a previous AMR package version). Please update your MO codes with `as.mo()`."))) } else { - message_(font_blue(paste0(n_matched, " old microbial code", ifelse(n_matched == 1, "", "s"), + message_(font_blue(paste0(n_matched, " old MO code", ifelse(n_matched == 1, "", "s"), " (from a previous AMR package version) ", ifelse(n_matched == 1, "was", "were"), " updated to ", ifelse(n_matched == 1, "a ", ""), @@ -2100,7 +2105,7 @@ repair_reference_df <- function(reference_df) { reference_df[, "x"] <- as.character(reference_df[, "x", drop = TRUE]) reference_df[, "mo"] <- as.character(reference_df[, "mo", drop = TRUE]) - # some microbial codes might be old + # some MO codes might be old reference_df[, "mo"] <- as.mo(reference_df[, "mo", drop = TRUE]) reference_df } diff --git a/_pkgdown.yml b/_pkgdown.yml index f97ef6861..61bdb2cc1 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -177,6 +177,7 @@ reference: - "`availability`" - "`get_locale`" - "`ggplot_pca`" + - "`italicise_taxonomy`" - "`join`" - "`like`" - "`mo_matching_score`" diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index 706ce19f9..6a21e6231 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 5e772d390..94c3a876e 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 2b45ddf4d..7a589580d 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016 diff --git a/docs/articles/index.html b/docs/articles/index.html index 1c2b4105c..cc1d1e25a 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016 diff --git a/docs/authors.html b/docs/authors.html index 2df5e85d3..7716aca7f 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016 diff --git a/docs/countries.png b/docs/countries.png index ba6bf274d..37b140610 100644 Binary files a/docs/countries.png and b/docs/countries.png differ diff --git a/docs/countries_large.png b/docs/countries_large.png index aa1018665..5c81f9dc6 100644 Binary files a/docs/countries_large.png and b/docs/countries_large.png differ diff --git a/docs/index.html b/docs/index.html index 7f9bd6cd4..16e78406a 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016 @@ -206,7 +206,7 @@

This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). It was designed to work in any setting, including those with very limited resources. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice Foundation and University Medical Center Groningen. This R package is actively maintained and is free software (see Copyright).

- Used in 155 countries
Since its first public release in early 2018, this package has been downloaded from 155 countries. Click the map to enlarge and to see the country names. + Used in 162 countries
Since its first public release in early 2018, this package has been downloaded from 162 countries. Click the map to enlarge and to see the country names.

diff --git a/docs/news/index.html b/docs/news/index.html index 018641852..6a2a4d358 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016
@@ -236,9 +236,9 @@ Source: NEWS.md -
-

- Unreleased AMR 1.6.0.9015

+
+

+ Unreleased AMR 1.6.0.9016

Last updated: 3 May 2021 @@ -340,7 +340,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:

    @@ -397,7 +397,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 a321ac6da..0da9d4cc1 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-03T08:19Z +last_built: 2021-05-03T11:04Z 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 a4800456b..b909715a2 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016
    @@ -592,6 +592,12 @@

    PCA Biplot with ggplot2

    + +

    italicise_taxonomy() italicize_taxonomy()

    + +

    Italicise Taxonomic Families, Genera, Species, Subspecies

    + +

    inner_join_microorganisms() left_join_microorganisms() right_join_microorganisms() full_join_microorganisms() semi_join_microorganisms() anti_join_microorganisms()

    diff --git a/docs/survey.html b/docs/survey.html index e1493254f..bf346fa24 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9015 + 1.6.0.9016
    diff --git a/index.md b/index.md index 0f85e3163..c16924691 100644 --- a/index.md +++ b/index.md @@ -15,8 +15,8 @@ This package is [fully independent of any other R package](https://en.wikipedia.

    - Used in 155 countries
    - Since its first public release in early 2018, this package has been downloaded from 155 countries. Click the map to enlarge and to see the country names.

    + Used in 162 countries
    + Since its first public release in early 2018, this package has been downloaded from 162 countries. Click the map to enlarge and to see the country names.

    ##### With `AMR` (for R), there's always a knowledgeable microbiologist by your side! diff --git a/pkgdown/logos/countries.png b/pkgdown/logos/countries.png index ba6bf274d..37b140610 100644 Binary files a/pkgdown/logos/countries.png and b/pkgdown/logos/countries.png differ diff --git a/pkgdown/logos/countries_large.png b/pkgdown/logos/countries_large.png index aa1018665..5c81f9dc6 100644 Binary files a/pkgdown/logos/countries_large.png and b/pkgdown/logos/countries_large.png differ diff --git a/tests/testthat/test-italicise_taxonomy.R b/tests/testthat/test-italicise_taxonomy.R new file mode 100644 index 000000000..859e84faf --- /dev/null +++ b/tests/testthat/test-italicise_taxonomy.R @@ -0,0 +1,39 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +context("italicise_taxonomy.R") + +test_that("italic taxonomy works", { + skip_on_cran() + + expect_identical(italicise_taxonomy("test for E. coli"), + "test for *E. coli*") + expect_identical(italicise_taxonomy("test for E. coli"), + italicize_taxonomy("test for E. coli")) + if (has_colour()) { + expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"), + "test for \033[3mE. coli\033[23m") + } +})