diff --git a/R/global_settings.R b/R/global_settings.R index 985b0ec..d816bfa 100644 --- a/R/global_settings.R +++ b/R/global_settings.R @@ -16,14 +16,18 @@ global_settings_get <- function(fn_name = "makeme") { #' @param fn_name String, one of `"make_link"`, `"fig_height_h_barchart"` and `"makeme"`. #' @param new List of arguments (see `?make_link()`, `?makeme()`, `fig_height_h_barchart()`) #' @param quiet Flag. If `FALSE` (default), informs about what has been set. +#' @param null_deletes Flag. If `FALSE` (default), `NULL` elements in `new` +#' become `NULL` elements in the option. Otherwise, the corresponding element, +#' if present, is deleted from the option. +#' #' @return Invisibly returned list of old and new values. #' @export #' #' @examples global_settings_set(new=list(digits=2)) -global_settings_set <- function(new, fn_name = "makeme", quiet=FALSE) { +global_settings_set <- function(new, fn_name = "makeme", quiet = FALSE, null_deletes = FALSE) { saros_options <- getOption("saros", list()) current_options <- saros_options[[paste0(fn_name, "_defaults")]] - updated_options <- utils::modifyList(current_options, new) + updated_options <- utils::modifyList(current_options, new, keep.null = !null_deletes) saros_options[[paste0(fn_name, "_defaults")]] <- updated_options options(saros = saros_options) if(isFALSE(quiet)) { diff --git a/R/make_content.cat_table_html.R b/R/make_content.cat_table_html.R index 1e7890f..d973d20 100644 --- a/R/make_content.cat_table_html.R +++ b/R/make_content.cat_table_html.R @@ -22,14 +22,15 @@ make_content.cat_table_html <- label_separator = dots$label_separator, warn_multiple = TRUE) indep_label <- unique(indep_label) - if(nchar(indep_label)==0) browser() #cli::cli_warn("Indep {.var {indep_pos}} lacks a label.") + if(nchar(indep_label)==0) indep_label <- dots$indep[1] #browser() #cli::cli_warn("Indep {.var {indep_pos}} lacks a label.") } else indep_label <- character(0) # indep_label <- unname(get_raw_labels(data = dots$data, col_pos = dots$indep)) - cat_lvls <- levels(data_summary[[".category"]]) + cat_lvls[is.na(cat_lvls)] <- "NA" + if(length(indep_label)==1 && length(dots$indep)==0) { cli::cli_abort("Something wrong in function.") } @@ -39,8 +40,13 @@ make_content.cat_table_html <- dplyr::arrange(as.integer(.data[[".variable_label"]]), if(length(dots$indep)>0) as.integer(.data[[dots$indep]])) |> tidyr::pivot_wider(id_cols = tidyselect::all_of(c(".variable_label", dots$indep, ".count_total")), - names_from = ".category", values_from = ".data_label") |> - dplyr::relocate(tidyselect::all_of(c(".variable_label", dots$indep, cat_lvls, ".count_total")), .after = 1) |> + names_from = ".category", values_from = ".data_label") + names(data_out)[names(data_out) == "NA"] <- "NA" + new_col_order <- + c(".variable_label", dots$indep, cat_lvls, ".count_total") + data_out <- + data_out |> + dplyr::relocate(tidyselect::all_of(new_col_order), .after = 1) |> dplyr::rename_with(.cols = tidyselect::all_of(cat_lvls), .fn = ~stringi::stri_c(ignore_null=TRUE, .x, if(dots$data_label %in% c("percentage", "percentage_bare")) " (%)")) |> dplyr::rename_with(.cols = ".count_total", diff --git a/man/global_settings_set.Rd b/man/global_settings_set.Rd index 1946868..db41624 100644 --- a/man/global_settings_set.Rd +++ b/man/global_settings_set.Rd @@ -4,7 +4,12 @@ \alias{global_settings_set} \title{Get Global Options for saros-functions} \usage{ -global_settings_set(new, fn_name = "makeme", quiet = FALSE) +global_settings_set( + new, + fn_name = "makeme", + quiet = FALSE, + null_deletes = FALSE +) } \arguments{ \item{new}{List of arguments (see \code{?make_link()}, \code{?makeme()}, \code{fig_height_h_barchart()})} @@ -12,6 +17,10 @@ global_settings_set(new, fn_name = "makeme", quiet = FALSE) \item{fn_name}{String, one of \code{"make_link"}, \code{"fig_height_h_barchart"} and \code{"makeme"}.} \item{quiet}{Flag. If \code{FALSE} (default), informs about what has been set.} + +\item{null_deletes}{Flag. If \code{FALSE} (default), \code{NULL} elements in \code{new} +become \code{NULL} elements in the option. Otherwise, the corresponding element, +if present, is deleted from the option.} } \value{ Invisibly returned list of old and new values. diff --git a/tests/testthat/test-make_content.cat_table_html.R b/tests/testthat/test-make_content.cat_table_html.R index 1ad5a83..53c137e 100644 --- a/tests/testthat/test-make_content.cat_table_html.R +++ b/tests/testthat/test-make_content.cat_table_html.R @@ -7,3 +7,18 @@ testthat::test_that("make_content.cat_table_html works", { add_n_to_label = TRUE) testthat::expect_equal(as.character(result$.variable_label[[4]]), "Blue Party (N = 266)") }) + +testthat::test_that("make_content.cat_table_html works with NA on both dep and indep", { + + expected_df <- + tibble::tibble(b=factor(c("Z", NA), exclude = NULL), + `F (%)` = c(NA, "50"), + `M (%)` = c(NA, "50"), + `NA (%)` = c("100", NA), + `Total (N)` = c(1L, 2L)) + attr(expected_df$b, "label") <- NA_character_ +data.frame(a=factor(c("M", "F", NA), exclude = NULL), + b=factor(c(NA, NA, "Z"), exclude = NULL)) |> + saros.contents::makeme(dep=a, indep=b, showNA = "never", type="cat_table_html") |> + testthat::expect_equal(expected = expected_df) +})