Merge pull request #162 from Crunch-io/develop

Release 1.2.8

.Rbuildignore

@@ -14,3 +14,5 @@
 ^docs$
 ^pkgdown$
 ^\.github$
+^research$
+^dev-misc$

.github/workflows/ci.yml

@@ -10,12 +10,14 @@ jobs:
     steps:
     - uses: actions/checkout@v2
     - name: Add kableExtra
-      run: Rscript -e 'install.packages("kableExtra")'
+      run: Rscript -e 'devtools::install_github("haozhu233/kableExtra")'
+    - name: CRAN crunch
+      run: Rscript -e 'install.packages("crunch")'
     - name: Build
       run: R CMD build --no-build-vignettes --no-manual .
     - name: Check
       run: |
-        R CMD check --no-vignettes --no-manual crunchtabs_*.tar.gz
+        R CMD check --no-vignettes --ignore-vignettes --no-manual crunchtabs_*.tar.gz
     - name: Coverage
       run: |
         Rscript -e 'covr::codecov(token = "${{ secrets.CODECOV_TOKEN }}")'

DESCRIPTION

@@ -15,22 +15,26 @@ 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.3.0),
-    crunch,
-    kableExtra
+    R (>= 3.5.0),
+    crunch
 Imports:
+    kableExtra,
+    rlang,
     openxlsx,
     digest,
     methods,
-    tinytex
+    tinytex,
+    magrittr
 Suggests:
     covr,
     httptest (>= 2.0.0),
     jsonlite,
     knitr,
     rmarkdown,
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    kableExtra (>= 1.1.0.9000)
 RoxygenNote: 7.1.0
 VignetteBuilder: knitr
 Encoding: UTF-8

NAMESPACE

@@ -40,8 +40,10 @@ export(codeBookItemTxtDescription)
 export(codeBookItemTxtHeader)
 export(codeBookSummary)
 export(crosstabs)
+export(default_yg_logo)
 export(getName)
 export(kable_strip_rules)
+export(kable_strip_toprules)
 export(prepareExtraSummary)
 export(sortAliases)
 export(surveyDuration)
@@ -52,7 +54,7 @@ export(themeHuffPoToplines)
 export(themeNew)
 export(themeUKPolitical)
 export(with_api_fixture)
-export(writeCodeBook)
+export(writeCodeBookLatex)
 export(writeExcel)
 export(writeLatex)
 import(crunch)
@@ -82,11 +84,16 @@ importFrom(crunch,values)
 importFrom(crunch,weight)
 importFrom(crunch,weightVariables)
 importFrom(digest,digest)
+importFrom(kableExtra,column_spec)
+importFrom(kableExtra,kable_styling)
+importFrom(magrittr,`%>%`)
 importFrom(methods,is)
+importFrom(rlang,.data)
 importFrom(stats,ave)
 importFrom(stats,median)
 importFrom(stats,pnorm)
 importFrom(stats,quantile)
 importFrom(stats,weighted.mean)
 importFrom(utils,installed.packages)
 importFrom(utils,modifyList)
+importFrom(utils,type.convert)

NEWS.md

