Consoldiate and rework checkbox value conversion

R/combine_checkboxes.R

@@ -89,19 +89,6 @@ combine_checkboxes <- function(supertbl,
   data_tbl_mod <- data_tbl
   .new_col <- unique(metadata_spec$.new_value)
 
-  for (i in seq_along(.new_col)) {
-    cols_to_sum <- metadata_spec$field_name[metadata_spec$.new_value == .new_col[i]] # nolint: object_usage_linter
-
-    data_tbl_mod <- data_tbl_mod %>%
-      mutate(
-        !!.new_col[i] := case_when(
-          rowSums(select(., cols_to_sum)) > 1 ~ TRUE,
-          .default = FALSE
-        )
-      )
-  }
-
-  # Replace TRUEs/1s with raw/label values from metadata
   data_tbl_mod <- data_tbl_mod %>%
     mutate(
       across(
@@ -115,10 +102,14 @@ combine_checkboxes <- function(supertbl,
       across(selected_cols, as.character) # enforce to character strings
     )
 
-  # Use the metadata_spec table to fill values in .new_col
-  data_tbl_mod <- reduce(.new_col, function(tbl, col_item) {
-    convert_metadata_spec(col_item, metadata_spec, tbl, raw_or_label, multi_value_label, values_fill)
-  }, .init = data_tbl_mod)
+  new_cols <- metadata_spec %>%
+    nest(.by = .data$.new_value, .key = "metadata") %>%
+    pmap(convert_checkbox_vals,
+      data_tbl = data_tbl_mod,
+      raw_or_label = raw_or_label, multi_value_label = multi_value_label, values_fill = values_fill
+    )
+
+  data_tbl_mod <- bind_cols(data_tbl_mod, new_cols)
 
   final_tbl <- bind_cols(
     data_tbl,
@@ -204,52 +195,35 @@ replace_true <- function(col, col_name, metadata, raw_or_label) {
   return(col)
 }
 
-#' @title Use metadata_spec to convert new column values
+#' @title Convert a new checkbox column's values
 #'
-#' @description
-#' [convert_metadata_spec()] uses the `metadata_spec` table provided by [get_metadata_spec()]
-#' to automatically convert new column values to either:
+#' @description This function takes a single column of data and converts the values
+#' based on the overall data tibble cross referenced with a nested section of the
+#' metadata tibble.
 #'
-#' - A `raw_or_label` checkbox value when only a single value is detected
-#' - `mult_value_label` when multiple values are detected
-#' - `values_fill` when `NA` is detected
+#' [case_when()] logic helps determine whether the value is a coalesced singular
+#' value or a user-specified one via `multi_value_label` or `values_fill`.
 #'
-#' @inheritParams combine_checkboxes
-#' @param .new_col_item A character string
-#' @param metadata_spec A tibble output from [convert_metadata_spec()]
-#' @param data_tbl_mod A modified data tibble
-#'
-#' @returns a tibble
+#' @details
+#' This function is used in conjunction with [pmap()].
 #'
 #' @keywords internal
-convert_metadata_spec <- function(.new_col_item,
-                                  metadata_spec,
-                                  data_tbl_mod,
-                                  raw_or_label,
-                                  multi_value_label,
-                                  values_fill) {
-  .col_group <- metadata_spec$field_name[metadata_spec$.new_value == .new_col_item]
-
-  metadata_overwrite <- metadata_spec %>%
-    filter(.data$field_name %in% .col_group) %>%
-    pull(raw_or_label)
-
-  data_tbl_mod <- data_tbl_mod %>%
+#'
+#' @param metadata A nested portion of the overall metadata tibble
+#' @param data_tbl The data tibble from the original supertibble
+#' @param .new_value The new column values made by [combine_checkboxes()]
+#' @inheritParams combine_checkboxes
+convert_checkbox_vals <- function(metadata, .new_value, data_tbl, raw_or_label, multi_value_label, values_fill) {
+  tibble(
+    !!.new_value := rowSums(!is.na(data_tbl[names(data_tbl) %in% metadata$field_name]))
+  ) %>%
     mutate(
-      !!.new_col_item := ifelse(!!sym(.new_col_item),
-        multi_value_label,
-        coalesce(!!!syms(.col_group))
+      !!.new_value := case_when(. > 1 ~ multi_value_label,
+        . == 1 ~ coalesce(!!!data_tbl[, names(data_tbl) %in% metadata$field_name]),
+        .default = values_fill
       ),
-      !!.new_col_item := ifelse(is.na(!!sym(.new_col_item)),
-        values_fill,
-        !!sym(.new_col_item)
-      )
-    ) %>%
-    mutate(
-      !!.new_col_item := factor(!!sym(.new_col_item),
-        levels = c(metadata_overwrite, multi_value_label, values_fill)
+      !!.new_value := factor(!!sym(.new_value),
+        levels = c(metadata[[raw_or_label]], multi_value_label, values_fill)
       )
     )
-
-  return(data_tbl_mod)
 }

tests/testthat/test-combine_checkboxes.R

@@ -202,36 +202,30 @@ test_that("combine_checkboxes works for multiple checkbox fields with logicals",
   expect_equal(out, expected_out)
 })
 
-test_that("convert_metadata_spec works", {
-  .new_col_item <- "_multi"
-  metadata_spec <- get_metadata_spec(
-    metadata_tbl = supertbl$redcap_metadata[[1]],
-    selected_cols = c("multi___1", "multi___2", "multi___3"),
-    names_prefix = "", names_suffix = NULL, names_sep = "_" # Mimic defaults
+test_that("convert_checkbox_vals works()", {
+  metadata <- tibble::tribble(
+    ~"field_name", ~".value", ~"raw", ~"label",
+    "multi___1", "multi", "1", "Red",
+    "multi___2", "multi", "2", "Yellow",
+    "multi___3", "multi", "3", "Blue"
   )
 
-  data_tbl_mod <- tibble::tribble(
-    ~"study_id", ~"multi___1", ~"multi___2", ~"multi___3", ~"single_checkbox___1",
-    ~"extra_data", ~"_multi", ~"_single_checkbox",
-    1, "Red", NA, NA, NA, 1, FALSE, FALSE,
-    2, "Red", "Yellow", NA, "Green", 2, TRUE, FALSE,
-    3, NA, NA, NA, NA, 3, FALSE, FALSE
+  # Same as nonrepeat data tbl but with NAs for FALSEs, post processed with metadata spec vals
+  data_tbl <- tibble::tribble(
+    ~"study_id", ~"multi___1", ~"multi___2", ~"multi___3", ~"single_checkbox___1", ~"extra_data",
+    1, "Red", NA, NA, "Green", 1,
+    2, "Red", "Yellow", NA, "Green", 2,
+    3, NA, NA, NA, NA, 3
   )
 
-  out <- convert_metadata_spec(.new_col_item, metadata_spec, data_tbl_mod,
-    raw_or_label = "label", multi_value_label = "Multiple", values_fill = NA
+  out <- convert_checkbox_vals(
+    metadata = metadata, .new_value = "_multi", data_tbl = data_tbl,
+    raw_or_label = "label", multi_value_label = "multi", values_fill = NA
   )
 
-  expected_out <- tibble::tribble(
-    ~"study_id", ~"multi___1", ~"multi___2", ~"multi___3", ~"single_checkbox___1",
-    ~"extra_data", ~"_multi", ~"_single_checkbox",
-    1, "Red", NA, NA, NA, 1, "Red", FALSE,
-    2, "Red", "Yellow", NA, "Green", 2, "Multiple", FALSE,
-    3, NA, NA, NA, NA, 3, NA, FALSE
-  ) %>%
-    mutate(
-      `_multi` = factor(`_multi`, levels = c("Red", "Yellow", "Blue", "Multiple"))
-    )
+  expected_out <- tibble(
+    `_multi` = factor(c("Red", "multi", NA), levels = c("Red", "Yellow", "Blue", "multi"))
+  )
 
   expect_equal(out, expected_out)
 })