Merge pull request #115 from NIFU-NO/dev

Dev

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)) {

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",

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)
+})