(v1.7.1.9010) fix for count_* and proportion_*

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.7.1.9009
+Version: 1.7.1.9010
-Date: 2021-07-03
+Date: 2021-07-04
 Title: Antimicrobial Resistance Data Analysis
 Authors@R: c(
     person(role = c("aut", "cre"), 

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%")

NEWS.md

@@ -1,12 +1,12 @@
-# `AMR` 1.7.1.9009
+# `AMR` 1.7.1.9010
-## <small>Last updated:  3 July 2021</small>
+## <small>Last updated:  4 July 2021</small>
 
 ### 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 `<mic>`, `<disk>`, `<rsi>` and `<resistance_predict>`
 * 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

R/ab_class_selectors.R

@@ -268,6 +268,7 @@ ab_selector <- function(function_name,
   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)
@@ -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 = "|")))

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 <mo>
-    return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE])
+    x <- MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]
-  }
 
-  # try to catch an error when inputting an invalid argument
+  } else {
-  # so the 'call.' can be set to FALSE
+    # try to catch an error when inputting an invalid argument
-  tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE],
+    # so the 'call.' can be set to FALSE
-           error = function(e) stop(e$message, call. = 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) {
+    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, ...)
+      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
+}

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)]
+  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)
 }
 
 rsi_calc <- function(...,

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")

data-raw/rsi.md5

@@ -1 +1 @@
-1a7fe52f8185c9bb2c470712863d1887
+7c7f6a0ecfc2e122c4547c0ebed09346

docs/404.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/LICENSE-text.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/articles/datasets.html

@@ -39,7 +39,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 
@@ -192,7 +192,7 @@
     <div class="page-header toc-ignore">
       <h1 data-toc-skip>Data sets for download / own use</h1>
             
-            <h4 class="date">03 July 2021</h4>
+            <h4 class="date">04 July 2021</h4>
       
       <small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/master/vignettes/datasets.Rmd"><code>vignettes/datasets.Rmd</code></a></small>
       <div class="hidden name"><code>datasets.Rmd</code></div>

docs/articles/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/authors.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/index.html

@@ -42,7 +42,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/news/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 
@@ -236,12 +236,12 @@
       <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
     </div>
 
-    <div id="amr-1719009" class="section level1">
+    <div id="amr-1719010" class="section level1">
-<h1 class="page-header" data-toc-text="1.7.1.9009">
+<h1 class="page-header" data-toc-text="1.7.1.9010">
-<a href="#amr-1719009" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.7.1.9009</h1>
+<a href="#amr-1719010" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.7.1.9010</h1>
-<div id="last-updated-3-july-2021" class="section level2">
+<div id="last-updated-4-july-2021" class="section level2">
 <h2 class="hasAnchor">
-<a href="#last-updated-3-july-2021" class="anchor"></a><small>Last updated: 3 July 2021</small>
+<a href="#last-updated-4-july-2021" class="anchor"></a><small>Last updated: 4 July 2021</small>
 </h2>
 <div id="changed" class="section level3">
 <h3 class="hasAnchor">
@@ -255,7 +255,7 @@
 <li>Fix for using selectors multiple times in one call (e.g., using them in <code><a href="https://dplyr.tidyverse.org/reference/filter.html">dplyr::filter()</a></code> and immediately after in <code><a href="https://dplyr.tidyverse.org/reference/select.html">dplyr::select()</a></code>)</li>
 </ul>
 </li>
-<li>Fixed duplicate ATC codes in the <code>antibiotics</code> data set</li>
+<li>Fix for duplicate ATC codes in the <code>antibiotics</code> data set</li>
 <li>Added <code><a href="https://ggplot2.tidyverse.org/reference/autoplot.html">ggplot2::autoplot()</a></code> generic for classes <code>&lt;mic&gt;</code>, <code>&lt;disk&gt;</code>, <code>&lt;rsi&gt;</code> and <code>&lt;resistance_predict&gt;</code>
 </li>
 <li>Fix to prevent introducing <code>NA</code>s for old MO codes when running <code><a href="../reference/as.mo.html">as.mo()</a></code> on them</li>
@@ -267,7 +267,9 @@
 <li>The right input types for <code><a href="../reference/random.html">random_mic()</a></code>, <code><a href="../reference/random.html">random_disk()</a></code> and <code><a href="../reference/random.html">random_rsi()</a></code> are now enforced</li>
 <li>
 <code><a href="../reference/as.rsi.html">as.rsi()</a></code> can now correct for textual input (such as “Susceptible”, “Resistant”) in Dutch, English, French, German, Italian, Portuguese and Spanish</li>
-<li>More informative warnings for all <code>count_*()</code>, <code>proportion_*()</code> functions (and <code>resistant()</code> and <code>susceptible()</code>) when they return NA because of too few test results. The warnings now include the official drug name and if used, the <code>dplyr</code> group name.</li>
+<li>When warnings are throws because of too few isolates in any <code>count_*()</code>, <code>proportion_*()</code> function (or <code>resistant()</code> or <code>susceptible()</code>), the <code>dplyr</code> group will be shown, if available</li>
+<li>Taxonomic names now print in italic in tibbles, if created with <code><a href="../reference/mo_property.html">mo_name()</a></code>, <code><a href="../reference/mo_property.html">mo_fullname()</a></code>, <code><a href="../reference/mo_property.html">mo_shortname()</a></code>, <code><a href="../reference/mo_property.html">mo_genus()</a></code> or <code><a href="../reference/mo_property.html">mo_family()</a></code>
+</li>
 </ul>
 </div>
 </div>
@@ -321,7 +323,7 @@
 </ul>
 </li>
 <li>Function <code><a href="../reference/antibiotic_class_selectors.html">betalactams()</a></code> as additional antbiotic column selector and function <code><a href="../reference/AMR-deprecated.html">filter_betalactams()</a></code> as additional antbiotic column filter. The group of betalactams consists of all carbapenems, cephalosporins and penicillins.</li>
-<li>A <code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> method for <code><a href="../reference/resistance_predict.html">resistance_predict()</a></code>
+<li>A <code>ggplot()</code> method for <code><a href="../reference/resistance_predict.html">resistance_predict()</a></code>
 </li>
 </ul>
 </div>
@@ -422,7 +424,7 @@
 <span class="co">#&gt; Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"</span></code></pre></div>
 </li>
 <li><p>Support for custom MDRO guidelines, using the new <code><a href="../reference/mdro.html">custom_mdro_guideline()</a></code> function, please see <code><a href="../reference/mdro.html">mdro()</a></code> for additional info</p></li>
-<li><p><code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> generics for classes <code>&lt;mic&gt;</code> and <code>&lt;disk&gt;</code></p></li>
+<li><p><code>ggplot()</code> generics for classes <code>&lt;mic&gt;</code> and <code>&lt;disk&gt;</code></p></li>
 <li>
 <p>Function <code><a href="../reference/mo_property.html">mo_is_yeast()</a></code>, which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:</p>
 <div class="sourceCode" id="cb4"><pre class="downlit sourceCode r">
@@ -479,7 +481,7 @@
 <li>Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent</li>
 <li>All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)</li>
 <li>Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see <code>translate</code>)</li>
-<li>Plotting is now possible with base R using <code><a href="../reference/plot.html">plot()</a></code> and with ggplot2 using <code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> on any vector of MIC and disk diffusion values</li>
+<li>Plotting is now possible with base R using <code><a href="../reference/plot.html">plot()</a></code> and with ggplot2 using <code>ggplot()</code> on any vector of MIC and disk diffusion values</li>
 </ul>
 </li>
 <li>Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the <code>microorganisms</code> data set</li>

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

docs/reference/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>
 

docs/survey.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9009</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9010</span>
       </span>
     </div>