Merge pull request #164 from Crunch-io/issue_152

Issue 152
Crunch-io · Jul 20, 2020 · 828f0bb · 828f0bb
2 parents 403f405 + 1bd2784
commit 828f0bb
Show file tree

Hide file tree

Showing 8 changed files with 354 additions and 61 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -14,4 +14,5 @@
 ^docs$
 ^pkgdown$
 ^\.github$
-research
+^research$
+^dev-misc$
diff --git a/R/codeBookSummary.R b/R/codeBookSummary.R
@@ -106,7 +106,12 @@ codeBookSummary.MultipleResponseVariable <- function(x, ...) {
   for (i in 1:rws) {
     # We merge on a complete frame because responses
     # can be missing from categories
-    responses_adj <- merge(frame, responses[[i]], all.x = TRUE)$n
+    responses_adj <- merge(
+      frame,
+      responses[[i]],
+      all.x = TRUE,
+      sort = FALSE)$n # merge unintuitive sort behaviour!
+
     m[i,3:(cols + 2)] <- responses_adj
   }
 

diff --git a/R/codebookLatex.R b/R/codebookLatex.R
@@ -13,8 +13,6 @@ codeBookItemTxtHeader <- function(x, ...)  {
 
   tex = "\\textbf{%s}\\hfill\\textbf{\\ttfamily{%s}}"
 
-
-
   sprintf(
     tex,
     fixUnderscore(txt$name),
@@ -42,16 +40,18 @@ codeBookItemTxtDescription <- function(x, ...) {
   txt$notes <- crunch::notes(x)
 
   if (txt$notes != "") {
-    tex = "\\vskip 0.10in\n\\addcontentsline{lot}{table}{%s}\n\\vskip 0.10in\n\\emph{%s}"
+    tex = "\\vskip 0.10in\n%s\n\\addcontentsline{lot}{table}{%s}\n\\vskip 0.10in\n\\emph{%s}\n\\vskip 0.10in"
     tex = sprintf(
       tex,
       txt$description,
+      txt$description,
       txt$notes
     )
   } else {
-    tex = "\\vskip 0.10in\n\\addcontentsline{lot}{table}{%s}"
+    tex = "\\vskip 0.10in\n%s\n\\addcontentsline{lot}{table}{%s}\n\\vskip 0.10in"
     tex = sprintf(
       tex,
+      txt$description,
       txt$description
     )
   }
@@ -92,55 +92,51 @@ codeBookItemBody.CategoricalVariable <- function(x, ...) {
   k = codeBookSummary(x)
   k = k[order(as.numeric(k[,1])),] %>% as.data.frame(stringsAsFactors = F)
 
+
   names(k) = c("Code", "Label", "Count")
 
   if (nrow(k) > 20) {
     # If we have more than 20 hide counts
     # only show codes. Use multiple tables
     # row-wise
 
-    une_duex_trois <- suppressWarnings(matrix(1:nrow(k), nrow = 3))
+    une_duex_trois <- suppressWarnings(matrix(1:nrow(k), nrow = 2))
     une_duex_trois[which(duplicated(as.vector(une_duex_trois)))] <- NA
     une_duex_trois <- t(une_duex_trois)
-    cbind(
+    k = cbind(
       k[une_duex_trois[,1],],
       k[une_duex_trois[,2],],
-      k[une_duex_trois[,3],]
+      stringsAsFactors = FALSE
     )
 
+    rownames(k) = NULL
+    names(k) = rep(c("Code", "Label", "Count"),2)
+    k[is.na(k)] = " "
 
-    num_splits = round(nrow(k) / 5, 0)
-    splits = split(1:nrow(k), sort(rep_len(1:num_splits, nrow(k))))
-
-    k = lapply(splits, function(x) k[x,c("Code", "Label")])
-    k = lapply(k, function(x) { rownames(x) = NULL; return(x) })
 
-    j = list()
-
-    for (i in seq(1, length(k), 2)) {
-      j[[as.character(i)]] = tryCatch({
-        cbind(k[[i]], k[[i + 1]])
-      },
-      error = function(e) k[[i]])
-    }
-
-    alignment = c("c","l", "c", "l")
+    alignment = "clcclc"
 
     knitr::kable(
-      j, "latex", booktabs = TRUE, align = alignment) %>%
-      kable_styling(full_width = TRUE)
-
+      k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment, linesep = "") %>%
+      kableExtra::kable_styling(full_width = TRUE) %>%
+      kableExtra::column_spec(c(2,5), width = "1.75in") %>%
+      # {gsub(
+      #   "\\midrule",
+      #   "\\cmidrule{1-3}\n\\cmidrule{4-6}", .,
+      #   fixed = TRUE) } %>%
+      {gsub(
+        "\\addlinespace",
+        "", .,
+        fixed = TRUE) }
 
   } else {
     alignment = c("c","l", "r")
     kableExtra::kable(
-      k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment) %>%
+      k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment, linesep = "") %>%
       kable_styling_defaults(...) %>%
       kableExtra::column_spec(c(1,3), width = "1in")
   }
 
-
-
 }
 
 #' @describeIn codeBookItemBody Creates item body for CategoricalArrayVariable
@@ -152,26 +148,59 @@ codeBookItemBody.CategoricalArrayVariable <- function(x, ...) {
   names(k) = c("Variable", "Label", names(k)[-c(1,2)])
   header_width = round(nchar(names(k)[-c(1,2)])*0.08,2)
 
-  space_remaining = 5.5 - col_one - sum(header_width)
-  col_two <- 1.5
-
-
+  space_remaining = 6.0 - col_one - sum(header_width)*1.5
+  message(name(x), space_remaining)
   k$Variable <- kableExtra::cell_spec(k$Variable, "latex", monospace = TRUE)
 
   ln = ncol(k) - 2
 
-  kableExtra::kable(
-    k,
-    "latex",
-    booktabs = TRUE,
-    longtable = TRUE,
-    align = alignment,
-    escape = F) %>%
-    # kable_styling_defaults(...) %>%
-    kableExtra::column_spec(1, width = paste0(col_one, "in")) %>%
-    kableExtra::column_spec(2, width = paste0(col_two, "in")) %>%
-    # column_spec(c(3:ncol(k)), width = paste0(header_width[-1], "in")) %>%
-    kableExtra::add_header_above(c("", "", "Codes" = ln))
+  if ((sum(nchar(k$Label) > 45) < 2) & (space_remaining >= 1.5)) {
+
+    kableExtra::kable(
+      k,
+      "latex",
+      booktabs = TRUE,
+      longtable = F,
+      align = alignment,
+      escape = F,
+      linesep = " ") %>%
+      # kable_styling_defaults(...) %>%
+      kableExtra::column_spec(column = 1, width = paste0(col_one, "in")) %>%
+      kableExtra::column_spec(column = 2, width = paste0(col_two, "in")) %>%
+      kableExtra::add_header_above(c("", "", "Codes" = ln))
+
+
+  } else {
+
+    k_adj <- dplyr::select(k, names(k)[!names(k) %in% "Label"])
+
+    label_table <- kableExtra::kable(
+      k[1:2],
+      "latex",
+      booktabs = TRUE,
+      longtable = FALSE,
+      align = "ll",
+      escape = F, linesep = " ") %>%
+      kableExtra::column_spec(column = 1, width = paste0(col_one, "in")) %>%
+      kableExtra::column_spec(column = 2, width = paste0(6 - col_one, "in"))
+
+    counts_table <- kableExtra::kable(
+      k_adj,
+      "latex",
+      booktabs = TRUE,
+      longtable = F,
+      align = alignment,
+      escape = F, linesep = "") %>%
+      # kable_styling_defaults(...) %>%
+      kableExtra::column_spec(column = 1, width = paste0(col_one, "in")) %>%
+      # kableExtra::column_spec(2, width = paste0(col_two, "in")) %>%
+      kableExtra::add_header_above(c(" ", "Codes" = ncol(k_adj) - 1))
+
+
+    list(label_table, "\\vspace{2em}", counts_table, "\\vspace{2em}")
+  }
+
+
 }
 
 #' @describeIn codeBookItemBody Creates item body for MultipleResponseVariable
@@ -183,7 +212,7 @@ codeBookItemBody.MultipleResponseVariable <- codeBookItemBody.CategoricalArrayVa
 codeBookItemBody.DatetimeVariable <- function(x, ...) {
   k = codeBookSummary(x)
   alignment <- c("c", "l")
-  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment) %>%
+  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment, linesep = "") %>%
     kable_styling_defaults(...) %>%
     kableExtra::column_spec(1, width = "1in")
 }
@@ -193,7 +222,7 @@ codeBookItemBody.DatetimeVariable <- function(x, ...) {
 codeBookItemBody.NumericVariable <- function(x, ...) {
   k = codeBookSummary(x)
   alignment <- c("c", "l")
-  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment) %>%
+  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment, linesep = "") %>%
     kable_styling_defaults(...) %>%
     kableExtra::column_spec(1, width = "1in")
 }
