Include code to inject custom summary stats into codebookr file

- Related to issue # 53.
- If this commit is accepted, the code for injecting custom summary stats will be added into the codebookr file and some style issues will be fixed.

R/cb_custom_summary_stats_to_ft.R

@@ -2,7 +2,8 @@
 #'
 #' @param df Data frame of summary statistics
 #' @param ... Other stuff
-#' @param col_width Set the width of the column that will appear in the Word table
+#' @param col_width Set the width of the column that will appear in the Word
+#' table
 #'
 #' @return Flextable object
 #' @importFrom dplyr %>%
@@ -16,16 +17,15 @@ cb_custom_summary_stats_to_ft <- function(df, col_width = 1.3, ...) {
     flextable::fontsize(size = 11, part = "all") %>%
     # Center align text
     flextable::align(align = "center", part = "all") %>%
-    # Bold header
-    # bold(part = "header") %>%
     # Set the column width
     flextable::width(width = col_width) %>%
 
     # Format borders
     # Remove default borders
     flextable::border_remove() %>%
     # Add light gray top border
-    flextable::hline_top(border = officer::fp_border(color = "gray80", width = 1), part = "all")
+    flextable::hline_top(border = officer::fp_border(color = "gray80",
+                                                     width = 1), part = "all")
 
   # Return formatted flextable
   ft

R/codebook.R

@@ -41,7 +41,14 @@
 #'   values that are sensitive or may be used to identify individual people
 #'   (e.g., names, addresses, etc.) and the individual values for that column
 #'   should not appear in the codebook.
-#'
+#' @param custom_summary_stats_list A list of named data frames with each data
+#' frame containing user-prepared summary statistics for a column. Each column
+#' that has a corresponding data frame in this list will have a table containing
+#' user-prepared statistics in the codebook instead of generated summary
+#' statistics.
+#' @param omit_na_columns A list of variable names. Variables in this list will
+#' have all missing values omitted and 'Missing' will not be included as a
+#' category for each of these variables in the resulting codebook file.
 #' @return An rdocx object that can be printed to a Word document
 #' @importFrom dplyr %>%
 #' @import haven
@@ -61,7 +68,12 @@
 #' }
 codebook <- function(
     df, title = NA, subtitle = NA, description = NA,
-    keep_blank_attributes = FALSE, no_summary_stats = NULL) {
+    keep_blank_attributes = FALSE, no_summary_stats = NULL,
+    custom_summary_stats_list = NULL,
+    omit_na_columns = NULL) {
+
+  # Create character vector of column names in custom_summary_stats_list
+  custom_summary_stats_cols <- names(custom_summary_stats_list)
 
   # ===========================================================================
   # Checks
@@ -183,11 +195,13 @@ codebook <- function(
 
     # Get column attributes
     table_var_attributes <- df %>%
-      cb_get_col_attributes(col_nms[[i]], keep_blank_attributes = keep_blank_attributes)
+      cb_get_col_attributes(col_nms[[i]], keep_blank_attributes =
+                              keep_blank_attributes)
     # Iss 10: Add column number to the column attributes table
     table_var_attributes$Column <- i
     table_var_attributes$Column[-1] <- NA
-    table_var_attributes <- table_var_attributes[, c("Column", "Attribute", "value")]
+    table_var_attributes <- table_var_attributes[, c("Column", "Attribute",
+                                                     "value")]
     # Make into a flextable and format
     table_var_attributes <- table_var_attributes %>%
       flextable::flextable() %>%
@@ -199,18 +213,36 @@ codebook <- function(
 
     # Get summary statistics
     # Iss 22. Add option to prevent summary stats table for selected columns
-    if (!(col_nms[[i]] %in% no_summary_stats)) {
-      summary_stats <- df %>%
-        cb_add_summary_stats(col_nms[[i]]) %>%
-        cb_summary_stats_to_ft()
-
-      # Add summary statistics flextable to the codebook object
-      temp_doc <- temp_doc %>%
-        flextable::body_add_flextable(summary_stats)
+    if (!(col_nms[[i]] %in% no_summary_stats) & !(col_nms[[i]] %in%
+                                                  custom_summary_stats_cols)) {
+      # Add option to remove missing values for each column
+      if (!(col_nms[[i]] %in% no_summary_stats) & !(col_nms[[i]] %in%
+                                                    custom_summary_stats_cols) &
+          col_nms[[i]] %in% omit_na_columns){
+        summary_stats <- df %>% select(col_nms[[i]]) %>% drop_na(.) %>%
+          cb_add_summary_stats(col_nms[[i]]) %>%
+          cb_summary_stats_to_ft()
+      }
+      else{
+        summary_stats <- df %>%
+          cb_add_summary_stats(col_nms[[i]]) %>%
+          cb_summary_stats_to_ft()
+      }
+    }
+
+    # Use arbitrary summary stats instead of generated summary stats for
+    # specified columns
+    else if (col_nms[[i]] %in% custom_summary_stats_cols){
+      summary_stats <- custom_summary_stats_list[[paste0(col_nms[[i]])]] %>%
+        cb_custom_summary_stats_to_ft()
     }
+    # Add summary statistics flextable to the codebook object
+    temp_doc <- temp_doc %>%
+      flextable::body_add_flextable(summary_stats)
+
 
     # Create temporary Word document from the temporary rdocx object
-    # Put it in one of the tempory files created above the loop.
+    # Put it in one of the temporary files created above the loop.
     print(temp_doc, target = tempfiles[i])
   }
 
@@ -229,8 +261,26 @@ codebook <- function(
 }
 
 # For testing
+
+
 # data(study)
 # devtools::load_all()
-# codebook(study)
-# print(codebook(study), "test.docx")
-# print(codebook(study, no_summary_stats = "address"), "test.docx")
+#
+# # Test named list of data frames
+# days <- data.frame(y1 = c(1, 2, 3),
+#                    y2 = c(4, 5, 6))
+# height <- data.frame(y1 = c(3, 2, 1),
+#                      y2 = c(6, 5, 4))
+# list_test <- list(days, height)
+# names(list_test) <- c("days","height")
+#
+#
+# test_codebook <- codebook(
+#   df = study,
+#   title = "Test study",
+#   description = "Testing! Testing",
+#   custom_summary_stats_list = list_test,
+#   omit_na_columns = c("sex")
+# )
+#
+# print(test_codebook, "test.docx")