From 62080afd33a73d0e9332f007e8ff9d65339a3a6c Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Mon, 15 Jul 2024 16:38:59 -0400 Subject: [PATCH] Add standard checks for params --- R/reduce_multi_to_single_column.R | 35 ++++++++++++------- man/combine_checkboxes.Rd | 7 ++-- man/get_metadata_ref.Rd | 4 +-- .../test-reduce_multi_to_single_column.R | 10 +++--- 4 files changed, 32 insertions(+), 24 deletions(-) diff --git a/R/reduce_multi_to_single_column.R b/R/reduce_multi_to_single_column.R index 1f3fe717..b4119fe8 100644 --- a/R/reduce_multi_to_single_column.R +++ b/R/reduce_multi_to_single_column.R @@ -7,8 +7,7 @@ #' factor column. #' #' @param supertbl A supertibble generated by [read_redcap()]. Required. -#' @param form_name The name of the REDCap form (instrument) containing the checkbox -#' fields. 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 #' single column. Required. #' @param values_to A string specifying the name of the column to combine checkbox @@ -28,7 +27,7 @@ #' supertbl <- read_redcap(redcap_uri, token) #' combined_tbl <- combine_checkboxes( #' supertbl = supertbl, -#' form_name = "demographics", +#' tbl = "demographics", #' cols = starts_with("race"), #' values_to = "race_combined", #' multi_value_label = "Multiple", @@ -39,19 +38,29 @@ #' @export combine_checkboxes <- function(supertbl, - form_name, + tbl, cols, values_to, 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(tbl, len = 1, any.missing = FALSE) + check_arg_is_character(values_to, 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) + check_arg_choices(raw_or_label, choices = c("label", "raw")) + check_arg_is_logical(keep, len = 1, any.missing = FALSE) + # Save user cols to enquosure cols_exp <- enquo(cols) - # Extract form_name from supertbl + # Extract tbl from supertbl data_tbl <- supertbl %>% - extract_tibble(form_name) + extract_tibble(tbl) # Get field names from cols_exp, check that fields exist field_names <- names(eval_select(cols_exp, data = data_tbl)) @@ -59,7 +68,7 @@ combine_checkboxes <- function(supertbl, # Assume the first instrument in the metadata contains IDs # REDCap enforces this constraints, we reflect this in read_redcap -> get_field_to_drop - record_id_field <- supertbl$redcap_metadata[supertbl$redcap_form_name == form_name][[1]]$field_name[1] + record_id_field <- supertbl$redcap_metadata[supertbl$redcap_form_name == tbl][[1]]$field_name[1] # Combine record identifier with remaining possible project identifiers instrument_identifiers <- c( @@ -82,7 +91,7 @@ combine_checkboxes <- function(supertbl, ) # Get metadata reference table, check that chosen fields are checkboxes - metadata <- get_metadata_ref(data_tbl_mod, supertbl, form_name, instrument_identifiers) + metadata <- get_metadata_ref(data_tbl_mod, supertbl, tbl, instrument_identifiers) # Replace TRUEs/1s with raw/label values from metadata data_tbl_mod <- data_tbl_mod %>% @@ -115,7 +124,7 @@ combine_checkboxes <- function(supertbl, !!values_to := factor(!!sym(values_to), levels = c(metadata[[raw_or_label]], multi_value_label, values_fill)) ) - # Join back onto original data form_name + # Join back onto original data tbl data_tbl_mod <- data_tbl_mod %>% right_join(data_tbl, by = intersect(instrument_identifiers, names(data_tbl_mod))) %>% relocate(!!values_to, .after = everything()) @@ -127,7 +136,7 @@ combine_checkboxes <- function(supertbl, } # Update the supertbl data tibble - supertbl$redcap_data[supertbl$redcap_form_name == form_name][[1]] <- data_tbl_mod + supertbl$redcap_data[supertbl$redcap_form_name == tbl][[1]] <- data_tbl_mod supertbl } @@ -136,7 +145,7 @@ combine_checkboxes <- function(supertbl, #' #' @param data a data tibble #' @param supertbl A supertibble generated by [read_redcap()]. -#' @param form_name The name of the REDCap form (instrument) containing the checkbox +#' @param tbl The name of the REDCap form (instrument) containing the checkbox #' fields. #' @param instrument_identifiers Character string vector of project record identifier vars #' @@ -145,10 +154,10 @@ combine_checkboxes <- function(supertbl, #' @keywords internal get_metadata_ref <- function(data, supertbl, - form_name, + tbl, instrument_identifiers) { # Create a metadata reference table linking field name to raw and label values - out <- supertbl$redcap_metadata[supertbl$redcap_form_name == form_name][[1]] %>% + out <- supertbl$redcap_metadata[supertbl$redcap_form_name == tbl][[1]] %>% filter(.data$field_name %in% names(data)[!names(data) %in% instrument_identifiers]) # Make sure selection is checkbox metadata field type diff --git a/man/combine_checkboxes.Rd b/man/combine_checkboxes.Rd index 8fc340e3..f7b347c8 100644 --- a/man/combine_checkboxes.Rd +++ b/man/combine_checkboxes.Rd @@ -6,7 +6,7 @@ \usage{ combine_checkboxes( supertbl, - form_name, + tbl, cols, values_to, multi_value_label = "Multiple", @@ -18,8 +18,7 @@ combine_checkboxes( \arguments{ \item{supertbl}{A supertibble generated by \code{\link[=read_redcap]{read_redcap()}}. Required.} -\item{form_name}{The name of the REDCap form (instrument) containing the checkbox -fields. Required.} +\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 single column. Required.} @@ -52,7 +51,7 @@ factor column. supertbl <- read_redcap(redcap_uri, token) combined_tbl <- combine_checkboxes( supertbl = supertbl, - form_name = "demographics", + tbl = "demographics", cols = starts_with("race"), values_to = "race_combined", multi_value_label = "Multiple", diff --git a/man/get_metadata_ref.Rd b/man/get_metadata_ref.Rd index 75ff31c4..3ff8f401 100644 --- a/man/get_metadata_ref.Rd +++ b/man/get_metadata_ref.Rd @@ -4,14 +4,14 @@ \alias{get_metadata_ref} \title{Utility function for getting metadata raw and label values for checkboxes} \usage{ -get_metadata_ref(data, supertbl, form_name, instrument_identifiers) +get_metadata_ref(data, supertbl, tbl, instrument_identifiers) } \arguments{ \item{data}{a data tibble} \item{supertbl}{A supertibble generated by \code{\link[=read_redcap]{read_redcap()}}.} -\item{form_name}{The name of the REDCap form (instrument) containing the checkbox +\item{tbl}{The name of the REDCap form (instrument) containing the checkbox fields.} \item{instrument_identifiers}{Character string vector of project record identifier vars} diff --git a/tests/testthat/test-reduce_multi_to_single_column.R b/tests/testthat/test-reduce_multi_to_single_column.R index 7c807f30..79596220 100644 --- a/tests/testthat/test-reduce_multi_to_single_column.R +++ b/tests/testthat/test-reduce_multi_to_single_column.R @@ -39,7 +39,7 @@ class(supertbl) <- c("redcap_supertbl", class(supertbl)) test_that("combine_checkboxes returns an expected supertbl", { out <- combine_checkboxes( supertbl = supertbl, - form_name = "nonrepeat_instrument", + tbl = "nonrepeat_instrument", cols = starts_with("multi"), values_to = "new_col" ) # values_fill declared @@ -51,7 +51,7 @@ test_that("combine_checkboxes returns an expected supertbl", { test_that("combine_checkboxes works for nonrepeat instrument", { out <- combine_checkboxes( supertbl = supertbl, - form_name = "nonrepeat_instrument", + tbl = "nonrepeat_instrument", cols = starts_with("multi"), values_to = "new_col", multi_value_label = "multiple", # multi_value_label declared @@ -76,7 +76,7 @@ test_that("combine_checkboxes works for nonrepeat instrument", { test_that("combine_checkboxes works for nonrepeat instrument and drop old values", { out <- combine_checkboxes( supertbl = supertbl, - form_name = "nonrepeat_instrument", + tbl = "nonrepeat_instrument", cols = starts_with("multi"), values_to = "new_col", keep = FALSE # Test keep = FALSE @@ -100,7 +100,7 @@ test_that("combine_checkboxes works for nonrepeat instrument and drop old values test_that("combine_checkboxes works for repeat instrument", { out <- combine_checkboxes( supertbl = supertbl, - form_name = "repeat_instrument", + tbl = "repeat_instrument", cols = starts_with("repeat"), values_to = "new_col" ) %>% @@ -128,7 +128,7 @@ test_that("get_metadata_ref works", { out <- get_metadata_ref( data = data, supertbl = supertbl, - form_name = "nonrepeat_instrument", + tbl = "nonrepeat_instrument", instrument_identifiers = "study_id" )