(v1.7.1.9014) rep() for S3 classes

R/ab.R

@@ -580,6 +580,15 @@ unique.ab <- function(x, incomparables = FALSE, ...) {
   y
 }
 
+#' @method rep ab
+#' @export
+#' @noRd
+rep.ab <- function(x, ...) {
+  y <- NextMethod()
+  attributes(y) <- attributes(x)
+  y
+}
+
 generalise_antibiotic_name <- function(x) {
   x <- toupper(x)
   # remove suffices

R/bug_drug_combinations.R

@@ -113,7 +113,7 @@ bug_drug_combinations <- function(x,
         data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
       })
       merged <- do.call(rbind, pivot)
-      out_group <- data.frame(mo = unique_mo[i],
+      out_group <- data.frame(mo = rep(unique_mo[i], NROW(merged)),
                               ab = rownames(merged),
                               S = merged$S,
                               I = merged$I,

R/disk.R

@@ -195,6 +195,15 @@ unique.disk <- function(x, incomparables = FALSE, ...) {
   y
 }
 
+#' @method rep disk
+#' @export
+#' @noRd
+rep.disk <- function(x, ...) {
+  y <- NextMethod()
+  attributes(y) <- attributes(x)
+  y
+}
+
 # will be exported using s3_register() in R/zzz.R
 get_skimmers.disk <- function(column) {
   skimr::sfl(

R/mic.R

@@ -320,6 +320,15 @@ unique.mic <- function(x, incomparables = FALSE, ...) {
   y
 }
 
+#' @method rep mic
+#' @export
+#' @noRd
+rep.mic <- function(x, ...) {
+  y <- NextMethod()
+  attributes(y) <- attributes(x)
+  y
+}
+
 #' @method sort mic
 #' @export
 #' @noRd
@@ -337,7 +346,7 @@ sort.mic <- function(x, decreasing = FALSE, ...) {
 #' @export
 #' @noRd
 hist.mic <- function(x, ...) {
-  warning_("Use `plot()` or `ggplot()` for optimal plotting of MIC values", call = FALSE)
+  warning_("Use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values", call = FALSE)
   hist(log2(x))
 }
 

R/mo_property.R

@@ -48,7 +48,7 @@
 #' 
 #' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] functions can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics).
 #'
-#' The functions [mo_family()], [mo_genus()], [mo_name()], [mo_fullname()] and [mo_shortname()] are returned with an additional class `taxonomic_name`, which allows italic printing in [tibbles][tibble::tibble()].
+#' The functions [mo_family()], [mo_genus()], [mo_name()], [mo_fullname()] and [mo_shortname()] are returned with an additional class `taxonomic_name`, which allows italic printing in [tibbles][tibble::tibble()] and markdown tables such as with [knitr::kable()].
 #' 
 #' All output [will be translated][translate] where possible.
 #'
@@ -786,9 +786,9 @@ print.taxonomic_name <- function(x, ...) {
 as.data.frame.taxonomic_name <- function(x, ...) {
   nm <- deparse1(substitute(x))
   if (!"nm" %in% names(list(...))) {
-    as.data.frame(unclass(x), ..., nm = nm)
+    as.data.frame.vector(x, ..., nm = nm)
   } else {
-    as.data.frame(unclass(x), ...)
+    as.data.frame.vector(x, ...)
   }
 }
 
@@ -801,12 +801,27 @@ type_sum.taxonomic_name <- function(x, ...) {
 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 format taxonomic_name
+#' @export
+#' @noRd
+format.taxonomic_name <- function(x, ...) {
+  # format only in case of markdown knitting
+  x <- unclass(x)
+  if (any(as.character(sys.calls()) %like% "(^|:| )kable\\(") ||
+      tryCatch(!is.null(knitr::opts_knit$get("out.format")), error = function(e) FALSE) ||
+      tryCatch(isTRUE(getOption('knitr.in.progress')), error = function(e) FALSE)) {
+    # perhaps this could be extended or better specified in the future?
+    hits <- tolower(x) %in% MO_lookup$fullname_lower | tolower(gsub("[^a-zA-Z ]", "", x)) %in% c(MO_lookup$g_species)
+    x[hits] <- paste0("*", x[hits], "*")
+  }
+  x
+}
+
 #' @method [ taxonomic_name
 #' @export
 #' @noRd
@@ -856,3 +871,12 @@ unique.taxonomic_name <- function(x, incomparables = FALSE, ...) {
   attributes(y) <- attributes(x)
   y
 }
+
+#' @method rep taxonomic_name
+#' @export
+#' @noRd
+rep.taxonomic_name <- function(x, ...) {
+  y <- NextMethod()
+  attributes(y) <- attributes(x)
+  y
+}

R/rsi.R

@@ -1054,6 +1054,15 @@ unique.rsi <- function(x, incomparables = FALSE, ...) {
   y
 }
 
+#' @method rep rsi
+#' @export
+#' @noRd
+rep.rsi <- function(x, ...) {
+  y <- NextMethod()
+  attributes(y) <- attributes(x)
+  y
+}
+
 check_reference_data <- function(reference_data) {
   if (!identical(reference_data, AMR::rsi_translation)) {
     class_rsi <- vapply(FUN.VALUE = character(1), rsi_translation, function(x) paste0("<", class(x), ">", collapse = " and "))