R/sigtables.R

In adviceas/adviceverse: Tools for Data and Survey Analysis, Advice A/S

#
#   Install Package:           'Cmd + Shift + B'
#   Check Package:             'Cmd + Shift + E'
#   Test Package:              'Cmd + Shift + T'
#
#   Update documentation:       devtools::document()
#

#' Make cross tables (expss-based) with significance test.
#'
#' @param df Data frame of survey responses (acccepts Haven labels).
#' @param crosstablevars Vector of variable names for cross tabs
#' @param weight_var Name of variable defining the weight (string)
#' @return List of cross tables to print
create_sig_tables <- function(df,
                              crosstablevars = NULL,
                              weight_var = NULL) {

  # Convert Haven-style labels to expss-style labels
  datasetSPSS <- expss::add_labelled_class(df, remove_classes = c("haven_labelled", "spss_labelled"))

  # Fast and stupid implementation of the required list type
  # TODO: Rewrite this part
  # TODO: Take tidyselect helpers

  listlist <- list()
  listlist[[1]] <- expss::total()

  if (!is.null(crosstablevars)) {

    for (i in 1:length(crosstablevars)) {
      listlist[[i + 1]] <- datasetSPSS[[crosstablevars[[i]]]]
    }

  }

  # Weigthing (quick implementation)

  if (!is.null(weight_var)) weight_var <- datasetSPSS[[weight_var]]

  # Create list of cross tables

  tablelist <- pbapply::pblapply(datasetSPSS,
                                 function(varname) {

                                   # TODO: Make nicer conditions
                                   # TODO: Use has_label, has_labels, print_label etc. instead
                                   # TODO: Format tables: decimal seperator, significance sign etc.

                                   vallabs <- attr(varname, "labels", exact = TRUE)
                                   varlab <- attr(varname, "label", exact = TRUE)

                                   if (!is.null(varlab)) {

                                     # Binomial test for categorical proportions

                                     if (!is.null(vallabs) | is.factor(varname)) {

                                       expss::cro_cpct(varname,
                                                       expss::calc(datasetSPSS, listlist),
                                                       weight = weight_var) %>%
                                         expss::significance_cpct() %>%
                                         expss::set_caption(varlab)

                                       # t-test for numerical variables

                                     } else if (is.numeric(varname)) {

                                       expss::cro_mean_sd_n(varname, expss::calc(datasetSPSS, listlist)) %>%
                                         expss::significance_means() %>%
                                         expss::set_caption(varlab)

                                     }

                                   }

                                 }
  )

  # Quick formatting fix: Remove variable labels from first column column ("|").

  for (each in names(tablelist)) {

    tablelist[[each]][["row_labels"]] <- stringr::str_replace_all(tablelist[[each]][["row_labels"]], "\\n", "") # Fix: Remove all newline escapes in labels
    tablelist[[each]][["row_labels"]] <- stringr::str_replace(tablelist[[each]][["row_labels"]], "(.*?)[|]", "")

  }

  return(tablelist)

}


#' Write cross tables from \code{create_sig_tables} to Excel (.xlsx)
#'
#' @param expsstablelist List of cross tables made by the package 'expss'.
#' @param crosstablevars Vector of variable names for cross tabs
#' @param theme E.g. 'expss' (standard), 'raw' (faster), 'advice' (to come)
#' @return List of cross tables to print
write_sig_tables <- function(expsstablelist,
                             filename,
                             theme = "expss") {

  # TODO: Check filename

  message("Tabeller skrives til Excel. Lav en kop kaffe...")

  workbook <- openxlsx::createWorkbook()
  sheet <- openxlsx::addWorksheet(workbook, "Krydstabeller")

  # TODO: Add title/header

  # 'xl_write_list_progress_wrapper' replaces the default 'xl_write.list' method in the expss package.
  # 'xl_write' is SLOW and NOT efficient why a progress bar is added.

  if (theme == "expss") {

    adviceverse:::.xl_write_list_progress_wrapper(expsstablelist,
                                                  workbook,
                                                  sheet,
                                                  col_symbols_to_remove = "#", # Default expss settings
                                                  row_symbols_to_remove = "#", # Default expss settings
                                                  other_col_labels_formats = list("#" = openxlsx::createStyle(textDecoration = "bold")), # Default expss settings
                                                  other_cols_formats = list("#" = openxlsx::createStyle(textDecoration = "bold")) # Default expss settings
    )

  } else if (theme == "advice") {

    # TODO: Add Advice styling to the tables.

    stop("Theme in the making.")

  } else if (theme == "raw") {

    adviceverse:::.xl_write_list_progress_wrapper(expsstablelist,
                                                  workbook,
                                                  sheet)

  } else {

    stop("No such theme.")

  }

  message("Gemmer Excel-fil...")
  openxlsx::saveWorkbook(workbook, filename, overwrite = TRUE) # Update: In April 2020 still not updated to use zipr() instead of zip()
  message("\nFærdig.")

}