From b68e372027fe5664e4efc75e4aded0ad447346c6 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Tue, 23 Mar 2021 21:45:18 -0500 Subject: [PATCH 1/7] Fixes for tracking report edge cases --- R/asToplineCategoricalArray.R | 89 +++++++++++++++++++++-------------- 1 file changed, 54 insertions(+), 35 deletions(-) diff --git a/R/asToplineCategoricalArray.R b/R/asToplineCategoricalArray.R index 7d4316d..c2c2693 100644 --- a/R/asToplineCategoricalArray.R +++ b/R/asToplineCategoricalArray.R @@ -28,36 +28,6 @@ as.ToplineCategoricalArray <- function( ) } - categoryFill <- function(clist) { - cbindFill <- function(x, y) { - r <- merge(x, y, by = "row.names", all = TRUE, sort = FALSE) - rownames(r) <- r$Row.names - r$Row.names <- NULL - r - } - - addPos <- function(x) { - x[,1] <- 1:nrow(x) - x - } - - r <- lapply(clist, addPos) - r <- do.call(rbind, r) - r <- data.frame(nm = names(r[,1]), pos = r[,1]) - r <- unique(r) - rownames(r) <- r$nm - r$nm <- NULL - - m <- Reduce(function(x,y) suppressWarnings(cbindFill(x,y)), clist) - m <- suppressWarnings(merge(m, r, by = "row.names", all = TRUE, sort = FALSE)) - m <- m[with(m, order(pos)),] - - rownames(m) <- m$Row.names - m$Row.names <- NULL - m$pos <- NULL - as.matrix(m) - } - counts <- obj$crosstabs$Results$`___total___`$counts second_label <- attr(counts, "dimnames")[[1]] @@ -137,11 +107,13 @@ catArrayToCategoricals <- function(questions, question_alias, labels) { # Pull out our data for (i in seq_len(nrow(guide))) { - guide$value[i] <- questions[[ - guide$label[i] - ]]$crosstabs$Results$`___total___`$proportions[ - guide$cat[i], guide$statement[i] - ] + guide$value[i] <- tryCatch({ + questions[[ + guide$label[i] + ]]$crosstabs$Results$`___total___`$proportions[ + guide$cat[i], guide$statement[i] + ] + }, error = function(e) NA_real_) } # Pre allocate @@ -175,3 +147,50 @@ catArrayToCategoricals <- function(questions, question_alias, labels) { names(l) <- nms return(l) } + +#' Merge two data.frames by rownames +#' +#' This function is designed to cbind via rownames where +#' the rownames may not match and then fix the result so that +#' it can be further merged to another data.frame. +#' @param x A data.frame +#' @param y A data.frame +cbindFill <- function(x, y) { + r <- merge(x, y, by = "row.names", all = TRUE, sort = FALSE) + rownames(r) <- r$Row.names + r$Row.names <- NULL + r +} + +#' Add position +#' +#' A small utility function to add position to a matrix +#' @param x A matrix +addPos <- function(x) { + x[,1] <- 1:nrow(x) + x +} + +#' Column Bind Unequal Matrices +#' +#' This function takes a list of matrices and binds them together into +#' a single frame. Accounts for missing or unequal rows, by rowname. +#' +#' @param clist A list of matrices with rownames +categoryFill <- function(clist) { + r <- lapply(clist, addPos) + r <- do.call(rbind, r) + r <- data.frame(nm = names(r[,1]), pos = r[,1]) + r <- r[!duplicated(r$nm),] + rownames(r) <- r$nm + r$nm <- NULL + + m <- Reduce(function(x,y) suppressWarnings(cbindFill(x,y)), clist) + m <- suppressWarnings(merge(m, r, by = "row.names", all = TRUE, sort = FALSE)) + m <- m[with(m, order(pos)),] + + rownames(m) <- m$Row.names + m$Row.names <- NULL + m$pos <- NULL + as.matrix(m) +} From bc0b4dcbdf62e78a13eeca8cca2c0ed2b69c0359 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Thu, 25 Mar 2021 13:37:13 -0500 Subject: [PATCH 2/7] Fix broken theme tex Rd --- R/theme.R | 4 -- man/addPos.Rd | 14 ++++++ man/categoryFill.Rd | 15 +++++++ man/cbindFill.Rd | 18 ++++++++ man/themeNew.Rd | 103 +++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 148 insertions(+), 6 deletions(-) create mode 100644 man/addPos.Rd create mode 100644 man/categoryFill.Rd create mode 100644 man/cbindFill.Rd diff --git a/R/theme.R b/R/theme.R index e213e80..160ca76 100644 --- a/R/theme.R +++ b/R/theme.R @@ -3,7 +3,6 @@ #' `themeNew` produces themes for `writeExcel` or `writeLatex`. #' #' @section Theme Arguments: -# nolint start #' \describe{ #' \item{digits}{A numeric. How many digits should the data be rounded to? (In Excel, this is excel styling.) Defaults to 0.} #' \item{digits_numeric}{A numeric. How many digits should continuous variable data be rounded to? (In Latex, , this is Latex styling.) Defaults to 2.} @@ -82,7 +81,6 @@ #' \item{border_color}{In Excel, an optional color. The border color of the relevant cells.} #' \item{border_left}{In Excel, an optional logical. Should there be a border on the left of the relevant cells? } #' \item{border_right}{In Excel, an optional logical. Should there be a border on the right of the relevant cells? } -#' \item{border_style}{In Excel, an optional character. The style of the border of the relevant #' \item{border_style}{In Excel, an optional character. The style of the border of the relevant cells. Valid options are: "dashDot", "dashDotDot", "dashed", "dotted", "double", "hair", "medium", "mediumDashDot", "mediumDashDotDot", "mediumDashed", "none", "slantDashDot", "thick", and "thin".} #' \item{border_top}{In Excel, an optional logical. Should there be a border on the top of the relevant cells? } #' \item{decoration}{An optional character vector. Text decorations to be applied to relevant cells. Valid options are: "bold", "italic", "strikeout", "underline", and "underline2".} @@ -153,8 +151,6 @@ themeNew <- function(..., default_theme = themeDefaultExcel()) { } } - # nolint end - theme <- modifyList(default_theme, dots, keep.null = TRUE) theme <- theme[union(names(dots), names(default_theme))] diff --git a/man/addPos.Rd b/man/addPos.Rd new file mode 100644 index 0000000..cc4433a --- /dev/null +++ b/man/addPos.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/asToplineCategoricalArray.R +\name{addPos} +\alias{addPos} +\title{Add position} +\usage{ +addPos(x) +} +\arguments{ +\item{x}{A matrix} +} +\description{ +A small utility function to add position to a matrix +} diff --git a/man/categoryFill.Rd b/man/categoryFill.Rd new file mode 100644 index 0000000..05b099d --- /dev/null +++ b/man/categoryFill.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/asToplineCategoricalArray.R +\name{categoryFill} +\alias{categoryFill} +\title{Column Bind Unequal Matrices} +\usage{ +categoryFill(clist) +} +\arguments{ +\item{clist}{A list of matrices with rownames} +} +\description{ +This function takes a list of matrices and binds them together into +a single frame. Accounts for missing or unequal rows, by rowname. +} diff --git a/man/cbindFill.Rd b/man/cbindFill.Rd new file mode 100644 index 0000000..8fbd413 --- /dev/null +++ b/man/cbindFill.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/asToplineCategoricalArray.R +\name{cbindFill} +\alias{cbindFill} +\title{Merge two data.frames by rownames} +\usage{ +cbindFill(x, y) +} +\arguments{ +\item{x}{A data.frame} + +\item{y}{A data.frame} +} +\description{ +This function is designed to cbind via rownames where +the rownames may not match and then fix the result so that +it can be further merged to another data.frame. +} diff --git a/man/themeNew.Rd b/man/themeNew.Rd index a68628b..4fae1df 100644 --- a/man/themeNew.Rd +++ b/man/themeNew.Rd @@ -14,7 +14,106 @@ themeNew(..., default_theme = themeDefaultExcel()) \description{ `themeNew` produces themes for `writeExcel` or `writeLatex`. } -\section{}{ -NA +\section{Theme Arguments}{ + +\describe{ +\item{digits}{A numeric. How many digits should the data be rounded to? (In Excel, this is excel styling.) Defaults to 0.} +\item{digits_numeric}{A numeric. How many digits should continuous variable data be rounded to? (In Latex, , this is Latex styling.) Defaults to 2.} +\item{digits_final}{In Excel, an optional numeric. How many digits should the data be rounded to before being added to Excel?} +\item{excel_footer}{In Excel, an optional character vector of length 3. The footer text of the file.} +\item{excel_freeze_column}{In Excel, a numeric. What column should be the last frozen column? Defaults to 1.} +\item{excel_header}{In Excel, An optional character vector of length 3. The header text of the file.} +\item{excel_orientation}{In Excel, a character. The orientation of the page if printed. Valid options are: "landscape", and "portrait". Defaults to "landscape".} +\item{excel_percent_sign}{In Excel, a logical. Should "\%" be pasted in each cell that contains a proportion? Defaults to FALSE.} +\item{excel_show_grid_lines}{In Excel, a logical. Should the default grid lines of the file show? Defaults to FALSE.} +\item{excel_table_border}{In Excel, an optional list. The formatting of the border around each downbreak. Includes: border_color, and border_style.} +\item{font}{An optional character. The font to be used.} +\item{font_color}{In Excel, an optional color. The color of the font.} +\item{font_size}{An optional numeric. The size of the font.} +\item{format_banner_categories}{In Excel, a list. How the banner/crossbreak response options should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_banner_names}{In Excel, an optional list. How the banner/crossbreak variable names should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_banner_split}{In Excel, an optional list. How should the banner variables be separated? Includes: border_color, border_style} +\itemize{ + \item{\code{empty_col} In Excel, a logical. Should there be an empty column to separate banner variables? Defaults to FALSE.} +} +\item{format_headers}{An optional list. How headers should be formatted. If `NULL` headers will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_label_column}{In Excel, a list. How the labels column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text. In LaTeX, allows you to set col_width only, in inches of the crosstab stub globally.} +Includes: +\itemize{ + \item{\code{col_width} A numeric. Width of the label column. Defaults to 40.} + \item{\code{extend_borders} In Excel, a logical. Should the borders created for certain rows extend to the label column? Defaults to FALSE.} +} +\item{format_label_column_exceptions}{In LaTeX, a character vector of columns widths, specified in inches and named after the question alias whose stub they would effect.} +\item{format_means}{An optional list. How means should be formatted. If `NULL` means will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.} +\item{format_medians}{An optional list. How medians should be formatted. If `NULL` medians will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.} +\item{format_min_base}{An optional list. If a minimum base size is desired, how variables that fall below that base size should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text} +Includes: +\itemize{ + \item{\code{mask} An optional character to be used to mark cells with base below the min_base.} + \item{\code{min_base} An optional numeric. The minimum acceptable base size for a question.} +} +\item{format_subtitle}{An optional list. How the table subtitle should be formatted. If `NULL` the table subtitle will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_subtotals}{An optional list. How subtotals should be formatted. If `NULL` subtotals will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_title}{An optional list. How the table title should be formatted. If `NULL` the table title will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_totals_column}{In Excel, a list. How the totals column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.} +\item{format_totals_row}{An optional list. How total rows should be formatted. If `NULL` total rows will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.} +\item{format_var_alias}{An optional list. How downbreak variable aliases should be formatted. If `NULL` downbreak variable aliases will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_q_number, valign, and wrap_text.} +\item{format_var_description}{An optional list. How downbreak variable descriptions should be formatted. If `NULL` downbreak variable descriptions will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.} +\item{format_var_filtertext}{An optional list. How downbreak variable filtertext/notes should be formatted. If `NULL` downbreak variable filtertext/notes will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.} +\item{format_var_name}{An optional list. How downbreak variable names should be formatted. If `NULL` downbreak variable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.} +\item{format_var_subname}{An optional list. How downbreak subvariable names should be formatted. If `NULL` downbreak subvariable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, valign, and wrap_text.} +\item{format_unweighted_n}{An optional list. How unweighted Ns should be formatted. If `NULL` unweighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.} +\item{format_weighted_n}{An optional list. How weighted Ns should be formatted. If `NULL` weighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.} +\item{latex_foottext}{In Latex, a character. A character string indicating what text should be placed at the top of continuation tables. 'tbc' is a shortcut for 'to be continued.'} +\item{latex_headtext}{In Latex, a character. A character string indicating what text should be placed at the bottom of continuation tables. 'tbc' is a shortcut for 'to be continued.'} +\item{latex_max_lines_for_tabular}{In Latex, an integer. What is the maximum number of lines a table can be before it is converted to a longtable? Currently only works on toplines. Defaults to 0.} +\item{latex_multirowheaderlines}{In Latex, a logical. Should banners allow multi-row headlines? Defaults to FALSE.} +\item{latex_round_percentages}{In Latex, a logical. In Latex, should percentages be recalculated so they do not exceed 100\% where necessary? Defaults to FALSE.} +\item{latex_round_percentages_exception}{In Latex, an optional character. A list of variable aliases that should have the opposite behaviour of that specified in latex_round_percentages.} +\item{latex_table_align}{In Latex, a character. A character string indicating what the table alignment should be. Defaults to 'r'.} +\item{latex_flip_grids}{In Latex, a logical. Categorical arrays will be flipped so that there rows are now transposed to columns.} +\item{latex_flip_specific_grids}{An optional vector of aliases whose presentation should be transposed} +\item{logo}{An optional list. Information about the logo to be included in the tables.} +Includes: +\itemize{ + \item{\code{file} The path to a PNG file that should be used for the logo. Include the extension (.png) for an Excel theme. Exclude the extension for a Latex theme } + \item{\code{dpi} In Excel, a numeric. The image resolution used for conversion between units. Defaults to 300.} + \item{\code{height} In Excel, a numeric. The height of the logo. Defaults to 2.} + \item{\code{width} In Excel, a numeric. The width of the logo. Defaults to 4.} + \item{\code{startCol} In Excel, a numeric. The column coordinate of upper left corner of the logo. Defaults to 1.} + \item{\code{startRow} In Excel, a numeric. The row coordinate of upper left corner of the logo. Defaults to 1.} + \item{\code{units} In Excel, a character. Units of width and height. Valid options are: "cm", "in", and "px." Defaults to "in".} +} +\item{one_per_sheet}{A logical. Should each question be on its own sheet/page? Defaults to FALSE.} +} + +\subsection{Subarguments}{ +\describe{ +\item{background_color}{In Excel, an optional color. Cell background color.} +\item{border_bottom}{In Excel, an optional logical. Should there be a border on the bottom? } +\item{border_color}{In Excel, an optional color. The border color of the relevant cells.} +\item{border_left}{In Excel, an optional logical. Should there be a border on the left of the relevant cells? } +\item{border_right}{In Excel, an optional logical. Should there be a border on the right of the relevant cells? } +\item{border_style}{In Excel, an optional character. The style of the border of the relevant cells. Valid options are: "dashDot", "dashDotDot", "dashed", "dotted", "double", "hair", "medium", "mediumDashDot", "mediumDashDotDot", "mediumDashed", "none", "slantDashDot", "thick", and "thin".} +\item{border_top}{In Excel, an optional logical. Should there be a border on the top of the relevant cells? } +\item{decoration}{An optional character vector. Text decorations to be applied to relevant cells. Valid options are: "bold", "italic", "strikeout", "underline", and "underline2".} +\item{font}{An optional character. The font to be used.} +\item{font_color}{In Excel, an optional color. The color of the font.} +\item{font_size}{An optional numeric. The size of the font.} +\item{halign}{In Excel, an optional character. The horizontal alignment of the text. Valid options are: "center", "left", and "right".} +\item{include_alias}{A logical. Should the alias of the variable be included with the other information? Defaults to FALSE.} +\item{include_q_number}{A logical. Should the question number be included with the other information? Defaults to FALSE.} +\item{latex_add_parenthesis}{In Latex, a logical. Should parenthesis be added surrounding the values? Defaults to FALSE.} +\item{latex_adjust}{In Latex, an optional character. How should the values be adjusted? Can be missing.} +\item{name}{A character. The name to be used for the relevant row(s).} +\item{position_bottom}{In Excel, a logical. Should the relevant row(s) be at the bottom of each table? Defaults to TRUE.} +\item{position_fixed}{In Excel, a logical. Should the relevant row(s) be fixed at the top of the file with the banner? Defaults to FALSE.} +\item{position_top}{In Excel, a logical. Should should the relevant row(s) be at the top of each table? Defaults to FALSE.} +\item{repeat_for_subs}{A logical. Should the information be repeated for each subvariable? Defaults to TRUE.} +\item{pagebreak_in_banner}{A logical. Allow a banner to be broken midway across pages. Defaults to TRUE. If FALSE, Pushes the page breaking banner sub-table to the next page similar to manually using clearpage} +\item{valign}{In Excel, an optional character. The vertical alignment of the text. Valid options are: "bottom", "center", and "top".} +\item{wrap_text}{In Excel, an optional logical. Should the text wrap if it extends beyond the width of the cell? Defaults to TRUE.} +} +} } From fe530e829c674f5f563f6b0a4e11a1b4a0f30039 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Thu, 25 Mar 2021 20:27:57 -0500 Subject: [PATCH 3/7] Adding date asked to single availability questions in tracking reports --- R/trackingReports.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/trackingReports.R b/R/trackingReports.R index a94d001..f1aa99f 100644 --- a/R/trackingReports.R +++ b/R/trackingReports.R @@ -76,6 +76,13 @@ trackingReport <- function(dataset_list, vars, labels = NULL, weight = NULL, sho # The single case if (length(results_available) == 1) { rebuilt_results$results[[v]]$availability <- "single" + if(rebuilt_results$results[[v]]$notes == "") { + rebuilt_results$results[[v]]$notes <- paste0("Asked in ", labels[results_available]) + } else { + rebuilt_results$results[[v]]$notes <- paste0( + rebuilt_results$results[[v]]$notes, + " (Asked in ", labels[results_available], ")") + } } else { rebuilt_results$results[[v]]$availability <- "general" } From 79972782cfdf3676c397c889d0f44c124d2e6e23 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Fri, 26 Mar 2021 00:30:32 -0500 Subject: [PATCH 4/7] Cheeky naming collision when researchers version their aliases --- R/asToplineCategoricalArray.R | 9 ++++++++- R/trackingReports.R | 10 +++++----- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/R/asToplineCategoricalArray.R b/R/asToplineCategoricalArray.R index c2c2693..01a6eeb 100644 --- a/R/asToplineCategoricalArray.R +++ b/R/asToplineCategoricalArray.R @@ -81,7 +81,14 @@ catArrayToCategoricals <- function(questions, question_alias, labels) { labels <- paste0("Wave ", seq_along(questions)) } - nms <- paste0(question_alias, seq_along(statements)) + # Collisions can occur so we randomize names because people version aliases sometimes + # votefactors with sub vars + votefactors2 :/ + randNames <- function(n) { + a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE)) + paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE)) + } + + nms <- paste0(question_alias, randNames(length(statements))) # Create list of objects to fill in, one for each sub statement of the # multiple response group diff --git a/R/trackingReports.R b/R/trackingReports.R index f1aa99f..1a48fc4 100644 --- a/R/trackingReports.R +++ b/R/trackingReports.R @@ -31,7 +31,8 @@ trackingReport <- function(dataset_list, vars, labels = NULL, weight = NULL, sho rebuilt_results <- list() class(rebuilt_results) <- c("Toplines", "CrunchTabs") rebuilt_results$results <- lapply(vars, function(x) NULL) - rebuilt_results$metadata <- tabs[[1]]$metadata + has_meta <- which(!unlist(lapply(lapply(tabs, function(x) x$metadata), is.null)))[1] + rebuilt_results$metadata <- tabs[[has_meta]]$metadata names(rebuilt_results$results) <- vars rebuilt_results$banner <- NULL @@ -62,12 +63,11 @@ trackingReport <- function(dataset_list, vars, labels = NULL, weight = NULL, sho # For each alias, we set an attribute that identifies it's availability - # across all the datasets: "all", "partial", and "single" - # - "all" means it is available in every dataset - # - "partial" means it is available in only some datasets + # across all the datasets: "general", and "single" + # - "general" means it is available in only some datasets # - "single" means it is available in exactly one dataset - # Because we use subsetting at the list level, "all" and "partial" + # Because we use subsetting at the list level, "general" and "single" # would follow a typical path that labeling was adjusted appropriately # for presentation in the resulting pdf "single" should act as a simple # passthrough where no additional formatting or manipulation takes place From b5bddbc35046722bc8cdd1b9f683658ab2564593 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Mon, 29 Mar 2021 10:59:59 -0500 Subject: [PATCH 5/7] Fixing tests --- R/asToplineCategoricalArray.R | 10 +++++----- tests/testthat/test-catArrayToCategoricals.R | 2 +- tests/testthat/test-tracking_report.R | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/asToplineCategoricalArray.R b/R/asToplineCategoricalArray.R index 01a6eeb..d76e536 100644 --- a/R/asToplineCategoricalArray.R +++ b/R/asToplineCategoricalArray.R @@ -83,12 +83,12 @@ catArrayToCategoricals <- function(questions, question_alias, labels) { # Collisions can occur so we randomize names because people version aliases sometimes # votefactors with sub vars + votefactors2 :/ - randNames <- function(n) { - a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE)) - paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE)) - } + # randNames <- function(n) { + # a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE)) + # paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE)) + # } - nms <- paste0(question_alias, randNames(length(statements))) + nms <- paste0(question_alias, "_", seq_along(statements)) # Create list of objects to fill in, one for each sub statement of the # multiple response group diff --git a/tests/testthat/test-catArrayToCategoricals.R b/tests/testthat/test-catArrayToCategoricals.R index e00cdac..4577f9a 100644 --- a/tests/testthat/test-catArrayToCategoricals.R +++ b/tests/testthat/test-catArrayToCategoricals.R @@ -5,7 +5,7 @@ test_that("Binds categorical arrays appropriately", { res <- catArrayToCategoricals(questions, "petloc", labels = NULL) expect_equal( - res$petloc1$crosstabs$Results$`___total___`$proportions, + res$petloc_1$crosstabs$Results$`___total___`$proportions, structure(c( 0.421875000002028, 0.484374999997521, 0.0937500000004507, 0.5, 0.333333333333333, 0.166666666666667, 0.321428571427136, diff --git a/tests/testthat/test-tracking_report.R b/tests/testthat/test-tracking_report.R index 6bfdcdd..15fda43 100644 --- a/tests/testthat/test-tracking_report.R +++ b/tests/testthat/test-tracking_report.R @@ -34,9 +34,9 @@ test_that("tracking report with cat arrays", { # mockery::stub(trackingReport, "trackingReport_tabs", questions) res <- suppressWarnings(trackingReport(dataset_list, vars = "petloc")) - expect_named(res$results, c("petloc1", "petloc2")) + expect_named(res$results, c("petloc_1", "petloc_2")) expect_equal( - res$results$petloc1$crosstabs$Results$`___total___`$proportions, + res$results$petloc_1$crosstabs$Results$`___total___`$proportions, structure(c( 0.421875000002028, 0.484374999997521, 0.0937500000004507, 0.5, 0.333333333333333, 0.166666666666667, 0.321428571427136, From 4bcdc82f6a41d3fd32e2770146ca3f5ae4004d33 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Mon, 29 Mar 2021 12:16:14 -0500 Subject: [PATCH 6/7] Adding new tests for code cov --- R/trackingReports.R | 60 +++++++++++-------- .../test-trackingDeclareAvailability.R | 55 +++++++++++++++++ 2 files changed, 90 insertions(+), 25 deletions(-) create mode 100644 tests/testthat/test-trackingDeclareAvailability.R diff --git a/R/trackingReports.R b/R/trackingReports.R index 1a48fc4..f2d3d2b 100644 --- a/R/trackingReports.R +++ b/R/trackingReports.R @@ -60,32 +60,10 @@ trackingReport <- function(dataset_list, vars, labels = NULL, weight = NULL, sho } rebuilt_results$results[[v]]$available_at <- results_available + rebuilt_results <- trackingDeclareAvailability( + rebuilt_results, results_available, var = v, labels + ) - - # For each alias, we set an attribute that identifies it's availability - # across all the datasets: "general", and "single" - # - "general" means it is available in only some datasets - # - "single" means it is available in exactly one dataset - - # Because we use subsetting at the list level, "general" and "single" - # would follow a typical path that labeling was adjusted appropriately - # for presentation in the resulting pdf "single" should act as a simple - # passthrough where no additional formatting or manipulation takes place - # on the result. - - # The single case - if (length(results_available) == 1) { - rebuilt_results$results[[v]]$availability <- "single" - if(rebuilt_results$results[[v]]$notes == "") { - rebuilt_results$results[[v]]$notes <- paste0("Asked in ", labels[results_available]) - } else { - rebuilt_results$results[[v]]$notes <- paste0( - rebuilt_results$results[[v]]$notes, - " (Asked in ", labels[results_available], ")") - } - } else { - rebuilt_results$results[[v]]$availability <- "general" - } } # Now that we have an attribute that identifies availability we can use it as @@ -139,7 +117,39 @@ trackingReport <- function(dataset_list, vars, labels = NULL, weight = NULL, sho rebuilt_results } +#' Specify question availability in a tracking report #' +#' For each alias, we set an attribute that identifies it's availability +#' across all the datasets: "general", and "single" +#' - "general" means it is available in only some datasets +#' - "single" means it is available in exactly one dataset +#' Because we use subsetting at the list level, "general" and "single" +#' would follow a typical path that labeling was adjusted appropriately +#' for presentation in the resulting pdf "single" should act as a simple +#' passthrough where no additional formatting or manipulation takes place +#' on the result. +#' @md +#' @param rebuilt_results A list of result objects from crunch +#' @param results_available A vector identifying in which list elements +#' @param var The name of the alias that we are declaring its availability +#' @param labels The wave labels +trackingDeclareAvailability <- function(rebuilt_results, results_available, var, labels) { + if (length(results_available) == 1) { + rebuilt_results$results[[var]]$availability <- "single" + if(rebuilt_results$results[[var]]$notes == "") { + rebuilt_results$results[[var]]$notes <- paste0("Asked in ", labels[results_available]) + } else { + rebuilt_results$results[[var]]$notes <- paste0( + rebuilt_results$results[[var]]$notes, + " (Asked in ", labels[results_available], ")") + } + } else { + rebuilt_results$results[[var]]$availability <- "general" + } + return(rebuilt_results) +} + + trackingReport_tabs <- function(datasets, vars, weight = NULL) { lapply( datasets, diff --git a/tests/testthat/test-trackingDeclareAvailability.R b/tests/testthat/test-trackingDeclareAvailability.R new file mode 100644 index 0000000..2268bb0 --- /dev/null +++ b/tests/testthat/test-trackingDeclareAvailability.R @@ -0,0 +1,55 @@ +context("trackingDeclareAvailability") + +test_that("Returns single as expected", { + rebuilt_results <- list() + rebuilt_results$results <- list( + somevar = list( + notes = "" + ) + ) + results_available <- 1 + labels = "Mar 2021" + + rebuilt_results <- trackingDeclareAvailability( + rebuilt_results, results_available, var = "somevar", labels + ) + + expect_equal(rebuilt_results$results$somevar$notes, "Asked in Mar 2021") + expect_equal(rebuilt_results$results$somevar$availability, "single") +}) + +test_that("Returns single as expected existing note", { + rebuilt_results <- list() + rebuilt_results$results <- list( + somevar = list( + notes = "Existing note" + ) + ) + results_available <- 1 + labels = "Mar 2021" + + rebuilt_results <- trackingDeclareAvailability( + rebuilt_results, results_available, var = "somevar", labels + ) + + expect_equal(rebuilt_results$results$somevar$notes, "Existing note (Asked in Mar 2021)") + expect_equal(rebuilt_results$results$somevar$availability, "single") +}) + +test_that("Returns general as expected", { + rebuilt_results <- list() + rebuilt_results$results <- list( + somevar = list( + notes = "Existing note" + ) + ) + results_available <- c(1,3,5) + labels = paste0("Wave ", 1:5) + + rebuilt_results <- trackingDeclareAvailability( + rebuilt_results, results_available, var = "somevar", labels + ) + + expect_equal(rebuilt_results$results$somevar$notes, "Existing note") + expect_equal(rebuilt_results$results$somevar$availability, "general") +}) From e213f0132414c83eae1838ad8cf665370b9acbb9 Mon Sep 17 00:00:00 2001 From: Brandon Bertelsen Date: Mon, 29 Mar 2021 12:23:40 -0500 Subject: [PATCH 7/7] Bump version, update NEWS and DESCRIPTION --- DESCRIPTION | 6 +++--- NEWS.md | 14 ++++++++++++++ man/crunchtabs-package.Rd | 4 ++-- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 977802a..8af3cc2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,11 +2,11 @@ Package: crunchtabs Type: Package Title: Custom Report Generation for Crunch Datasets Description: In order to generate custom survey reports, this package provides - functions for computing 'toplines' (one-way frequency summaries) and - 'banners' (cross-tabulations) of datasets in the Crunch + functions for computing 'toplines' (one-way frequency summaries), + 'banners' (cross-tabulations) and codebooks of datasets in the Crunch () web service. Reports can be written in 'PDF' format using 'LaTeX' or in Microsoft Excel '.xlsx' files. -Version: 1.4.0 +Version: 1.4.1 Authors@R: c( person("Persephone", "Tsebelis", role="aut"), person("Kamil", "Sedrowicz", role="aut"), diff --git a/NEWS.md b/NEWS.md index 8048f7c..88c2052 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,17 @@ +## crunchtabs 1.4.1 + +- Multiple adjustments for tracking report edge cases +- In a tracking report, if an alias appears only once we now specify that by appending the wave label to the question's note. +- In a tracking report, we now have the option to show a variable only once even if it appears in multiple datasets. + +Fixes: + +- In some cases there are duplicated row names in different positions when we use cbindFill, we did not account for this possibility. +- When creating a tracking report for a multiple response question, it's possible that one or more of the responses is not included in one or more of the waves, we have added a tryCatch to accomodate this possibility. +- themeNew documentation was missing a closing } that silently broke the display of documentation via ?themeNew. +- When converting MR variables we rename subVars using numbers. If a researcher included an alias with the same number they would collide. Now we assign random strings instead of sequential numbers to the subVars. + + ## crunchtabs 1.4.0 Features: diff --git a/man/crunchtabs-package.Rd b/man/crunchtabs-package.Rd index 3134697..bcaba94 100644 --- a/man/crunchtabs-package.Rd +++ b/man/crunchtabs-package.Rd @@ -7,8 +7,8 @@ \title{crunchtabs: Custom Report Generation for Crunch Datasets} \description{ In order to generate custom survey reports, this package provides - functions for computing 'toplines' (one-way frequency summaries) and - 'banners' (cross-tabulations) of datasets in the Crunch + functions for computing 'toplines' (one-way frequency summaries), + 'banners' (cross-tabulations) and codebooks of datasets in the Crunch () web service. Reports can be written in 'PDF' format using 'LaTeX' or in Microsoft Excel '.xlsx' files.