From 9db8c899df7d26fdd8049a16f54eb95702700b68 Mon Sep 17 00:00:00 2001 From: Philip Chase Date: Wed, 15 Jan 2025 10:20:48 -0500 Subject: [PATCH] Add support for unvalidated text fields Address issues #3, #7. Add get_long_text_fields(). Add get_long_text_field_values(). Modify get_long_categorical_field_response_values(). Modify get_one_rectangle_of_values() Update proof_of_concept(). Update README to reflect the new feature. --- DESCRIPTION | 2 + NAMESPACE | 2 + ...t_long_categorical_field_response_values.R | 9 ++ R/get_long_text_field_values.R | 48 ++++++++++ R/get_long_text_fields.R | 85 ++++++++++++++++++ R/get_one_rectangle_of_values.R | 26 ++++-- README.md | 2 +- man/get_long_text_field_values.Rd | 24 +++++ man/get_long_text_fields.Rd | 35 ++++++++ man/get_one_rectangle_of_values.Rd | 5 +- proof_of_concept.R | 20 +++-- .../get_long_text_field_values/input.rds | Bin 0 -> 290 bytes .../make_test_data.R | 25 ++++++ .../get_long_text_fields/make_test_data.R | 23 +++++ .../get_long_text_fields/metadata.csv | 52 +++++++++++ .../get_one_rectangle_of_values/input.rds | Bin 0 -> 1857 bytes .../make_test_data.R | 10 +++ .../get_one_rectangle_of_values/metadata.csv | 21 +++++ .../test-get_long_text_field_values.R | 33 +++++++ tests/testthat/test-get_long_text_fields.R | 32 +++++++ .../test-get_one_rectangle_of_values.R | 16 ++-- 21 files changed, 449 insertions(+), 21 deletions(-) create mode 100644 R/get_long_text_field_values.R create mode 100644 R/get_long_text_fields.R create mode 100644 man/get_long_text_field_values.Rd create mode 100644 man/get_long_text_fields.Rd create mode 100644 tests/testthat/get_long_text_field_values/input.rds create mode 100644 tests/testthat/get_long_text_field_values/make_test_data.R create mode 100644 tests/testthat/get_long_text_fields/make_test_data.R create mode 100644 tests/testthat/get_long_text_fields/metadata.csv create mode 100644 tests/testthat/get_one_rectangle_of_values/input.rds create mode 100644 tests/testthat/get_one_rectangle_of_values/make_test_data.R create mode 100644 tests/testthat/get_one_rectangle_of_values/metadata.csv create mode 100644 tests/testthat/test-get_long_text_field_values.R create mode 100644 tests/testthat/test-get_long_text_fields.R diff --git a/DESCRIPTION b/DESCRIPTION index f461b61..b7c662c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,6 +37,8 @@ Suggests: Config/testthat/edition: 3 Imports: dplyr, + lorem, + purrr, rlang, tidyr RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 5974d5b..5a14d7e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,5 +2,7 @@ export(get_long_categorical_field_response_values) export(get_long_categorical_field_responses) +export(get_long_text_field_values) +export(get_long_text_fields) export(get_one_rectangle_of_values) importFrom(rlang,.data) diff --git a/R/get_long_categorical_field_response_values.R b/R/get_long_categorical_field_response_values.R index e4e5bb1..d5d5000 100644 --- a/R/get_long_categorical_field_response_values.R +++ b/R/get_long_categorical_field_response_values.R @@ -16,6 +16,14 @@ #' } get_long_categorical_field_response_values <- function(long_categorical_field_responses) { single_value_responses <- long_categorical_field_responses |> + # Filter for any categorical field_type + dplyr::filter(.data$field_type %in% c( + "checkbox", + "dropdown", + "radio", + "yesno" + )) |> + # Filter for anything but checkbox fields dplyr::filter(.data$field_type != "checkbox") |> dplyr::group_by(.data$field_name) |> dplyr::slice_sample(n = 1, weight_by = .data$weight) |> @@ -23,6 +31,7 @@ get_long_categorical_field_response_values <- function(long_categorical_field_re multi_value_responses <- long_categorical_field_responses |> + # Filter for checkbox fields dplyr::filter(.data$field_type == "checkbox") |> dplyr::group_by(.data$field_group) |> dplyr::slice_sample(prop = 0.5, weight_by = .data$weight) |> diff --git a/R/get_long_text_field_values.R b/R/get_long_text_field_values.R new file mode 100644 index 0000000..5201a12 --- /dev/null +++ b/R/get_long_text_field_values.R @@ -0,0 +1,48 @@ +#' @title generate text field values +#' @description +#' Provide a set of values for each field in the output of +#' `get_long_text_fields` +#' +#' @param long_text_fields a long data set of text +#' fields, their parameters, and weights. +#' +#' @return a long dataframe of text field values with one row for each value set. +#' @export +#' +#' @examples +#' \dontrun{ +#' get_long_text_field_values(long_text_fields) +#' } +get_long_text_field_values <- function(long_text_fields) { + tvt_na <- function(df) { + df |> + dplyr::filter(.data$tvt == "tvt_na") |> + dplyr::mutate(value = replicate(length(.data$field_name), lorem::ipsum_words(round(stats::rnorm(mean = .data$mean, sd = .data$sd, n = 1))))) + # |> + # dplyr::slice_sample(prop = 0.5, weight_by = .data$weight) + } + + tvt_types <- c( + "tvt_na" + ) + + process_one_text_validation_type <- function(my_tvt, df) { + # exec (run) the function named in `alert` on the rows of data that + # have an alert_type of `alert` + result <- rlang::exec(my_tvt, df |> + dplyr::filter(.data$tvt == my_tvt)) + return(result) + } + + text_field_values <- + purrr::map(tvt_types, + process_one_text_validation_type, + long_text_fields |> dplyr::filter(.data$field_type == "text") + ) |> + dplyr::bind_rows() + + result <- text_field_values |> + dplyr::select("field_name", "value") + + return(result) +} diff --git a/R/get_long_text_fields.R b/R/get_long_text_fields.R new file mode 100644 index 0000000..f32de06 --- /dev/null +++ b/R/get_long_text_fields.R @@ -0,0 +1,85 @@ +#' @title Get every text field response from a REDCap data dictionary +#' +#' @description +#' Given a REDCap data dictionary, enumerate every text field in that data dictionary and return a dataset with default weights +#' +#' @param metadata A REDCap data dictionary +#' +#' @returns a dataframe with these columns +#' \describe{ +#' \item{field_name}{REDCap field name} +#' \item{form_name}{REDCap form name} +#' \item{field_type}{REDCap field type} +#' \item{text_validation_type}{REDCap text validation type} +#' \item{text_validation_min}{REDCap text validation min} +#' \item{text_validation_max}{REDCap text validation max} +#' \item{tvt}{text validation type function name} +#' \item{weight}{a default weight for the field} +#' \item{mean}{mean of data to be generated} +#' \item{sd}{standard deviation of data to be generated} +#' } +#' @export +#' +#' @examples +#' \dontrun{ +#' long_text_fields <- +#' get_long_text_fields(metadata_to_populate) +#' } +get_long_text_fields <- function(metadata) { + text_fields <- + metadata |> + # include only categorical field types + dplyr::filter(.data$field_type %in% c("text")) |> + # excluding anything displayed by branching logic + dplyr::filter(is.na(.data$branching_logic)) |> + # narrow our focus to the required columns + dplyr::select(c( + "field_name", + "form_name", + "field_type", + "text_validation_type_or_show_slider_number", + "text_validation_min", + "text_validation_max" + )) |> + dplyr::rename(text_validation_type = "text_validation_type_or_show_slider_number") |> + dplyr::mutate(tvt = dplyr::case_when( + is.na(.data$text_validation_type) ~ "tvt_na", + TRUE ~ "tvt_unsupported" + )) |> + # set weights for each response + dplyr::mutate(weight = 100) + + tvt_na <- function(text_fields) { + result <- + text_fields |> + dplyr::filter(is.na(.data$text_validation_type)) |> + dplyr::mutate(mean = 1.5, sd = 0.8) + return(result) + } + + tvt_unsupported <- function(text_fields) { + result <- + text_fields |> + dplyr::filter(F) + return(result) + } + + tvt_types <- c( + "tvt_na", + "tvt_unsupported" + ) + + process_one_text_validation_type <- function(my_tvt, df) { + # exec (run) the function named in `alert` on the rows of data that + # have an alert_type of `alert` + result <- rlang::exec(my_tvt, df |> + dplyr::filter(.data$tvt == my_tvt)) + return(result) + } + + text_fields_and_weights <- + purrr::map(tvt_types, process_one_text_validation_type, text_fields) |> + dplyr::bind_rows() + + return(text_fields_and_weights) +} diff --git a/R/get_one_rectangle_of_values.R b/R/get_one_rectangle_of_values.R index b0d017d..e548a5f 100644 --- a/R/get_one_rectangle_of_values.R +++ b/R/get_one_rectangle_of_values.R @@ -3,7 +3,8 @@ #' @param one_record_id a single record_id #' @param record_id_name the column name the record_id should be returned in #' @param forms_to_fill the forms to fill for this rectangle -#' @param long_categorical_field_responses the output of `get_long_categorical_field_responses()` +#' @param long_fields_and_responses the output of `get_long_*_fields` and +#' `get_long_categorical_field_responses_responses` functions #' #' @returns a rectangle of data with appropriate REDCap identifiers ready to write to REDCap #' @export @@ -17,7 +18,7 @@ get_one_rectangle_of_values <- function( one_record_id = 1, record_id_name, forms_to_fill, - long_categorical_field_responses) { + long_fields_and_responses) { # Build tibble of static REDCap identifiers redcap_identifiers <- dplyr::tibble( record_id = one_record_id @@ -26,14 +27,25 @@ get_one_rectangle_of_values <- function( # fix the first column name names(redcap_identifiers) <- record_id_name + value_getter_functions <- c( + "get_long_categorical_field_response_values", + "get_long_text_field_values" + ) + + process_one_value_getter <- function(value_getter, df) { + rlang::exec(value_getter, df) + } + # pick values for one record on one event # ...by binding the output of each field_type / field_validation function - all_responses <- dplyr::bind_rows( - get_long_categorical_field_response_values( - long_categorical_field_responses |> + all_responses <- + purrr::map( + value_getter_functions, + process_one_value_getter, + long_fields_and_responses |> dplyr::filter(.data$form_name %in% forms_to_fill) - ) - ) + ) |> + dplyr::bind_rows() # prefix responses with redcap fields long_result <- dplyr::bind_cols( diff --git a/README.md b/README.md index 32685e6..220a58b 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,7 @@ Copy [proof_of_concept.R](https://github.com/ctsit/redcapfiller/blob/main/proof_ ### Limitations -REDCap Filler does not yet understand all the dimensions of a modern REDCap project. It can fill the categorical fields checkbox, dropdown, and radio. It ignores all other field types and will not attempt to fill them. It doesn't even know how to fill a yesno field. :-( Filler only knows how to fill classic projects without repeating forms or events. It does not honor form display logic and ignores all fields governed by branching logic. +REDCap Filler does not yet understand all the dimensions of a modern REDCap project. It can fill the categorical fields checkbox, dropdown, and radio. It can fill unvalidated text fields. It ignores all other field types and will not attempt to fill them. It doesn't even know how to fill a yesno field. :-( Filler only knows how to fill classic projects without repeating forms or events. It does not honor form display logic and ignores all fields governed by branching logic. Focusing more on what Filler _can_ do, the first release milestone will support these features: diff --git a/man/get_long_text_field_values.Rd b/man/get_long_text_field_values.Rd new file mode 100644 index 0000000..a7b28ed --- /dev/null +++ b/man/get_long_text_field_values.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_long_text_field_values.R +\name{get_long_text_field_values} +\alias{get_long_text_field_values} +\title{generate text field values} +\usage{ +get_long_text_field_values(long_text_fields) +} +\arguments{ +\item{long_text_fields}{a long data set of text +fields, their parameters, and weights.} +} +\value{ +a long dataframe of text field values with one row for each value set. +} +\description{ +Provide a set of values for each field in the output of +`get_long_text_fields` +} +\examples{ +\dontrun{ +get_long_text_field_values(long_text_fields) +} +} diff --git a/man/get_long_text_fields.Rd b/man/get_long_text_fields.Rd new file mode 100644 index 0000000..823d3c1 --- /dev/null +++ b/man/get_long_text_fields.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_long_text_fields.R +\name{get_long_text_fields} +\alias{get_long_text_fields} +\title{Get every text field response from a REDCap data dictionary} +\usage{ +get_long_text_fields(metadata) +} +\arguments{ +\item{metadata}{A REDCap data dictionary} +} +\value{ +a dataframe with these columns +\describe{ + \item{field_name}{REDCap field name} + \item{form_name}{REDCap form name} + \item{field_type}{REDCap field type} + \item{text_validation_type}{REDCap text validation type} + \item{text_validation_min}{REDCap text validation min} + \item{text_validation_max}{REDCap text validation max} + \item{tvt}{text validation type function name} + \item{weight}{a default weight for the field} + \item{mean}{mean of data to be generated} + \item{sd}{standard deviation of data to be generated} +} +} +\description{ +Given a REDCap data dictionary, enumerate every text field in that data dictionary and return a dataset with default weights +} +\examples{ +\dontrun{ +long_text_fields <- + get_long_text_fields(metadata_to_populate) +} +} diff --git a/man/get_one_rectangle_of_values.Rd b/man/get_one_rectangle_of_values.Rd index 36e4538..80e504d 100644 --- a/man/get_one_rectangle_of_values.Rd +++ b/man/get_one_rectangle_of_values.Rd @@ -8,7 +8,7 @@ get_one_rectangle_of_values( one_record_id = 1, record_id_name, forms_to_fill, - long_categorical_field_responses + long_fields_and_responses ) } \arguments{ @@ -18,7 +18,8 @@ get_one_rectangle_of_values( \item{forms_to_fill}{the forms to fill for this rectangle} -\item{long_categorical_field_responses}{the output of `get_long_categorical_field_responses()`} +\item{long_fields_and_responses}{the output of `get_long_*_fields` and +`get_long_categorical_field_responses_responses` functions} } \value{ a rectangle of data with appropriate REDCap identifiers ready to write to REDCap diff --git a/proof_of_concept.R b/proof_of_concept.R index e0e13e5..c3d095a 100644 --- a/proof_of_concept.R +++ b/proof_of_concept.R @@ -19,7 +19,8 @@ library(redcapfiller) path_credential <- Sys.getenv("path_credential") credentials <- REDCapR::retrieve_credential_local( path_credential, - project_id = Sys.getenv("filler_demo_pid") + project_id = 16255 + # Sys.getenv("filler_demo_pid") ) metadata <- REDCapR::redcap_metadata_read( @@ -43,15 +44,16 @@ field_types_we_know_how_to_fill <- c( "dropdown", # "notes", "radio", - # "text", + "text", "yesno" ) metadata_to_populate <- metadata |> - # Filter for record ID and forms we want to fill - filter(field_name == record_id_name | - form_name %in% forms_to_fill) |> + # exclude the record_id field from filling + filter(field_name != record_id_name) |> + # Filter for forms we want to fill + filter(form_name %in% forms_to_fill) |> # Exclude descriptive fields because they are not fillable filter(field_type != "descriptive") |> # Exclude calc fields because we don't control them @@ -85,13 +87,19 @@ record_ids <- seq(first_id, first_id + number_of_records_to_populate) # get the categorical field responses in a long table and populate them long_categorical_field_responses <- get_long_categorical_field_responses(metadata_to_populate) +long_text_fields <- get_long_text_fields(metadata_to_populate) + +long_fields_and_responses <- bind_rows( + long_categorical_field_responses, + long_text_fields +) picked_values <- purrr::map(record_ids, get_one_rectangle_of_values, record_id_name, forms_to_fill, - long_categorical_field_responses + long_fields_and_responses ) |> bind_rows() diff --git a/tests/testthat/get_long_text_field_values/input.rds b/tests/testthat/get_long_text_field_values/input.rds new file mode 100644 index 0000000000000000000000000000000000000000..45ba121647c88155a7dae61e254ed754137c48eb GIT binary patch literal 290 zcmV+-0p0!|iwFP!0000019ef$PQx$|+~!e~NFb#08?D5R8=Uw8kl1UXh) zPVgIWe4}{hjFL&`B;H=OveA7MP)D#fRy!q#V)yn&jDWZ$ zJU=mVMox&ebXLh=yLQaYQm(P>zm(iYD#yv$gpIZjkAvxrmV7?zRWefLyUl{fI%faz oId get_long_text_fields() + +long_text_fields |> saveRDS(testthat::test_path("get_long_text_field_values", "input.rds")) diff --git a/tests/testthat/get_long_text_fields/make_test_data.R b/tests/testthat/get_long_text_fields/make_test_data.R new file mode 100644 index 0000000..00b5e7a --- /dev/null +++ b/tests/testthat/get_long_text_fields/make_test_data.R @@ -0,0 +1,23 @@ +# Download the data dictionary from a copy of REDCapR's validation-types-1 project. +# See https://ctsit.github.io/redcapfiller/articles/demonstration_and_testing.html for details + +library(tidyverse) +library(REDCapR) +# Read environment from ".env" in the project directory +library(dotenv) +load_dot_env(".env") + +# Get our credentials using environment variables to locate +# the credentials file and describe the project in it +path_credential <- Sys.getenv("path_credential") +credentials <- REDCapR::retrieve_credential_local( + path_credential, + project_id = Sys.getenv("filler_demo_pid") +) + +metadata <- REDCapR::redcap_metadata_read( + token = credentials$token, + redcap_uri = credentials$redcap_uri +)$data + +metadata |> readr::write_csv(testthat::test_path("get_long_text_fields", "metadata.csv"), na = "") diff --git a/tests/testthat/get_long_text_fields/metadata.csv b/tests/testthat/get_long_text_fields/metadata.csv new file mode 100644 index 0000000..6cc2589 --- /dev/null +++ b/tests/testthat/get_long_text_fields/metadata.csv @@ -0,0 +1,52 @@ +field_name,form_name,section_header,field_type,field_label,select_choices_or_calculations,field_note,text_validation_type_or_show_slider_number,text_validation_min,text_validation_max,identifier,branching_logic,required_field,custom_alignment,question_number,matrix_group_name,matrix_ranking,field_annotation +record_id,form_1,,text,Record ID,,,,,,,,,,,,, +f_calculated,form_1,Menu of Field Types,calc,Calculated Field,3+4,,,,,,,,,,,, +f_checkbox,form_1,,checkbox,Checkboxes,"0, Zero|1, One|2, Two",,,,,,,,,,,, +f_descriptive,form_1,,descriptive,Descriptive Text,,,,,,,,,,,,, +f_dropdown,form_1,,dropdown,Dropdown,"0, Zero|1, One|2, Two",,,,,,,,,,,, +f_file_upload,form_1,,file,File Upload,,,,,,,,,,,,, +f_notes,form_1,,notes,Notes Box,,,,,,,,,,,,, +f_radio,form_1,,radio,Radio Buttons,"0, Zero|1, One|2, Two",,,,,,,,,,,, +f_signature,form_1,,file,Signature,,,signature,,,,,,,,,, +f_slider,form_1,,slider,Slider,5 | | 95,,,,33,,,,RH,,,, +f_slider2,form_1,,slider,Slider 2,20 | 30 | 60,,,,11,,,,RH,,,, +f_sql,form_1,,sql,Dynamic SQL,,,,,,,,,RH,,,, +f_text,form_1,,text,text box (no validation),,,,,,,,,,,,, +f_true_false,form_1,,truefalse,True -False,,,,,,,,,,,,, +f_yes_no,form_1,,yesno,Yes - No,,,,,,,,,,,,, +v_alpha_only,form_1,Menu of Validation Types (for Text Boxes),text,alpha_only,,,alpha_only,,,,,,,,,, +v_date_dmy,form_1,,text,Date (D-M-Y),,,date_dmy,,,,,,,,,, +v_date_mdy,form_1,,text,Date (M-D-Y),,,date_mdy,,,,,,,,,, +v_date_ymd,form_1,,text,Date (Y-M-D),,,date_ymd,,,,,,,,,, +v_datetime_dmy,form_1,,text,Datetime (D-M-Y H:M),,,datetime_dmy,,,,,,,,,, +v_datetime_mdy,form_1,,text,Datetime (M-D-Y H:M),,,datetime_mdy,,,,,,,,,, +v_datetime_seconds_dmy,form_1,,text,Datetime w/ seconds (D-M-Y H:M:S),,,datetime_seconds_dmy,,,,,,,,,, +v_datetime_seconds_mdy,form_1,,text,Datetime w/ seconds (M-D-Y H:M:S),,,datetime_seconds_mdy,,,,,,,,,, +v_datetime_seconds_ymd,form_1,,text,Datetime w/ seconds (Y-M-D H:M:S),,,datetime_seconds_ymd,,,,,,,,,, +v_datetime_ymd,form_1,,text,Datetime (Y-M-D H:M),,,datetime_ymd,,,,,,,,,, +v_email,form_1,,text,Email,,,email,,,,,,,,,, +v_integer,form_1,,text,Integer,,,integer,,,,,,,,,, +v_mrn_10d,form_1,,text,MRN (10 digits),,,mrn_10d,,,,,,,,,, +v_mrn_generic,form_1,,text,MRN (generic),,,mrn_generic,,,,,,,,,, +v_number,form_1,,text,Number,,,number,,,,,,,,,, +v_number_1dp,form_1,,text,Number (1 decimal place),,,number_1dp,,,,,,,,,, +v_number_2dp,form_1,,text,Number (2 decimal places),,,number_2dp,,,,,,,,,, +v_number_3dp,form_1,,text,Number (3 decimal places),,,number_3dp,,,,,,,,,, +v_number_4dp,form_1,,text,Number (4 decimal places),,,number_4dp,,,,,,,,,, +v_number_comma_decimal,form_1,,text,Number (comma as decimal),,,number_comma_decimal,,,,,,,,,, +v_number_1dp_comma_decimal,form_1,,text,Number (1 decimal place - comma as decimal),,,number_1dp_comma_decimal,,,,,,,,,, +v_number_2dp_comma_decimal,form_1,,text,Number (2 decimal places - comma as decimal),,,number_2dp_comma_decimal,,,,,,,,,, +v_number_3dp_comma_decimal,form_1,,text,Number (3 decimal places - comma as decimal),,,number_3dp_comma_decimal,,,,,,,,,, +v_number_4dp_comma_decimal,form_1,,text,Number (4 decimal places - comma as decimal),,,number_4dp_comma_decimal,,,,,,,,,, +v_phone,form_1,,text,Phone (North America),,,phone,,,,,,,,,, +v_phone_australia,form_1,,text,Phone (Australia),,,phone_australia,,,,,,,,,, +v_postalcode_australia,form_1,,text,Postal Code (Australia),,,postalcode_australia,,,,,,,,,, +v_postalcode_canada,form_1,,text,Postal Code (Canada),,,postalcode_canada,,,,,,,,,, +v_postalcode_french,form_1,,text,Code Postal 5 characters (France),,,postalcode_french,,,,,,,,,, +v_postalcode_germany,form_1,,text,Postal Code (Germany),,,postalcode_germany,,,,,,,,,, +v_ssn,form_1,,text,Social Security Number (U.S.),,,ssn,,,,,,,,,, +v_time_hh_mm,form_1,,text,Time (HH:MM),,,time,,,,,,,,,, +v_time_hh_mm_ss,form_1,,text,Time (HH:MM:SS),,,time_hh_mm_ss,,,,,,,,,, +v_time_mm_ss,form_1,,text,Time (MM:SS),,,time_mm_ss,,,,,,,,,, +v_vmrn,form_1,,text,Vanderbilt MRN,,,vmrn,,,,,,,,,, +v_zipcode,form_1,,text,Zipcode (U.S.),,,zipcode,,,,,,,,,, diff --git a/tests/testthat/get_one_rectangle_of_values/input.rds b/tests/testthat/get_one_rectangle_of_values/input.rds new file mode 100644 index 0000000000000000000000000000000000000000..e2d289a6fb7b13b570a80620df98bef58a7d4f8c GIT binary patch literal 1857 zcmV-H2fp|piwFP!000001MON%ZyU)G9!Zo%NtWZq?k32skwZWu^oyi-~~%bH3V7vS}=}ycTNV zqY}2cjZ?vdon548Xv+9|=64ihc}A^J=|`&B)|@FF4n^pr7Ns=75XwSWu4kK;8*6Hz z7HXju&KH&|Mw7*yO-AbUW0ga#vQSOaTCU|<{+IHmrlC;(4?@H8Q+px5T;e25Tl0}J;dlC#y!NicXrY5oY7n+4c719|4HM|rqTNTKKyV013u@_#VxV*Ou1_f ze{!(%=rmGN&=gM>+DA6#nwW`5$^6Dfn`Dwx!->f_6VZ%}xKz_ye(xQs6faN?`3cvR zuzLWL#GGW*_y9=;nY5 zT$1L1>Y1dezo6V3P-7^IbHgpJdvhRIEXEWsLk9w4VwCk$?hb@8?we&|KE@c8YcFpN zRBGo&G!OYmFRarQSZ|79+B@V^@`NUti3Nsv$0@(z+VI(;X24GcQ}b!3=4v!b;3j>PYi3UW8wL&ePP)jVPn4Sg*jo91ThyrB@WbZpVs zy*F@%Pgc5ZzY&JPMi;)<)|;71U|c1#C&Fal9lQOET1Z0DDuPVYHtFXhN1o?gTSZ=! z%F-pJNgq;AQ%N2qT$fFtR7KHv=_WKWVY#%q<~J&+pC2kqJe=!YB6>soM5N4q*P-0r zDLI6WC!Dm3wQPInHh~4G45|jV$uw3ZriM_cT4DtD(I^s7*<7{rhWzP)+asj)m}>F} z>P+Po6gEp-6CluJq{4!O7y~J6YLjnh<~)6>pdz-(fJ!k;n>pP*Mi%WCf=A|{!UUhDZGse|8M$0R2|+{-k0^G3`|*^pHry85Xuq=6s@vP zn|z(q1iYe&q6_P?+~0T$SfA#MmLYkR!wDrXR=*7L?WOphNrx&&1|ke4FM`Q+nF{5; zt9*Czt319z=EtU(f)O4Z7sP%$trf}(q)O(6MYxvwLoLf;MSVVXv^uuAic3hm6* zu6~qQ6_h;Y%-ytg(K1x>%8}*35tC=m1=6x-d!O4A;AN3_vT}6My6$A_U)>Li&xQ1>cbB6f*1fhd vJfTvA#eI%NoKIKV5`36-wuzo%)K2i7kc8vYlywur|KI-!PZZ21DKG#42%@WT literal 0 HcmV?d00001 diff --git a/tests/testthat/get_one_rectangle_of_values/make_test_data.R b/tests/testthat/get_one_rectangle_of_values/make_test_data.R new file mode 100644 index 0000000..8a8841f --- /dev/null +++ b/tests/testthat/get_one_rectangle_of_values/make_test_data.R @@ -0,0 +1,10 @@ +metadata_file <- testthat::test_path("get_one_rectangle_of_values", "metadata.csv") +metadata <- readr::read_csv(metadata_file) + +long_fields_and_responses <- dplyr::bind_rows( + get_long_categorical_field_responses(metadata), + get_long_text_fields(metadata) +) + +long_fields_and_responses |> + saveRDS(testthat::test_path("get_one_rectangle_of_values", "input.rds")) diff --git a/tests/testthat/get_one_rectangle_of_values/metadata.csv b/tests/testthat/get_one_rectangle_of_values/metadata.csv new file mode 100644 index 0000000..696c23b --- /dev/null +++ b/tests/testthat/get_one_rectangle_of_values/metadata.csv @@ -0,0 +1,21 @@ +field_name,form_name,section_header,field_type,field_label,select_choices_or_calculations,field_note,text_validation_type_or_show_slider_number,text_validation_min,text_validation_max,identifier,branching_logic,required_field,custom_alignment,question_number,matrix_group_name,matrix_ranking,field_annotation +record_id,tests,,text,Record ID,,,,,,,,,,,,, +incl_visit_date,tests,,text,Visit date,,,date_mdy,,,,,,,,,, +incl_icf_date,tests,,text,Date subject provided informed consent:,,,date_mdy,,,,"[event-name] = ""initial_study_visi_arm_1""",,,,,, +incl_1,tests,,yesno,Female at least 18 years old,,,,,,,,,,,,,@DEFAULT='[screening_arm_1][incl_1:value]' +excl_1,tests,,yesno,"Any condition that at the discretion of the investigator, medical doctor, or designee will impact the safety of the subject or the scientific integrity of the trial",,,,,,,,,,,,,@DEFAULT='[screening_arm_1][excl_5:value]' +bl_date,tests,,text,Today's date,,,date_mdy,,,,,y,LV,,,,@TODAY +bl_treatments,tests,,checkbox,Do you regularly use any of the following on your torso/ bra area? Choose all that apply.,"1, Lotions | 2, Exfoliants | 3, Other skin treatments, please specify below. | 0, None",,,,,,,y,LV,,,,@NONEOFTHEABOVE='0' +bl_treatments_other,tests,,text,Specify Other,,,,,,,[bl_treatments(3)] = '1',y,LV,,,, +bl_exercise,tests,,checkbox,Regular exercise (3 times per week),"1, Never | 2, In the past | 3, Now",,,,,,,y,LV,,,,@NONEOFTHEABOVE='1' +bl_caffeine,tests,,checkbox,Daily caffeinated drink,"1, Never | 2, In the past | 3, Now",,,,,,,y,LV,,,,@NONEOFTHEABOVE='1' +fname,tests,,text,First name,,,,,,y,,y,LV,,,, +lname,tests,,text,Last name,,,,,,y,,y,LV,,,, +dob,tests,,text,Date of birth,,,date_mdy,,,y,,y,LV,,,,@HIDEBUTTON +age,tests,,calc,Age,"rounddown(datediff([dob],[bl_date],""y""))",,,,,,,,LV,,,, +state,tests,,dropdown,State,"1, Alabama | 2, Alaska | 3, Arizona | 4, Arkansas | 5, California | 6, Colorado | 7, Connecticut | 8, Delaware | 9, District of Columbia | 10, Florida | 11, Georgia | 12, Hawaii | 13, Idaho | 14, Illinois | 15, Indiana | 16, Iowa | 17, Kansas | 18, Kentucky | 19, Louisiana | 20, Maine | 21, Maryland | 22, Massachusetts | 23, Michigan | 24, Minnesota | 25, Mississippi | 26, Missouri | 27, Montana | 28, Nebraska | 29, Nevada | 30, New Hampshire | 31, New Jersey | 32, New Mexico | 33, New York | 34, North Carolina | 35, North Dakota | 36, Ohio | 37, Oklahoma | 38, Oregon | 39, Pennsylvania | 40, Rhode Island | 41, South Carolina | 42, South Dakota | 43, Tennessee | 44, Texas | 45, Utah | 46, Vermont | 47, Virginia | 48, Washington | 49, West Virginia | 50, Wisconsin | 51, Wyoming",,,,,y,,y,LV,,,, +ethnicity,tests,,radio,Which category best describes your ethnic group?,"1, Hispanic/Latino (Mexican, Cuban, Puerto Rican, South or Central American, or other Spanish culture) | 0, Not Hispanic or Latino",,,,,,,y,LV,,,, +race,tests,,radio,Which category best describes your racial group?,"1, American Indian or Alaskan Native (North, Central, and South America, who has a tribal affiliation) | 2, Asian (Far East, Southeast Asia, Cambodia, China, India, Japan, Korea, Malaysia, Pakistan, Philippine Islands, Thailand, and Vietnam) | 3, Black or African-American | 4, Native Hawaiian or Other Pacific Islander (Hawaii, Guam, Samoa, or other Pacific Islands) | 5, Caucasian (European, Central/South American, Puerto Rican, Cuban, Middle Eastern, or North African) | 6, Multi-racial (specify races below) | 99, Choose not to provide",,,,,,,y,LV,,,, +race_multi,tests,,checkbox,Which categories best describes your multi-racial groups?,"1, American Indian or Alaskan Native (North, Central, and South America, who has a tribal affiliation) | 2, Asian (Far East, Southeast Asia, Cambodia, China, India, Japan, Korea, Malaysia, Pakistan, Philippine Islands, Thailand, and Vietnam.) | 3, Black or African-American | 4, Native Hawaiian or Other Pacific Islander (Hawaii, Guam, Samoa, or other Pacific Islands) | 5, Caucasian (European, Central/South American, Puerto Rican, Cuban, Middle Eastern, or North African)",Check all that apply,,,,,[race] = '6',y,LV,,,, +occupation,tests,,radio,Occupation,"1, Homemaker, raising children, care of others | 2, Managerial, professional specialty (executive, managerial, administrative, teacher, guidance counselor, registered nurse, doctor, etc.) | 3, Operators, fabricators, and laborers (factory, transport, construction work, assembly, etc.) | 4, Service protective service (police, fire), health or food services, craft and repair, farming, etc. | 5, Technical, sales, and administrative support (technical, sales, administrative support, clerical work, etc.) | 6, Disabled/Unable to work | 7, Student | 8, Currently unemployed | 88, Other (specify below)",,,,,,,y,LV,,,, +occupation_other,tests,,text,Specify other occupation,,,,,,,[occupation] = '88',y,LV,,,, diff --git a/tests/testthat/test-get_long_text_field_values.R b/tests/testthat/test-get_long_text_field_values.R new file mode 100644 index 0000000..b0bdd38 --- /dev/null +++ b/tests/testthat/test-get_long_text_field_values.R @@ -0,0 +1,33 @@ +long_text_field_values <- readRDS( + testthat::test_path("get_long_text_field_values", "input.rds") +) + +output <- get_long_text_field_values(long_text_field_values) +output_b <- get_long_text_field_values(long_text_field_values) +output_c <- get_long_text_field_values(long_text_field_values) + +testthat::test_that("get_long_text_field_values returns field_name and value columns", { + testthat::expect_true(all.equal( + names(output), + c("field_name", "value") + )) +}) + +testthat::test_that("get_long_text_field_values returns a constant vector of field_names when called repeatedly", { + testthat::expect_true(identical( + output$field_name, output_b$field_name + )) + testthat::expect_true(identical( + output$field_name, output_c$field_name + )) +}) + +testthat::test_that("get_long_text_field_values returns a varying vector of values when called repeatedly", { + testthat::expect_false(identical( + output$value, output_b$value + )) + testthat::expect_false(identical( + output$value, output_c$value + )) +}) + diff --git a/tests/testthat/test-get_long_text_fields.R b/tests/testthat/test-get_long_text_fields.R new file mode 100644 index 0000000..2fa0992 --- /dev/null +++ b/tests/testthat/test-get_long_text_fields.R @@ -0,0 +1,32 @@ +metadata_file <- testthat::test_path("get_long_text_fields", "metadata.csv") +metadata <- readr::read_csv(metadata_file) + +output <- get_long_text_fields(metadata) + +testthat::test_that("get_long_text_fields: processes only text fields", { + testthat::expect_equal( + output |> + dplyr::distinct(field_type) |> + dplyr::pull(field_type), + c("text") + ) +}) + +testthat::test_that("get_long_text_fields: returns the validation type columns", { + text_validation_columns <- c( + "text_validation_type", + "text_validation_min", + "text_validation_max" + ) + testthat::expect_equal( + output |> dplyr::select(dplyr::all_of(text_validation_columns)) |> names(), + text_validation_columns + ) +}) + +testthat::test_that("get_long_text_fields: weights are balanced", { + testthat::expect_true(output |> + dplyr::summarise(balanced = (min(weight) == max(weight))) |> + dplyr::distinct(balanced) |> + dplyr::pull(balanced)) +}) diff --git a/tests/testthat/test-get_one_rectangle_of_values.R b/tests/testthat/test-get_one_rectangle_of_values.R index 215fb7b..fefba30 100644 --- a/tests/testthat/test-get_one_rectangle_of_values.R +++ b/tests/testthat/test-get_one_rectangle_of_values.R @@ -1,19 +1,21 @@ -long_categorical_field_responses <- readRDS( - testthat::test_path("get_long_categorical_field_response_values", "input.rds") -) +long_fields_and_responses <- readRDS( + testthat::test_path("get_one_rectangle_of_values", "input.rds") +) |> + # filter out the record_id row because we are generating it in these tests + dplyr::filter(.data$field_name != "record_id") output <- get_one_rectangle_of_values( one_record_id = 1, record_id_name = "record_id", forms_to_fill = "tests", - long_categorical_field_responses + long_fields_and_responses ) output_with_special_record_id <- get_one_rectangle_of_values( one_record_id = 1, record_id_name = "special_id", forms_to_fill = "tests", - long_categorical_field_responses + long_fields_and_responses ) testthat::test_that("get_one_rectangle_of_values: ethnicity, occupation, race, and state are represented in the columns", { @@ -27,3 +29,7 @@ testthat::test_that("get_one_rectangle_of_values: bl_caffeine, bl_exercise, and testthat::test_that("get_one_rectangle_of_values: special_id is in the record_id position", { testthat::expect_equal(names(output_with_special_record_id)[[1]], "special_id") }) + +testthat::test_that("get_one_rectangle_of_values: fname and lname are represented in the columns", { + testthat::expect_true(all(c("fname", "lname") %in% gsub("___.*", "", names(output)))) +})