Implements spec_col_freq() (#5)

NAMESPACE

@@ -27,4 +27,5 @@ export(prj_shadow_if)
 export(prj_tbl_cols)
 export(prj_tbl_rows)
 export(prj_tbl_summarise)
+export(spec_col_freq)
 import(vctrs)

R/spec_col.R

@@ -0,0 +1,71 @@
+#' Frequency cross-tabulations
+#'
+#' Conveniently generate frequency column specifications by passing through an
+#' unquoted variable name and a set of valid values. This specification can then
+#' be spliced into `prj_tbl_cols()`.
+#'
+#' @param .var An unquoted variable name
+#' @param .vals A vector of values `.var` might take
+#' @param .type A string designating the type of frequency to calculate: "row", "col" or "cell"
+#'
+#' @return A list of expressions to be passed into `prj_tbl_cols()`
+#' @export
+#'
+#' @examples
+#' # Specify the rows
+#' my_tbl <- prj_tbl_rows(
+#'   .data = mtcars,
+#'   Cylinders = cyl,
+#'   Transmission = am,
+#' )
+#'
+#' # Specify the columns
+#' my_tbl1 <- prj_tbl_cols(
+#'   .data = my_tbl,
+#'   !!!spec_col_freq(vs, 0:1)
+#' )
+#'
+#' # Summarise
+#' prj_tbl_summarise(my_tbl1)
+#'
+#' # Specify the columns and provide custom names
+#' col_spec <- `names<-`(spec_col_freq(vs, 0:1), c("Not V-Shaped", "V-Shaped"))
+#' my_tbl2 <- prj_tbl_cols(
+#'   .data = my_tbl,
+#'   !!!col_spec
+#' )
+#'
+#' # Summarise
+#' prj_tbl_summarise(my_tbl2)
+
+spec_col_freq <- function(.var, .vals, .type = "row") {
+    stopifnot(is.character(.type))
+    .var <- substitute(.var)
+    if (.type == "cell") {
+      out <- lapply(.vals, function(i) {
+        bquote(col_freq(
+          .(.var) %in% .(i),
+          .data[[.(deparse(.var))]] %in% .data[[.(deparse(.var))]]
+        ))
+      })
+    } else if (.type == "col") {
+      out <- lapply(.vals, function(i) {
+        bquote(col_freq(
+          .(.var) %in% .(i),
+          .data[[.(deparse(.var))]] %in% .(i)
+        ))
+      })
+    } else if (.type == "row") {
+      out <- lapply(.vals, function(i) {
+        bquote(col_freq(
+          .(.var) %in% .(i),
+          .(.var) %in% .(.vals)
+        ))
+      })
+    } else {
+      stop("`.type` must be one of c('row', 'col', 'cell')", call. = FALSE)
+    }
+    names(out) <- paste(deparse(.var), .vals, sep = ".")
+
+    out
+  }

tests/testthat/test-spec_col.R

@@ -0,0 +1,29 @@
+testthat::test_that("spec_col", {
+  testthat::expect_error(spec_col_freq(vs, 0:1, "something"), "`.type` must be one of")
+
+  for (i in c('row', 'col', 'cell')) {
+    testthat::expect_true(is.list(spec_col_freq(vs, 0:1, i)))
+  }
+
+  my_tbl <- prj_tbl_rows(
+    .data = mtcars,
+    Cylinders = cyl,
+    Transmission = am,
+  )
+
+  # Specify the columns and provide custom names
+  col_spec <- `names<-`(spec_col_freq(vs, 0:1), c("NV", "V"))
+  my_tbl1 <- prj_tbl_cols(
+    .data = my_tbl,
+    !!!col_spec,
+    `Three Gears` = col_freq(n = gear %in% 3, N = gear %in% 3:5)
+  )
+  my_tbl2 <- prj_tbl_cols(
+    .data = my_tbl,
+    `NV` = col_freq(n = vs %in% 0, N = vs %in% 0:1),
+    `V` = col_freq(n = vs %in% 1, N = vs %in% 0:1),
+    `Three Gears` = col_freq(n = gear %in% 3, N = gear %in% 3:5)
+  )
+  # Summarise
+  testthat::expect_identical(prj_tbl_summarise(my_tbl1), prj_tbl_summarise(my_tbl2))
+})