Updates

Crunch-io · Jun 5, 2020 · 32c0d3e · 32c0d3e
1 parent 3d03e6f
commit 32c0d3e
Show file tree

Hide file tree

Showing 164 changed files with 126 additions and 31,458 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -17,7 +17,8 @@ BugReports: https://github.com/Crunch-io/crunchtabs/issues
 License: LGPL (>= 3)
 Depends:
     R (>= 3.3.0),
-    crunch
+    crunch,
+    kableExtra
 Imports:
     openxlsx,
     digest,

diff --git a/NAMESPACE b/NAMESPACE
@@ -4,12 +4,19 @@ S3method(calculateIfLongtable,CrossTabVar)
 S3method(calculateIfLongtable,ToplineCategoricalArray)
 S3method(calculateIfLongtable,ToplineVar)
 S3method(calculateIfLongtable,default)
-S3method(codebookItem,CategoricalArrayVariable)
-S3method(codebookItem,CategoricalVariable)
-S3method(codebookItem,DatetimeVariable)
-S3method(codebookItem,MultipleResponseVariable)
-S3method(codebookItem,NumericVariable)
-S3method(codebookItem,TextVariable)
+S3method(codeBookItem,CategoricalArrayVariable)
+S3method(codeBookItem,CategoricalVariable)
+S3method(codeBookItem,DatetimeVariable)
+S3method(codeBookItem,MultipleResponseVariable)
+S3method(codeBookItem,NumericVariable)
+S3method(codeBookItem,TextVariable)
+S3method(codeBookSummary,CategoricalArrayVariable)
+S3method(codeBookSummary,CategoricalVariable)
+S3method(codeBookSummary,DatetimeVariable)
+S3method(codeBookSummary,MultipleResponseVariable)
+S3method(codeBookSummary,NumericVariable)
+S3method(codeBookSummary,TextVariable)
+S3method(codeBookSummary,default)
 S3method(getName,BannerVar)
 S3method(getName,CrossTabVar)
 S3method(getName,CrunchCube)
@@ -27,10 +34,15 @@ S3method(tableHeader,ToplineCategoricalArray)
 S3method(tableHeader,ToplineVar)
 S3method(tableHeader,default)
 export(banner)
-export(codebookItem)
-export(codebookItemTxt)
+export(bcodeBookItemBody)
+export(bcodeBookItemTxtDescription)
+export(bwriteCodeBook)
+export(codeBookItem)
+export(codeBookItemTxt)
+export(codeBookSummary)
 export(crosstabs)
 export(getName)
+export(kable_strip_rules)
 export(prepareExtraSummary)
 export(sortAliases)
 export(surveyDuration)
@@ -40,7 +52,7 @@ export(themeHuffPoCrosstabs)
 export(themeHuffPoToplines)
 export(themeNew)
 export(themeUKPolitical)
-export(writeCodebook)
+export(with_api_fixture)
 export(writeExcel)
 export(writeLatex)
 import(crunch)

diff --git a/R/codebook.R b/R/codebook.R
@@ -16,12 +16,12 @@
 #' @param x An object of one of the types listed
 #' @param ... Additional arguents passed to codebookItem methods
 #' @export