@@ -203,7 +232,7 @@ codeBookItemBody.NumericVariable <- function(x, ...) {
 codeBookItemBody.TextVariable <- function(x, ...) {
   k = codeBookSummary(x)
   alignment <- c("c","l")
-  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment) %>%
+  kableExtra::kable(k, "latex", booktabs = TRUE, longtable = TRUE, align = alignment, linesep = "") %>%
     kable_styling_defaults(...) %>%
     kableExtra::column_spec(1, width = "1in")
 }
@@ -259,7 +288,7 @@ noBreaks <- function(tex) {
     stop("Sorry, noBreaks only works on a string of length 1")
 
   paste0(
-    "\\begin{absolutelynopagebreak}",
+    "\\begin{absolutelynopagebreak}\n",
     tex, "",
     "\\end{absolutelynopagebreak}",
     collapse = "\n"

diff --git a/R/tabBooks.R b/R/tabBooks.R
@@ -47,7 +47,8 @@ tabBooks <- function(dataset, vars, banner, weight = NULL, topline = FALSE) {
     subnames <- if (is_array_type) getSubNames(crunch_cube)
     var_cats <- categories(cube_variable[[1]])
     inserts <- if (is_cat_type) {
-      crunch:::collateCats(crunch::transforms(cube_variable)[[1]]$insertions, var_cats)
+      collateCats <- get("collateCats", envir = asNamespace("crunch"), inherits = FALSE)
+      collateCats(crunch::transforms(cube_variable)[[1]]$insertions, var_cats)
     }
     show_mean_median <- is_cat_type && any(!is.na(values(na.omit(var_cats))))
 

diff --git a/R/writeCodeBookLatex.R b/R/writeCodeBookLatex.R
@@ -11,11 +11,12 @@
 #' of the report Defaults to \code{FALSE}.
 #' @param sample_desc A character string describing the sample.
 #' @param field_period A character string describing the field period.
+#' @param preamble A latex string, usually a methodological statement.
 #' @param ... Additional arguments. 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, ...) {
+  field_period = NULL, preamble = NULL, ...) {
 
   # Initialize Codebook Latex ----
   codebook <- readLines(system.file(
@@ -62,17 +63,38 @@ writeCodeBookLatex <- function(ds, url = NULL, rmd = TRUE, pdf = TRUE, title = N
 
   for (nm in nms) {
     items[[nm]] = list()
-    items[[nm]]$txtHeader <- codeBookItemTxtHeader(ds[[nm]]) # tex
-    items[[nm]]$txtDescription <- codeBookItemTxtDescription(ds[[nm]]) # tex
-    items[[nm]]$body <- codeBookItemBody(ds[[nm]]) # A kable
+    items[[nm]]$header <- noBreaks(paste0(
+      codeBookItemTxtHeader(ds[[nm]]),
+      codeBookItemTxtDescription(ds[[nm]]),
+      collapse = "\n"
+      )
+    )
+
+    body <- codeBookItemBody(ds[[nm]]) # A kable
+
+    if (is.list(body)) {
+      items[[nm]]$body <- noBreaks(paste0(unlist(body), collapse = "\n"))
+    } else {
+      items[[nm]]$body <- body
+    }
+
   }
 
   # Assign Codebook ----
+
+  codebook[codebook == "<<methods>>"] <- ifelse(!is.null(preamble), preamble, "")
+  codebook[codebook == "<<toc>>"] <- ifelse(table_of_contents, "\\listoftables\n\\clearpage", "")
   codebook[codebook == "<<fh>>"] <- fh
   codebook[codebook == "<<sample_description>>"] <- sample_description
 
   # Non breaking blocks
-  items = lapply(items, function(x) noBreaks(paste0(unlist(x), collapse = "\n")))
+  items = lapply(items, function(x) {
+    if (any(grepl("longtabu", x))) {
+      return(x)
+    } else {
+      noBreaks(paste0(unlist(x), collapse = "\n"))
+    }
+  })
 
   codebook[codebook == "<<body>>"] <- paste0(unname(unlist(items)), collapse = "\n")
 

diff --git a/tests/testthat/codebook_visual_integration.R → dev-misc/codebook_visual_integration.R b/tests/testthat/codebook_visual_integration.R → dev-misc/codebook_visual_integration.R
@@ -49,6 +49,7 @@ ct = crosstabs(ds)
 
 writeLatex(ct, theme = localTheme, pdf = TRUE, title = "A", subtitle = "B")
 writeExcel(ct, theme = localTheme)
+
 # DFN
 
 ds = loadDataset("https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/")
@@ -57,15 +58,20 @@ writeCodeBook(ds, url = "https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70
 # DFN Long question
 
 ds = loadDataset("https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/")
-writeCodeBook(ds[1], url = "https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/")
+writeCodeBookLatex(ds[1:4], url = "https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/")
 
 
 # CBS
 
 ds = loadDataset("CBS News Poll - April 10, 2020 - FOR TESTING")
 writeCodeBook(ds)
 
-# Huff
+# Codebook Latex
 
-ds = loadDataset("HuffPost Daily Survey #20200331")
-writeCodeBook(ds)
+
+
+ds = loadDataset("CBS News Poll - April 10, 2020 - FOR TESTING")
+writeCodeBookLatex(ds, table_of_contents = TRUE, sample_desc = "US Voting Adults")
+
+ds = loadDataset("https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/")
+writeCodeBookLatex(ds, url = "https://app.crunch.io/dataset/10c3c3cbd28b420aaa4976b70caba851/", table_of_contents = TRUE)