Merge pull request #188 from Crunch-io/issue_185

Release 1.2.9

DESCRIPTION

@@ -6,7 +6,7 @@ Description: In order to generate custom survey reports, this package provides
     'banners' (cross-tabulations) of datasets in the Crunch
     (<https://crunch.io/>) web service. Reports can be written in 'PDF' format
     using 'LaTeX' or in Microsoft Excel '.xlsx' files.
-Version: 1.2.8
+Version: 1.2.9
 Authors@R: c(
     person("Persephone", "Tsebelis", role="aut"),
     person("Kamil", "Sedrowicz", role="aut"),
@@ -15,7 +15,6 @@ Authors@R: c(
 URL: https://github.com/Crunch-io/crunchtabs
 BugReports: https://github.com/Crunch-io/crunchtabs/issues
 License: LGPL (>= 3)
-Remotes: haozhu233/kableExtra
 Depends:
     R (>= 3.5.0),
     crunch
@@ -35,6 +34,6 @@ Suggests:
     rmarkdown,
     testthat (>= 2.1.0),
     kableExtra (>= 1.1.0.9000)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 VignetteBuilder: knitr
 Encoding: UTF-8

NEWS.md

@@ -1,3 +1,13 @@
+## crunchtabs 1.2.9
+
+- Codebook question descriptions now appropriately escape special characters (#187)
+- Added option enforce_onehundred which allows one to avoid rounding errors in totals rows (#189)
+- Codebook table of contents overruns, cutting text and adding "..." (#186)
+- Codebook generation now supports a filepath (#185)
+- Added vertical space before append_text (#182)
+- Bugfix: append_text that is multiple lines du0lpicated vertical space. Collapsing. (#191)
+- Remove requirement for dev version of kableExtra (#184)
+
 ## crunchtabs 1.2.8
 
 - Documentation for generating codebooks (#180)

R/codebookLatex.R

@@ -64,24 +64,37 @@ codeBookItemTxtDescription <- function(x, ...) {
   txt$description <- crunch::description(x)
   txt$notes <- crunch::notes(x)
   txt$alias <- crunch::alias(x)
+  txt$alias_toc <- ifelse(
+    nchar(txt$alias) > 20,
+    paste0(substr(txt$alias, 1, 22), "..."),
+    txt$alias
+  )
+
   txt$name <- crunch::name(x)
 
+  txt$name_toc <- ifelse(
+    nchar(txt$name) > 65,
+    paste0(substr(txt$name, 1, 65), "..."),
+    txt$name
+  )
+
+
   if (txt$notes != "") {
     tex = "\\vskip 0.10in\n%s\n\\addcontentsline{lot}{table}{\\parbox{1.8in}{\\ttfamily{%s}} %s}\n\\vskip 0.10in\n\\emph{%s}\n\\vskip 0.10in"
     tex = sprintf(
       tex,
-      txt$description,
-      texEscape(txt$alias),
-      texEscape(txt$name),
+      texEscape(txt$description),
+      texEscape(txt$alias_toc),
+      texEscape(txt$name_toc),
       txt$notes
     )
   } else {
     tex = "\\vskip 0.10in\n%s\n\\addcontentsline{lot}{table}{\\parbox{1.8in}{\\ttfamily{%s}} %s}\n\\vskip 0.10in"
     tex = sprintf(
       tex,
-      txt$description,
-      texEscape(txt$alias),
-      texEscape(txt$name)
+      texEscape(txt$description),
+      texEscape(txt$alias_toc),
+      texEscape(txt$name_toc)
     )
   }
 

R/reformatResults.R

@@ -203,6 +203,9 @@ reformatVar <- function(var, banner_name, theme, proportions, banner_info, latex
     if (dt %in% "totals_row") {
       if (proportions) {
         data_tmp <- colSums(data)
+        if (theme$enforce_onehundred) {
+          data_tmp[data_tmp < 100 | data_tmp > 100] = 100
+        }
       } else {
         data_tmp <-  getItemData(
           data = var$crosstabs[[banner_name]],

R/tex.R

@@ -34,16 +34,12 @@ texEscape <- function(string) {
   if (is.null(string)) {
     return("")
   }
-  # TODO: Change to one line rather than nested gsubs(), yuck.
-  gsub("^ *(\\[)", "\\\\hspace\\*\\{0in\\}\\1", # Trim leading whitespace
-       gsub("([#$%&_])", "\\\\\\1", # Escape special characters
-            gsub("[\u00A3\uFFE1]", "\\\\pounds", # Handle GBP currency
-                 gsub("\n", " \\\\newline ", # Turn newlines into \newlines
-                      string
-                 )
-            )
-       )
-  )
+
+  string <- gsub("^ *(\\[)", "\\\\hspace\\*\\{0in\\}\\1", string)
+  string <- gsub("([#$%&_])", "\\\\\\1", string)
+  string <- gsub("[\u00A3\uFFE1]", "\\\\pounds", string)
+  string <- gsub("\n", " \\\\newline ", string)
+  string
 }
 
 #' Font Size

R/theme.R

@@ -209,6 +209,7 @@ themeDefaultExcel <- function(
     digits_numeric = 2,
     one_per_sheet = FALSE,
     latex_round_percentages = TRUE,
+    enforce_onehundred = FALSE,
     latex_headtext = "",
     latex_foottext = "",
     latex_table_align = "r",
@@ -261,6 +262,7 @@ themeDefaultLatex <- function(font = getOption("font", default = "helvet"),
     excel_freeze_column = 0,
     excel_orientation = "portrait",
     latex_round_percentages = FALSE,
+    enforce_onehundred = FALSE,
     latex_headtext = "",
     latex_foottext = "",
     latex_table_align = "r",
@@ -417,6 +419,7 @@ validators_to_use <- list(
   latex_multirowheaderlines = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
   latex_round_percentages = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
   latex_round_percentages_exception = c(class = "character", len = NA, missing = TRUE),
+  enforce_onehundred = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
   latex_table_align = c(class = "character", len = 1, missing = FALSE, default = ""),
   logo = list(missing = TRUE, include = list("file", "startRow", "startCol",
                                              "width", "height", "units", "dpi")),
@@ -461,7 +464,7 @@ theme_validator <- function(theme) {
     "format_var_alias", "format_var_description", "format_var_filtertext",
     "format_var_name", "format_var_subname", "format_weighted_n", "halign",
     "latex_foottext", "latex_headtext", "latex_max_lines_for_tabular",
-    "latex_multirowheaderlines", "latex_round_percentages",
+    "latex_multirowheaderlines", "latex_round_percentages", "enforce_onehundred",
     "latex_round_percentages_exception", "latex_table_align", "logo",
     "one_per_sheet","valign", "pagebreak_in_banner")
 

R/writeCodeBookLatex.R

@@ -17,13 +17,16 @@
 #' @param appendix Should categorical questions with greater than 20 categories be put in an apppendix? Defaults to TRUE.
 #' @param logo Default to NULL. A character string one of: yougov or ygblue. Includes the logo automatically. Also accepts a path to a logo file.
 #' @param position Defaults to NULL. Identifies the position of the table on the page. Accepts "c", "l", or "r". Default position is left aligned tables.
+#' @param path The path to place .tex and .pdf files.
+#' @param logging Leave logs in the working directory, defaults to FALSE
 #' @param ... Additional arguments passed to \link[kableExtra]{kable_styling} Unused.
+#'
 #' @export
 writeCodeBookLatex <- function(
   ds, url = NULL, rmd = TRUE, pdf = TRUE, title = NULL, subtitle = NULL,
   table_of_contents = FALSE, sample_desc = NULL, field_period = NULL,
   preamble = NULL, suppress_zero_counts = FALSE, appendix = TRUE, logo = NULL,
-  position = NULL,
+  position = NULL, path = NULL, logging = FALSE,
   ...) {
 
   options("crunchtabs.codebook.suppress.zeros" = suppress_zero_counts)
@@ -194,10 +197,31 @@ writeCodeBookLatex <- function(
     # codebook <- gsub("\\begin{longtabu}", paste0("\\begin{longtabu}", replacement), codebook, fixed = TRUE)
   }
 
-  write(codebook, gsub(" ","-", paste0(name(ds), ".tex")))
+
+  # Issue 185 - Specify a path
+  if (!is.null(path)) {
+    basename <- gsub(" ","-", name(ds))
+    texname <- paste0(path,"/", basename, ".tex")
+    pdfname <- paste0(path, "/", basename, ".pdf")
+  } else {
+    basename <- gsub(" ","-", name(ds))
+    texname <- paste0(basename, ".tex")
+    pdfname <- paste0(basename, ".pdf")
+  }
+
+  write(codebook, texname)
 
   if (pdf) {
-    tinytex::pdflatex(gsub(" ","-", paste0(name(ds), ".tex")))
-    file.open(paste0(gsub(" ","-", paste0(name(ds))), ".pdf"))
+    tinytex::pdflatex(texname, pdf_file = pdfname)
+
+    if (!logging) {
+      files <- list.files(path = getwd())
+      files <- grep("out$|log$|aux$", files, value = TRUE)
+      if (length(files)) {
+        file.remove(file.path(getwd(), files))
+      }
+    }
+
+    file.open(pdfname)
   }
 }

R/writeLatex.R

@@ -20,7 +20,7 @@
 #' @param moe An optional numeric margin of error.
 #' @param append_text An optional character string that, if supplied, will be appended after
 #' the final table. Useful for adding in disclosure information. Defaults to an empty string.
-#' @param logging add log messages
+#' @param logging Leave logs in the working directory, defaults to FALSE
 #'
 #' @return If \code{returndata} is set to \code{TRUE}, a processed data that was used to produce
 #' the report is returned. Otherwise \code{NULL} is returned.
@@ -65,7 +65,7 @@ writeLatex <- function(data_summary, theme = themeDefaultLatex(),
   }
 
   if (!is.null(append_text)) {
-    append_text <- paste0("\\vspace{0.5in}\n\n", append_text)
+    append_text <- paste0("\\vspace{0.5in}\n\n", paste0(append_text, collapse = "\n"))
   }
 
   # Now assemble the .tex document

README.md

@@ -78,11 +78,9 @@ writeExcel(ct_summary, filename = "output") # output.xlsx will be written
 
 ## Generating Codebooks 
 
-To generate a codebook, you must install the development version of kableExtra
+Generating a codebook is easy! 
 
 ```
-devtools::install_github("haozhu233/kableExtra")
-
 # library(crunchtabs)
 # login()
 

dev-misc/codebook_visual_integration.R

@@ -84,3 +84,21 @@ writeCodeBookLatex(ds)
 
 ds <- loadDataset("Forked Huffpost")
 writeCodeBookLatex(ds, logo = "yougov", table_of_contents = T)
+
+ds = loadDataset("https://app.crunch.io/dataset/2375608c53694a899213fe7daf7e2d1e/")
+
+writeCodeBookLatex(
+  ds,
+  url = "https://app.crunch.io/dataset/2375608c53694a899213fe7daf7e2d1e/",
+  table_of_contents = TRUE, logo = "yougov",
+  pdf = TRUE
+)
+
+
+ds <- loadDataset("BEB Fork STAN0138")
+weight(ds) <- NULL
+writeCodeBookLatex(ds, table_of_contents = TRUE, suppress_zero_counts = TRUE,
+                   title = 'Presidential Election Study - August 2020',
+                   field_period = 'August 24-31, 2020',
+                   sample_desc = paste0(nrow(ds), ' Adults'),
+                   rmd=FALSE)

tests/testthat/test-codeBookItemTxtDescription.R

@@ -51,4 +51,12 @@ with_api_fixture("fixtures-1-2-5", {
     )
   })
 
+  test_that("codebookItemTxtDescription notes", {
+    res = with_mock(codeBookItemTxtDescription(ds$q1), "crunch::notes" = function(x) "This is a note!")
+    expect_equal(
+      res,
+      "\\vskip 0.10in\nWhat is your favorite pet?\n\\addcontentsline{lot}{table}{\\parbox{1.8in}{\\ttfamily{q1}} Pet}\n\\vskip 0.10in\n\\emph{This is a note!}\n\\vskip 0.10in")
+
+  })
+
 })

tests/testthat/test-codeBookItemTxtHeader.R

@@ -51,4 +51,9 @@ with_api_fixture("fixtures-1-2-5", {
     )
 
   })
+
+
+  # Test for texEscape()
+
+
 })

tests/testthat/test-tex.R

@@ -0,0 +1,37 @@
+context("underline")
+
+test_that("underline works as expected", {
+  r <- underline("Hello!")
+  expect_equal(r, "\\underline{Hello!}")
+})
+
+context("applyLatexStyle")
+
+test_that("underline or underline2", {
+  item <- "Hello!"
+  item_theme <- list()
+  item_theme$decoration <- "underline"
+  r <- applyLatexStyle(item, item_theme)
+  expect_equal(r, "\\underline{Hello!}")
+})
+
+test_that("Warning on hex color", {
+  item <- "Hello!"
+  item_theme <- list()
+  item_theme$font_color <- "#000000"
+  expect_warning(applyLatexStyle(item, item_theme), "In Latex, colors must be color names not hex codes")
+})
+
+test_that("Color application", {
+  item <- "Hello!"
+  item_theme <- list()
+  item_theme$font_color <- "blue"
+  r <- applyLatexStyle(item, item_theme)
+  expect_equal(r, "\\color{blue}Hello!")
+})
+
+context("validLatexFont")
+
+test_that("Warning on missing font set to helvet", {
+  expect_warning(validLatexFont("notafont"), "It has been set to")
+})