-codebookItem <- function(x, ...) {
+codeBookItem <- function(x, ...) {
   UseMethod("codebookItem", x)
 }
 
 #' @rdname codebookItem
-codebookItem.default <- function(x) {
+codeBookItem.default <- function(x) {
   wrong_class_error(x, c("CategoricalVariable", "CategoricalArrayVariable", "MultipleResponseVariable", "TextVariable", "NumericVariable", "DatetimeVariable"), "codebookItem")
 }
 
@@ -38,8 +38,13 @@ codebookItem.default <- function(x) {
 #' @md
 #' @importFrom glue glue
 #' @export
-codebookItemTxt <- function(x) {
-  txt <- x@tuple@body
+codeBookItemTxt <- function(x) {
+  txt <- list()
+  txt$name <- crunch::name(x)
+  txt$alias <- crunch::alias(x)
+  txt$description <- crunch::description(x)
+  txt$notes <- crunch::notes(x)
+
 
   if (txt$description == "") {
     warning(txt$alias, " is missing a description.")
@@ -61,52 +66,35 @@ codebookItemTxt <- function(x) {
   )
 
   if (txt$notes != "") {
-    notes <- glue(
+    notestxt <- glue(
       "\\begin{tabularx}{\\textwidth}{lllr} ",
        "& Notes &  <<<txt$notes>>> &  \\\\ ",
        "& & & & \\\\ ",
       "\\end{tabularx} "
       , .open = "<<<", .close = ">>>", .sep = "\n"
     )
   } else {
-    notes <- ""
+    notestxt <- ""
   }
 
   paste(
     alias_name,
     question,
-    notes,
+    notestxt,
     sep = "\n\n"
   )
 }
 
-#'
-codebookItemSubVars <- function(x) {
-  sv <- subvariables(x)
-  als <- unname(unlist(lapply(sv@index, getElement, "alias")))
-  resp <- unname(unlist(lapply(sv@index, getElement, "name")))
-  sv <- data.frame(`Sub Alias` = als, Name = resp)
-  sv_responses <- categories(x)
-
-  list(
-    key = sv,
-    key2 = setNames(sv_responses, c("Response", "Value"))
-  )
-
-}
-
-
-
 #' @describeIn codebookItem Prepares a codebookItem for a CategoricalVariable
 #' @export
-codebookItem.CategoricalVariable <- function(x) {
+codeBookItem.CategoricalVariable <- function(x) {
   header <- codebookItemTxt(x)
-  res <- as.data.frame(x)
+  res <- codeBookSummary(x)
 
-  top = "\\begin{tabularx}{\\textwidth}{llcXrr} \n"
-  bottom = "\n\\end{tabularx}"
+  top <- "\\begin{tabularx}{\\textwidth}{llcXrr} \n"
+  bottom <- "\n\\end{tabularx}"
 
-  l = 1:nrow(res)
+  l <- 1:nrow(res)
   for (i in 1:nrow(res)) {
     l[i] <- glue(
       '
@@ -129,25 +117,35 @@ codebookItem.CategoricalVariable <- function(x) {
 
 #' @describeIn codebookItem Prepares a codebookitem for a CategoricalArrayVariable
 #' @export
-codebookItem.CategoricalArrayVariable <- function(x) {
-  header = codebookItemTxt(x)
-  subvars = codebookItemSubVars(x)
+codeBookItem.CategoricalArrayVariable <- function(x) {
+  header <- codebookItemTxt(x)
+  r <- codeBookSummary(x)
+
+
+
+  topalignment <- paste0(c("{",
+    rep("l",2),
+    "X",
+    rep("c", ncol(r) - 2)), collapse = ""
+  )
+  top <- "\\begin{tabularx}{\\textwidth}{%s}"
+  top <- sprintf(top, topalignment)
+  bottom <- "\\end{tabularx}"
+
+
 }
 
 #' @describeIn codebookItem Prepares a codebookitem for a MultipleResponseVariable
 #' @export
-codebookItem.MultipleResponseVariable <- function(x) {
-  header = codebookItemTxt(x)
-
-}
+codeBookItem.MultipleResponseVariable <- function(x) codebookItem.CategoricalArrayVariable(x)
 
 #' @describeIn codebookItem Prepares a codebookitem for a NumericVariable
 #' @export
-codebookItem.NumericVariable <- function(x) {
-  header = codebookItemTxt(x)
+codeBookItem.NumericVariable <- function(x) {
+  header <- codebookItemTxt(x)
 
-  top = "\\begin{tabularx}{\\textwidth}{llXr}"
-  bottom = "\\end{tabularx}"
+  top <- "\\begin{tabularx}{\\textwidth}{llXr}"
+  bottom <- "\\end{tabularx}"
 
   minima <- min(x, na.rm = T)
   maxima <- max(x, na.rm = T)
@@ -160,7 +158,6 @@ codebookItem.NumericVariable <- function(x) {
     missings_row <- glue("& Missing & <<<missings>>> & \\\\",
                          .open = "<<<", .close = ">>>")
 
-
   paste0(
     header,
     top,
@@ -178,83 +175,10 @@ codebookItem.NumericVariable <- function(x) {
 
 #' @describeIn codebookItem Prepares a codebookitem for a TextVariable
 #' @export
-codebookItem.TextVariable <- function(x) {
-  header = codebookItemTxt(x)
+codeBookItem.TextVariable <- function(x) {
+  header <- codebookItemTxt(x)
 }
 
 #' @describeIn codebookItem Prepares a codebookitem for a DatetimeVariable
 #' @export
-codebookItem.DatetimeVariable <- codebookItem.NumericVariable
-
-#' Generate LaTeX CodeBooks
-#'
-#' \code{writeCodebook} produces publication-quality LaTeX reports
-#'
-#' @param ds A crunch dataset
-#'
-#' @param ... Additional arguments passed to writeLatx
-#'
-#' @importFrom utils installed.packages
-#' @export
-writeCodebook <- function(...) {
-  writeLatex(...)
-}
-
-#' Categorical Variable to data.frame
-#'
-#' Manipulate categorical into a results object without hitting the tabBook
-#' endpoint. For the purpose of creating a codebookItem.
-#'
-#' @param x A CategoricalVariable from a crunch \link[crunch]{loadDataset}
-#' @param ... Ignored
-as.data.frame.CategoricalVariable <- function(x, ...) {
-  cats <- crunch::categories(x)
-  responses <- suppressWarnings(do.call(rbind, cats@.Data))
-  l <- list()
-  for (i in 1:nrow(responses)) {
-
-    if (is.null(responses[i, ]$numeric_value)) {
-      # CategoricalVariable within MultipleResponseVariable
-      if (responses[i, ]$name %in% c("not selected", "selected")) {
-        responses[i,]$numeric_value <- ifelse(
-          responses[i, ]$name == "selected",
-          1L,
-          2L
-        )
-      } else {
-        responses[i,]$numeric_value <- NA_integer_
-      }
-    }
-
-    l[[i]] <- as.data.frame(
-      matrix(
-        unlist(responses[i,]),
-        ncol = dim(responses)[2]
-      )
-    )
-  }
-
-  l <- do.call(rbind, l)
-  # CategoricalVariable
-  if (ncol(l) == 4) {
-    names(l) <- c("id", "missing", "name", "value")
-  }
-
-  # CategoricalVariable within MultipleResponseVariable
-  if (ncol(l) == 5) {
-    names(l) <- c("id", "missing", "name", "value", "drop")
-
-  }
-
-  for (i in 1:ncol(l)) { l[[i]] <- type.convert(l[[i]], as.is = T) }
-
-  smry <- data.frame(crunch::table(x, useNA = "ifany"))
-  names(smry) <- c("name", "n")
-
-  res <- merge(l, smry)
-  res[with(res, order(value)),]
-}
-
-as.data.frame.MultipleResponseVariable <- function(x, ...) {
-  responses = lapply(x, as.data.frame.CategoricalVariable)
-}
+codeBookItem.DatetimeVariable <- codeBookItem.NumericVariable
diff --git a/R/utils.R b/R/utils.R
@@ -161,6 +161,7 @@ collapse_items <- function(x, and = FALSE, or = FALSE, quotes = FALSE){
 #'
 #' @param fixture_path A full path to fixtures
 #' @param expr An expression to be run within the api fixture
+#' @export
 with_api_fixture <- function(fixture_path, expr) {
   with(
     crunch::temp.options(