Add (minimal) support for filtering

DESCRIPTION

@@ -38,6 +38,6 @@ Suggests:
     rmarkdown,
     stringi,
     testthat (>= 2.1.0)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr
 Encoding: UTF-8

R/crosstabs.R

@@ -26,6 +26,9 @@
 #' should we include the default weighted vars? Defaults to TRUE.
 #' @param num_verbatims An integer identifying the number of examples to extract
 #' from a text variable. Defaults to 10. Implemented for Toplines only.
+#' @param filter A list of `CrunchExpression`s, `CrunchFilter`s, or string names
+#' of filters to be combined with the filter applied to dataset passed into the
+#' `dataset` argument.
 #' @return A Toplines (when no banner is provided) or Crosstabs (when a banner
 #' is provided) summary of the input dataset.
 #' @examples
@@ -44,7 +47,8 @@ crosstabs <- function(
                       dataset, vars = names(dataset), weight = crunch::weight(dataset),
                       banner = NULL, codebook = FALSE, include_numeric = FALSE,
                       include_datetime = FALSE, include_verbatims = FALSE,
-                      num_verbatims = 10, include_original_weighted = TRUE) {
+                      num_verbatims = 10, include_original_weighted = TRUE,
+                      filter = NULL) {
   wrong_class_error(dataset, "CrunchDataset", "dataset")
   # nolint start
   all_types <- crunch::types(crunch::allVariables(dataset))
@@ -121,6 +125,7 @@ crosstabs <- function(
     vars = vars_out,
     banner = banner_use,
     weight = weight_var,
+    filter = filter,
     topline = is.null(banner),
     include_original_weighted = include_original_weighted
   )

R/tabBooks.R

@@ -11,9 +11,12 @@
 #' @param weight A weighting variable passed to \link[crunch]{tabBook}
 #' @param topline Logical identifying if this is a topline only
 #' @param include_original_weighted Logical, if you have specified complex weights
+#' @param filter A list of `CrunchExpression`s, `CrunchFilter`s, or string names
+#' of filters to be combined with the filter applied to dataset passed into the
+#' `dataset` argument.
 #' should the original weighted variable be included or only the custom weighted version?
 tabBooks <- function(dataset, vars, banner, weight = NULL, topline = FALSE,
-                     include_original_weighted = TRUE) {
+                     include_original_weighted = TRUE, filter = NULL) {
   banner_flatten <- unique(unlist(banner, recursive = FALSE))
   names(banner_flatten) <- sapply(banner_flatten, function(v) v$alias)
   banner_use <- banner
@@ -42,7 +45,8 @@ tabBooks <- function(dataset, vars, banner, weight = NULL, topline = FALSE,
         multitable,
         dataset = dataset[unique(c(vars, unique(tab_frame$weight)))],
         weight = weight,
-        append_default_wt = include_original_weighted
+        append_default_wt = include_original_weighted,
+        filter = filter
       )
     )
   } else {
@@ -52,7 +56,8 @@ tabBooks <- function(dataset, vars, banner, weight = NULL, topline = FALSE,
       tabBook_crunchtabs(
         multitable,
         dataset = dataset[vars],
-        weight = weight
+        weight = weight,
+        filter = filter
       )
     )
   }

R/tabbook-additions.R