@@ -1,7 +1,19 @@
+## crunchtabs 1.2.8
+
+- Documentation for generating codebooks (#180)
+- Tests and fixes for broken tests (#176)
+- Spacing and font type for codebooks (#178)
+- Additional refinements for codebooks such as title, subtitle, sample description (#152)
+- Fixes for warnings in existing code (#158)
+- Bugfix for logo assignment in excel (#155)
+- Added pagebreak_in_banner which stops multi-banner crosstabs from being spread across pages using "to be continued" (#161, #169)
+- Major rework of codebooks (#165, #172, #170, #160, #159)
+
 ## crunchtabs 1.2.7
 
-- Initial support for latex codebooks 
-- 
+- Initial support for latex codebooks (#122 and #152)
+- Adjustments for categorical array presentation
+- Fixes for problems related to logos (#155)
 
 ## crunchtabs 1.2.6
 

R/codeBookSummary.R

@@ -24,6 +24,8 @@ codeBookSummary.default <- function(x, ...) {
 }
 
 #' @describeIn codeBookSummary Prepares a codeBookSummary data.frame for a CategoricalVariable
+#' @importFrom utils type.convert
+#' @param multiple Is this a MultipleResponse or CategoricalArray variable?
 #' @export
 codeBookSummary.CategoricalVariable <- function(x, multiple = FALSE, ...) {
   cats <- crunch::categories(x)
@@ -69,18 +71,28 @@ codeBookSummary.CategoricalVariable <- function(x, multiple = FALSE, ...) {
   smry <- data.frame(crunch::table(x, useNA = "ifany"))
   names(smry) <- c("name", "n")
 
-  res <- merge(l, smry)
+  res <- merge(l, smry, sort = FALSE)
 
   if (multiple) {
-    res[with(res, order(id)),]
+    res = res[with(res, order(id)),]
   } else {
-    res = matrix(c(
+    res = as.data.frame(
+      matrix(c(
       res$id,
       res$name,
       res$n
-    ), ncol = 3)
+    ), ncol = 3),
+    stringsAsFactors = FALSE
+  )
+    names(res) <- c("id","name", "n")
   }
 
+  if (getOption("crunchtabs.codebook.suppress.zeros", default = FALSE)) {
+    warning('Zero count categoricals are supressed by options')
+    res <- res[res$n != "0",]
+  }
+
+  res
 }
 
 #' @describeIn codeBookSummary Prepares a codeBookSummary data.frame for a MultipleResponseVariable
@@ -103,7 +115,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
   }
 
@@ -121,24 +138,27 @@ codeBookSummary.CategoricalArrayVariable <- function(x, ...) codeBookSummary.Mul
 #' @describeIn codeBookSummary Prepares a codeBookSummary data.frame for a NumericVariable
 #' @export
 codeBookSummary.NumericVariable <- function(x, ...) {
+  mu <- round(mean(x, na.rm = T), 2)
+  std <- round(sd(x, na.rm = TRUE))
   minima <- round(min(x, na.rm = T), 2)
   maxima <- round(max(x, na.rm = T), 2)
   missings <- sum(is.na(as.vector(x)))
-
-  type_row <- c("Type", "Numeric")
-  range_row <- c("Range", paste0("[", minima,", ", maxima,"]"))
-
-  if (missings > 0) {
-    missings_row <- c("Missing", missings)
-    r <- rbind(
-      type_row, missings_row, range_row
-    )
-  } else {
-    r <- rbind(
-      type_row, range_row
-    )
-  }
-
+  n <- length(is.na(as.vector(x)))
+
+  #type_row <- c("Type", "Numeric")
+  #range_row <- c("Range", paste0("[", minima,", ", maxima,"]"))
+
+  r <- as.data.frame(
+    matrix(c(
+      mu,
+      std,
+      minima,
+      maxima,
+      n - missings,
+      missings), nrow = 1)
+  )
+
+  names(r) <- c("Mean", "SD", "Min", "Max","n", "Missing")
   rownames(r) <- NULL
   r
 
@@ -148,11 +168,26 @@ codeBookSummary.NumericVariable <- function(x, ...) {
 #' @export
 codeBookSummary.TextVariable <- function(x, ...) {
 
-  filled <- sum(as.vector(x) != "" | !is.na(as.vector(x)), na.rm = TRUE)
-  type_row <- c("Type", "Text")
-  filled <- c("Filled", filled)
-
-  r <- rbind(type_row, filled)
+  filled_verbs <- as.vector(x)
+  filled_verbs <- filled_verbs[!is.na(filled_verbs)]
+  filled_verbs <- filled_verbs[!filled_verbs %in% c("", "__NA__")]
+  #verbsamp <- sample(filled_verbs, 5, replace = TRUE)
+  #verbsamp <- paste0(substr(verbsamp, start = 1, stop = 27),
+  #       "...",
+  #       collapse = ", "
+  #)
+  filled <- length(filled_verbs)
+  missing <- length(as.vector(x)) - filled
+
+  r <- as.data.frame(
+    matrix(c(
+      filled,
+      missing,
+      ifelse(filled == 0, 0, max(nchar(filled_verbs)))
+      ), nrow = 1, ncol = 3), stringsAsFactors = FALSE
+  )
+
+  names(r) <- c("Filled","Missing", "Max Length")
   rownames(r) <- NULL
   r
 }
@@ -164,19 +199,16 @@ codeBookSummary.DatetimeVariable <- function(x, ...) {
   maxima <- max(x, na.rm = T)
   missings <- sum(is.na(as.vector(x)))
 
-  type_row <- c("Type", "Datetime")
-  range_row <- c("Range", paste0("[", minima,", ", maxima,"]"))
+  filled <- sum(!is.na(as.vector(x)))
+  range_row <- c(paste0("[", minima,", ", maxima,"]"))
+
+  r = data.frame(
+    Filled = filled,
+    Missing = missings,
+    Range = range_row,
+    stringsAsFactors = FALSE
+  )
 
-  if (missings > 0) {
-    missings_row <- c("Missing", missings)
-    r <- rbind(
-      type_row, missings_row, range_row
-    )
-  } else {
-    r <- rbind(
-      type_row, range_row
-    )
-  }
 
   rownames(r) <- NULL
   r