From 604586472f003dc802bfb45cfca677bb0cbdea9d Mon Sep 17 00:00:00 2001
From: kinto-b <kinto.behr@srcentre.com.au>
Date: Wed, 11 Nov 2020 17:16:13 +1100
Subject: [PATCH] Implements `spec_col_freq()` (#5)

---
 NAMESPACE                      |  1 +
 R/spec_col.R                   | 71 ++++++++++++++++++++++++++++++++++
 man/spec_col_freq.Rd           | 50 ++++++++++++++++++++++++
 tests/testthat/test-spec_col.R | 29 ++++++++++++++
 4 files changed, 151 insertions(+)
 create mode 100644 R/spec_col.R
 create mode 100644 man/spec_col_freq.Rd
 create mode 100644 tests/testthat/test-spec_col.R

diff --git a/NAMESPACE b/NAMESPACE
index 5921410..0a62686 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/spec_col.R b/R/spec_col.R
new file mode 100644
index 0000000..c306fda
--- /dev/null
+++ b/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
+  }
diff --git a/man/spec_col_freq.Rd b/man/spec_col_freq.Rd
new file mode 100644
index 0000000..529ecff
--- /dev/null
+++ b/man/spec_col_freq.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/spec_col.R
+\name{spec_col_freq}
+\alias{spec_col_freq}
+\title{Frequency cross-tabulations}
+\usage{
+spec_col_freq(.var, .vals, .type = "row")
+}
+\arguments{
+\item{.var}{An unquoted variable name}
+
+\item{.vals}{A vector of values \code{.var} might take}
+
+\item{.type}{A string designating the type of frequency to calculate: "row", "col" or "cell"}
+}
+\value{
+A list of expressions to be passed into \code{prj_tbl_cols()}
+}
+\description{
+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 \code{prj_tbl_cols()}.
+}
+\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)
+}
diff --git a/tests/testthat/test-spec_col.R b/tests/testthat/test-spec_col.R
new file mode 100644
index 0000000..a0117f2
--- /dev/null
+++ b/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))
+})