From 7789a228b8514a09450a96a82622338ccea44656 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Mon, 29 Jul 2024 15:51:52 -0400 Subject: [PATCH] Update API, clean up, new methods, new docs --- NAMESPACE | 1 + R/REDCapTidieR-package.R | 2 +- R/checks.R | 31 +---- R/combine_checkboxes.R | 159 +++++++++++++++-------- man/check_fields_exist.Rd | 2 +- man/check_values_to_length.Rd | 19 --- man/combine_checkboxes.Rd | 17 ++- man/convert_metadata_spec.Rd | 43 ++++++ man/get_metadata_ref.Rd | 20 --- man/get_metadata_spec.Rd | 33 +++++ man/replace_true.Rd | 25 ++++ tests/testthat/test-checks.R | 19 --- tests/testthat/test-combine_checkboxes.R | 82 ++++++++---- 13 files changed, 276 insertions(+), 177 deletions(-) delete mode 100644 man/check_values_to_length.Rd create mode 100644 man/convert_metadata_spec.Rd delete mode 100644 man/get_metadata_ref.Rd create mode 100644 man/get_metadata_spec.Rd create mode 100644 man/replace_true.Rd diff --git a/NAMESPACE b/NAMESPACE index e48eab82..a9fbdb2a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -81,6 +81,7 @@ importFrom(purrr,map_lgl) importFrom(purrr,pluck) importFrom(purrr,pmap) importFrom(purrr,pmap_chr) +importFrom(purrr,reduce) importFrom(purrr,some) importFrom(readr,parse_character) importFrom(readr,parse_date) diff --git a/R/REDCapTidieR-package.R b/R/REDCapTidieR-package.R index f942d740..16d54f28 100644 --- a/R/REDCapTidieR-package.R +++ b/R/REDCapTidieR-package.R @@ -11,7 +11,7 @@ #' @importFrom lobstr obj_size #' @importFrom lubridate is.difftime is.period is.POSIXt is.Date #' @importFrom purrr compose map map2 map_int map_lgl pluck pmap_chr some pmap -#' discard flatten_chr map2_chr +#' discard flatten_chr map2_chr reduce #' @importFrom REDCapR redcap_arm_export redcap_event_instruments redcap_instruments #' redcap_metadata_read redcap_read_oneshot sanitize_token #' @importFrom rlang .data !!! abort as_closure caller_arg caller_env catch_cnd diff --git a/R/checks.R b/R/checks.R index 940afafe..46758d71 100644 --- a/R/checks.R +++ b/R/checks.R @@ -664,7 +664,7 @@ check_extra_field_values_message <- function(extra_field_values, call = caller_e #' Check fields exist for checkbox combination #' #' @param fields Vector of character strings to check the length of -#' @param expr A quosure expression +#' @param expr An expression #' @param call The calling environment to use in the error message #' #' @keywords internal @@ -712,32 +712,3 @@ check_fields_are_checkboxes <- function(metadata_tbl, call = caller_env()) { ) } } - -#' @title -#' Check values_to length against detected number of checkbox fields -#' -#' @param col_groups a list of column groups identified by checkbox field detection -#' @param values_to a user defined character vector passed from [combine_checkboxes()] -#' @param call The calling environment to use in the error message -#' -#' @keywords internal -check_values_to_length <- function(col_groups, values_to, call = caller_env()) { - if (length(values_to) < length(names(col_groups))) { - cli_warn( - message = c( - `!` = "Detected fewer {.code values_to} arguments than the number of checkbox fields. Only the first {length(values_to)} will be used." # nolint line_length_linter - ), - class = c("checkbox_value_to_length", "REDCapTidieR_cond") - ) - } - - if (length(values_to) > length(names(col_groups))) { - cli_abort( - message = c( - `x` = "The number of {.code values_to} arguments supplied is greater than the number of checkbox fields detected.", # nolint line_length_linter - `i` = "{length(values_to)} {.code values_to} supplied, {length(names(col_groups))} checkbox fields detected." - ), - class = c("checkbox_value_to_length", "REDCapTidieR_cond") - ) - } -} diff --git a/R/combine_checkboxes.R b/R/combine_checkboxes.R index df799b77..e004d185 100644 --- a/R/combine_checkboxes.R +++ b/R/combine_checkboxes.R @@ -8,10 +8,12 @@ #' #' @param supertbl A supertibble generated by [read_redcap()]. Required. #' @param tbl The `redcap_form_name` of the data tibble to extract. Required. -#' @param cols <[`tidy-select`][tidyr_tidy_select]> Checbox columns to combine to +#' @param cols <[`tidy-select`][tidyr_tidy_select]> Checkbox columns to combine to #' single column. Required. -#' @param values_to A string specifying the name of the column to combine checkbox -#' values under. Required. +#' @param names_prefix String added to the start of every variable name. +#' @param names_suffix String added to the end of every variable name. +#' @param names_sep String to separate new column names from `names_prefix` and/or +#' `names_suffix`. #' @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`. @@ -25,11 +27,10 @@ #' @examples #' \dontrun{ #' supertbl <- read_redcap(redcap_uri, token) -#' combined_tbl <- combine_checkboxes( +#' combine_checkboxes( #' supertbl = supertbl, #' tbl = "demographics", #' cols = starts_with("race"), -#' values_to = "race_combined", #' multi_value_label = "Multiple", #' values_fill = NA #' ) @@ -40,15 +41,19 @@ combine_checkboxes <- function(supertbl, tbl, cols, - values_to, + names_prefix = "", + names_suffix = NULL, + names_sep = "_", multi_value_label = "Multiple", values_fill = NA, raw_or_label = "label", keep = TRUE) { # Check args --- 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_suffix, len = 1, null.ok = TRUE) + check_arg_is_character(names_sep, len = 1, any.missing = TRUE) check_arg_is_character(tbl, len = 1, any.missing = FALSE) - check_arg_is_character(values_to, 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) check_arg_choices(raw_or_label, choices = c("label", "raw")) @@ -58,33 +63,29 @@ combine_checkboxes <- function(supertbl, data_tbl <- supertbl %>% extract_tibble(tbl) - # Save user cols to quosure + # Save user cols to quo cols_exp <- enquo(cols) # Evaluate the cols expression to get the selected column names selected_cols <- names(eval_select(cols_exp, data = data_tbl)) check_fields_exist(fields = selected_cols, expr = cols_exp) # Check supplied fields exist - # Extract the prefix of each selected column - prefixes <- sub("___.*", "", selected_cols) - - # Split the selected columns based on their prefixes - col_groups <- split(selected_cols, prefixes) - check_values_to_length(col_groups, values_to) # Check values_to columns match length of fields - # Get metadata reference table, check that chosen fields are checkboxes metadata_tbl <- supertbl$redcap_metadata[supertbl$redcap_form_name == tbl][[1]] - metadata_ref <- get_metadata_ref(metadata_tbl, selected_cols) + metadata_spec <- get_metadata_spec(metadata_tbl, selected_cols, names_prefix, names_suffix, names_sep) - # Define values_to as the count of TRUEs/1s for the given checkbox field + # Define .new_col as the count of TRUEs/1s for the given checkbox field # Assign TRUE if multiple selections made, and FALSE if one or zero made 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 - for (i in seq_along(values_to)) { data_tbl_mod <- data_tbl_mod %>% mutate( - !!values_to[i] := case_when( - rowSums(select(., col_groups[[i]])) > 1 ~ TRUE, + !!.new_col[i] := case_when( + rowSums(select(., cols_to_sum)) > 1 ~ TRUE, .default = FALSE ) ) @@ -97,39 +98,21 @@ combine_checkboxes <- function(supertbl, selected_cols, ~ replace_true(.x, cur_column(), - metadata = metadata_ref, + metadata = metadata_spec, raw_or_label = raw_or_label ) ), across(selected_cols, as.character) # enforce to character strings ) - for (i in seq_along(values_to)) { - metadata_overwrite <- metadata_ref %>% - filter(.data$field_name %in% col_groups[[i]]) %>% - pull(raw_or_label) - - data_tbl_mod <- data_tbl_mod %>% - mutate( - !!values_to[i] := ifelse(!!sym(values_to[i]), - multi_value_label, - coalesce(!!!syms(col_groups[[i]])) - ), - !!values_to[i] := ifelse(is.na(!!sym(values_to[i])), - values_fill, - !!sym(values_to[i]) - ) - ) %>% - mutate( - !!values_to[i] := factor(!!sym(values_to[i]), - levels = c(metadata_overwrite, multi_value_label, values_fill) - ) - ) - } + # 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) final_tbl <- bind_cols( data_tbl, - data_tbl_mod %>% select(!!values_to) + data_tbl_mod %>% select(!!.new_col) ) # Keep or remove original multi columns @@ -144,21 +127,28 @@ combine_checkboxes <- function(supertbl, supertbl } -#' @title Utility function for getting metadata raw and label values for checkboxes +#' @title Get metadata specification table #' +#' @inheritParams combine_checkboxes #' @param metadata_tbl A metadata tibble from the supertibble generated by [read_redcap()]. #' @param selected_cols Character string vector of field names for checkbox combination #' #' @returns a tibble #' #' @keywords internal -get_metadata_ref <- function(metadata_tbl, - selected_cols) { +get_metadata_spec <- function(metadata_tbl, + selected_cols, + names_prefix, + names_suffix, + names_sep) { # Create a metadata reference table linking field name to raw and label values out <- metadata_tbl %>% filter(.data$field_name %in% selected_cols) %>% mutate( - original_field = sub("___.*$", "", .data$field_name) + .value = sub("___.*$", "", .data$field_name), + .new_value = case_when(!is.null(names_suffix) ~ paste(names_prefix, .value, names_suffix, sep = names_sep), + .default = paste(names_prefix, .data$.value, sep = names_sep) + ) ) # Make sure selection is checkbox metadata field type @@ -167,19 +157,30 @@ get_metadata_ref <- function(metadata_tbl, # Bind raw/label values per original field grouping parsed_vals <- tibble() - for (i in seq_along(unique(out$original_field))) { - index <- unique(out$original_field)[i] - out_filtered <- out %>% filter(.data$original_field == index) + for (i in seq_along(unique(out$.value))) { + index <- unique(out$.value)[i] + out_filtered <- out %>% filter(.data$.value == index) parsed_vals <- rbind(parsed_vals, parse_labels(first(out_filtered$select_choices_or_calculations))) } bind_cols(out, parsed_vals) %>% - select(.data$field_name, .data$raw, .data$label, .data$original_field) %>% - relocate(.data$original_field, .after = .data$field_name) + select(.data$field_name, .data$raw, .data$label, .data$.value, .data$.new_value) %>% + relocate(c(.data$.value, .data$.new_value), .after = .data$field_name) } -#' @noRd +#' @title Replace checkbox TRUEs with raw_or_label values +#' +#' @inheritParams combine_checkboxes +#' @param col A vector +#' @param col_name A string +#' @param metadata A metadata tibble from the original supertibble +#' +#' @description +#' Simple utility function for replacing checkbox field values. +#' +#' @returns A character string +#' #' @keywords internal replace_true <- function(col, col_name, metadata, raw_or_label) { # Replace TRUEs/1s with the appropriate raw or label value from the metadata @@ -190,3 +191,53 @@ replace_true <- function(col, col_name, metadata, raw_or_label) { # Convert non-TRUEs to NA, since values can be either "FALSE" or "0" for unchecked values return(col) } + +#' @title Use metadata_spec to convert new column values +#' +#' @description +#' [convert_metadata_spec()] uses the `metadata_spec` table provided by [get_metadata_spec()] +#' to automatically convert new column values to either: +#' +#' - 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 +#' +#' @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 +#' +#' @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 %>% + mutate( + !!.new_col_item := ifelse(!!sym(.new_col_item), + multi_value_label, + coalesce(!!!syms(.col_group)) + ), + !!.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) + ) + ) + + return(data_tbl_mod) +} diff --git a/man/check_fields_exist.Rd b/man/check_fields_exist.Rd index 5076a1b7..8c65e2d7 100644 --- a/man/check_fields_exist.Rd +++ b/man/check_fields_exist.Rd @@ -9,7 +9,7 @@ check_fields_exist(fields, expr, call = caller_env()) \arguments{ \item{fields}{Vector of character strings to check the length of} -\item{expr}{A quosure expression} +\item{expr}{An expression} \item{call}{The calling environment to use in the error message} } diff --git a/man/check_values_to_length.Rd b/man/check_values_to_length.Rd deleted file mode 100644 index e9194a08..00000000 --- a/man/check_values_to_length.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checks.R -\name{check_values_to_length} -\alias{check_values_to_length} -\title{Check values_to length against detected number of checkbox fields} -\usage{ -check_values_to_length(col_groups, values_to, call = caller_env()) -} -\arguments{ -\item{col_groups}{a list of column groups identified by checkbox field detection} - -\item{values_to}{a user defined character vector passed from \code{\link[=combine_checkboxes]{combine_checkboxes()}}} - -\item{call}{The calling environment to use in the error message} -} -\description{ -Check values_to length against detected number of checkbox fields -} -\keyword{internal} diff --git a/man/combine_checkboxes.Rd b/man/combine_checkboxes.Rd index f2ed6094..4a7a362d 100644 --- a/man/combine_checkboxes.Rd +++ b/man/combine_checkboxes.Rd @@ -8,7 +8,9 @@ combine_checkboxes( supertbl, tbl, cols, - values_to, + names_prefix = "", + names_suffix = NULL, + names_sep = "_", multi_value_label = "Multiple", values_fill = NA, raw_or_label = "label", @@ -20,11 +22,15 @@ combine_checkboxes( \item{tbl}{The \code{redcap_form_name} of the data tibble to extract. Required.} -\item{cols}{<\code{\link[=tidyr_tidy_select]{tidy-select}}> Checbox columns to combine to +\item{cols}{<\code{\link[=tidyr_tidy_select]{tidy-select}}> Checkbox columns to combine to single column. Required.} -\item{values_to}{A string specifying the name of the column to combine checkbox -values under. Required.} +\item{names_prefix}{String added to the start of every variable name.} + +\item{names_suffix}{String added to the end of every variable name.} + +\item{names_sep}{String to separate new column names from \code{names_prefix} and/or +\code{names_suffix}.} \item{multi_value_label}{A string specifying the value to be used when multiple checkbox fields are selected. Default "Multiple".} @@ -49,11 +55,10 @@ factor column. \examples{ \dontrun{ supertbl <- read_redcap(redcap_uri, token) -combined_tbl <- combine_checkboxes( +combine_checkboxes( supertbl = supertbl, tbl = "demographics", cols = starts_with("race"), - values_to = "race_combined", multi_value_label = "Multiple", values_fill = NA ) diff --git a/man/convert_metadata_spec.Rd b/man/convert_metadata_spec.Rd new file mode 100644 index 00000000..81b40fad --- /dev/null +++ b/man/convert_metadata_spec.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combine_checkboxes.R +\name{convert_metadata_spec} +\alias{convert_metadata_spec} +\title{Use metadata_spec to convert new column values} +\usage{ +convert_metadata_spec( + .new_col_item, + metadata_spec, + data_tbl_mod, + raw_or_label, + multi_value_label, + values_fill +) +} +\arguments{ +\item{.new_col_item}{A character string} + +\item{metadata_spec}{A tibble output from \code{\link[=convert_metadata_spec]{convert_metadata_spec()}}} + +\item{data_tbl_mod}{A modified data tibble} + +\item{raw_or_label}{Either 'raw' or 'label' to specify whether to use raw coded +values or labels for the options. Default 'label'.} + +\item{multi_value_label}{A string specifying the value to be used when multiple +checkbox fields are selected. Default "Multiple".} + +\item{values_fill}{Value to use when no checkboxes are selected. Default \code{NA}.} +} +\value{ +a tibble +} +\description{ +\code{\link[=convert_metadata_spec]{convert_metadata_spec()}} uses the \code{metadata_spec} table provided by \code{\link[=get_metadata_spec]{get_metadata_spec()}} +to automatically convert new column values to either: +\itemize{ +\item A \code{raw_or_label} checkbox value when only a single value is detected +\item \code{mult_value_label} when multiple values are detected +\item \code{values_fill} when \code{NA} is detected +} +} +\keyword{internal} diff --git a/man/get_metadata_ref.Rd b/man/get_metadata_ref.Rd deleted file mode 100644 index 6ced220b..00000000 --- a/man/get_metadata_ref.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/combine_checkboxes.R -\name{get_metadata_ref} -\alias{get_metadata_ref} -\title{Utility function for getting metadata raw and label values for checkboxes} -\usage{ -get_metadata_ref(metadata_tbl, selected_cols) -} -\arguments{ -\item{metadata_tbl}{A metadata tibble from the supertibble generated by \code{\link[=read_redcap]{read_redcap()}}.} - -\item{selected_cols}{Character string vector of field names for checkbox combination} -} -\value{ -a tibble -} -\description{ -Utility function for getting metadata raw and label values for checkboxes -} -\keyword{internal} diff --git a/man/get_metadata_spec.Rd b/man/get_metadata_spec.Rd new file mode 100644 index 00000000..dc5ade39 --- /dev/null +++ b/man/get_metadata_spec.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combine_checkboxes.R +\name{get_metadata_spec} +\alias{get_metadata_spec} +\title{Get metadata specification table} +\usage{ +get_metadata_spec( + metadata_tbl, + selected_cols, + names_prefix, + names_suffix, + names_sep +) +} +\arguments{ +\item{metadata_tbl}{A metadata tibble from the supertibble generated by \code{\link[=read_redcap]{read_redcap()}}.} + +\item{selected_cols}{Character string vector of field names for checkbox combination} + +\item{names_prefix}{String added to the start of every variable name.} + +\item{names_suffix}{String added to the end of every variable name.} + +\item{names_sep}{String to separate new column names from \code{names_prefix} and/or +\code{names_suffix}.} +} +\value{ +a tibble +} +\description{ +Get metadata specification table +} +\keyword{internal} diff --git a/man/replace_true.Rd b/man/replace_true.Rd new file mode 100644 index 00000000..b1d8ced5 --- /dev/null +++ b/man/replace_true.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combine_checkboxes.R +\name{replace_true} +\alias{replace_true} +\title{Replace checkbox TRUEs with raw_or_label values} +\usage{ +replace_true(col, col_name, metadata, raw_or_label) +} +\arguments{ +\item{col}{A vector} + +\item{col_name}{A string} + +\item{metadata}{A metadata tibble from the original supertibble} + +\item{raw_or_label}{Either 'raw' or 'label' to specify whether to use raw coded +values or labels for the options. Default 'label'.} +} +\value{ +A character string +} +\description{ +Simple utility function for replacing checkbox field values. +} +\keyword{internal} diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index 3fc71072..77435375 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -272,22 +272,3 @@ test_that("check_fields_are_checkboxes works", { expect_error(check_fields_are_checkboxes(metadata), class = "non_checkbox_fields") expect_no_error(check_fields_are_checkboxes(metadata_filtered)) }) - -test_that("check_values_to_length length works", { - col_groups <- list( - checkbox_1 = c("checkbox1___1", "checkbox1___2"), - checkbox_2 = c("checkbox2___1") - ) - - values_to <- c("new_col1", "new_col2") - - expect_no_message(check_values_to_length(col_groups, values_to)) - - values_to_warn <- "new_col1" - - expect_warning(check_values_to_length(col_groups, values_to_warn), class = "checkbox_value_to_length") - - values_to_error <- c("new_col1", "new_col2", "new_col3") - - expect_error(check_values_to_length(col_groups, values_to_error), class = "checkbox_value_to_length") -}) diff --git a/tests/testthat/test-combine_checkboxes.R b/tests/testthat/test-combine_checkboxes.R index 5132c2e5..7071a2b0 100644 --- a/tests/testthat/test-combine_checkboxes.R +++ b/tests/testthat/test-combine_checkboxes.R @@ -42,8 +42,7 @@ test_that("combine_checkboxes returns an expected supertbl", { out <- combine_checkboxes( supertbl = supertbl, tbl = "nonrepeat_instrument", - cols = starts_with("multi"), - values_to = "new_col" + cols = starts_with("multi") ) # values_fill declared expect_setequal(class(out), c("redcap_supertbl", "tbl_df", "tbl", "data.frame")) @@ -55,7 +54,6 @@ test_that("combine_checkboxes works for nonrepeat instrument", { supertbl = supertbl, tbl = "nonrepeat_instrument", cols = starts_with("multi"), - values_to = "new_col", multi_value_label = "multiple", # multi_value_label declared values_fill = "none" # values_fill declared ) %>% @@ -63,13 +61,13 @@ test_that("combine_checkboxes works for nonrepeat instrument", { dplyr::first() expected_out <- tibble::tribble( - ~"study_id", ~"multi___1", ~"multi___2", ~"multi___3", ~"single_checkbox___1", ~"extra_data", ~"new_col", + ~"study_id", ~"multi___1", ~"multi___2", ~"multi___3", ~"single_checkbox___1", ~"extra_data", ~"_multi", 1, TRUE, FALSE, FALSE, TRUE, 1, "Red", 2, TRUE, TRUE, FALSE, TRUE, 2, "multiple", 3, FALSE, FALSE, FALSE, FALSE, 3, "none" ) %>% mutate( - new_col = factor(new_col, levels = c("Red", "Yellow", "Blue", "multiple", "none")) + `_multi` = factor(`_multi`, levels = c("Red", "Yellow", "Blue", "multiple", "none")) ) expect_equal(out, expected_out) @@ -80,20 +78,19 @@ test_that("combine_checkboxes works for nonrepeat instrument and drop old values supertbl = supertbl, tbl = "nonrepeat_instrument", cols = starts_with("multi"), - values_to = "new_col", keep = FALSE # Test keep = FALSE ) %>% pull(redcap_data) %>% dplyr::first() expected_out <- tibble::tribble( - ~"study_id", ~"single_checkbox___1", ~"extra_data", ~"new_col", + ~"study_id", ~"single_checkbox___1", ~"extra_data", ~"_multi", 1, TRUE, 1, "Red", 2, TRUE, 2, "Multiple", 3, FALSE, 3, NA ) %>% mutate( - new_col = factor(new_col, levels = c("Red", "Yellow", "Blue", "Multiple")) + `_multi` = factor(`_multi`, levels = c("Red", "Yellow", "Blue", "Multiple")) ) expect_equal(out, expected_out) @@ -103,36 +100,36 @@ test_that("combine_checkboxes works for repeat instrument", { out <- combine_checkboxes( supertbl = supertbl, tbl = "repeat_instrument", - cols = starts_with("repeat"), - values_to = "new_col" + cols = starts_with("repeat") ) %>% pull(redcap_data) %>% dplyr::nth(2) expected_out <- tibble::tribble( - ~"study_id", ~"redcap_event", ~"redcap_form_instance", ~"repeat___1", ~"repeat___2", ~"repeat___3", ~"new_col", + ~"study_id", ~"redcap_event", ~"redcap_form_instance", ~"repeat___1", ~"repeat___2", ~"repeat___3", ~"_repeat", 1, "event_1", 1, TRUE, FALSE, FALSE, "A", 2, "event_1", 1, TRUE, TRUE, TRUE, "Multiple", 2, "event_1", 2, FALSE, FALSE, FALSE, NA ) %>% mutate( - new_col = factor(new_col, levels = c("A", "B", "C", "Multiple")) + `_repeat` = factor(`_repeat`, levels = c("A", "B", "C", "Multiple")) ) expect_equal(out, expected_out) }) -test_that("get_metadata_ref works", { - out <- get_metadata_ref( +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") + selected_cols = c("multi___1", "multi___2", "multi___3"), + names_prefix = "", names_suffix = NULL, names_sep = "_" # Mimic defaults ) expected_out <- tibble::tribble( - ~"field_name", ~"original_field", ~"raw", ~"label", - "multi___1", "multi", "1", "Red", - "multi___2", "multi", "2", "Yellow", - "multi___3", "multi", "3", "Blue" + ~"field_name", ~".value", ~".new_value", ~"raw", ~"label", + "multi___1", "multi", "_multi", "1", "Red", + "multi___2", "multi", "_multi", "2", "Yellow", + "multi___3", "multi", "_multi", "3", "Blue" ) expect_equal(out, expected_out) @@ -162,21 +159,20 @@ test_that("combine_checkboxes works for multiple checkbox fields", { supertbl = supertbl, tbl = "nonrepeat_instrument", cols = c(starts_with("multi"), starts_with("single_checkbox")), - values_to = c("new_col1", "new_col2"), keep = FALSE ) %>% pull(redcap_data) %>% dplyr::first() expected_out <- tibble::tribble( - ~"study_id", ~"extra_data", ~"new_col1", ~"new_col2", + ~"study_id", ~"extra_data", ~"_multi", ~"_single_checkbox", 1, 1, "Red", "Green", 2, 2, "Multiple", "Green", 3, 3, NA, NA ) %>% mutate( - new_col1 = factor(new_col1, levels = c("Red", "Yellow", "Blue", "Multiple")), - new_col2 = factor(new_col2, levels = c("Green", "Multiple")) + `_multi` = factor(`_multi`, levels = c("Red", "Yellow", "Blue", "Multiple")), + `_single_checkbox` = factor(`_single_checkbox`, levels = c("Green", "Multiple")) ) expect_equal(out, expected_out) @@ -187,21 +183,53 @@ test_that("combine_checkboxes works for multiple checkbox fields with logicals", supertbl = supertbl, tbl = "nonrepeat_instrument", cols = c(starts_with("multi") | starts_with("single_checkbox")), - values_to = c("new_col1", "new_col2"), keep = FALSE ) %>% pull(redcap_data) %>% dplyr::first() expected_out <- tibble::tribble( - ~"study_id", ~"extra_data", ~"new_col1", ~"new_col2", + ~"study_id", ~"extra_data", ~"_multi", ~"_single_checkbox", 1, 1, "Red", "Green", 2, 2, "Multiple", "Green", 3, 3, NA, NA ) %>% mutate( - new_col1 = factor(new_col1, levels = c("Red", "Yellow", "Blue", "Multiple")), - new_col2 = factor(new_col2, levels = c("Green", "Multiple")) + `_multi` = factor(`_multi`, levels = c("Red", "Yellow", "Blue", "Multiple")), + `_single_checkbox` = factor(`_single_checkbox`, levels = c("Green", "Multiple")) + ) + + 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 + ) + + 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 + ) + + out <- convert_metadata_spec(.new_col_item, metadata_spec, data_tbl_mod, + raw_or_label = "label", multi_value_label = "Multiple", 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")) ) expect_equal(out, expected_out)