(v1.3.0.9032) support skimr

R/disk.R

@@ -186,3 +186,17 @@ unique.disk <- function(x, incomparables = FALSE, ...) {
   attributes(y) <- attributes(x)
   y
 }
+
+# will be exported using s3_register() in R/zzz.R
+get_skimmers.disk <- function(column) {
+  sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE)
+  inline_hist <- import_fn("inline_hist", "skimr", error_on_fail = FALSE)
+  sfl(
+    skim_type = "disk",
+    smallest = ~min(as.double(.), na.rm = TRUE),
+    largest = ~max(as.double(.), na.rm = TRUE),
+    median = ~stats::median(as.double(.), na.rm = TRUE),
+    n_unique = n_unique,
+    hist = ~inline_hist(stats::na.omit(as.double(.)))
+  )
+}

R/mic.R

@@ -296,3 +296,17 @@ unique.mic <- function(x, incomparables = FALSE, ...) {
   attributes(y) <- attributes(x)
   y
 }
+
+# will be exported using s3_register() in R/zzz.R
+get_skimmers.mic <- function(column) {
+  sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE)
+  inline_hist <- import_fn("inline_hist", "skimr", error_on_fail = FALSE)
+  sfl(
+    skim_type = "mic",
+    min = ~as.character(sort(na.omit(.))[1]),
+    max = ~as.character(sort(stats::na.omit(.))[length(stats::na.omit(.))]),
+    median = ~as.character(stats::na.omit(.)[as.double(stats::na.omit(.)) == median(as.double(stats::na.omit(.)))])[1],
+    n_unique = n_unique,
+    hist_log2 = ~inline_hist(log2(as.double(stats::na.omit(.))))
+  )
+}

R/mo.R

@@ -1637,11 +1637,24 @@ freq.mo <- function(x, ...) {
                                                                   decimal.mark = "."),
                                                            " (", percentage(sum(grams == "Gram-positive", na.rm = TRUE) / length(grams), digits = digits),
                                                            ")"),
-                                  `No. of genera` = pm_n_distinct(mo_genus(x_noNA, language = NULL)),
-                                  `No. of species` = pm_n_distinct(paste(mo_genus(x_noNA, language = NULL),
+                                  `Nr. of genera` = pm_n_distinct(mo_genus(x_noNA, language = NULL)),
+                                  `Nr. of species` = pm_n_distinct(paste(mo_genus(x_noNA, language = NULL),
                                                                          mo_species(x_noNA, language = NULL)))))
 }
 
+# will be exported using s3_register() in R/zzz.R
+get_skimmers.mo <- function(column) {
+  sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE)
+  sfl(
+    skim_type = "mo",
+    unique_total = n_unique,
+    gram_negative = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-negative", na.rm = TRUE),
+    gram_positive = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-positive", na.rm = TRUE),
+    top_genus = ~names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L],
+    top_species = ~names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L]
+  )
+}
+
 #' @method print mo
 #' @export
 #' @noRd

R/rsi.R

@@ -743,6 +743,43 @@ freq.rsi <- function(x, ...) {
   }
 }
 
+
+# will be exported using s3_register() in R/zzz.R
+get_skimmers.rsi <- function(column) {
+  # a bit of a crazy hack to get the variable name
+  name_call <- function(.data, name = deparse(substitute(column))) {
+    vars <- tryCatch(eval(parse(text = ".data$skim_variable"), envir = sys.frame(2)), 
+                     error = function(e) NULL)
+    calls <- sys.calls()
+    i <- tryCatch(attributes(calls[[length(calls)]])$position, 
+                  error = function(e) NULL)
+    if (is.null(vars) | is.null(i)) {
+      NA_character_
+    } else{
+      lengths <- sapply(vars, length)
+      lengths <-  sum(lengths[!names(lengths) == "rsi"])
+      var <- vars$rsi[i - lengths]
+      if (var == "data") {
+        NA_character_
+      } else{
+        ab_name(var)
+      }
+    }
+  }
+  
+  sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE)
+  sfl(
+    skim_type = "rsi",
+    name = name_call,
+    count_R = count_R,
+    count_S = count_susceptible,
+    count_I = count_I,
+    prop_R = ~proportion_R(., minimum = 0),
+    prop_S = ~susceptibility(., minimum = 0),
+    prop_I = ~proportion_I(., minimum = 0)
+  )
+}
+
 #' @method print rsi
 #' @export
 #' @noRd

R/rsi_calc.R

@@ -151,9 +151,10 @@ rsi_calc <- function(...,
       data_vars <- paste(" for", data_vars)
     }
     warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` = ", minimum, ").", call. = FALSE)
-    fraction <- NA
+    fraction <- NA_real_
   } else {
     fraction <- numerator / denominator
+    fraction[is.nan(fraction)] <- NA_real_
   }
   
   if (as_percent == TRUE) {

R/zzz.R

@@ -49,9 +49,14 @@
   s3_register("tibble::type_sum", "mic")
   s3_register("pillar::pillar_shaft", "disk")
   s3_register("tibble::type_sum", "disk")
-  # support for frequency tables
+  # support for frequency tables from the cleaner package
   s3_register("cleaner::freq", "mo")
   s3_register("cleaner::freq", "rsi")
+  # support from skim from the skimr package
+  s3_register("skimr::get_skimmers", "mo")
+  s3_register("skimr::get_skimmers", "rsi")
+  s3_register("skimr::get_skimmers", "mic")
+  s3_register("skimr::get_skimmers", "disk")
 }
 
 .onAttach <- function(...) {