@@ -274,6 +274,9 @@ resultsObject <- function(x, top = NULL, weighted, body_values, body_labels, vec
 #' if specified, or the the autogenerated file name). If you request "json" and
 #' wish to access the JSON data underlying the `TabBookResult`, pass in a path
 #' for `file` and you will get a JSON file written there as well.
+#' @param filter A list of `CrunchExpression`s, `CrunchFilter`s, or string names
+#' of filters to be combined with the filter applied to dataset passed into the
+#' `dataset` argument.
 #' @examples
 #' \dontrun{
 #' m <- newMultitable(~ gender + age4 + marstat, data = ds)
@@ -284,28 +287,29 @@ resultsObject <- function(x, top = NULL, weighted, body_values, body_labels, vec
 #' @importFrom jsonlite fromJSON
 #' @export
 tabBook_crunchtabs <- function(multitable, dataset, weight = crunch::weight(dataset),
-                               append_default_wt = TRUE) {
+                               append_default_wt = TRUE, filter = NULL) {
   if (is.null(weight) | is.variable(weight)) {
-    return(tabBookSingle_crunchtabs(multitable, dataset, weight))
+    return(tabBookSingle_crunchtabs(multitable, dataset, weight, filter))
   } else if (is.list(weight) || is.data.frame(weight)) {
     return(tabBookMulti_crunchtabs(
       multitable,
       dataset,
       weight,
-      append_default_wt
+      append_default_wt,
+      filter
     ))
   } else {
     stop("weight must be NULL, a CrunchVariable or a list indicating a multi-weight spec")
   }
 }
 
-tabBookSingle_crunchtabs <- function(multitable, dataset, weight) {
+tabBookSingle_crunchtabs <- function(multitable, dataset, weight, filter = NULL) {
   if (!is.null(weight)) {
     weight <- self(weight)
   }
-  # filter <- standardize_tabbook_filter(dataset, filter)
+  filter <- standardizeTabbookFilter(dataset, filter)
   body <- list(
-    filter = NULL,
+    filter = filter,
     weight = weight,
     options = list(format = NULL)
   )
@@ -331,6 +335,11 @@ varFilter <- function(dataset) {
   variablesFilter(dataset)
 }
 
+standardizeTabbookFilter <- function(dataset, filter) {
+    func <- utils::getFromNamespace("standardize_tabbook_filter", "crunch")
+    func(dataset, filter)
+}
+
 download_result <- function(result) {
   retry <- utils::getFromNamespace("retry", "crunch")
   retry(crunch::crGET(result), wait = 0.5) # For mocks
@@ -347,7 +356,8 @@ tabBookMulti_crunchtabs <- function(
                                     multitable,
                                     dataset,
                                     weight_spec,
-                                    append_default_wt) {
+                                    append_default_wt,
+                                    filter = NULL) {
   if (length(weight_spec) == 0) {
     stop("Empty list not allowed as a weight spec, use NULL to indicate no weights")
   }
@@ -379,7 +389,8 @@ tabBookMulti_crunchtabs <- function(
     tabBookSingle_crunchtabs(
       multitable,
       dataset[page_vars],
-      weight = dataset[[wt]]
+      weight = dataset[[wt]],
+      filter = filter
     )
   })
 

R/writeLatex.R

@@ -315,7 +315,7 @@ latexDocHead <- function(theme, title, subtitle, banner = NULL) {
       "includeheadfoot"
     ),
     usepackage("array"),
-    usepackage("babel", "english"),
+    usepackage("babel"), # , "english"
     "\\newcolumntype{B}[2]{>{#1\\hspace{0pt}\\arraybackslash}b{#2}}",
     "\\setlength{\\parindent}{0pt}",
     usepackage("color", "dvipsnames"),

inst/codebook_latex_wrap.tex

@@ -20,7 +20,7 @@
 }
 \usepackage[top=0.6in, bottom=0.6in, left=1in, right=1in, includeheadfoot]{geometry}
 \usepackage{array}
-\usepackage[english]{babel}
+\usepackage{babel}
 \newcolumntype{B}[2]{>{#1\hspace{0pt}\arraybackslash}b{#2}}
 \setlength{\parindent}{0pt}
 \usepackage[dvipsnames]{color}

tests/testthat/ref/tabbook1.tex

@@ -11,7 +11,7 @@
 \usepackage{booktabs, dcolumn, longtable}
 \usepackage[top=0.6in, bottom=0.6in, left=0.5in, right=0.5in, includeheadfoot]{geometry}
 \usepackage{array}
-\usepackage[english]{babel}
+\usepackage{babel}
 \newcolumntype{B}[2]{>{#1\hspace{0pt}\arraybackslash}b{#2}}
 \setlength{\parindent}{0pt}
 \usepackage[dvipsnames]{color}

tests/testthat/ref/topline1.tex

@@ -11,7 +11,7 @@
 \usepackage{booktabs, dcolumn, longtable}
 \usepackage[top=0.6in, bottom=0.6in, left=1in, right=1in, includeheadfoot]{geometry}
 \usepackage{array}
-\usepackage[english]{babel}
+\usepackage{babel}
 \newcolumntype{B}[2]{>{#1\hspace{0pt}\arraybackslash}b{#2}}
 \setlength{\parindent}{0pt}
 \usepackage[dvipsnames]{color}

tests/testthat/test-nonTabBookSummary.R

@@ -34,7 +34,7 @@ test_that("Creates result object appropriately for a TextVariable", {
         ), class = c(
           "POSIXct",
           "POSIXt"
-        ))), .Names = NA_character_, class = "data.frame", row.names = c(
+        ), tzone = "UTC")), .Names = NA_character_, class = "data.frame", row.names = c(
           "Minimum",
           "1st Quartile", "Median", "3rd Quartile", "Maximum"
         )),

tests/testthat/test-tabbooks.R

@@ -193,6 +193,7 @@ test_that("tabBookSingle_crunchtabs", {
   mockery::stub(tabBookSingle_crunchtabs, "crunch::shojiURL", "shoji_url")
   mockery::stub(tabBookSingle_crunchtabs, "download_result", "downloaded_result")
   mockery::stub(tabBookSingle_crunchtabs, "varFilter", "Doesn't matter!")
+  mockery::stub(tabBookSingle_crunchtabs, "standardizeTabbookFilter", "Doesn't matter!")
   mockery::stub(tabBookSingle_crunchtabs, "tabBookResult", function(x) x)
   mockery::stub(tabBookSingle_crunchtabs, "crunch::crPOST", function(x, ...) x)
   res <- tabBookSingle_crunchtabs("mt", "dataset", weight = NULL)

vignettes/Edgar-Anderson-s-Iris-Data.tex

@@ -19,7 +19,7 @@
 }
 \usepackage[top=0.6in, bottom=0.6in, left=1in, right=1in, includeheadfoot]{geometry}
 \usepackage{array}
-\usepackage[english]{babel}
+\usepackage{babel}
 \newcolumntype{B}[2]{>{#1\hspace{0pt}\arraybackslash}b{#2}}
 \setlength{\parindent}{0pt}
 \usepackage[dvipsnames]{color}
@@ -77,8 +77,8 @@
 \vspace{.25in}
 
 \begin{longtable}[l]{ll}
-Sample  &  The irises of the Gaspe Peninsula \\ 
-Conducted  &  1935 \\ 
+Sample  &  The irises of the Gaspe Peninsula \\
+Conducted  &  1935 \\
 \end{longtable}
 This famous (Fisher's or Anderson's) iris data set gives the measurements in centimeters of the variables sepal length and width and petal length and width, respectively, for 50 flowers from each of 3 species of iris. The species are Iris setosa, versicolor, and virginica.
 
@@ -96,7 +96,7 @@
 \vskip 0.10in
 The length of the flower's sepal
 \addcontentsline{lot}{table}{\parbox{1.8in}{\ttfamily{Sepal.Length}} Sepal Length}
-\vskip 0.10in\end{absolutelynopagebreak} 
+\vskip 0.10in\end{absolutelynopagebreak}
 \begin{longtable}[l]{cccccc}
 \toprule
 {Mean} & {SD} & {Min} & {Max} & {n} & {Missing}\\
@@ -115,7 +115,7 @@
 \vskip 0.10in
 The iris species
 \addcontentsline{lot}{table}{\parbox{1.8in}{\ttfamily{Species}} Iris Species}
-\vskip 0.10in\end{absolutelynopagebreak} 
+\vskip 0.10in\end{absolutelynopagebreak}
 \begin{longtable}[l]{JlK}
 \toprule
 {Code} & {Label} & {Count}\\