Merge branch 'main' of https://github.com/sfirke/janitor into main

NEWS.md

@@ -63,6 +63,8 @@ These are all minor breaking changes resulting from enhancements and are not exp
 
 * `adorn_ns()` can act on a single-column data.frame input with custom Ns supplied if the variable to adorn is specified with `...` (#456).
 
+* `adorn_totals()` on a one_way tabyl preserves the `tabyl_type` attribute so that a subsequent call to `adorn_pct_formatting()` works correctly on one-way tabyls (#523).
+
 # janitor 2.1.0 (2021-01-05)
 
 ## New features

R/adorn_totals.R

@@ -59,7 +59,8 @@ adorn_totals <- function(dat, where = "row", fill = "-", na.rm = TRUE, name = "T
     if ("grouped_df" %in% class(dat)) {
       dat <- dplyr::ungroup(dat)
     }
-    dat <- as_tabyl(dat)
+
+    dat <- as_tabyl(dat) # even a tabyl needs to be recast as a tabyl to reset the core in case it's been sorted
 
     # set totals attribute
     if (sum(where %in% attr(dat, "totals")) > 0) { # if either of the values of "where" are already in totals attribute

R/as_and_untabyl.R

@@ -47,10 +47,13 @@ as_tabyl <- function(dat, axes = 2, row_var_name = NULL, col_var_name = NULL) {
     attr(dat, "core") <- as.data.frame(dat) # core goes first so dat does not yet have attributes attached to it
   }
 
-  attr(dat, "tabyl_type") <- dplyr::case_when(
-    axes == 1 ~ "one_way",
-    axes == 2 ~ "two_way"
-  )
+  attr(dat, "tabyl_type") <- ifelse(
+    !is.null(attr(dat, "tabyl_type")),
+    attr(dat, "tabyl_type"), # if a one_way tabyl has as_tabyl called on it, it should stay a one_way #523
+    dplyr::case_when(
+      axes == 1 ~ "one_way",
+      axes == 2 ~ "two_way"
+    ))
   class(dat) <- c("tabyl", setdiff(class(dat), "tabyl"))
 
   if (!missing(row_var_name) | !missing(col_var_name)) {

tests/testthat/test-adorn-totals.R

@@ -401,6 +401,14 @@ test_that("supplying NA as fill still works with non-character first col and num
   expect_equal(test_df[1:3, 2:7], out[1:3,2:7], ignore_attr = TRUE)
 })
 
+test_that("one_way tabyl inputs retain that class", {
+  expect_equal(
+    attr(mtcars %>% tabyl(am) %>% adorn_totals("both"), "tabyl_type"),
+    "one_way"
+  )
+})
+
+
 # Tests from #413, different values for row and col names
 test_that("long vectors are trimmed", {
   expect_equal(