diff --git a/DESCRIPTION b/DESCRIPTION index 6019ff00..91a7cdbe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,6 +38,7 @@ Imports: stats Suggests: covr, + glue, knitr, labelled, lintr, diff --git a/R/combine_checkboxes.R b/R/combine_checkboxes.R index 027b2f0f..20bd638b 100644 --- a/R/combine_checkboxes.R +++ b/R/combine_checkboxes.R @@ -24,6 +24,10 @@ #' @param names_sep String to separate new column names from `names_prefix`. #' @param names_glue Instead of `names_sep` and `names_prefix`, you can supply #' a glue specification and the unique `.value` to create custom column names. +#' @param names_repair What happens if the output has invalid column names? +#' The default, "check_unique" is to error if the columns are duplicated. +#' Use "minimal" to allow duplicates in the output, or "unique" to de-duplicated +#' by adding numeric suffixes. See [vctrs::vec_as_names()] for more options. #' @param multi_value_label A string specifying the value to be used when multiple #' checkbox fields are selected. Default "Multiple". #' @param values_fill Value to use when no checkboxes are selected. Default `NA`. @@ -63,6 +67,8 @@ combine_checkboxes <- function(supertbl, check_arg_is_supertbl(supertbl, req_cols = c("redcap_data", "redcap_metadata")) check_arg_is_character(names_prefix, len = 1) check_arg_is_character(names_sep, len = 1, any.missing = TRUE) + check_arg_is_character(names_repair, len = 1, any.missing = FALSE) + check_arg_is_character(names_glue, len = 1, any.missing = FALSE, null.ok = TRUE) check_arg_is_character(tbl, len = 1, any.missing = FALSE) check_arg_is_character(multi_value_label, len = 1, any.missing = TRUE) check_arg_is_character(values_fill, len = 1, any.missing = TRUE) @@ -139,6 +145,7 @@ get_metadata_spec <- function(metadata_tbl, # Create a metadata reference table linking field name to raw and label values if (!is.null(names_glue)) { + check_installed("glue", reason = "to use `names_glue` in `combine_checkboxes()`") # Similar to pivot_*, use of `names_glue` overrides use of names_prefix/sep out <- metadata_tbl %>% filter(.data$field_name %in% selected_cols) %>% @@ -152,7 +159,7 @@ get_metadata_spec <- function(metadata_tbl, mutate( .value = sub("___.*$", "", .data$field_name), .new_value = case_when(names_prefix != "" ~ paste(names_prefix, .value, sep = names_sep), - .default = paste(names_prefix, .data$.value, sep = "") + .default = paste(names_prefix, .data$.value, sep = "") ) ) } diff --git a/man/combine_and_repair_tbls.Rd b/man/combine_and_repair_tbls.Rd index e6b35e86..edb4f653 100644 --- a/man/combine_and_repair_tbls.Rd +++ b/man/combine_and_repair_tbls.Rd @@ -12,6 +12,11 @@ combine_and_repair_tbls(data_tbl, data_tbl_mod, new_cols, names_repair) \item{data_tbl_mod}{A modified data table from \code{data_tbl}} \item{new_cols}{The new columns created for checkbox combination} + +\item{names_repair}{What happens if the output has invalid column names? +The default, "check_unique" is to error if the columns are duplicated. +Use "minimal" to allow duplicates in the output, or "unique" to de-duplicated +by adding numeric suffixes. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for more options.} } \value{ a tibble diff --git a/man/combine_checkboxes.Rd b/man/combine_checkboxes.Rd index f95c74a3..3d78a441 100644 --- a/man/combine_checkboxes.Rd +++ b/man/combine_checkboxes.Rd @@ -33,6 +33,11 @@ single column. Required.} \item{names_glue}{Instead of \code{names_sep} and \code{names_prefix}, you can supply a glue specification and the unique \code{.value} to create custom column names.} +\item{names_repair}{What happens if the output has invalid column names? +The default, "check_unique" is to error if the columns are duplicated. +Use "minimal" to allow duplicates in the output, or "unique" to de-duplicated +by adding numeric suffixes. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for more options.} + \item{multi_value_label}{A string specifying the value to be used when multiple checkbox fields are selected. Default "Multiple".} diff --git a/tests/testthat/test-combine_checkboxes.R b/tests/testthat/test-combine_checkboxes.R index 56325995..8f2f3af7 100644 --- a/tests/testthat/test-combine_checkboxes.R +++ b/tests/testthat/test-combine_checkboxes.R @@ -74,13 +74,11 @@ test_that("combine_checkboxes works for nonrepeat instrument", { }) test_that("combine_checkboxes glue spec works", { - name_appender <- "suffix" - out <- combine_checkboxes( supertbl = supertbl, tbl = "nonrepeat_instrument", cols = starts_with("multi"), - names_glue = "{.value}_{name_appender}", + names_glue = "{.value}_suffix", multi_value_label = "multiple", # multi_value_label declared values_fill = "none" # values_fill declared ) %>% @@ -149,7 +147,7 @@ test_that("get_metadata_spec works", { out <- get_metadata_spec( metadata_tbl = supertbl$redcap_metadata[[1]], selected_cols = c("multi___1", "multi___2", "multi___3"), - names_prefix = "", names_sep = "_" # Mimic defaults + names_prefix = "", names_sep = "_", names_glue = NULL # Mimic defaults ) expected_out <- tibble::tribble(