From b2187fc3023e982b5ba886ca33721e951762df89 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 6 Feb 2025 15:26:38 +0100 Subject: [PATCH 1/9] Solving issue when splitting the data by form while having repeated instruments --- R/utils-transform.R | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/R/utils-transform.R b/R/utils-transform.R index 5979ff6..b0d069c 100644 --- a/R/utils-transform.R +++ b/R/utils-transform.R @@ -459,8 +459,18 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ stop("To split the data by form the event_form has to be provided in a longitudinal project", call. = FALSE) } + #Check if the project has repeated instruments + if("redcap_repeat_instrument" %in% names(data)) { + repeat_instrument <- dplyr::case_when( + any(!is.na(data$redcap_repeat_instrument)) ~ TRUE, + TRUE ~ FALSE + ) + } else { + repeat_instrument <- FALSE + } + #Find basic REDCap variables found in the database - basic_redcap_vars <- c("record_id","redcap_event_name","redcap_repeat_instrument","redcap_repeat_instance","redcap_data_access_group","redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_survey_identifier") + basic_redcap_vars <- c("record_id","redcap_event_name","redcap_repeat_instrument", "redcap_repeat_instrument.factor","redcap_repeat_instance","redcap_data_access_group","redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_survey_identifier") basic_redcap_vars <- basic_redcap_vars[basic_redcap_vars%in%names(data)] @@ -525,6 +535,26 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ dplyr::select(tidyselect::all_of(unique(c(basic_redcap_vars, .x)))))) } + if(repeat_instrument) { + form_check <- data %>% + dplyr::distinct(redcap_repeat_instrument, redcap_repeat_instrument.factor) + + ndata <- ndata %>% + dplyr::left_join(form_check, by = dplyr::join_by("form" == "redcap_repeat_instrument")) %>% + dplyr::relocate("form_factor" = "redcap_repeat_instrument.factor", .after = form) %>% + dplyr::mutate(df = purrr::map2(.data$form_factor, .data$df, ~ { + if (is.na(.x)) { + .y %>% + dplyr::filter(is.na(redcap_repeat_instrument.factor)) + } else { + .y %>% + dplyr::filter(redcap_repeat_instrument.factor == .x) + } + })) %>% + dplyr::select(-"form_factor") + } + + if(wide){ @@ -569,12 +599,13 @@ to_factor <- function(data, dic, exclude = NULL){ #We need redcap_event_name to have the original values so we exclude of the conversion the variable redcap_event_name.factor. Also for redcap_data_access_group if present - keep <- c("redcap_event_name.factor", "redcap_data_access_group.factor") + keep <- c("redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_repeat_instrument.factor") keep_factors <- data %>% dplyr::select(keep[keep %in% names(data)]) data$redcap_event_name.factor <- NULL data$redcap_data_access_group.factor <- NULL + data$redcap_repeat_instrument.factor <- NULL factors <- names(data)[grep("\\.factor$",names(data))] factors <- gsub("\\.factor$","",factors) @@ -586,7 +617,8 @@ to_factor <- function(data, dic, exclude = NULL){ #Assign to the non factor variable the factor one and remove the later dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get(stringr::str_glue("{dplyr::cur_column()}.factor")))) %>% dplyr::select(-tidyselect::ends_with(".factor")) %>% - tibble::add_column("redcap_event_name.factor" = keep_factors$redcap_event_name.factor, .after = "redcap_event_name") + tibble::add_column("redcap_event_name.factor" = keep_factors$redcap_event_name.factor, .after = "redcap_event_name") %>% + tibble::add_column("redcap_repeat_instrument.factor" = keep_factors$redcap_repeat_instrument.factor, .after = "redcap_repeat_instrument") if (length(factors) > 0) { From 790deebc6b29e593dc245248f467e8466fbe719f Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Wed, 12 Nov 2025 15:08:03 +0100 Subject: [PATCH 2/9] review --- .Rbuildignore | 1 + .github/workflows/test-coverage.yaml | 62 + DESCRIPTION | 19 +- NAMESPACE | 13 +- R/REDCapDM-package.R | 49 + R/REDCapDM_PACKAGE.R | 37 - R/check_queries.R | 154 +- R/rd_checkbox.R | 380 +++++ R/rd_dates.R | 125 ++ R/rd_delete_vars.R | 161 ++ R/rd_dictionary.R | 229 +++ R/rd_event.R | 534 ++++--- R/rd_export.R | 127 +- R/rd_factor.R | 154 ++ R/rd_insert_na.R | 166 +- R/rd_query.R | 1412 ++++++++--------- R/rd_recalculate.R | 243 +++ R/rd_rlogic.R | 461 +++--- R/rd_split.R | 345 ++++ R/rd_transform.R | 404 ++--- R/redcap_data.R | 402 +++-- R/suplementary_package.R | 124 +- R/utils-pipe.R | 14 - R/utils-suplement.R | 116 ++ R/utils-transform.R | 217 ++- R/zzz.R | 7 +- README.md | 54 +- REDCapDM.Rproj | 5 +- man/REDCapDM-package.Rd | 61 +- man/check_proj.Rd | 22 + man/check_queries.Rd | 39 +- man/checkbox_names.Rd | 2 +- man/covican.Rd | 52 +- man/figures/Thumbs.db | Bin 14336 -> 14336 bytes man/figures/lifecycle-deprecated.svg | 21 + man/figures/lifecycle-experimental.svg | 21 + man/figures/lifecycle-stable.svg | 29 + man/figures/lifecycle-superseded.svg | 21 + man/fill_data.Rd | 4 +- man/pipe.Rd | 20 - man/rd_checkbox.Rd | 71 + man/rd_dates.Rd | 46 + man/rd_delete_vars.Rd | 70 + man/rd_dictionary.Rd | 38 + man/rd_event.Rd | 54 +- man/rd_export.Rd | 37 +- man/rd_factor.Rd | 52 + man/rd_insert_na.Rd | 42 +- man/rd_query.Rd | 78 +- man/rd_recalculate.Rd | 69 + man/rd_rlogic.Rd | 52 +- man/rd_split.Rd | 64 + man/rd_transform.Rd | 26 +- man/recalculate.Rd | 2 +- man/redcap_data.Rd | 74 +- man/round.Rd | 25 + man/split_form.Rd | 2 +- man/to_factor.Rd | 4 +- man/transform_checkboxes.Rd | 4 +- tests/testthat.R | 12 + tests/testthat/test-check_queries.R | 72 + tests/testthat/test-rd_checkbox.R | 79 + tests/testthat/test-rd_dates.R | 89 ++ tests/testthat/test-rd_delete_vars.R | 73 + tests/testthat/test-rd_dic.R | 119 ++ tests/testthat/test-rd_event.R | 98 ++ tests/testthat/test-rd_export.R | 104 ++ tests/testthat/test-rd_factor.R | 52 + tests/testthat/test-rd_insert_na.R | 128 ++ tests/testthat/test-rd_query.R | 546 +++++++ tests/testthat/test-rd_recalculate.R | 83 + tests/testthat/test-rd_rlogic.R | 225 +++ tests/testthat/test-rd_split.R | 250 +++ tests/testthat/test-rd_transform.R | 172 ++ tests/testthat/test-redcap_data.R | 422 +++++ vignettes/Data-reading-and-processing.Rmd | 149 -- vignettes/REDCapDM.Rmd | 411 ++++- .../articles/Data-reading-and-processing.Rmd | 184 +++ vignettes/{ => articles}/Queries.Rmd | 33 +- vignettes/markdown.css | 52 - 80 files changed, 7893 insertions(+), 2577 deletions(-) create mode 100644 .github/workflows/test-coverage.yaml create mode 100644 R/REDCapDM-package.R delete mode 100644 R/REDCapDM_PACKAGE.R create mode 100644 R/rd_checkbox.R create mode 100644 R/rd_dates.R create mode 100644 R/rd_delete_vars.R create mode 100644 R/rd_dictionary.R create mode 100644 R/rd_factor.R create mode 100644 R/rd_recalculate.R create mode 100644 R/rd_split.R delete mode 100644 R/utils-pipe.R create mode 100644 R/utils-suplement.R create mode 100644 man/check_proj.Rd create mode 100644 man/figures/lifecycle-deprecated.svg create mode 100644 man/figures/lifecycle-experimental.svg create mode 100644 man/figures/lifecycle-stable.svg create mode 100644 man/figures/lifecycle-superseded.svg delete mode 100644 man/pipe.Rd create mode 100644 man/rd_checkbox.Rd create mode 100644 man/rd_dates.Rd create mode 100644 man/rd_delete_vars.Rd create mode 100644 man/rd_dictionary.Rd create mode 100644 man/rd_factor.Rd create mode 100644 man/rd_recalculate.Rd create mode 100644 man/rd_split.Rd create mode 100644 man/round.Rd create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-check_queries.R create mode 100644 tests/testthat/test-rd_checkbox.R create mode 100644 tests/testthat/test-rd_dates.R create mode 100644 tests/testthat/test-rd_delete_vars.R create mode 100644 tests/testthat/test-rd_dic.R create mode 100644 tests/testthat/test-rd_event.R create mode 100644 tests/testthat/test-rd_export.R create mode 100644 tests/testthat/test-rd_factor.R create mode 100644 tests/testthat/test-rd_insert_na.R create mode 100644 tests/testthat/test-rd_query.R create mode 100644 tests/testthat/test-rd_recalculate.R create mode 100644 tests/testthat/test-rd_rlogic.R create mode 100644 tests/testthat/test-rd_split.R create mode 100644 tests/testthat/test-rd_transform.R create mode 100644 tests/testthat/test-redcap_data.R delete mode 100644 vignettes/Data-reading-and-processing.Rmd create mode 100644 vignettes/articles/Data-reading-and-processing.Rmd rename vignettes/{ => articles}/Queries.Rmd (80%) delete mode 100644 vignettes/markdown.css diff --git a/.Rbuildignore b/.Rbuildignore index c0537c2..eed7b8e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,3 +7,4 @@ ^docs$ ^pkgdown$ ^\.github$ +^vignettes/articles$ diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..0ab748d --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,62 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: test-coverage.yaml + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2 + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + print(cov) + covr::to_cobertura(cov) + shell: Rscript {0} + + - uses: codecov/codecov-action@v5 + with: + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/DESCRIPTION b/DESCRIPTION index 8492ff5..76e597e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: REDCapDM Type: Package Title: 'REDCap' Data Management -Version: 0.9.9 +Version: 1.0.0 Authors@R: c( person("João", "Carmezim", email = "jcarmezim@igtp.cat", role = c("aut", "cre")), person("Pau", "Satorra", role = c("aut")), @@ -11,16 +11,15 @@ Authors@R: c( person("Cristian", "Tebé", role = c("aut")) ) Maintainer: João Carmezim -Description: REDCap Data Management - REDCapDM is an R package that allows users to manage data exported directly from REDCap or using an API connection. This package includes several functions designed for pre-processing data, generating reports of queries such as outliers or missing values, and following up on the identified queries. 'REDCap' (Research Electronic Data CAPture; ) is a web application developed at Vanderbilt University, designed for creating and managing online surveys and databases and the REDCap API is an interface that allows external applications to connect to REDCap remotely, and is used to programmatically retrieve or modify project data or settings within REDCap, such as importing or exporting data. +Description: REDCap Data Management - 'REDCap' (Research Electronic Data CAPture; ) is a web application developed at Vanderbilt University, designed for creating and managing online surveys and databases and the REDCap API is an interface that allows external applications to connect to REDCap remotely, and is used to programmatically retrieve or modify project data or settings within REDCap, such as importing or exporting data. REDCapDM is an R package that allows users to manage data exported directly from REDCap or using an API connection. This package includes several functions designed for pre-processing data, generating reports of queries such as outliers or missing values, and following up on previously identified queries. License: MIT + file LICENSE URL: https://bruigtp.github.io/REDCapDM/, https://doi.org/10.1186/s12874-024-02178-6 BugReports: https://github.com/bruigtp/REDCapDM/issues Encoding: UTF-8 -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Imports: dplyr, janitor, - magrittr, openxlsx, purrr, REDCapR, @@ -33,12 +32,18 @@ Imports: utils, stringi, cli, - forcats + forcats, + lifecycle Suggests: knitr, rmarkdown, - kableExtra + kableExtra, + testthat (>= 3.0.0), + mockery VignetteBuilder: knitr Depends: - R (>= 3.6) + R (>= 4.1) LazyData: true +Config/testthat/edition: 3 +Config/Needs/website: rmarkdown +Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index 10dbec9..4560580 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,15 +1,24 @@ # Generated by roxygen2: do not edit by hand -export("%>%") +export(check_proj) export(check_queries) +export(rd_checkbox) +export(rd_dates) +export(rd_delete_vars) +export(rd_dictionary) export(rd_event) export(rd_export) +export(rd_factor) export(rd_insert_na) export(rd_query) +export(rd_recalculate) export(rd_rlogic) +export(rd_split) export(rd_transform) export(redcap_data) +export(round) import(cli) -importFrom(magrittr,"%>%") +importFrom(lifecycle,deprecated) importFrom(rlang,":=") importFrom(rlang,.data) +importFrom(stats,setNames) diff --git a/R/REDCapDM-package.R b/R/REDCapDM-package.R new file mode 100644 index 0000000..930d38c --- /dev/null +++ b/R/REDCapDM-package.R @@ -0,0 +1,49 @@ +#' @name REDCapDM-package +#' @keywords internal +#' @aliases REDCapDM +#' +#' @title Managing REDCap Data: The R package REDCapDM / REDCapDM: A Toolkit for Managing REDCap Data in R +#' +#' @description +#' The **REDCapDM** package provides tools to import, process, and manage REDCap data within R. +#' It supports data retrieval through the REDCap API or directly from exported files and includes a robust +#' set of functions for data transformation, validation, and discrepancy management. Designed for efficient +#' workflow integration, **REDCapDM** simplifies the handling of REDCap datasets, making it easier to ensure +#' data quality and consistency. +#' +#' Key Features: +#' +#' - **Flexible Data Import**: Import data directly from REDCap using API connections or process exported REDCap files. +#' - **Data Transformation**: Streamline the cleaning and preparation of raw datasets for analysis. +#' - **Query Management**: Identify and track data discrepancies, missing events, and manage resolution reports. +#' +#' Core Functions: +#' +#' - `redcap_data`: Reads data exported from REDCap or retrieved through the REDCap API. +#' - `rd_transform`: Processes raw REDCap datasets into a structured and analyzable format. +#' - `transform_dates`: Transform dates and datetimes variables. +#' - `recalculate`: Recalculates REDCap calculated fields, compares them to originals, and reports discrepancies. +#' - `to_factor`: Converts variables to factors and updates the dictionary's branching logic. +#' - `rd_delete_vars`: Deletes specified or pattern-matched variables from the data and dictionary. +#' - `transform_checkbox`: Transforms the names of REDCap checkbox variables and updates the branching logic in the dictionary. +#' - `transform_dic`: Evaluates and transforms branching logic in the REDCap dictionary into R logic. +#' - `rd_split`: Splits a REDCap dataset by form or event. +#' - `rd_rlogic`: Converts REDCap branching and conditional logic into R-compatible expressions. +#' - `rd_insert_na`: Inserts missing values into specified variables based on filters. +#' - `rd_query`: Identifies discrepancies (queries) in the dataset for validation. +#' - `rd_event`: Detects missing events in longitudinal datasets. +#' - `check_queries`: Compares historical and current query reports to track changes and additions. +#' - `rd_export`: Exports a summary report of identified queries to an Excel (.xlsx) file. +#' +#' +#' @examples +#' \dontrun{ +#' # Install REDCapDM from CRAN: +#' install.packages("REDCapDM") +#' +#' # Install the latest version of REDCapDM from GitHub: +#' remotes::install_github("bruigtp/REDCapDM") +#' } +#' +#' @importFrom lifecycle deprecated +NULL diff --git a/R/REDCapDM_PACKAGE.R b/R/REDCapDM_PACKAGE.R deleted file mode 100644 index 235f73f..0000000 --- a/R/REDCapDM_PACKAGE.R +++ /dev/null @@ -1,37 +0,0 @@ -#' @name REDCapDM-package -#' @keywords internal -#' @aliases REDCapDM -#' -#' @title Managing REDCap Data: The R package REDCapDM -#' -#' @description -#' -#' The REDCapDM package facilitates the importing of data from REDCap into R through either an API connection or directly from exported files. It includes a range of data processing and transformation functions, and supports the creation and management of queries to address any discrepancies or uncertainties within the dataset. -#' -#' REDCapDM functions: -#' -#' - `redcap_data`: reads data exported directly from REDCap or via an API connection. -#' -#' - `rd_transform`: processes the raw dataset. -#' -#' - `rd_rlogic`: translates REDCap logic into R logic. -#' -#' - `rd_insert_na`: manually inserts a missing value for specified variables using a filter. -#' -#' - `rd_query`: identifies discrepancies in the dataset (queries). -#' -#' - `rd_event`: identifies missing events in each record of the dataset. -#' -#' - `check_queries`: compares a current report of queries with an older one to determine which queries have been modified, which remain unchanged, and which are new. -#' -#' - `rd_export`: exports a report of identified queries to an .xlsx file. -#' -#' @examples -#' \dontrun{ -#' # Install REDCapDM from CRAN: -#' install.packages('REDCapR') -#' -#' # Install REDCapDM from GitHub: -#' remotes::install_github('bruigtp/REDCapDM') -#' } -NULL diff --git a/R/check_queries.R b/R/check_queries.R index c8e5e2f..14aa8fd 100644 --- a/R/check_queries.R +++ b/R/check_queries.R @@ -1,104 +1,122 @@ #' Check for Changes Between Two Query Reports #' -#' This function compares an old report of queries with a new one. It allows you to identify which queries are new, which have been modified, and which remain unchanged. -#' @param old Previous version of the queries report. -#' @param new New version of the queries report. This object is used to determine the status of each query. -#' @param report_title Character string specifying the title of the report. -#' @return A list consisting of a dataframe containing each individual query from both reports and a column showing the status of the queries (new, solved, miscorrected or pending) compared to the previous query report. In addition to this dataframe, there is also a summary of the total number of queries per category. +#' @description +#' `r lifecycle::badge('stable')` +#' +#' This function compares an old query report with a new one to identify the status of each query. +#' Queries are categorized as `new`, `solved`, `pending`, or `miscorrected`. +#' The function generates a detailed comparison dataframe and a summary report. +#' +#' @param old Dataframe containing the previous version of the query report. +#' @param new Dataframe containing the new version of the query report.\cr +#' This is compared against the `old` report to determine query statuses. +#' @param report_title (Optional) A character string specifying the title for the generated report.\cr +#' If not provided, the default title will be "Comparison report". +#' @param return_viewer logical, whether to return the HTML viewer (default TRUE) +#' +#' @return A list containing: +#' \item{queries}{A dataframe with all individual queries from both reports and a status column (`new`, `solved`, `pending`, or `miscorrected`).} +#' \item{results}{A styled HTML summary table showing the total number of queries in each status category.} +#' #' @examples #' # Example of a query #' data_old <- rd_query(covican, -#' variables = "copd", -#' expression = "is.na(x)", -#' event = "baseline_visit_arm_1") -#' data_new <- rbind(data_old$queries[1:5,], c("100-20",rep("abc",8))) +#' variables = "copd", +#' expression = "is.na(x)", +#' event = "baseline_visit_arm_1" +#' ) +#' data_new <- rbind(data_old$queries[1:5, ], c("100-20", rep("abc", 8))) #' -#' # Control of queries -#' check <- check_queries(old = data_old$queries, -#' new = data_new) +#' # Compare the two query reports +#' check <- check_queries( +#' old = data_old$queries, +#' new = data_new +#' ) #' @export -check_queries <-function(old, new, report_title = NULL) - { +check_queries <- function(old, new, report_title = NULL, return_viewer = TRUE) { + # Ensure both objects provided are dataframes + if (!is.data.frame(old) | !is.data.frame(new)) { + stop("The 'old' and 'new' arguments must be a data frame.", call. = FALSE) + } + if (!is.null(report_title) && length(report_title) > 1) { + stop("There is more than one title for the report, please choose only one.", call. = FALSE) + } - # Creation of the merged dataset - new <- new %>% dplyr::select(-"Code") - old[,"comp"] <- paste0(old$Identifier, old$Description, old$Query) - new[,"comp"] <- paste0(new$Identifier, new$Description, new$Query) + # Merge old and new datasets + new <- new |> dplyr::select(-dplyr::any_of("Code")) + old[, "comp"] <- paste0(old$Identifier, old$Description, old$Query) + new[, "comp"] <- paste0(new$Identifier, new$Description, new$Query) check <- merge(old, new, by = intersect(names(old), names(new)), all = TRUE) - # Checking each type of query - check[,"comp"] <- paste0(check$Identifier, check$Description, check$Query) - check[,"comp2"] <- paste0(check$Identifier, check$Description) - check[,"Modification"] <- NA - check[,"Modification"][check$comp %in% old$comp & check$comp %in% new$comp] <- "Pending" - check[,"Modification"][check$comp %in% old$comp & !check$comp %in% new$comp] <- "Solved" - check[,"Modification"][!check$comp %in% old$comp & check$comp %in% new$comp] <- "New" - - # Adding the new category of miscorrected if a query is not present in the old report but there is a new query from the same variable with the same identifier - check <- check %>% - dplyr::group_by(.data$comp2) %>% - dplyr::mutate(n = dplyr::n()) + # Add columns for comparisons and determine statuses + check[, "comp"] <- paste0(check$Identifier, check$Description, check$Query) + check[, "comp2"] <- paste0(check$Identifier, check$Description) + check[, "Modification"] <- NA + check[, "Modification"][check$comp %in% old$comp & check$comp %in% new$comp] <- "Pending" + check[, "Modification"][check$comp %in% old$comp & !check$comp %in% new$comp] <- "Solved" + check[, "Modification"][!check$comp %in% old$comp & check$comp %in% new$comp] <- "New" + + # Identify miscorrected queries: If a query does not exist in the old report, but there is a new query from the same variable with the same identifier + check <- check |> + dplyr::group_by(.data$comp2) |> + dplyr::mutate(n = dplyr::n()) check <- as.data.frame(check) - # The duplicated queries are the ones that were miscorrected if (any(check[, "n"] > 1)) { - dups <- check %>% - dplyr::filter(.data$n > 1 & .data$Modification %in% "New") + dups <- check |> + dplyr::filter(.data$n > 1 & .data$Modification %in% "New") if (nrow(dups) > 0) { dups[, "Modification"] <- "Miscorrected" - check <- check %>% + check <- check |> dplyr::filter(!(.data$n > 1 & .data$Modification %in% "New")) check <- rbind(check, dups) } } - # Convert the column Modification in a factor + # Convert the "Modification" column to a factor check[, "Modification"] <- factor(check[, "Modification"], - levels = c("Pending", "Solved", "Miscorrected", "New")) + levels = c("Pending", "Solved", "Miscorrected", "New") + ) - # Remove exceeding columns - check <- check %>% - dplyr::select(-"comp", -"comp2", -"n") + # Clean up unnecessary columns + check <- check |> + dplyr::select(-dplyr::any_of(c("comp", "comp2", "n"))) - # Arrange the dataset + # Arrange the dataset by specific fields if (any(stringr::str_detect(check$Identifier, "-"))) { - - check <- check %>% tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) + check <- check |> tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) check[, "center"] <- as.numeric(check[, "center"]) check[, "id"] <- as.numeric(check[, "id"]) check <- check[order(check[, "center"], check[, "id"], check[, "Code"], na.last = TRUE), ] rownames(check) <- NULL - check <- check %>% - dplyr::select(-"center", -"id") - + check <- check |> + dplyr::select(-dplyr::any_of(c("center", "id"))) } else { - check$Identifier <- as.numeric(check$Identifier) check <- check[order(check$Identifier, check$Code), ] - } - # We update the code of each query in order to match the old dataset - check <- data.frame(check %>% - dplyr::group_by(.data$Identifier) %>% - dplyr::mutate(cod = 1:dplyr::n())) + # Assign new codes to each query to match the old dataset + check <- data.frame(check |> + dplyr::group_by(.data$Identifier) |> + dplyr::mutate(cod = 1:dplyr::n())) check$Code <- paste0(as.character(check$Identifier), "-", check$cod) - check <- check %>% - dplyr::select(-"cod") + check <- check |> + dplyr::select(-dplyr::any_of("cod")) - # Creation of the report indicating the variables checked - report <- check %>% - dplyr::group_by(.data$Modification, .drop = FALSE) %>% - dplyr::summarise("total" = dplyr::n()) + # Summarize query statuses + report <- check |> + dplyr::group_by(.data$Modification, .drop = FALSE) |> + dplyr::summarise("total" = dplyr::n()) report <- as.data.frame(report) report <- report[order(as.numeric(report$total), decreasing = TRUE), ] names(report) <- c("State", "Total") rownames(report) <- NULL - # Before starting we check if there is more than one report_title and if it isn't the case we stabilish the caption for the report_title + # Handle report title if (all(is.na(report_title))) { report_title <- "Comparison report" } else { @@ -107,13 +125,17 @@ check_queries <-function(old, new, report_title = NULL) } } - # Adaptation to viewer - viewer <- knitr::kable(report, align = c("cc"), row.names = FALSE, caption = report_title, format = "html", longtable = TRUE) - viewer <- kableExtra::kable_styling(viewer, bootstrap_options = c("striped", "condensed"), full_width = FALSE) - viewer <- kableExtra::row_spec(viewer, 0, italic = FALSE, extra_css = "border-bottom: 1px solid grey") + # Generate styled HTML summary + viewer <- NULL + if (isTRUE(return_viewer)) { + viewer <- knitr::kable(report, align = c("cc"), row.names = FALSE, caption = report_title, format = "html", longtable = TRUE) + viewer <- kableExtra::kable_styling(viewer, bootstrap_options = c("striped", "condensed"), full_width = FALSE) + viewer <- kableExtra::row_spec(viewer, 0, italic = FALSE, extra_css = "border-bottom: 1px solid grey") + } - # Return the final product - list(queries = check, - results = viewer) + # Return results + list( + queries = check, + results = viewer + ) } - diff --git a/R/rd_checkbox.R b/R/rd_checkbox.R new file mode 100644 index 0000000..f153e23 --- /dev/null +++ b/R/rd_checkbox.R @@ -0,0 +1,380 @@ +#' Transform Checkbox Variables in a REDCap Project +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function is used to convert checkbox variables in a REDCap dataset from their default categories (e.g., "Checked" and "Unchecked") to numeric values (0 and 1), and optionally, relabel and rename them according to user-defined options. It also evaluates branching logic for checkbox fields and adjusts the data and dictionary accordingly. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param checkbox_labels A character vector of length 2 specifying the labels to be used for the checkbox options. Defaults to `c("No", "Yes")`. +#' @param checkbox_na Logical indicating whether to assign `NA` to checkbox fields when the branching logic condition is not satisfied. Defaults to `FALSE`. +#' @param checkbox_names Logical indicating whether to rename the checkbox variables in the dataset and dictionary according to their label options. Defaults to `TRUE`. +#' +#' @return A list containing the following elements: +#' \item{data}{The transformed dataset with checkbox variables updated.} +#' \item{dictionary}{The updated dictionary reflecting any changes made to the checkbox fields, including renamed variables.} +#' \item{event_form}{The event-form mapping (if provided).} +#' \item{results}{A summary of the transformation process, including any issues with branching logic or fields that need review.} +#' +#' @details +#' This function is primarily used to process checkbox fields in a REDCap project. It performs the following: +#' - Converts checkbox variables in the dataset from text labels ("Checked" and "Unchecked") to numeric values (0 and 1), and then applies the specified labels. +#' - Optionally renames the checkbox variables based on their labels (e.g., transforming variable names like `varname___1` to `varname_Yes`). +#' - Optionally modifies the branching logic in the REDCap dictionary to reflect renamed checkbox options. +#' +#' @note +#' - If `event_form` is not provided for a longitudinal project, the function may not be able to evaluate branching logic correctly. +#' +#' @examples +#' # Example with a project object containing data and dictionary +#' results <- rd_checkbox(project = covican) +#' +#' # Example with custom labels for the checkboxes +#' results <- rd_checkbox( +#' data = covican$data, +#' dic = covican$dictionary, +#' checkbox_labels = c("No", "Yes") +#' ) +#' +#' # Example without renaming checkbox fields +#' results <- rd_checkbox(covican, checkbox_names = FALSE) +#' +#' @export +#' @importFrom stats setNames + +rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, checkbox_names = TRUE) { + results <- NULL + rlogic_eval <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Extract labels from the data to reapply later + labels <- labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + # Identify if the project is longitudinal or includes repeated instruments + longitudinal <- "redcap_event_name" %in% names(data) + repeat_instrument <- any("redcap_repeat_instrument" %in% names(data) & !is.na(data$redcap_repeat_instrument)) + + # Identify checkbox variables in the data (those with '___' in their names) + var_check <- names(data)[grep("___", names(data))] + + # Remove factor-type checkbox variables from the list + var_check_factors <- var_check[grep(".factor$", var_check)] + + # Identify checkbox variables in the dictionary + var_check_dic <- dic$field_name[dic$field_type == "checkbox"] + + # Ensure there are checkbox fields in either the data or the dictionary + if (length(var_check) == 0 & length(var_check_dic) == 0) { + stop("No checkbox fields found in either the data or the dictionary.") + } + + # Check for missing checkbox fields in either the data or the dictionary + if (length(var_check) > 0 & length(var_check_dic) == 0) { + stop("No checkbox fields found in the dictionary.") + } + if (length(var_check) == 0 & length(var_check_dic) > 0) { + stop("No checkbox fields found in the data.") + } + + # Remove factor-type checkbox variables from the data + if (length(var_check_factors) > 0) { + data <- data |> + dplyr::select(-tidyselect::all_of(var_check_factors)) + + var_check <- var_check[!grepl(".factor$", var_check)] + } else { + if (any(purrr::map_lgl(var_check, ~ "Unchecked" %in% levels(data[[.x]])))) { + # Transform checkbox variables into binary values (0 or 1) + data <- data |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(var_check), + ~ dplyr::case_when( + .x == "Unchecked" ~ 0, + .x == "Checked" ~ 1, + TRUE ~ NA + ) + )) + } + } + + # Update results with the this transformation + transf_message <- if (!repeat_instrument) { + reason <- if (checkbox_na) + "when the logic isn't satisfied or it's missing" + else + "when the logic is missing" + + stringr::str_glue( + "Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. ", + "For checkboxes that have a branching logic, {reason} their values will be set to missing." + ) + } else { + stringr::str_glue( + "Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options." + ) + } + + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. {transf_message} (rd_checkbox)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. {transf_message} (rd_checkbox)\n")) + } + + # Evaluate branching logic for checkbox variables if applicable + if (any(dic$field_type == "checkbox" & dic$branching_logic_show_field_only_if != "")) { + if (is.null(event_form) & longitudinal) { + warning("Branching logic evaluation could not be performed because the project contains multiple events and the event-form correspondence was not specified. Please provide the `event_form` argument to enable branching logic evaluation.", call. = FALSE) + } else { + # Handle projects with repeated instruments where branching logic can't be evaluated + if (repeat_instrument) { + warning("The project contains repeated instruments, and this function cannot accurately evaluate the branching logic of checkboxes in such cases.", call. = FALSE) + } + + # warning(stringr::str_glue("There are {sum(dic$field_type == 'checkbox' & dic$branching_logic_show_field_only_if != '')} checkboxes with branching logic, please specify `checkbox_na` to determine the behaviour of this function for these cases.\n For more information `?rd_checkbox`."), call. = FALSE) + + + caption <- "Checkbox variables advisable to be reviewed" + review <- NULL + review2 <- NULL + + for (i in seq_along(var_check_dic)) { + # Identify variables associated with each checkbox option + vars_data <- names(data)[grep(stringr::str_glue("{var_check_dic[i]}___"), names(data))] + + # Retrieve branching logic for the checkbox field + logic <- dic$branching_logic_show_field_only_if[dic$field_name == var_check_dic[i]] + + # If there is branching logic, attempt to translate and evaluate it + if (!is.na(logic) & !logic %in% "") { + # Checking if the logic is already in R format + if (grepl("<>|\\[.*?\\]", logic) & !grepl("==|!=|\\$", logic)) { + # Translate REDCap logic to R language using rd_rlogic function + rlogic <- try(rd_rlogic(data = data, dic = dic, event_form = event_form, logic = logic, var = var_check_dic[i]), silent = TRUE) + + if (!inherits(rlogic, "try-error")) { + # Evaluate the logic and apply missing values accordingly + rlogic_eval <- rlogic$eval + } else { + # Track variables that can't be evaluated due to logic issues + review2 <- c(review2, var_check_dic[i]) + } + } else { + rlogic_eval <- eval(parse(text = logic)) + } + + # Set missing values where logic is not satisfied + if (checkbox_na) { + for (j in seq_along(vars_data)) { + data[, vars_data[j]] <- ifelse(rlogic_eval, as.character(data[, vars_data[j]]), NA) + } + } else { + # Set missing values only where logic evaluation is missing + for (j in seq_along(vars_data)) { + data[, vars_data[j]] <- ifelse(!is.na(rlogic_eval), as.character(data[, vars_data[j]]), NA) + } + } + } else { + # If no branching logic, mark variable for review + review <- c(review, var_check_dic[i]) + } + } + + # Summarize the results of the branching logic review + if (!is.null(review)) { + results1 <- tibble::tibble("Variables without any branching logic" = review) + results <- c(results, "", knitr::kable(results1, "pipe", align = c("ccc"), caption = caption)) + if (!is.null(review2)) { + results <- c(results, "\n") + caption <- NULL + } + } + + if (!is.null(review2)) { + results2 <- tibble::tibble("Variables with a logic that can't be transcribed" = review2) + results <- c(results, knitr::kable(results2, "pipe", align = c("ccc"), caption = caption)) + } + + data <- data + } + } + + # Transform checkbox variables into "No"/"Yes" labels + data <- data |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(var_check), + ~ factor(.x, levels = 0:1, labels = checkbox_labels) + )) + + # Identify checkbox variables + var_check <- names(data)[grep("___", names(data))] + + # Trim the checkbox variable names + names_trim <- unique(gsub("___.*$", "", var_check)) + + correspondence <- NULL + + # Update the dictionary with new variable names and labels + for (i in seq_along(names_trim)) { + # Find variable names in `var_check` that start with the current name in `names_trim` + svar_check <- grep(stringr::str_glue("^{names_trim[i]}___"), var_check, value = TRUE) + + # Extract labels corresponding to the found variables + label <- labels[svar_check] + label <- gsub(".*choice=", "", label) + label <- gsub("\\)", "", label) + + # Add rows to dictionary for each checkbox option + new_row <- dic |> + dplyr::filter(.data$field_name == names_trim[i]) + + # Repeat the `new_row` for each checkbox option and update fields + new_row <- purrr::map_dfr(seq_len(length(svar_check)), ~new_row) |> + dplyr::mutate( + field_name = svar_check, + field_label = label, + choices_calculations_or_slider_labels = stringr::str_glue("0, {checkbox_labels[1]} | 1, {checkbox_labels[2]}") + ) + + # Add the new row to the dictionary and remove the original checkbox variable + dic <- dic |> + tibble::add_row(new_row, .before = which(dic$field_name == names_trim[i])) |> + dplyr::filter(!.data$field_name %in% names_trim[i]) + + # Create clean variable names for the new checkbox options + label_name <- purrr::map_chr(label, ~ janitor::make_clean_names(.x)) + label_name <- gsub("^x(\\d)", "\\1", label_name) + + if (checkbox_names) { + # Generate new variable names by appending the cleaned labels to the original variable names + out <- stringr::str_glue("{names_trim[i]}_{label_name}") + + # Trim the name if it exceeds 60 characters (to prevent very long names) + out <- strtrim(out, 60) + + # Save correspondence between the old names and the new names + x <- cbind(gsub("___(.+)", "\\(\\1\\)", svar_check), out) + correspondence <- rbind(correspondence, x) + + # For each new variable name, check if it already exists in the dataset + for (j in seq_along(out)) { + out0 <- out[j] + + # Ensure uniqueness by appending a unique suffix if necessary + out[j] <- utils::tail(make.unique(c(names(data), out[j])), 1) + + # If the name was changed to ensure uniqueness, issue a warning + if (out[j] != out0) { + warning( + stringr::str_glue( + "The transformed checkbox name '{out0}' already exists in the dataset. It has been renamed to '{out[j]}' to avoid conflicts." + ) + ) + } + + # Update the variable names in the data and dictionary + names(data) <- dplyr::case_when(names(data) == svar_check[j] ~ out[j], TRUE ~ names(data)) + + # Update the labels to match the new variable names + names(labels) <- dplyr::case_when(names(labels) == svar_check[j] ~ out[j], TRUE ~ names(labels)) + + # Update the dictionary with the new variable name + dic <- dic |> + dplyr::mutate(field_name = dplyr::case_when(field_name == svar_check[j] ~ out[j], TRUE ~ field_name)) + } + } else { + # Trim the name if it exceeds 60 characters (to prevent very long names) + out <- strtrim(svar_check, 60) + + # Save correspondence between the old names and the new names + x <- cbind(gsub("___(.+)", "\\(\\1\\)", svar_check), out) + correspondence <- rbind(correspondence, x) + } + } + + # After processing all the checkboxes, transform the branching logic that contains checkboxes + correspondence <- as.data.frame(correspondence) + + # Filter the dictionary to include only variables that were renamed during checkbox transformation + cats <- dic |> + dplyr::select("field_name", "choices_calculations_or_slider_labels") |> + dplyr::filter(.data$field_name %in% correspondence$out) + + # Split the `choices_calculations_or_slider_labels` into separate options for each checkbox + cats <- cats |> + dplyr::mutate(choices_calculations_or_slider_labels = strsplit(.data$choices_calculations_or_slider_labels, "\\|")) |> + tidyr::unnest("choices_calculations_or_slider_labels") + + # Separate numeric and category parts from the options + cats <- cats |> + tidyr::separate(.data$choices_calculations_or_slider_labels, c("num", "cat"), ", ", extra = "merge") |> + dplyr::filter(.data$cat != "") |> + dplyr::mutate(num = trimws(.data$num), cat = trimws(.data$cat)) + + # Merge the transformed data with the correspondence to link new names with the original variables + cats <- merge(cats, correspondence, by.x = "field_name", by.y = "out") + + # Prepare the branching logic expressions for the transformed checkbox variables + cats <- cats |> + dplyr::mutate( + factor = paste0("[", .data$field_name, "]='", .data$cat, "'"), + V1 = stringi::stri_replace_all_fixed(cats$V1, c("(", ")"), c("\\(", "\\)"), vectorize_all = FALSE), + redcap = paste0("\\[", .data$V1, "\\] ?=? ?'?", .data$num, "'?"), + redcap2 = paste0("\\[", .data$V1, "\\] ?? ?'?", .data$num, "'?") + ) |> + dplyr::select(-"V1") |> + dplyr::arrange(dplyr::desc(.data$redcap)) + + # Create the final mappings for replacing the branching logic in REDCap with the new factor logic + replace <- setNames(cats$factor, cats$redcap) + replace2 <- setNames(cats$factor, cats$redcap2) + + # Apply the new branching logic to the dictionary by replacing the old logic with the new ones + dic <- dic |> + dplyr::mutate( + choices_calculations_or_slider_labels = stringr::str_replace_all(.data$choices_calculations_or_slider_labels, replace), + choices_calculations_or_slider_labels = stringr::str_replace_all(.data$choices_calculations_or_slider_labels, replace2), + branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace), + branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace2) + ) + + # Apply the labels to the data + data <- data |> + labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) + + + # Return the modified data, dictionary, event_form, and results + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_dates.R b/R/rd_dates.R new file mode 100644 index 0000000..dee1504 --- /dev/null +++ b/R/rd_dates.R @@ -0,0 +1,125 @@ +#' Transform Dates and Datetimes in REDCap Data +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function processes and transforms date and datetime fields in a REDCap dataset. +#' It ensures proper handling of data, dictionary (metadata), and event-form mapping, +#' and applies labels to the dataset for better usability. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' +#' @return A list containing the following elements: +#' \item{data}{The transformed dataset with date and datetime variables correctly formatted.} +#' \item{dictionary}{The original data dictionary passed to the function.} +#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} +#' +#' @details +#' The function performs the following tasks: +#' - Extracts date and datetime fields from the data dictionary using validation types +#' (`date_*` and `datetime_*`). +#' - Converts these fields in the dataset to `Date` and `POSIXct` objects, respectively. +#' +#' +#' @examples +#' +#' # Example usage: +#' result <- rd_dates(data = covican$data, dic = covican$dictionary) +#' +#' result <- covican |> rd_dates() +#' +#' @export + +rd_dates <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) { + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + # browser() + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Extract labels from the data to reapply later + labels <- labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + # Identify date variables in the dictionary (those with `date_` in validation type) + var_date <- dic |> + dplyr::filter(grepl("^date_", .data$text_validation_type_or_show_slider_number)) |> + dplyr::pull(.data$field_name) + + var_date_valid <- data |> + dplyr::select(dplyr::all_of(var_date)) |> + purrr::keep(~ inherits(.x, "Date")) |> + names() + + # Identify datetime variables in the dictionary (those with `datetime_` in validation type) + var_datetime <- dic |> + dplyr::filter(grepl("^datetime_", .data$text_validation_type_or_show_slider_number)) |> + dplyr::pull(.data$field_name) + + var_datetime_valid <- data |> + dplyr::select(dplyr::all_of(var_datetime)) |> + purrr::keep(~ inherits(.x, "POSIXct")) |> + names() + + # Validation for Date/Datetime Formatting + if (identical(var_date, var_date_valid) & identical(var_datetime, var_datetime_valid)) { + warning("All date and datetime variables are already in the correct format. No transformation applied.", call. = FALSE) + } else { + var_date <- setdiff(var_date, var_date_valid) + + var_datetime <- setdiff(var_datetime, var_datetime_valid) + + # Convert date variables in the data to `Date` class + data <- data |> + dplyr::mutate_at(var_date, as.Date) |> + # Convert datetime variables to `POSIXct` class, handling empty strings as NA + dplyr::mutate_at(var_datetime, function(x) { + x <- dplyr::case_when(x == "" ~ NA, TRUE ~ x) + as.POSIXct(x, origin = "1970-01-01", tz = "UTC") + }) + } + + # Reapply variable labels to the data after transformation + data <- data |> + labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Transforming date and datetime fields. (rd_dates)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Transforming date and datetime fields. (rd_dates)\n")) + } + + # Return the updated data, dictionary, event_form, and results (if present) + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove NULL elements from the list +} diff --git a/R/rd_delete_vars.R b/R/rd_delete_vars.R new file mode 100644 index 0000000..007858d --- /dev/null +++ b/R/rd_delete_vars.R @@ -0,0 +1,161 @@ +#' Delete Variables from REDCap Data and Dictionary +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function removes variables from a REDCap dataset and its associated dictionary based on +#' specific variable names or patterns. It ensures consistency between the data and dictionary +#' while preserving labels. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, +#' typically the output of the `redcap_data` function. If provided, +#' it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, +#' including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. +#' Optional; defaults to `NULL` if not applicable. +#' @param vars A character vector specifying variable names to delete from the dataset and dictionary. +#' These variables will be removed from both the `data` and `dic`. +#' @param pattern A character vector of regular expression patterns. Variables matching these patterns +#' will be removed from the `data` and `dic`. +#' +#' @return A list containing the following elements: +#' \item{data}{The updated dataset with specified variables removed.} +#' \item{dictionary}{The updated data dictionary with corresponding variables removed.} +#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} +#' +#' @details +#' The function performs the following operations: +#' - Removes variables specified in the `vars` argument from both the dataset and dictionary. +#' - Removes variables matching patterns provided in the `pattern` argument. +#' +#' @examples +#' # Example usage: +#' +#' # Deleting specific variables +#' result <- rd_delete_vars(covican, +#' vars = c("potassium", "leuk_lymph") +#' ) +#' +#' # Deleting variables based on patterns +#' result <- rd_delete_vars( +#' data = covican$data, +#' dic = covican$dictionary, +#' pattern = c("_complete$", "_other$") +#' ) +#' +#' @export + +rd_delete_vars <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars = NULL, pattern = NULL) { + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.", call. = FALSE) + } + + # Ensure one of the arguments is fullfilled + if (is.null(vars) & is.null(pattern)) { + stop("At least one of the 'vars' or 'pattern' arguments must be provided.", call. = FALSE) + } + + # Extract labels from the data to reapply later + labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + # If `vars` is specified, iterate through each variable and remove it from the data and dictionary + if (!is.null(vars)) { + vars_missing <- setdiff(vars, names(data)) + + if (length(vars_missing) > 0) { + stop(stringr::str_glue("The following variables are not present in the dataset: {paste0(vars_missing, collapse = ', ')}.\nPlease remove them from the `vars` argument."), call. = FALSE) + } + + for (i in seq_along(vars)) { + # Remove the variable from the dataset + data <- data |> + dplyr::select(!vars[i]) + + # Check if the factor version of the variable exists and remove it if present + if (paste0(vars[i], ".factor") %in% names(data)) { + data <- data |> + dplyr::select(!paste0(vars[i], ".factor")) + } + + # Remove the variable from the dictionary + dic <- dic |> + dplyr::filter(.data$field_name != vars[i]) + } + } + + + # If `pattern` is specified, use it to identify and remove matching variables + if (!is.null(pattern)) { + # Collapse patterns used + comb_pattern <- paste(pattern, collapse = "|") + + # Create factor versions of the patterns for additional checks + pattern_factor <- data |> + dplyr::select(grep(comb_pattern, names(data), value = TRUE)) |> + names() + + if (length(pattern_factor) > 0) { + pattern_factor <- paste0(pattern_factor, ".factor") + + # Warn if factor versions of the variables matching the patterns are present in the dataset + if (any(pattern_factor %in% names(data) & grepl("\\$", pattern))) { + warning("The dataset contains factor versions of variables matching the specified patterns. To properly remove them, use the `rd_factor` function first.", call. = FALSE) + } + } + + # Remove variables matching the pattern from the dataset + data <- data |> + dplyr::select(!dplyr::matches(comb_pattern)) + + # Remove variables matching the pattern from the dictionary + dic <- dic |> + dplyr::filter(!grepl(comb_pattern, .data$field_name)) + } + + # Reapply variable labels to the dataset after modifications + data <- data |> + labelled::set_variable_labels( + .labels = labels |> as.list(), .strict = FALSE + ) + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Removing selected variables (rd_delete_vars)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Removing selected variables (rd_delete_vars)\n")) + } + + # Return the updated dataset, dictionary, event_form, and results + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_dictionary.R b/R/rd_dictionary.R new file mode 100644 index 0000000..7043f85 --- /dev/null +++ b/R/rd_dictionary.R @@ -0,0 +1,229 @@ +#' Transform the data dictionary and handle branching logic +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function updates the data dictionary by evaluating and transforming the branching logic expressions for each field in the dictionary. +#' It checks if any branching logic is present and attempts to convert it using the specified data, dictionary, and event-form mapping. +#' If there are any issues with the conversion, those fields are listed in the results. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' +#' @return A list containing the following elements: +#' \item{data}{The original dataset, passed to the function.} +#' \item{dictionary}{The updated data dictionary, with modified branching logic.} +#' \item{event_form}{The original event-form mapping, passed to the function (if applicable).} +#' \item{results}{A string summarizing the results of the transformation process, including any variables with unconverted branching logic.} +#' +#' @examples +#' +#' result <- covican |> rd_dictionary() +#' +#' print(result$results) +#' +#' @export +#' @importFrom stats setNames + + +rd_dictionary <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) { + + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Checking if there was already a transformation of the original variables into factors + factors <- data |> + dplyr::select(dplyr::any_of(dic$field_name) & dplyr::where(is.factor)) |> + colnames() + + if (length(factors) > 0) { + # Select the branching logic for any variables that are being transformed into factors + cat_factors <- dic |> + dplyr::select("field_name", "choices_calculations_or_slider_labels") |> + dplyr::filter(.data$field_name %in% factors) + + # Split the `choices_calculations_or_slider_labels` to separate each option in a multi-option field + cat_factors <- cat_factors |> + dplyr::mutate( + choices_calculations_or_slider_labels = strsplit(.data$choices_calculations_or_slider_labels, "\\|") + ) |> + tidyr::unnest("choices_calculations_or_slider_labels") + + # Separate numeric and category labels from the choices string + cat_factors <- cat_factors |> + tidyr::separate(.data$choices_calculations_or_slider_labels, + into = c("num", "cat"), + sep = ", ", + extra = "merge" + ) |> + dplyr::filter(.data$cat != "") |> + dplyr::mutate( + num = stringr::str_trim(.data$num), + cat = stringr::str_trim(.data$cat) + ) + + # Transform each branching logic into R logic + cat_factors <- cat_factors |> + dplyr::mutate( + redcap_v1 = paste0("\\[", .data$field_name, "\\] ?=? ?'?", .data$num, "'?"), + redcap_v2 = paste0("\\[", .data$field_name, "\\] ?? ?'?", .data$num, "'?"), + factor_v1 = paste0("[", .data$field_name, "]='", .data$cat, "'"), + factor_v2 = paste0("[", .data$field_name, "]<>'", .data$cat, "'") + ) |> + dplyr::arrange(.data$field_name, dplyr::desc(.data$num)) + + # Create a mapping for replacing the branching logic in the dictionary + replace_v1 <- setNames(cat_factors$factor_v1, cat_factors$redcap_v1) + replace_v2 <- setNames(cat_factors$factor_v2, cat_factors$redcap_v2) + + # Apply the replacements to the dictionary + dic <- dic |> + dplyr::mutate( + branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace_v1), + branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace_v2), + choices_calculations_or_slider_labels = stringr::str_replace_all(.data$choices_calculations_or_slider_labels, replace_v1), + choices_calculations_or_slider_labels = stringr::str_replace_all(.data$choices_calculations_or_slider_labels, replace_v2) + ) + } + + logics <- NULL + # Generamos el objeto + warnings_env <- new.env(parent = emptyenv()) + warnings_env$count <- 0 + warnings_env$msgs <- character() + warnings_env$id <- numeric() + + # Identify rows in the dictionary with branching logic that needs evaluation + pos_branch <- which(!dic$branching_logic_show_field_only_if %in% "") + + # Loop through each row with branching logic + for (i in pos_branch) { + # Attempt to evaluate and convert the branching logic using `rd_rlogic` + evaluation <- withCallingHandlers( + { + try( + rd_rlogic( + data = data, + dic = dic, + event_form = event_form, + logic = dic$branching_logic_show_field_only_if[i], + var = dic$field_name[i] + )$rlogic, + silent = TRUE + ) + }, + warning = function(w) { + warnings_env$count <- warnings_env$count + 1 + warnings_env$msgs <- c(warnings_env$msgs, conditionMessage(w)) + invokeRestart("muffleWarning") + } + ) + + # If evaluation succeeds, update the dictionary with the converted logic + if (!inherits(evaluation, "try-error")) { + dic$branching_logic_show_field_only_if[i] <- evaluation + } else { + # If evaluation fails, add the variable name to the `logics` object + logics <- rbind(logics, dic$field_name[i]) + } + } + + # Identify rows in the dictionary with calculations that need evaluation + pos_calc <- which(dic$field_type == "calc") + + message("\u23F3 Almost done!") + + # message("\u23F3 Just a few more steps left!") + + # browser() + + # Loop through each row with calculations + for (i in pos_calc) { + # Attempt to evaluate and convert the calculations using `rd_rlogic` + evaluation <- withCallingHandlers( + { + try( + rd_rlogic( + data = data, + dic = dic, + event_form = event_form, + logic = dic$choices_calculations_or_slider_labels[i], + var = dic$field_name[i] + )$rlogic, + silent = TRUE + ) + }, + warning = function(w) { + warnings_env$count <- warnings_env$count + 1 + warnings_env$msgs <- c(warnings_env$msgs, conditionMessage(w)) + warnings_env$id <- c(warnings_env$id, i) + invokeRestart("muffleWarning") + } + ) + + # If evaluation succeeds, update the dictionary with the converted logic + if (!inherits(evaluation, "try-error")) { + dic$choices_calculations_or_slider_labels[i] <- evaluation + } else { + # If evaluation fails, add the variable name to the `logics` object + logics <- rbind(logics, dic$field_name[i]) + } + } + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Converting every branching logic in the dictionary into R logic. (rd_dictionary)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Converting every branching logic in the dictionary into R logic. (rd_dictionary)\n")) + } + + # If there are variables with unconverted logic, prepare a report + if (!is.null(logics)) { + # Make sure there are unique variables to review + logics <- unique(logics) + + # Create a table of unconverted variables + tabla <- tibble::tibble("Variables" = logics) + + # Append the table to the `results` for later reporting + results <- c(results, "\n", knitr::kable(tabla, "pipe", align = c("ccc"), caption = "Variables with unconverted branching logic")) + } + + # Generating a global warning if one of the iteractions of the loop generates a warning inside rd_rlogic + if (warnings_env$count > 0) { + warnings_env$msgs <- warnings_env$msgs |> unique() + + for (i in warnings_env$msgs) { + warning(i, call. = FALSE) + } + } + + # Return the processed objects + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_event.R b/R/rd_event.R index edfaf0e..673d5a6 100644 --- a/R/rd_event.R +++ b/R/rd_event.R @@ -1,303 +1,341 @@ -#' Identification of Missing Event(s) +#' Identify Missing Events in REDCap Data #' -#' When working with a longitudinal REDCap project, the exported data has a structure where each row represents one event per record. However, by default REDCap does not export events for which there is no information available. -#' This function allows you to identify which records do not contain information about a particular event. +#' @description +#' `r lifecycle::badge('stable')` #' -#' @param ... List containing the data, dictionary and event mapping (if required) of the REDCap project. This should be the output of the `redcap_data` function. -#' @param data Data frame containing the data read from REDCap. If the list is specified, this argument is not required. -#' @param dic Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not required. -#' @param event Character vector with the name of the REDCap event(s) to be analyzed. -#' @param filter A filter to be applied to the dataset. This argument can be used to identify the missing events on a subset of the dataset. -#' @param query_name Description of the query. It can be the same for all variables, or you can define a different one for each variable. By default, the function defines it as `The event [event] is missing' for each event`. -#' @param addTo Data frame corresponding to a previous query data frame to which you can add the new query data frame. By default, the function always generates a new data frame without taking into account previous reports. -#' @param report_title Character string specifying the title of the report. -#' @param report_zeros Logical. If `TRUE`, the function returns a report containing variables with zero queries. -#' @param link List of project information used to create a web link for each missing event. -#' @return A list with a data frame of 9 columns (10 columns if the link argument is specified) to help the user identify each missing event and a table with the total number of missing events per event analyzed. +#' This function identifies records in a REDCap longitudinal project that are missing specific events. +#' REDCap does not export events with no data by default, which can create challenges in verifying completeness. +#' This function provides insights into missing events, allowing you to identify which records do not contain information about a particular event. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param event A character vector specifying the name(s) of the REDCap event(s) to analyze for missing records. +#' @param filter An optional filter to apply to the dataset. This can be used to identify missing events in a subset of the data. +#' @param query_name A description of the query. Defaults to "The event (event_name) is missing" for each event if not provided. +#' @param addTo A data frame of previous query results to which new queries can be appended. If not provided, the function creates a new data frame. +#' @param report_title An optional title for the report. +#' @param report_zeros Logical; if `TRUE`, includes a report of variables without missing data. +#' @param link A list containing project information used to generate links for each missing event. Requires `domain`, `redcap_version`, and `proj_id` keys. +#' +#' @return A list with two elements: +#' \item{queries}{A data frame listing records with missing events, including metadata for each record.} +#' \item{results}{A summary table (HTML) showing the count of missing events for each analyzed event.} +#' +#' +#' @details +#' The function is designed to work with REDCap longitudinal projects, which may not include empty events in their exports. +#' By specifying the events of interest, users can quickly identify missing records for a specific event. +#' Filters can be applied to focus the analysis on specific subsets of the data. +#' +#' If project information (`link`) is provided, the output will include clickable URLs for each missing record. #' #' @examples -#' example <- rd_event(covican, -#' event = "follow_up_visit_da_arm_1") -#' example +#' # Example usage with a REDCap dataset: +#' example <- covican |> rd_event(event = "follow_up_visit_da_arm_1") +#' +#' example$queries +#' example$results +#' #' @export #' @importFrom rlang .data -rd_event <- function(..., data = NULL, dic = NULL, event, filter = NA, query_name = NA, addTo = NA, report_title = NA, report_zeros = FALSE, link = list()) - { - # If the entire list resulting from the 'redcap_data' function is used - project <- c(...) - - if(!is.null(project)){ - - if (!is.null(data)) { +rd_event <- function(project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + event, + filter = NA, + query_name = NA, + addTo = NA, + report_title = NA, + report_zeros = FALSE, + link = list()) { + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + + list2env(env_vars, envir = environment()) + } - warning("Data has been specified twice so the function will not use the information in the data argument.") + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } - } + # Ensure the input data is a data frame + data <- as.data.frame(data) - if (!is.null(dic)) { + # Create an empty data frame to store identified queries + queries <- as.data.frame(matrix(ncol = 10, nrow = 0)) + colnames(queries) <- c("Identifier", "DAG", "Event", "Instrument", "Field", "Repetition", "Description", "Query", "Code", "Link") - warning("Dictionary has been specified twice so the function will not use the information in the dic argument.") + # Rename the first column to "record_id" if necessary + if ("record_id" %in% names(data)) { + names(data)[1] <- "record_id" + } - } + # Error: Stop if more than one filter is provided + if (!is.na(filter) & length(filter) > 1) { + stop("More than one filter applied, please select only one.", call. = FALSE) + } - data <- project$data - dic <- project$dictionary - } + # Save the original dataset for reference + data0 <- data - # Making sure that the object data is a data.frame - data <- as.data.frame(data) + # Apply the filter expression to the dataset if provided + if (!is.na(filter) & length(filter) == 1) { + command <- paste0("data", "<-dplyr::filter(data,", filter, ")") - # Creation of the structure of the queries - queries <- as.data.frame(matrix(ncol = 10, nrow = 0)) - colnames(queries) <- c("Identifier", "DAG", "Event", "Instrument", "Field", "Repetition", "Description", "Query", "Code", "Link") + # Test the validity of the filter logic + evaluation <- try(eval(parse(text = command)), silent = TRUE) - # Naming the first column of the REDCap's database as record_id - if (all(!names(data) == "record_id")) { - names(data)[1] <- "record_id" + if (inherits(evaluation, "try-error")) { + stop("Invalid `filter` argument logic. Please review and correct the expression.", call. = FALSE) + } else { + eval(parse(text = command)) } - # Error: More than one filter applied. - if (!is.na(filter) & length(filter) > 1) { - stop("More than one filter applied, please select only one.", call. = FALSE) + # Warn if the filter results in no observations + if (nrow(data) == 0) { + warning("The filter applied does not match any records. Please review the `filter` argument.", call. = FALSE) } + } - # We save de original dataset - data0 <- data - - # Filtering the data using the information of the argument 'filter' - if (!is.na(filter) & length(filter) == 1) { - - # Error: logic used in the filter is incorrect - command <- paste0("data", "<-dplyr::filter(data,", filter, ")") - - evaluation <- try(eval(parse(text = command)), silent = TRUE) - - if(inherits(evaluation, "try-error")){ - - stop("The logic used in the filter is incorrect. Please review and adjust the filter's logic.") - - } else { - - eval(parse(text = command)) - - } - - # Error: filtering results in zero observations - if (nrow(data) == 0) { - warning("The applied filter is accurate, but it does not correspond to any observations. Please ensure that you have selected the appropriate filter.", call. = FALSE) + # Validate that the specified events are present in the dataset + if (all(!is.na(event))) { + if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data0))) { + if (any(!event %in% data0$redcap_event_name) & any(!event %in% data0$redcap_event_name.factor)) { + stop("One or more specified events do not exist in the dataset. Please review the 'event' argument.", call. = FALSE) } - } - # Applying a filter of the chosen events to the database - if (all(!is.na(event))) { + # Iterate over each specified event to identify missing records + for (k in seq_along(event)) { + # Find record IDs associated with the current event (factor form) + if (any(names(data0) == "redcap_event_name.factor") & all(event %in% data0$redcap_event_name.factor)) { + ids <- data0$record_id[data0$redcap_event_name.factor %in% event[k]] + } - # Error: one of the specified events does not exist in the database - if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data0))) { - if (any(!event %in% data0$redcap_event_name) & any(!event %in% data0$redcap_event_name.factor)) { - stop("One of the events mentioned does not exist in the database, please verify the argument 'event'.") - } + # Find record IDs associated with the current event (raw form) + if (all(event %in% data0$redcap_event_name)) { + ids <- data0$record_id[data0$redcap_event_name %in% event[k]] } - # Identify queries for each event - for (k in 1:length(event)) { - # If the event is specified in the factor form - if (any(names(data0) == "redcap_event_name.factor") & all(event %in% data0$redcap_event_name.factor)) { - ids <- data0$record_id[data0$redcap_event_name.factor %in% event[k]] - } + # Identify records missing the current event + raw <- data |> + dplyr::filter(!data$record_id %in% ids) |> + dplyr::slice(rep(1:dplyr::n(), each = length(event[k]))) - # If the event is specified in the raw form - if (all(event %in% data0$redcap_event_name)) { - ids <- data0$record_id[data0$redcap_event_name %in% event[k]] + # If missing records are found, create query entries for them + if (nrow(raw) > 0) { + # Assign the current event name to the missing records - raw version + if ("redcap_event_name" %in% names(raw)) { + raw$redcap_event_name <- rep(event[k], length(event[k])) } - - # Identification of the record_ids that do not present the events specified - raw <- data %>% - dplyr::filter(!data$record_id %in% ids) - raw <- raw %>% - dplyr::slice(rep(1:dplyr::n(), each = length(event[k]))) - - # Identification of queries, using the structure built before - if (nrow(raw) > 0) { - - # Retrieve the names of the missing events - raw version - if ("redcap_event_name" %in% names(raw)) { - raw$redcap_event_name <- rep(event[k], length(event[k])) - } - - # Retrieve the names of the missing events - factor version - if ("redcap_event_name.factor" %in% names(raw)) { - for (i in 1:nrow(raw)) { - - raw$redcap_event_name.factor[i] <- unique(data0$redcap_event_name.factor[data0$redcap_event_name %in% raw$redcap_event_name[i]]) - - } + # Assign the current event name to the missing records - factor version + if ("redcap_event_name.factor" %in% names(raw)) { + for (i in seq_len(nrow(raw))) { + raw$redcap_event_name.factor[i] <- unique(data0$redcap_event_name.factor[data0$redcap_event_name %in% raw$redcap_event_name[i]]) } + } - # Queries - x <- raw[, c("record_id", grep("redcap", names(raw), value = T))] - excel <- data.frame( - Identifier = x[, "record_id"], - DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(x))) { - ifelse("redcap_data_access_group.factor" %in% names(x), - as.character(x[, "redcap_data_access_group.factor"]), - as.character(x[, "redcap_data_access_group"])) - } else { - "-" - }, - Event = rep(event[k], length(event[k])), - Instrument = "-", - Field = "-", - Repetition = "-", - Description = if ("redcap_event_name.factor" %in% names(x)) { - as.character(x[, "redcap_event_name.factor"]) - } else{ - "-" - }, - Query = if (!is.na(query_name)) { - if (length(query_name) > 1) { - query_name[k] - } else { - query_name - } + # Queries + x <- raw[, c("record_id", grep("redcap", names(raw), value = TRUE))] + excel <- data.frame( + Identifier = x[, "record_id"], + DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(x))) { + ifelse("redcap_data_access_group.factor" %in% names(x), + as.character(x[, "redcap_data_access_group.factor"]), + as.character(x[, "redcap_data_access_group"]) + ) + } else { + "-" + }, + Event = rep(event[k], length(event[k])), + Instrument = "-", + Field = "-", + Repetition = "-", + Description = if ("redcap_event_name.factor" %in% names(x)) { + as.character(x[, "redcap_event_name.factor"]) + } else { + "-" + }, + Query = if (!is.na(query_name)) { + if (length(query_name) > 1) { + query_name[k] } else { - paste0("The event '", if ("redcap_event_name.factor" %in% names(x)) { + query_name + } + } else { + paste0( + "The event '", if ("redcap_event_name.factor" %in% names(x)) { as.character(x[, "redcap_event_name.factor"]) } else { as.character(x[, "redcap_event_name"]) - } - , "' is missing.") - }, - Code = "", - stringsAsFactors = FALSE - ) - - # Add the column Link - if (all(c("domain", "redcap_version", "proj_id") %in% names(link))) { - excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/record_home.php?pid=", link[["proj_id"]], "&id=", x[, "record_id"]) - } - - # Add the identified queries to the structure - queries <- rbind(queries, excel) + }, + "' is missing." + ) + }, + Code = "", + stringsAsFactors = FALSE + ) + + # Add a hyperlink for the query if link information is provided + if (all(c("domain", "redcap_version", "proj_id") %in% names(link))) { + excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/record_home.php?pid=", link[["proj_id"]], "&id=", x[, "record_id"]) } - } - } - - # If the argument 'addTo' is specified, combine the queries generated with a previous data frame of queries - if (!is.na(addTo)) { - col_names <- names(queries) - queries <- merge(queries, - addTo$queries, - by = intersect(names(addTo$queries), names(queries)), - all = TRUE) - queries <- queries %>% dplyr::select(col_names) - } - # Classify each query with it's own code - if (nrow(queries) != 0) { - - # First we sort the data frame by record_id - if (all(grepl("-", queries$Identifier))) { - queries <- queries %>% - tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) - queries[, "center"] <- as.numeric(queries[, "center"]) - queries[, "id"] <- as.numeric(queries[, "id"]) - queries <- queries[order(queries[, "center"], queries[, "id"]), ] - rownames(queries) <- NULL - queries <- queries %>% dplyr::select(-"center", -"id") - } else { - queries$Identifier <- as.numeric(queries$Identifier) - queries <- queries[order(queries$Identifier), ] + # Append the query to the list of identified queries + queries <- rbind(queries, excel) } + } + } - # Add the code to each query and eliminate duplicated ones - queries <- unique(queries %>% - dplyr::select(-"Code")) - queries <- data.frame(queries %>% - dplyr::group_by(.data$Identifier) %>% - dplyr::mutate(cod = 1:dplyr::n())) - queries$Code <- paste0(as.character(queries$Identifier), "-", queries$cod) - queries <- queries %>% dplyr::select(-"cod") - - # Reorder the columns if the link argument was specified - if ("Link" %in% names(queries)) { - queries <- queries %>% - dplyr::select("Identifier":"Query", "Code", "Link") - } + # Merge with an existing query data frame if specified in 'addTo' + if (!is.na(addTo)) { + # Save the column names of the existing queries + col_names <- names(queries) + + # Merge the existing queries with the new ones + queries <- merge(queries, + addTo$queries, + by = intersect(names(addTo$queries), names(queries)), + all = TRUE + ) + + # Reorder the columns to match the original structure + queries <- queries |> + dplyr::select(dplyr::all_of(col_names)) + } - # Build the report - report <- data.frame("var" = queries$Event, - "descr" = queries$Description) + # Classify each query with a unique code if there are queries present + if (nrow(queries) != 0) { + # Handle cases where the Identifier contains a center and id separated by a dash + if (all(grepl("-", queries$Identifier))) { + # Separate the Identifier into center and id components + queries <- queries |> + tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) - # If there is no previous report specified we convert the events and their description to factors using the dictionary - if (all(addTo %in% NA)) { - report$var <- factor(report$var, levels = c(unique(event))) - report$descr <- factor(report$descr) - } + # Convert center and id to numeric for sorting + queries[, "center"] <- as.numeric(queries[, "center"]) + queries[, "id"] <- as.numeric(queries[, "id"]) - # Report of all variables (including the ones with zero queries) - if (report_zeros == TRUE) { - report <- report %>% - dplyr::group_by(.data$var, .drop = FALSE) %>% - dplyr::summarise("total" = dplyr::n()) - } else { - report <- report %>% - dplyr::group_by(.data$var, .drop = TRUE) %>% - dplyr::summarise("total" = dplyr::n()) - } + # Sort queries by center and id + queries <- queries[order(queries[, "center"], queries[, "id"]), ] + # Reset row names and remove temporary columns + rownames(queries) <- NULL + queries <- queries |> dplyr::select(-"center", -"id") } else { - # If there is none query, the function still creates a report containing all selected variables. + # If Identifier doesn't contain a dash, sort numerically by Identifier + queries$Identifier <- as.numeric(queries$Identifier) + queries <- queries[order(queries$Identifier), ] + } - # Message: if there is none query to be identified - message("There is no query to be identified.") + # Remove duplicate queries and ensure only unique rows are retained + queries <- queries |> + dplyr::select(-"Code") |> + unique() + + # Assign a unique code to each query based on Identifier + queries <- data.frame(queries |> + dplyr::group_by(.data$Identifier) |> + dplyr::mutate(cod = 1:dplyr::n())) + queries$Code <- paste0(as.character(queries$Identifier), "-", queries$cod) + queries <- queries |> dplyr::select(-"cod") + + # Reorder columns if the 'Link' argument is specified + if ("Link" %in% names(queries)) { + queries <- queries |> + dplyr::select("Identifier":"Query", "Code", "Link") + } - report <- as.data.frame(matrix(ncol = 2, nrow = length(event))) - colnames(report) <- c("var", "descr") + # Create a summary report of the queries + report <- data.frame( + "var" = queries$Event, + "descr" = queries$Description + ) - report$var <- event - report$descr <- if ("redcap_event_name.factor" %in% names(data)) { - as.character(unique(data0$redcap_event_name.factor[which(data0$redcap_event_name %in% event)])) - } else{ - "-" - } - report$total <- 0 + # If no previous report exists, set events and descriptions as factors using the dictionary + if (all(addTo %in% NA)) { + report$var <- factor(report$var, levels = c(unique(event))) + report$descr <- factor(report$descr) + } + # Include all variables in the report, with or without zero queries, based on 'report_zeros' + if (report_zeros == TRUE) { + report <- report |> + dplyr::group_by(.data$var, .drop = FALSE) |> + dplyr::summarise("total" = dplyr::n()) + } else { + report <- report |> + dplyr::group_by(.data$var, .drop = TRUE) |> + dplyr::summarise("total" = dplyr::n()) } + } else { + # Handle cases where there are no queries + + # Notify the user that no queries were identified + message("No queries identified.") - # We check if there is more than one report_title and if it isn't the case we stabilish the caption for the report_title - if (all(is.na(report_title))) { - report_title <- "Report of queries" + # Create an empty report with placeholders for events + report <- as.data.frame(matrix(ncol = 2, nrow = length(event))) + colnames(report) <- c("var", "descr") + + # Populate the report with event names and placeholders for descriptions + report$var <- event + report$descr <- if ("redcap_event_name.factor" %in% names(data)) { + as.character(unique(data0$redcap_event_name.factor[which(data0$redcap_event_name %in% event)])) } else { - if (length(report_title) > 1) { - stop("There is more than one title for the report, please choose only one.", call. = FALSE) - } + "-" } - # Arrange report - report <- report %>% - dplyr::mutate(descr = unique(data0$redcap_event_name.factor[data0$redcap_event_name %in% report$var])) %>% - dplyr::select("var", "descr", "total") %>% - dplyr::arrange(dplyr::desc(.data$total)) - names(report) <- c("Events", "Description", "Total") - rownames(report) <- NULL - - # Viewer - result <- knitr::kable(report, - align = c("ccccc"), - row.names = FALSE, - caption = report_title, - format = "html", - longtable = TRUE) - result <- kableExtra::kable_styling(result, - bootstrap_options = c("striped", "condensed"), - full_width = FALSE) - result <- kableExtra::row_spec(result, 0, italic = FALSE, extra_css = "border-bottom: 1px solid grey") - - # Return the final product - list(queries = queries, - results = result) + # Set total queries for each event to zero + report$total <- 0 } + + # Set the report title or validate the provided title + if (all(is.na(report_title))) { + report_title <- "Report of queries" + } else { + # Ensure only one report title is provided + if (length(report_title) > 1) { + stop("Multiple titles provided for the report. Please specify only one..", call. = FALSE) + } + } + + # Finalize and arrange the report for output + report <- report |> + dplyr::mutate(descr = unique(data0$redcap_event_name.factor[data0$redcap_event_name %in% report$var])) |> + dplyr::select("var", "descr", "total") |> + dplyr::arrange(dplyr::desc(.data$total)) + + # Rename columns for the final report + names(report) <- c("Events", "Description", "Total") + rownames(report) <- NULL + + # Generate an HTML table for the report + result <- knitr::kable(report, + align = c("ccccc"), + row.names = FALSE, + caption = report_title, + format = "html", + longtable = TRUE + ) + result <- kableExtra::kable_styling(result, + bootstrap_options = c("striped", "condensed"), + full_width = FALSE + ) + result <- kableExtra::row_spec(result, 0, italic = FALSE, extra_css = "border-bottom: 1px solid grey") + + # Return the queries and the formatted report + list( + queries = queries, + results = result + ) +} diff --git a/R/rd_export.R b/R/rd_export.R index 824ba7e..4a24d38 100644 --- a/R/rd_export.R +++ b/R/rd_export.R @@ -1,44 +1,57 @@ -#' Exporting Query Dataset +#' Export Queries to an Excel File #' -#' This function exports a query report, generated using the `rd_query` or `rd_event` functions, to an .xlsx file. +#' @description +#' `r lifecycle::badge('experimental')` #' -#' @param ... List containing the data frame of queries. This list must be the output of the `rd_query` or `rd_event` functions. -#' @param queries Data frame containing the identified queries. If the list is specified, this argument is not required. -#' @param column Character element specifying the column containing the link for each query. -#' @param sheet_name Character element specifying the sheet name of the resulting xlsx file. -#' @param path Character element specifying the file path to save the xlsx file. If `NULL`, the file will be created in the current working directory. -#' @param password String with the password to protect the worksheet and prevent others from making changes. -#' @return An .xlsx file containing all the queries and, if available, hyperlinks to each of them. +#' This function exports a query dataset, typically generated using `rd_query` or `rd_event`, into an `.xlsx` file. +#' It supports adding hyperlinks to specified columns and optional password protection for the worksheet. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param queries A data frame containing the identified queries. If `...` is provided, this argument is ignored. +#' @param column A string specifying the column in the dataset that contains hyperlinks. If not specified, +#' hyperlinks will not be added unless a column named `Link` is detected. +#' @param sheet_name A string specifying the name of the sheet in the resulting `.xlsx` file. Defaults to `"Sheet1"`. +#' @param path A string specifying the file path to save the `.xlsx` file. If `NULL`, the file is saved in the +#' current working directory with the name `example.xlsx`. +#' @param password An optional string to password-protect the worksheet, preventing unauthorized edits. +#' +#' @return An `.xlsx` file saved to the specified path, containing the query data and hyperlinks if specified. +#' +#' @examples +#' \dontrun{ +#' # Export queries to an Excel file +#' rd_export( +#' queries = my_queries, +#' column = "Link", +#' sheet_name = "My Queries", +#' path = "queries.xlsx" +#' ) +#' } #' #' @export -rd_export <- function(..., queries = NULL, column = NULL, sheet_name = NULL, path = NULL, password = NULL) -{ - # If the entire list resulting from the 'redcap_data' function is used - project <- c(...) - if(!is.null(project)){ - if(!is.null(queries)){ - - warning("Queries have been specified twice so the function will not use the information in the queries argument.") +rd_export <- function(project = NULL, queries = NULL, column = NULL, sheet_name = NULL, path = NULL, password = NULL) { + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + if (!is.null(queries)) { + warning("Queries has been provided twice. The function will ignore the `queries` argument.") } queries <- project$queries } - # Making sure that the object data is a data.frame + # Ensure `queries` is a data frame queries <- as.data.frame(queries) # Warning: links detected but the column argument is not specified. - if (is.null(column) & !"Link" %in% names(queries) & any(queries %>% dplyr::summarise_all(~ any(grepl("https", .))))) { - - warning("A column containing links was detected. If you want to convert them into hyperlinks, please specify the column argument.", call. = F) - + if (is.null(column) & !"Link" %in% names(queries) & any(queries |> dplyr::summarise_all(~ any(grepl("https", .))))) { + warning("Links were detected in the dataset. To convert them into hyperlinks in the Excel file, specify the `column` argument.", call. = FALSE) } # Create a new workbook wb <- openxlsx::createWorkbook() - # Add a new worksheet to the workbook + # Set the worksheet name sheet_name <- if (!is.null(sheet_name)) { sheet_name } else { @@ -46,59 +59,67 @@ rd_export <- function(..., queries = NULL, column = NULL, sheet_name = NULL, pat } sheet <- openxlsx::addWorksheet(wb, sheet_name) - # Converting the links into hyperlinks + # Handle hyperlink conversion if a column is specified or `Link` is present if (!is.null(column) | "Link" %in% names(queries)) { - - # Stabilish the column name + # Determine the column name column <- if (!is.null(column)) { if (column %in% names(queries)) { column } else { - - # Error: the named column is not present in the dataset - stop("The column you have specified does not exist in the dataset.", call. = F) - + # Error: Stop execution if the specified column doesn't exist + stop("The specified column for hyperlinks does not exist in the dataset. Please review the `column` argument.", call. = FALSE) } } else { "Link" } - # Add hyperlinks to a cell + # Mark the column as hyperlinks class(queries[, column]) <- "hyperlink" - } - # Write the data frame to the worksheet - openxlsx::writeDataTable(wb = wb, sheet = sheet, x = queries, startRow = 1, startCol = 1, rowNames = F, tableStyle = "TableStyleLight11") - - # Align cells to the center - openxlsx::addStyle(wb = wb, sheet = sheet, style = openxlsx::createStyle(halign = "CENTER"), rows = 1:(nrow(queries) + 1), cols = 1:length(queries), gridExpand = T) - - # Cell widths - openxlsx::setColWidths(wb = wb, sheet = sheet, cols = 1:length(queries), widths = "auto") - - # Path to the file + # Write data to the worksheet + openxlsx::writeDataTable( + wb = wb, + sheet = sheet, + x = queries, + startRow = 1, + startCol = 1, + rowNames = FALSE, + tableStyle = "TableStyleLight11" + ) + + # Center-align cells + openxlsx::addStyle( + wb = wb, + sheet = sheet, + style = openxlsx::createStyle(halign = "CENTER"), + rows = 1:(nrow(queries) + 1), + cols = seq_along(queries), + gridExpand = TRUE + ) + + # Automatically adjust column widths + openxlsx::setColWidths( + wb = wb, + sheet = sheet, + cols = seq_along(queries), + widths = "auto" + ) + + # Determine the file path for saving path <- if (!is.null(path)) { path } else { paste0(getwd(), "/example.xlsx") } - # Save workbook to a file with password + # Save the workbook with or without password protection if (!is.null(password)) { - openxlsx::protectWorksheet(wb, sheet = sheet, password = password) - openxlsx::saveWorkbook(wb, path, overwrite = T) + openxlsx::saveWorkbook(wb, path, overwrite = TRUE) message(paste0("The file has been successfully created in '", path, "' with password protection.")) - } else { - - # Save workbook to a file - openxlsx::saveWorkbook(wb, path, overwrite = T) + openxlsx::saveWorkbook(wb, path, overwrite = TRUE) message(paste0("The file has been successfully created in '", path, "'.")) - } } - - - diff --git a/R/rd_factor.R b/R/rd_factor.R new file mode 100644 index 0000000..8106948 --- /dev/null +++ b/R/rd_factor.R @@ -0,0 +1,154 @@ +#' Convert Variables to Factors in a REDCap Dataset +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function converts variables in a REDCap dataset that have associated `.factor` columns into actual factor variables, while also updating branching logic in the associated dictionary. +#' +#' It also allows for the exclusion of specific variables from being converted into factors. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param exclude A character vector of variable names to exclude from being converted into factors. +#' +#' @return A list containing: +#' \item{data}{The transformed dataset with factor variables applied.} +#' \item{dictionary}{The dictionary with updated branching logic for the transformed variables.} +#' \item{event_form}{The event-form mapping used (if provided).} +#' \item{results}{A string summarizing the changes made during the transformation.} +#' +#' @details +#' This function searches for columns in the data that have a `.factor` suffix (indicating that they can be converted into factors) and converts them into factors based on their labels. +#' The `exclude` argument allows you to specify which variables should not be converted. +#' The function also modifies the branching logic in the dictionary to reflect the changes made in the data. +#' +#' Variables with the names `redcap_event_name.factor` and `redcap_data_access_group.factor` are excluded from the conversion process to avoid altering event and access group information. +#' +#' @examples +#' result <- REDCapDM::rd_factor(covican, exclude = c("available_analytics", "urine_culture")) +#' +#' transformed_data <- result$data +#' +#' @export + +rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude = NULL) { + + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Extract labels from the data to reapply later + labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + # We need to preserve the original values of `redcap_event_name` and `redcap_data_access_group`, so exclude them from conversion + keep <- c("redcap_event_name.factor", "redcap_repeat_instrument.factor", "redcap_data_access_group.factor") + keep_factors <- data |> + dplyr::select(dplyr::any_of(keep)) + + # Remove the factor versions of the variables to prevent them from being affected + data <- data |> + dplyr::select(-dplyr::any_of(keep)) + + # Identify the columns ending with '.factor' (these are the potential factor variables) + factors <- data |> + dplyr::select(dplyr::ends_with(".factor")) |> + names() |> + stringr::str_remove("\\.factor$") + + # If there are no factor variables, stop the function + if (length(factors) == 0) { + warning("There are no variables in the data which can be converted to factors.") + } else { + if (!is.null(exclude)) { + bad_vars <- exclude[grepl("\\.factor$", exclude)] + if (length(bad_vars) > 0) { + stop( + sprintf( + "Please use the original form of the variable(s) without '.factor' in the exclude argument: %s", + paste(bad_vars, collapse = ", ") + ), + call. = FALSE + ) + } + } + # Exclude specified variables that should not be converted to factors + factors <- setdiff(factors, exclude) + + # If no variables are left to convert, stop and ask to review the exclude argument + if (length(factors) == 0) { + stop("All variables in the data which can be converted to factors are specified in the `exclude` argument. Please, review the `exclude` argument.", call. = FALSE) + } + } + + # Perform the transformation of factor columns into actual factor variables + data <- data |> + # Assign the values from the factor columns to the original columns and remove the '.factor' versions + dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get(stringr::str_glue("{dplyr::cur_column()}.factor")))) |> + dplyr::select(-stringr::str_glue("{factors}.factor")) + + # If there were any variables that were excluded from conversion, reattach them to the data + if (length(keep_factors) > 0) { + data <- data |> + dplyr::bind_cols(keep_factors) + + # Relocate the kept factor variables to the correct position in the data + for (i in seq_along(keep_factors)) { + data <- data |> + dplyr::relocate(names(keep_factors)[i], .after = sub("\\.factor$", "", names(keep_factors)[i])) + } + + # Alternativa + # data <- purrr::reduce2( + # .x = c(names(keep_factors)), + # .y = c(sub("\\.factor$", "", names(keep_factors))), + # .f = ~ dplyr::relocate(..1, ..2, .after = ..3), + # .init = data + # ) + } + + # Apply the labels to the data + data <- data |> + labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Replacing original variables for their factor version. (rd_factor)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Replacing original variables for their factor version. (rd_factor)\n")) + } + + # Return the results: the transformed data, updated dictionary, event_form, and results + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_insert_na.R b/R/rd_insert_na.R index 42eeea7..088ac48 100644 --- a/R/rd_insert_na.R +++ b/R/rd_insert_na.R @@ -1,124 +1,126 @@ #' Insert Missing Values Using a Filter #' -#' This function allows you to manually insert a missing value into certain variables (`vars`) if the specified filter/s (`filter`) are satisfied. It's particularly useful for checkboxes without a gatekeeper question in the branching logic. Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +#' @description +#' `r lifecycle::badge('stable')` +#' +#' This function allows you to manually insert a missing value into certain variables (`vars`) if the specified filter/s (`filter`) are satisfied. +#' It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. +#' Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param vars A character vector with the names of the variables to be transformed. +#' @param filter A character vector of logical expressions to evaluate. If the evaluation is `TRUE`, the corresponding variable in `vars` is set to `NA`. +#' +#' @return The modified data frame with the specified variables updated. #' -#' @param ... List containing the data, the dictionary and the event if it's needed. Should be the output of the function `redcap_data`. -#' @param data Data frame containing data from REDCap. If the list is specified, this argument is not needed. -#' @param dic Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not needed. -#' @param event_form Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not needed. -#' @param vars Character vector containing the names of the variables to be transformed. -#' @param filter Character vector containing the logic to be evaluated directly. If each logic is TRUE, the corresponding variable in `vars` is set to missing. -#' @return Transformed data with the specified variables converted. #' @examples +#' +#' # Example usage: #' table(is.na(covican$data$potassium)) -#' data <- rd_insert_na(covican, -#' vars = "potassium", -#' filter = "age < 65") +#' +#' data <- covican |> +#' rd_insert_na( +#' vars = "potassium", +#' filter = "age < 65" +#' ) +#' #' table(data$potassium) +#' #' @export #' @importFrom rlang .data -rd_insert_na <- function(..., data = NULL, dic = NULL, event_form = NULL, vars, filter){ - - project <- c(...) - - if(!is.null(project)){ - if(!is.null(data)){ - warning("Data has been specified twice so the function will not use the information in the data argument.") - } - - if(!is.null(dic)){ - warning("Dictionary has been specified twice so the function will not use the information in the dic argument.") - } - - data <- project$data - dic <- project$dictionary +rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars, filter) { - if("event_form" %in% names(project)){ - if(!is.null(event_form)){ - warning("Event has been specified twice so the function will not use the information in the event argument.") - } - event_form <- project$event_form - } + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + # browser() + list2env(env_vars, envir = environment()) } - if(is.null(data) | is.null(dic)){ - stop("No data/dictionary was provided") + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") } - #Check if the project is longitudinal (has more than one event) or not: + # Determine if the dataset is longitudinal longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) - if(is.null(event_form) & longitudinal){ - stop("There is more than one event in the data and the event-form correspondence hasn't been specified") + # Error: For longitudinal data, ensure `event_form` is specified + if (is.null(event_form) & longitudinal) { + stop("The dataset contains multiple events, but the `event_form` mapping was not provided. Please specify it.") } - if(length(filter) != length(vars)){ - - stop("The number of filter variables specified doesn't match with the number of variables specified", call. = FALSE) - - }else{ - - for(i in 1:length(filter)){ - - #For every filter & variable get the variables specified in the filter and their events (if there is more than one event) - if(longitudinal){ - #First, let's get the variables in the filter: + # Validate matching lengths of `vars` and `filter` + if (length(filter) != length(vars)) { + stop("The number of variables (`vars`) does not match the number of filters (`filter`). Ensure both have equal length.") + } else { + # Loop through variables and filters to apply transformations + for (i in seq_along(filter)) { + # For every filter & variable get the variables specified in the filter and their events (if there is more than one event) + if (longitudinal) { + # Parse variables within the filter expression vars_filter <- trimws(unlist(stringr::str_split(filter[i], "[&|]"))) vars_filter <- gsub("!?is.na\\(", "", vars_filter) vars_filter <- unlist(stringr::str_extract_all(vars_filter, "^\\w+")) - #Get the events of these variables: - event_filter <- tibble::tibble(vars_filter = vars_filter) %>% - dplyr::mutate(form = purrr::map_chr(.data$vars_filter, ~dic %>% - dplyr::filter(.data$field_name %in% .x) %>% - dplyr::pull(.data$form_name)), - event = purrr::map(.data$form, ~event_form %>% - dplyr::filter(.data$form %in% .x) %>% - dplyr::pull(.data$unique_event_name))) - - #Get the events in common of all the filter variables: - events <- Reduce(intersect, event_filter$event) - - #If the filter variables have no events in common: - if(length(events) == 0){ - stop("Variables included in the filter are in different events.") + # Extract corresponding events for filter variables + event_filter <- tibble::tibble(vars_filter = vars_filter) |> + dplyr::mutate( + form = purrr::map_chr(.data$vars_filter, ~ dic |> + dplyr::filter(.data$field_name %in% .x) |> + dplyr::pull(.data$form_name)), + event = purrr::map(.data$form, ~ event_form |> + dplyr::filter(.data$form %in% .x) |> + dplyr::pull(.data$unique_event_name)) + ) + + # Identify common events for filter variables + events <- Reduce(intersect, event_filter$event) + + # Stop if there are no common events + if (length(events) == 0) { + stop("The variables in the filter belong to different events.") } - #Now let's get the event of the variable to be transformed: - form_var <- dic %>% - dplyr::filter(.data$field_name == vars[i]) %>% + # Identify events for the variable to be transformed + form_var <- dic |> + dplyr::filter(.data$field_name == vars[i]) |> dplyr::pull(.data$form_name) - event_var <- event_form %>% - dplyr::filter(.data$form == form_var) %>% + event_var <- event_form |> + dplyr::filter(.data$form == form_var) |> dplyr::pull(.data$unique_event_name) + # Ensure the variable's events overlap with filter events match_events <- intersect(events, event_var) - #If the filter variables are in different events with respect to the variable to be transformed it will give an error: - if(length(match_events) == 0){ - stop("The variable to be transformed is in a different event than the filter to be evaluated.") - }else{ - #If there is some event of the variable to be transformed that is not present in the filter it will give a warning: + # Error: filter variables are in different events from the variable to be transformed + if (length(match_events) == 0) { + stop("The variable `{vars[i]}` and the filter do not overlap in any events.") + } else { + # Warn: one of the events of the variable is not present in the filter if (!all(event_var %in% match_events)) { - warning(stringr::str_glue("The variable to be transformed ({vars[i]}) is present in more events than the events where the corresponding filter is evaluated. Only the rows of those events in common will be transformed ({match_events}).")) + warning(stringr::str_glue( + "The variable `{vars[i]}` is present in more events than the filter. ", + "Only rows in common events ({paste(match_events, collapse = ', ')}) will be transformed." + )) } } } - #Transform the data: - id <- data %>% - dplyr::mutate(id = dplyr::row_number()) %>% - dplyr::filter(eval(parse(text = filter[i]))) %>% + # Apply transformation: set specified variable to NA if filter is true + id <- data |> + dplyr::mutate(id = dplyr::row_number()) |> + dplyr::filter(eval(parse(text = filter[i]))) |> dplyr::pull(id) - data[id, vars[i]] <- NA - + data[id, vars[i]] <- NA } data - } - } diff --git a/R/rd_query.R b/R/rd_query.R index 388b722..43cbdbc 100644 --- a/R/rd_query.R +++ b/R/rd_query.R @@ -1,882 +1,866 @@ #' Identification of Queries #' -#' This function allows you to identify queries using a particular expression/filter. -#' It can be used to identify missing values or to identify values outside the lower and upper limits of a variable. +#' @description +#' `r lifecycle::badge('stable')` #' -#' @param ... List containing the data, dictionary and event mapping (if required) of the REDCap project. This should be the output of the `redcap_data` function. -#' @param data Data frame containing the data read from REDCap. If the list is given, this argument is not required. -#' @param dic Data frame containing the dictionary read from REDCap. If the list is given, this argument is not required. -#' @param event_form Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not required. -#' @param variables Character vector containing the names of the database variables to be checked. -#' @param expression Character vector of expressions to apply to the selected variables. -#' @param negate Logical value indicating whether the defined expression should be negated. Default value is `FALSE`. -#' @param variables_names Character vector containing the description of each selected variable. By default, the function automatically takes the description of each variable from of the REDCap project dictionary. -#' @param query_name Description of the query. It can be the same for all variables, or you can define a different one for each variable. By default, this function defines it as `The value is [value] and it should not be [expression]'`. -#' @param instrument REDCap instrument to which the variables belong. It can be the same for all variables, or you can define a different one for each variable. By default, the function automatically selects the corresponding instrument of each variable from the REDCap project dictionary. -#' @param event The name of the REDCap event to analyze. If there are events in your REDCap project, you should use this argument to name the event to which the defined variables belong. -#' @param filter A filter to be applied to the dataset. For example, this argument can be used to apply the branching logic of a defined variable. -#' @param addTo Data frame corresponding to a previous query data frame to which you can add the new query data frame. By default, this function always creates a new data frame regardless previous reports. -#' @param report_title Character string specifying the title of the report. -#' @param report_zeros Logical. If `TRUE`, the function returns a report containing variables with zero queries. -#' @param by_dag Logical. If `TRUE`, both elements of the output will be grouped by the Data Access Groups (DAGs) of the REDCap project. -#' @param link List containing project information used to create a web link to each query. -#' @return A list with a data frame of 9 columns (10 columns, if the link argument is specified) meant to help the user identify each query and a table with the total number of queries per variable. +#' This function allows you to identify queries based on a specific expression or filter. It is useful for detecting missing values or values that fall outside predefined lower or upper limits of a variable. +#' The function can also apply branching logic to variables, enabling targeted query identification in REDCap datasets. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param variables A character vector containing the names of the variables to be checked for queries. +#' @param expression A character vector of expressions to apply to the selected variables. +#' @param negate A logical value indicating whether the defined expression should be negated. The default is `FALSE`, meaning the expression will be applied as is. If `TRUE`, the function will identify values that do **not** meet the condition defined in `expression`. +#' @param variables_names A character vector containing the descriptions of each selected variable. By default, the function will pull these descriptions from the REDCap dictionary associated with the variables. You can specify custom descriptions if desired. +#' @param query_name A character string describing the query. By default, it uses the format `The value is [value] and it should not be [expression]`. You can specify a custom query description for each variable if needed. +#' @param instrument The REDCap instrument(s) that the variables belong to. This can be the same for all variables or you can define different instruments for each variable. By default, the function will retrieve the corresponding instrument from the REDCap dictionary. +#' @param event The name of the REDCap event to analyze. If your REDCap project includes multiple events, you should specify the event to which the variables belong. This is required if your dataset contains multiple events. +#' @param filter A character string specifying a filter to be applied to the dataset. This is useful for applying additional conditions, such as using branching logic or filtering based on a specific characteristic of the data (e.g., `filter = "available_analytics=='1'"`). +#' @param addTo A data frame corresponding to a previous query data frame, to which the new query data frame will be appended. If not provided, the function will create a new data frame for each call. Use this argument to combine multiple queries into one report. +#' @param report_title A character string specifying the title of the final report generated by the function. +#' @param report_zeros A logical value indicating whether queries with zero counts should be included in the report. Default is `FALSE`. Set it to `TRUE` to include variables with zero queries. +#' @param by_dag A logical value indicating whether the results should be grouped by Data Access Groups (DAGs). Default is `FALSE`. Set to `TRUE` to split the results by DAG if applicable. +#' @param link A list containing project information to create a web link for each query. This can be used to include clickable links to the REDCap project or other resources directly in the report. If not specified, no links will be included. +#' +#' @return A list containing: +#' - A data frame of 9 columns (10 columns if `link` is specified), providing detailed information on each identified query. +#' - A table showing the total number of queries per variable. #' #' @examples -#' # Missing values +#' # Example 1: Identifying missing values for multiple variables #' example <- rd_query(covican, -#' variables = c("copd", "age"), -#' expression = c("is.na(x)", "x %in% NA"), -#' event = "baseline_visit_arm_1") +#' variables = c("copd", "age"), +#' expression = c("is.na(x)", "x %in% NA"), +#' event = "baseline_visit_arm_1" +#' ) #' example #' -#' # Expression +#' # Example 2: Identifying values greater than 20 for the 'age' variable #' example <- rd_query(covican, -#' variables="age", -#' expression="x>20", -#' event="baseline_visit_arm_1") +#' variables = "age", +#' expression = "x>20", +#' event = "baseline_visit_arm_1" +#' ) #' example #' -#' # Using the filter argument +#' # Example 3: Identifying missing values for 'potassium' with a filter #' example <- rd_query(covican, -#' variables = "potassium", -#' expression = "is.na(x)", -#' event = "baseline_visit_arm_1", -#' filter = "available_analytics=='1'") +#' variables = "potassium", +#' expression = "is.na(x)", +#' event = "baseline_visit_arm_1", +#' filter = "available_analytics=='1'" +#' ) #' example +#' #' @export #' @importFrom rlang .data -rd_query <- function(..., variables = NA, expression = NA, negate = FALSE, event = NA, filter = NA, addTo = NA, variables_names = NA, query_name = NA, instrument = NA, report_title = NA, report_zeros = FALSE, by_dag = FALSE, link = list(), data = NULL, dic = NULL, event_form = NULL) - { +rd_query <- function(project = NULL, variables = NA, expression = NA, negate = FALSE, event = NA, filter = NA, addTo = NA, variables_names = NA, query_name = NA, instrument = NA, report_title = NA, report_zeros = FALSE, by_dag = FALSE, link = list(), data = NULL, dic = NULL, event_form = NULL) { - # If the entire list resulting from the 'redcap_data' function is used - project <- c(...) + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + # browser() + list2env(env_vars, envir = environment()) + } - if(!is.null(project)){ + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } - if(!is.null(data)){ - warning("Data has been specified twice so the function will not use the information in the data argument.") - } + # Ensure data and dictionary are data frames + data <- as.data.frame(data) + dic <- as.data.frame(dic) - if(!is.null(dic)){ - warning("Dictionary has been specified twice so the function will not use the information in the dic argument.") - } + # Initialize the query structure + queries <- as.data.frame(matrix(ncol = 10, nrow = 0)) + colnames(queries) <- c("Identifier", "DAG", "Event", "Instrument", "Field", "Repetition", "Description", "Query", "Code", "Link") - data <- project$data - dic <- project$dictionary + # Initialize the zero-query structure + excel_zero <- as.data.frame(matrix(ncol = 4, nrow = 0)) + colnames(excel_zero) <- c("DAG", "Variables", "Description", "Query") - if("event_form" %in% names(project)) { - if(!is.null(event_form)){ - warning("Event form has been specified twice so the function will not use the information in the event_form argument.") - } - event_form <- as.data.frame(project$event_form) - } - } + # Rename the first column of the dataset to 'record_id' if necessary + if (all(!names(data) == "record_id")) { + names(data)[1] <- "record_id" + } + + # Error: specified variables do not exist in the dataset + if (any(!variables %in% names(data))) { + stop("Specified variables do not exist in the dataset. Please review the `variables` argument.") + } - # Making sure that the object data and dic are a data.frame - data <- as.data.frame(data) - dic <- as.data.frame(dic) + # Warning: event not specified + if (all(is.na(event)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)) & is.null(event_form)) { + warning("No event or event-form has been specified. Therefore, the function will automatically consider observations from all events in the dataset. Ensure that the selected variable(s) is(are) collected in all specified events. This will avoid overestimating the number of queries.", call. = FALSE) + } - # Creation of the structure of the queries - queries <- as.data.frame(matrix(ncol = 10, nrow = 0)) - colnames(queries) <- c("Identifier", "DAG", "Event", "Instrument", "Field", "Repetition", "Description", "Query", "Code", "Link") + # Handle events automatically based on event_form and dictionary + if (all(is.na(event)) & !is.null(event_form)) { + var_form <- dic |> + dplyr::filter(.data$field_name %in% variables) |> + dplyr::pull(.data$form_name) - # Creation of the structure for variables with zero queries - excel_zero <- as.data.frame(matrix(ncol = 4, nrow = 0)) - colnames(excel_zero) <- c("DAG", "Variables", "Description", "Query") + event <- event_form |> + dplyr::filter(.data$form %in% var_form) |> + dplyr::pull(.data$unique_event_name) + } - # Naming the first column of the REDCap's database as record_id - if (all(!names(data) == "record_id")) { - names(data)[1] <- "record_id" - } + # Apply event filtering if events are specified + if (all(!is.na(event))) { + # Saving initial dataset + data0 <- data - # Error: one of the variables does not exist in the data - if (any(!variables %in% names(data))) { - stop("The data does not contain the specified variable(s). Please double-check the input variable name.") + # Error: event variable is missing in dataset + if (all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + stop("Event specified, but no event variable found in the dataset. Please review the `event` argument.") } - # Warning: event not specified - if (all(is.na(event)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)) & is.null(event_form)) { - warning("No event or event-form has been specified. Therefore, the function will automatically consider observations from all events in the dataset. Ensure that the selected variable(s) is(are) collected in all specified events. This will avoid overestimating the number of queries.", call. = F) + # Error: specified events are not in the dataset + if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + if (any(!event %in% data$redcap_event_name) & any(!event %in% data$redcap_event_name.factor)) { + stop("One or more specified events are not found in the dataset. Please review the `event` argument.") + } } - # If the argument event is not specified but there is the event form element in our data frame - if (all(is.na(event)) & !is.null(event_form)) { - var_form <- dic %>% - dplyr::filter(.data$field_name %in% variables) %>% - dplyr::pull(.data$form_name) + # Warning: multiple events are specified + if (length(event) > 1 & is.null(event_form)) { + warning("Multiple events specified. Ensure variables are collected across all events to avoid overestimation.", .call = FALSE) + } - event <- event_form %>% - dplyr::filter(.data$form %in% var_form) %>% - dplyr::pull(.data$unique_event_name) + # Filter data by events - factor version + if ("redcap_event_name.factor" %in% names(data) & all(event %in% data$redcap_event_name.factor)) { + data <- dplyr::filter(data, data$redcap_event_name.factor %in% event) } - # Applying a filter of the chosen events to the database - if (all(!is.na(event))) { + # Filter data by events - raw version + if (all(event %in% data$redcap_event_name)) { + data <- dplyr::filter(data, data$redcap_event_name %in% event) + } - # Saving initial dataset - data0 <- data + # Warning: identifiers are missing observations in any event (it only appears when checking for missings - %in%NA) + if (length(unique(data0$record_id)) != length(unique(data$record_id)) & any(grepl("%in%NA", gsub(" ", "", expression)))) { + warning("Some identifiers are missing observations in specified events.\nUse 'rd_event' to check which identifiers are missing.", call. = FALSE) + } + } - # Error: there is no event name variable in the dataset but the argument has a value - if (all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - stop("The event argument is specified, but there is no event name variable in the dataset.") - } + # Error: by_dag is TRUE but no DAG variable exists + if (by_dag %in% TRUE & all(!c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(data))) { + stop("DAG-based reporting requested, but no DAG variable found in the dataset. Use `by_dag = FALSE` to continue.") + } - # Error: one of the specified events does not exist in the database - if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - if (any(!event %in% data$redcap_event_name) & any(!event %in% data$redcap_event_name.factor)) { - stop("One of the events mentioned does not exist in the database, please verify the argument 'event'.") - } - } + # Warning: Validate 'link' argument and ensure completeness + if (!is.null(names(link))) { + if (!all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + stop("Incomplete 'link' argument. To properly use it, please provide domain, redcap_version, project ID, and event ID.", call. = FALSE) + } - # Warning: there is more than one event specified - if (length(event) > 1 & is.null(event_form)) { - warning("More than one event has been specified. Ensure that the selected variable(s) are collected in all specified events. This will avoid overestimating the number of queries.", call. = F) - } + if (!all(c("domain", "redcap_version", "proj_id") %in% names(link)) & !any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + stop("Incomplete 'link' argument. To properly use it, please provide domain, redcap_version and project ID.", call. = FALSE) + } + } - # Filtering by event_name.factor if the event is equal to the category in the factor version - if ("redcap_event_name.factor" %in% names(data) & all(event %in% data$redcap_event_name.factor)) { - data <- dplyr::filter(data, data$redcap_event_name.factor %in% event) + # Handle event_id addition based on the link argument + if (!is.null(link[["event_id"]])) { + if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + # The event argument is specified and the event_id is specified using the events in the raw version + if (all(event %in% names(link[["event_id"]])) & all(event %in% data[, "redcap_event_name"])) { + event_link <- data.frame( + "name" = names(link[["event_id"]]), + "event_id" = as.numeric(link[["event_id"]]) + ) + data <- merge(data, event_link, by.x = "redcap_event_name", by.y = "name") } - # Filtering by event_name if the event is equal to the category in the raw version - if (all(event %in% data$redcap_event_name)) { - data <- dplyr::filter(data, data$redcap_event_name %in% event) + # The event argument is specified and the event_id is specified using the events in the factor version + if (all(event %in% names(link[["event_id"]])) & all(event %in% data[, "redcap_event_name.factor"])) { + event_link <- data.frame( + "name" = names(link[["event_id"]]), + "event_id" = as.numeric(link[["event_id"]]) + ) + data <- merge(data, event_link, by.x = "redcap_event_name.factor", by.y = "name") } - # Warning: there are identifiers that do not present the specified event (it only appears when checking for missings - %in%NA) - if (length(unique(data0$record_id)) != length(unique(data$record_id)) & any(grepl("%in%NA", gsub(" ", "", expression)))) { - warning("There are certain identifiers without observations in one of the events. \nUse the function 'rd_event' to check which ones are missing.", call. = FALSE) + # The event argument is not specified and the event_id is specified using the events in the raw version + if (all(is.na(event) & all(names(data[, "redcap_event_name"] %in% names(link[["event_id"]]))))) { + event_link <- data.frame( + "name" = names(link[["event_id"]]), + "event_id" = as.numeric(link[["event_id"]]) + ) + data <- merge(data, event_link, by.x = "redcap_event_name", by.y = "name") } - } - - # Error: Trying to split the report by DAGs but the REDCap project does not present DAGs - if (by_dag %in% TRUE & all(!c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(data))) { - stop("Trying to split the query reporting according to each DAG, but the project does not present DAGs. To continue, please specify by_dag = F.", call. = F) - } - # Warning: If the link argument is not fully completed - if (!is.null(names(link))) { - if (!all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - stop("There is not enough information in the link argument. \nTo create the link correctly, please provide the domain, redcap version, project ID and event ID.", call. = F) + # The event argument is not specified and the event_id is specified using the events in the factor version + if (all(is.na(event) & all(names(data[, "redcap_event_name.factor"] %in% names(link[["event_id"]]))))) { + event_link <- data.frame( + "name" = names(link[["event_id"]]), + "event_id" = as.numeric(link[["event_id"]]) + ) + data <- merge(data, event_link, by.x = "redcap_event_name.factor", by.y = "name") } - if (!all(c("domain", "redcap_version", "proj_id") %in% names(link)) & !any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - stop("There is not enough information in the link argument. \nTo create the link correctly, please provide the domain, redcap version and project ID.", call. = F) + } else { + # There is not an event name variable in the dataset + if (length(link[["event_id"]]) == 1) { + data[, "event_id"] <- as.numeric(link[["event_id"]]) + } else { + # Error: More than one event_id is specified and the project is non-longitudinal + stop("Non-longitudinal project. Please provide only one event ID.", .call = FALSE) } } + } - # Adding the information of the event_id from the link argument to the data - if (!is.null(link[["event_id"]])) { - - # The dataset has an event name variable - if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - - # The event argument is specified and the event_id is specified using the events in the raw version - if (all(event %in% names(link[["event_id"]])) & all(event %in% data[, "redcap_event_name"])) { - event_link <- data.frame("name" = names(link[["event_id"]]), - "event_id" = as.numeric(link[["event_id"]])) - data <- merge(data, event_link, by.x = "redcap_event_name", by.y = "name") - } - - # The event argument is specified and the event_id is specified using the events in the factor version - if (all(event %in% names(link[["event_id"]])) & all(event %in% data[, "redcap_event_name.factor"])) { - event_link <- data.frame("name" = names(link[["event_id"]]), - "event_id" = as.numeric(link[["event_id"]])) - data <- merge(data, event_link, by.x = "redcap_event_name.factor", by.y = "name") - } - - # The event argument is not specified and the event_id is specified using the events in the raw version - if (all(is.na(event) & all(names(data[, "redcap_event_name"] %in% names(link[["event_id"]]))))) { - event_link <- data.frame("name" = names(link[["event_id"]]), - "event_id" = as.numeric(link[["event_id"]])) - data <- merge(data, event_link, by.x = "redcap_event_name", by.y = "name") - } - - # The event argument is not specified and the event_id is specified using the events in the factor version - if (all(is.na(event) & all(names(data[, "redcap_event_name.factor"] %in% names(link[["event_id"]]))))) { - event_link <- data.frame("name" = names(link[["event_id"]]), - "event_id" = as.numeric(link[["event_id"]])) - data <- merge(data, event_link, by.x = "redcap_event_name.factor", by.y = "name") - } - - } else { - - # There is not an event name variable in the dataset - if (length(link[["event_id"]]) == 1) { - - data[, "event_id"] <- as.numeric(link[["event_id"]]) + # Warning: expressions are less than variables + if (length(variables) > length(expression)) { + expression <- rep(expression[1], length(variables)) + warning("Fewer expressions than variables. Repeating the same expression for all variables.", call. = FALSE) + } - } else { + # Apply filter logic if specified + if (all(!is.na(filter)) & length(filter) == 1) { + # Error: logic used in the filter is incorrect + command <- paste0("data", "<-dplyr::filter(data,", filter, ")") - # Error: More than one event_id is specified and the project is non-longitudinal - stop("The project is non-longitudinal (has no events). Therefore, you only need to specify a single event ID.", call. = F) + evaluation <- try(eval(parse(text = command)), silent = TRUE) - } - } + if (inherits(evaluation, "try-error")) { + stop("Invalid filter logic. Please review the `filter` argument.") + } else { + eval(parse(text = command)) } - # Warning: detecting more variables than expressions, so the function applies the same expression to all variables - if (length(variables) > length(expression)) { - - expression <- rep(expression[1], length(variables)) - warning("Due to the greater number of variables compared to expressions, the same expression has been applied to all of them.", call. = FALSE) - + # Error: filter results in zero observations + if (nrow(data) == 0) { + warning("Filter applied successfully, but no matching observations found. Please review the `filter` argument.") } + } - # Filtering the data using the information of the argument 'filter' - if (all(!is.na(filter)) & length(filter) == 1) { + # Handle branching logic for variables + var_logic <- variables[which(variables %in% dic[!dic$branching_logic_show_field_only_if %in% c(NA, ""), "field_name"])] - # Error: logic used in the filter is incorrect - command <- paste0("data", "<-dplyr::filter(data,", filter, ")") + # Objects to track compatible logic, unconverted logic, and branching evaluations + compatible <- NULL + logics <- NULL + br_eval <- NULL - evaluation <- try(eval(parse(text = command)), silent = TRUE) + if (length(var_logic) > 0) { + # Create a data frame of variables, labels, and their branching logic + branch <- data.frame( + var = dic$field_name[dic$field_name %in% gsub("___\\d*$", "", var_logic)], + label = gsub("\\s+", "", gsub("<.*?>", "", dic$field_label[dic$field_name %in% gsub("___\\d*$", "", var_logic)])), + branch = dic$branching_logic_show_field_only_if[dic$field_name %in% gsub("___\\d*$", "", var_logic)] + ) - if(inherits(evaluation, "try-error")){ + # Save the original branching logic data for reference + branch0 <- branch - stop("The logic used in the filter is incorrect. Please review the filter argument and make the necessary adjustments.") + # Convert REDCap logic into R-compatible logic + if ((!is.null(event_form) | all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) & all(stringr::str_detect(branch$branch, paste(c("\\[", "\\]"), collapse = "|")))) { + for (j in seq_len(nrow(branch))) { + evaluation <- try(rd_rlogic(data = data, dic = dic, event_form = event_form, logic = branch$branch[j], var = branch$var[j])$rlogic, silent = TRUE) + if (!inherits(evaluation, "try-error")) { + branch$branch[j] <- rd_rlogic(data = data, dic = dic, event_form = event_form, logic = branch$branch[j], var = branch$var[j])$rlogic } else { - - eval(parse(text = command)) - - } - - # Error: filter results in zero observations - if (nrow(data) == 0) { - warning("The filter applied is correct but does not match any observations. Please double-check that the filter is properly formulated.", call. = FALSE) - } - } - - # Variables to be checked for missing values which present a branching logic - var_logic <- variables[which(variables %in% dic[!dic$branching_logic_show_field_only_if %in% c(NA, ""), "field_name"])] - - # We create three objects that will contain the branching logic that can't be converted to R logic - compatible <- NULL - logics <- NULL - br_eval <- NULL - - # Branching logic detected (only in variables checked for missing values) - if (length(var_logic) > 0) { - - # Data frame with variable, variable name and branching logic - branch <- data.frame( - var = dic$field_name[dic$field_name %in% gsub("___\\d*$", "", var_logic)], - label = gsub("\\s+", "", gsub("<.*?>", "", dic$field_label[dic$field_name %in% gsub("___\\d*$", "", var_logic)])), - branch = dic$branching_logic_show_field_only_if[dic$field_name %in% gsub("___\\d*$", "", var_logic)]) - - # Saving the original data frame before the transformation - branch0 <- branch - - # We convert the REDCap logic into R logic - if ((!is.null(event_form) | all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) & all(stringr::str_detect(branch$branch, paste(c("\\[", "\\]"), collapse = "|")))) { - - for (j in 1:nrow(branch)) { - - evaluation <- try(rd_rlogic(data = data, dic = dic, event_form = event_form, logic = branch$branch[j], var = branch$var[j])$rlogic, silent = T) - - if (!inherits(evaluation, "try-error")) { - - branch$branch[j] <- rd_rlogic(data = data, dic = dic, event_form = event_form, logic = branch$branch[j], var = branch$var[j])$rlogic - - } else { - - logics <- rbind(logics, branch$var[j]) - - } - } - - if (!is.null(logics) & nrow(data) > 0) { - - warning(c("The branching logic of the following variables could not be converted into R logic:", paste0("\n - ", unique(logics)), "\n Check the results element of the output(...$results) for details."), call. = F) - + logics <- rbind(logics, branch$var[j]) } } - # Arrange the data frames - rownames(branch0) <- NULL - names(branch0) <- c("Variable", "Label", "Branching logic") - rownames(branch) <- NULL - names(branch) <- c("Variable", "Label", "Branching logic") - - ## Warning about the variables with branching logic - if (is.null(event_form) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - warning("At least one of the variables that have been checked for missing values present a branching logic. \nCheck the results element of the output(...$results) for details.", call. = FALSE) + # Issue warning for logic that could not be converted + if (!is.null(logics) & nrow(data) > 0) { + warning(stringr::str_glue("The branching logic of the following variables could not be converted into R logic: {paste0('\n - ', unique(logics))}\nCheck the results element of the output(...$results) for details."), call. = FALSE) } } - # Apply an expression to the corresponding variable - for (i in 1:length(expression)) { - - # If the chosen variable has a branching logic - if (length(var_logic) > 0 & (!is.null(event_form) | all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) & any(!variables[i] %in% logics)) { - if (any(variables[i] == var_logic)) { + # Reorganize data frames for reporting + rownames(branch0) <- NULL + names(branch0) <- c("Variable", "Label", "Branching logic") + rownames(branch) <- NULL + names(branch) <- c("Variable", "Label", "Branching logic") - logic <- branch %>% - dplyr::filter(.data$Variable %in% variables[i]) %>% - dplyr::pull(.data$`Branching logic`) - - branching <- NULL - command <- paste0("branching", "<-dplyr::filter(data,", gsub(pattern = "data\\$", replacement = "data$", x = logic), ")") - - eval(parse(text = command)) + ## Warning branching logic in multi-event REDCap projects + if (is.null(event_form) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + warning("One or more variables checked for missing values have branching logic.\nSee results (...$results) for details.", call. = FALSE) + } + } - if(nrow(branching) > 0) { + # Apply expression filters to variables + for (i in seq_along(expression)) { + # If the chosen variable has a branching logic + if (length(var_logic) > 0 & (!is.null(event_form) | all(!c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) & any(!variables[i] %in% logics)) { + if (any(variables[i] == var_logic)) { + # Retrieve branching logic for the current variable + logic <- branch |> + dplyr::filter(.data$Variable %in% variables[i]) |> + dplyr::pull(.data$`Branching logic`) - compatible <- rbind(compatible, variables[i]) - raw0 <- branching + branching <- NULL - } else { + # Evaluate branching logic + command <- paste0("branching", "<-dplyr::filter(data,", gsub(pattern = "data\\$", replacement = "data$", x = logic), ")") - br_eval <- rbind(br_eval, variables[i]) - raw0 <- data + eval(parse(text = command)) - } + if (nrow(branching) > 0) { + compatible <- rbind(compatible, variables[i]) + raw0 <- branching } else { - + br_eval <- rbind(br_eval, variables[i]) raw0 <- data - } } else { - raw0 <- data - } + } else { + raw0 <- data + } - # Applying the expression - x <- variables[i] + # Apply custom expression filters + x <- variables[i] + command <- paste0("raw", "<-dplyr::filter(raw0,", gsub("\\bx\\b", x, expression[i]), ")") + eval(parse(text = command)) - command <- paste0("raw", "<-dplyr::filter(raw0,", gsub("\\bx\\b", x, expression[i]), ")") + # Transform the expression so it does not contain "x" + expression[i] <- gsub("\\bx\\b", "", expression[i]) - # Evaluation of the command with the resulting expression - eval(parse(text = command)) + # Handle negation if specified + if (negate == TRUE) { + raw <- suppressMessages(dplyr::anti_join(raw0, raw)) + } - # Transform the expression so it does not contain "x" - expression[i] <- gsub("\\bx\\b", "", expression[i]) + # Handle multiple filters + if (all(!filter %in% NA) & length(filter) > 1) { + # If the number of filters is equal to the number of variables + if (length(filter) == length(variables)) { + # Apply each filter individually + command <- paste0("definitive", "<-dplyr::filter(raw,", filter[i], ")") + eval(parse(text = command)) - # If the argument negate is TRUE, reverse the expression apllied - if (negate == TRUE) { - raw <- suppressMessages(dplyr::anti_join(raw0, raw)) + # Filtering results in zero observations + if (nrow(data) == 0) { + warning( + paste0( + "The filter for variable '", variables[i], "' resulted in no matching observations. Verify the filter logic." + ), + call. = FALSE + ) + } + } else { + # Error: number of filters is different from the number of variables + stop("Mismatch in the number of filters and variables. Ensure each variable has a corresponding filter.", call. = FALSE) } + } else { + definitive <- raw + } - # If there is more than one filter - if (all(!filter %in% NA) & length(filter) > 1) { - # If the number of filters is equal to the number of variables - if (length(filter) == length(variables)) { + # Generate query structure and metadata + if (nrow(definitive) > 0) { + # Construct query data frame + x <- definitive[, c("record_id", grep("redcap", names(definitive), value = TRUE), variables[i])] - # Apply each filter - command <- paste0("definitive", "<-dplyr::filter(raw,", filter[i], ")") - eval(parse(text = command)) + # Add event_id when the link argument is specified + if (all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link))) { + x[, "event_id"] <- definitive[, "event_id"] + } - # Filtering results in zero observations - if (nrow(data) == 0) { - warning("One of the applied filters does not match any observations. Please check that it is correct.", call. = FALSE) - } + # Filling the structure data frame with data + excel <- data.frame( + Identifier = x[, "record_id"], + DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(x))) { + if ("redcap_data_access_group.factor" %in% names(x)) { + as.character(x[, "redcap_data_access_group.factor"]) } else { - # Error: number of filters is different from the number of variables - stop("Multiple filters have been applied, but the number of filters does not match the number of variables. Please verify it.", call. = F) + as.character(x[, "redcap_data_access_group"]) } - } else { - definitive <- raw - } - - - # Identification of queries, using the structure built before - if (nrow(definitive) > 0) { - x <- definitive[, c("record_id", grep("redcap", names(definitive), value = T), variables[i])] - - # Add event_id when the link argument is specified - if (all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link))) { - x[, "event_id"] <- definitive[, "event_id"] - } - - # Filling the structure data frame with data - excel <- data.frame( - Identifier = x[, "record_id"], - DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(x))) { - if ("redcap_data_access_group.factor" %in% names(x)) { - as.character(x[, "redcap_data_access_group.factor"]) - } else { - as.character(x[, "redcap_data_access_group"]) - } + "-" + }, + Event = if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(x))) { + if ("redcap_event_name.factor" %in% names(x)) { + as.character(x[, "redcap_event_name.factor"]) } else { - "-" - }, - Event = if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(x))) { - if ("redcap_event_name.factor" %in% names(x)) { - as.character(x[, "redcap_event_name.factor"]) - } else { - as.character(x[, "redcap_event_name"]) - } + as.character(x[, "redcap_event_name"]) + } + } else { + "-" + }, + Instrument = if (all(is.na(instrument))) { + if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { + gsub("_", " ", stringr::str_to_sentence(dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"])) } else { "-" - }, - Instrument = if (all(is.na(instrument))) { - if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { - gsub("_", " ", stringr::str_to_sentence(dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"])) - } else{ - "-" - } + } + } else { + if (length(instrument) == 1) { + instrument } else { - if (length(instrument) == 1) { - instrument + if (length(instrument) == length(variables) & length(instrument) > 1) { + instrument[i] } else { - if (length(instrument) == length(variables) & length(instrument) > 1) { - instrument[i] - } else { - if (length(instrument) != length(variables) & length(instrument) > 1) { - stop("Multiple instruments specified, but the number of instruments is different from the number of variables. Please match each variable to each instrument.", call. = F) - } + if (length(instrument) != length(variables) & length(instrument) > 1) { + stop("Multiple instruments specified, but the number of instruments is different from the number of variables. Please match each variable to each instrument.", call. = FALSE) } } - }, - Field = variables[i], - Repetition = if (any(c("redcap_repeat_instrument", "redcap_repeat_instance") %in% names(x))) { - if ("redcap_repeat_instrument" %in% names(x) & all(is.na(x[, "redcap_repeat_instrument"]))) { - if ("redcap_repeat_instance" %in% names(x) & all(is.na(x[, "redcap_repeat_instance"]))) { - "-" - } else { - paste0(x[, "redcap_repeat_instance"]) - } + } + }, + Field = variables[i], + Repetition = if (any(c("redcap_repeat_instrument", "redcap_repeat_instance") %in% names(x))) { + if ("redcap_repeat_instrument" %in% names(x) & all(is.na(x[, "redcap_repeat_instrument"]))) { + if ("redcap_repeat_instance" %in% names(x) & all(is.na(x[, "redcap_repeat_instance"]))) { + "-" } else { - paste0(x[, "redcap_repeat_instrument"], "-", x[, "redcap_repeat_instance"]) + paste0(x[, "redcap_repeat_instance"]) } + } else { + paste0(x[, "redcap_repeat_instrument"], "-", x[, "redcap_repeat_instance"]) + } + } else { + "-" + }, + Description = if (all(is.na(variables_names))) { + if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { + trimws(gsub("<.*?>", "", as.character(dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "field_label"]))) } else { "-" - }, - Description = if (all(is.na(variables_names))) { - if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { - trimws(gsub("<.*?>", "", as.character(dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "field_label"]))) - } else{ - "-" - } + } + } else { + if (length(variables_names) == 1) { + variables_names } else { - if (length(variables_names) == 1) { - variables_names + if (length(variables_names) == length(variables) & length(variables_names) > 1) { + variables_names[i] } else { - if (length(variables_names) == length(variables) & length(variables_names) > 1) { - variables_names[i] - } else { - if (length(variables_names) != length(variables) & length(variables_names) > 1) { - stop("Multiple variables names specified, but the number of names is different from the number of variables. Please match each variable to each name.", call. = F) - } + if (length(variables_names) != length(variables) & length(variables_names) > 1) { + stop("Multiple variables names specified, but the number of names is different from the number of variables. Please match each variable to each name.", call. = FALSE) } } - }, - Query = if (all(!is.na(query_name))) { - if (length(query_name) %in% 1) { - query_name + } + }, + Query = if (all(!is.na(query_name))) { + if (length(query_name) %in% 1) { + query_name + } else { + if (length(query_name) %in% length(variables) & length(query_name) > 1) { + query_name[i] } else { - if (length(query_name) %in% length(variables) & length(query_name) > 1) { - query_name[i] - } else { - if (!length(query_name) %in% length(variables) & length(query_name) > 1) { - stop("Multiple query names specified, but the number of query names is different from the number of variables. Please match each variable to each query name.", call. = F) - } + if (!length(query_name) %in% length(variables) & length(query_name) > 1) { + stop("Multiple query names specified, but the number of query names is different from the number of variables. Please match each variable to each query name.", call. = FALSE) } } + } + } else { + if (negate == TRUE) { + trimws(gsub(" ", " ", paste("The value is", x[, variables[i]], "and it should be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern = c("<", ">", "<=", ">=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement = c(" less than ", " greater than ", " less than or equal to ", " greater than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize = FALSE)))) } else { - if (negate == TRUE) { - trimws(gsub(" ", " ", paste("The value is", x[, variables[i]], "and it should be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern=c("<", ">", "<=", ">=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement=c(" less than ", " greater than ", " less than or equal to ", " greater than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize=FALSE)))) - } else { - trimws(gsub(" ", " ", paste("The value is", x[, variables[i]], "and it should not be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern=c("<", ">", "<=", ">=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement=c(" less than ", "greater than ", " less than or equal to ", " greater than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize=FALSE)))) - } - }, - Code = "", - stringsAsFactors = FALSE - ) - - # Add link to each query - if (all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/index.php?pid=", link[["proj_id"]], "&event_id=", x[, "event_id"], "&page=", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"], "&id=", x[, "record_id"]) - } - - if (all(c("domain", "redcap_version", "proj_id") %in% names(link)) & !any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/index.php?pid=", link[["proj_id"]], "&page=", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"], "&id=", x[, "record_id"]) - } - - # Adding each identified query to the queries data frame - queries <- rbind(queries, excel) + trimws(gsub(" ", " ", paste("The value is", x[, variables[i]], "and it should not be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern = c("<", ">", "<=", ">=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement = c(" less than ", "greater than ", " less than or equal to ", " greater than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize = FALSE)))) + } + }, + Code = "", + stringsAsFactors = FALSE + ) + + # Add link to each query + if (all(c("domain", "redcap_version", "proj_id", "event_id") %in% names(link)) & any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/index.php?pid=", link[["proj_id"]], "&event_id=", x[, "event_id"], "&page=", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"], "&id=", x[, "record_id"]) + } - } else { + if (all(c("domain", "redcap_version", "proj_id") %in% names(link)) & !any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + excel[, "Link"] <- paste0("https://", link[["domain"]], "/redcap_v", link[["redcap_version"]], "/DataEntry/index.php?pid=", link[["proj_id"]], "&page=", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "form_name"], "&id=", x[, "record_id"]) + } - # If there are no queries to be identified, we still need this information to build the report - excel <- data.frame( - DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(data)) & nrow(data) > 0) { - if("redcap_data_access_group.factor" %in% names(data)) { - if (all(is.na(event))) { - unique(as.character(data[, "redcap_data_access_group.factor"])) - } else { - unique(as.character(data[data$redcap_event_name %in% event | data$redcap_event_name.factor %in% event, "redcap_data_access_group.factor"])) - } + # Adding each identified query to the queries data frame + queries <- rbind(queries, excel) + } else { + # Handle cases with zero queries + excel <- data.frame( + DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(data)) & nrow(data) > 0) { + if ("redcap_data_access_group.factor" %in% names(data)) { + if (all(is.na(event))) { + unique(as.character(data[, "redcap_data_access_group.factor"])) } else { - if (all(is.na(event))) { - unique(as.character(data[, "redcap_data_access_group"])) - } else { - unique(as.character(data[data$redcap_event_name %in% event | data$redcap_event_name.factor %in% event, "redcap_data_access_group"])) - } - } - } else { - "-" - }, - Variables = variables[i], - Description = if (all(is.na(variables_names))) { - if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { - trimws(gsub("<.*?>", "", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "field_label"])) - } else{ - "-" + unique(as.character(data[data$redcap_event_name %in% event | data$redcap_event_name.factor %in% event, "redcap_data_access_group.factor"])) } } else { - if (length(variables_names) == 1) { - variables_names - } else { - if (length(variables_names) == length(variables) & length(variables_names) > 1) { - variables_names[i] - } else { - if (length(variables_names) != length(variables) & length(variables_names) > 1) { - stop("Multiple variables names specified, but the number of names is different from the number of variables. Please match each variable to each name.", call. = F) - } - } - } - }, - Event = if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)) & nrow(data) > 0) { - if ("redcap_event_name.factor" %in% names(data)) { - unique(as.character(data[, "redcap_event_name.factor"])) + if (all(is.na(event))) { + unique(as.character(data[, "redcap_data_access_group"])) } else { - unique(as.character(data[, "redcap_event_name"])) + unique(as.character(data[data$redcap_event_name %in% event | data$redcap_event_name.factor %in% event, "redcap_data_access_group"])) } + } + } else { + "-" + }, + Variables = variables[i], + Description = if (all(is.na(variables_names))) { + if (gsub("___.*$", "", variables[i]) %in% dic$field_name) { + trimws(gsub("<.*?>", "", dic[dic[, "field_name"] %in% gsub("___.*$", "", variables[i]), "field_label"])) } else { "-" - }, - Query = if (all(!is.na(query_name))) { - if (length(query_name) == 1) { - query_name + } + } else { + if (length(variables_names) == 1) { + variables_names + } else { + if (length(variables_names) == length(variables) & length(variables_names) > 1) { + variables_names[i] } else { - if (length(query_name) == length(variables) & length(query_name) > 1) { - query_name[i] - } else { - if (length(query_name) != length(variables) & length(query_name) > 1) { - stop("Multiple query names specified, but the number of query names is different from the number of variables. Please match each variable to each query name.", call. = F) - } + if (length(variables_names) != length(variables) & length(variables_names) > 1) { + stop("Multiple variables names specified, but the number of names is different from the number of variables. Please match each variable to each name.", call. = FALSE) } } + } + }, + Event = if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)) & nrow(data) > 0) { + if ("redcap_event_name.factor" %in% names(data)) { + unique(as.character(data[, "redcap_event_name.factor"])) } else { - if (negate == TRUE) { - gsub(" ", " ", paste("The value should be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern=c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement=c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize=FALSE))) + unique(as.character(data[, "redcap_event_name"])) + } + } else { + "-" + }, + Query = if (all(!is.na(query_name))) { + if (length(query_name) == 1) { + query_name + } else { + if (length(query_name) == length(variables) & length(query_name) > 1) { + query_name[i] } else { - gsub(" ", " ", paste("The value should not be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern=c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement=c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize=FALSE))) + if (length(query_name) != length(variables) & length(query_name) > 1) { + stop("Multiple query names specified, but the number of query names is different from the number of variables. Please match each variable to each query name.", call. = FALSE) + } } - }, - stringsAsFactors = F - ) + } + } else { + if (negate == TRUE) { + gsub(" ", " ", paste("The value should be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern = c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement = c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize = FALSE))) + } else { + gsub(" ", " ", paste("The value should not be", stringi::stri_replace_all_regex(gsub(" ", "", expression[i]), pattern = c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement = c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize = FALSE))) + } + }, + stringsAsFactors = FALSE + ) - # Adding each variable with zero queries to the data frame - excel_zero <- rbind(excel_zero, excel) - } + # Adding each variable with zero queries to the data frame + excel_zero <- rbind(excel_zero, excel) } + } - ## Warnings about the variables with branching logic - if (!is.null(br_eval) & nrow(data) > 0) { - warning("The branching logic of the following variables can not be applied automatically:", paste0("\n- ", unique(br_eval)), "\nCheck the results element of the output(...$results) for details.", call. = FALSE) - } + # Warnings: variables where branching logic could not be applied automatically + if (!is.null(br_eval) & nrow(data) > 0) { + warning(stringr::str_glue("The branching logic for the following variables could not be applied automatically: {paste0('\n- ', unique(br_eval))}\nCheck the results element of the output(...$results) for details."), call. = FALSE) + } - if (!is.null(compatible)) { - if (length(compatible) > 1) { - sentence <- c("The branching logic of the following variables were applied automatically: ", paste0("\n- ", unique(compatible))) - } else { - sentence <- paste0("The branching logic of the following variable was applied automatically: ", unique(compatible)) - } - warning(sentence, call. = F) + # Report variables where branching logic was applied automatically + if (!is.null(compatible)) { + if (length(compatible) > 1) { + sentence <- stringr::str_glue("The branching logic of the following variables were applied automatically: {paste0('\n- ', unique(compatible), collapse = '')}") + } else { + sentence <- stringr::str_glue("The branching logic of the following variables were applied automatically: {unique(compatible)}") } + warning(sentence, call. = FALSE) + } - # If the argument 'addTo' is specified, combine the queries generated with a previous data frame of queries - if (all(!is.na(addTo))) { - - if ("Link" %in% names(addTo$queries)) { - col_names <- c(names(queries), "Link") - } else { - col_names <- names(queries) - } - - queries <- merge(queries, - addTo$queries, - by = intersect(names(addTo$queries), names(queries)), - all = TRUE) - queries <- queries %>% - dplyr::select(dplyr::all_of(col_names)) + # If 'addTo' argument is specified, merge previous queries + if (all(!is.na(addTo))) { + # Add 'Link' column if it exists in the addTo$queries data frame + if ("Link" %in% names(addTo$queries)) { + col_names <- c(names(queries), "Link") + } else { + col_names <- names(queries) } - # Classify each query with it's own code - if (nrow(queries) > 0) { - - # First we sort the data frame by record_id - if (all(grepl("-", queries$Identifier))) { - queries <- queries %>% - tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) - queries[, "center"] <- as.numeric(queries[, "center"]) - queries[, "id"] <- as.numeric(queries[, "id"]) - queries <- queries[order(queries[, "center"], queries[, "id"]), ] - rownames(queries) <- NULL - queries <- queries %>% dplyr::select(-"center", -"id") - } else { - queries$Identifier <- as.numeric(queries$Identifier) - queries <- queries[order(queries$Identifier), ] - } - - # Add the code to each query and eliminate duplicated ones - queries <- unique(queries %>% - dplyr::select(-"Code")) - queries <- data.frame(queries %>% - dplyr::group_by(.data$Identifier) %>% - dplyr::mutate(cod = 1:dplyr::n())) - queries$Code <- paste0(as.character(queries$Identifier), "-", queries$cod) - queries <- queries %>% dplyr::select(-"cod") - - # Reorder the columns if the link argument was specified - if ("Link" %in% names(queries)) { - queries <- queries %>% - dplyr::select("Identifier":"Query", "Code", "Link") - } + # Merge queries and add 'Link' if present + queries <- merge(queries, + addTo$queries, + by = intersect(names(addTo$queries), names(queries)), + all = TRUE + ) + queries <- queries |> + dplyr::select(dplyr::all_of(col_names)) + } - # Build the report - report <- data.frame("dag" = queries$DAG, - "var" = queries$Field, - "descr" = queries$Description, - "event" = queries$Event, - "query_descr" = gsub(" is .* it", "", queries$Query)) - - # If there is no previous report or variables names specified we convert the variables and their description to factors using the dictionary - if (all(addTo %in% NA & variables_names %in% NA)) { - report$var <- factor(report$var, - levels = c(unique(variables))) - report$descr <- factor(report$descr, - levels = c(unique(trimws(gsub("<.*?>", "", dic$field_label[dic$field_name %in% gsub("___.*$", "", variables)]))))) - - # If our project has events, we also convert them to factors - if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - report$event <- factor(report$event, - levels = if("redcap_event_name.factor" %in% names(data)) { - unique(as.character(data$redcap_event_name.factor)) - } else { - unique(as.character(data$redcap_event_name)) - }) - } - } + # Classify each query with its own code + if (nrow(queries) > 0) { + # Sort data by record ID + if (all(grepl("-", queries$Identifier))) { + queries <- queries |> + tidyr::separate("Identifier", c("center", "id"), sep = "([-])", remove = FALSE) + queries[, "center"] <- as.numeric(queries[, "center"]) + queries[, "id"] <- as.numeric(queries[, "id"]) + queries <- queries[order(queries[, "center"], queries[, "id"]), ] + rownames(queries) <- NULL + queries <- queries |> dplyr::select(-"center", -"id") + } else { + queries$Identifier <- as.numeric(queries$Identifier) + queries <- queries[order(queries$Identifier), ] + } - # If there is no previous report but the variables names argument is specified we convert the variables and their description to factors using the selected names - if (all(addTo %in% NA & !is.na(variables_names))) { - report$var <- factor(report$var, - levels = c(unique(variables))) - report$descr <- factor(report$descr, - levels = c(unique(variables_names))) - - # If our project has events, we also convert them to factors - if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { - report$event <- factor(report$event, - levels = if("redcap_event_name.factor" %in% names(data)) { - unique(as.character(data$redcap_event_name.factor)) - } else { - unique(as.character(data$redcap_event_name)) - }) - } + # Remove duplicates and add code for each query + queries <- unique(queries |> + dplyr::select(-"Code")) + queries <- data.frame(queries |> + dplyr::group_by(.data$Identifier) |> + dplyr::mutate(cod = 1:dplyr::n())) + queries$Code <- paste0(as.character(queries$Identifier), "-", queries$cod) + queries <- queries |> dplyr::select(-"cod") + + # Reorder columns if 'Link' was included + if ("Link" %in% names(queries)) { + queries <- queries |> + dplyr::select("Identifier":"Query", "Code", "Link") + } + # Build the report + report <- data.frame( + "dag" = queries$DAG, + "var" = queries$Field, + "descr" = queries$Description, + "event" = queries$Event, + "query_descr" = gsub(" is .* it", "", queries$Query) + ) + + # Convert variables and descriptions to factors if necessary + if (all(addTo %in% NA & variables_names %in% NA)) { + report$var <- factor(report$var, + levels = c(unique(variables)) + ) + report$descr <- factor(report$descr, + levels = c(unique(trimws(gsub("<.*?>", "", dic$field_label[dic$field_name %in% gsub("___.*$", "", variables)])))) + ) + + # If the project has events, convert them to factors + if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + report$event <- factor(report$event, + levels = if ("redcap_event_name.factor" %in% names(data)) { + unique(as.character(data$redcap_event_name.factor)) + } else { + unique(as.character(data$redcap_event_name)) + } + ) } + } + # Handle cases where only variable names are specified + if (all(addTo %in% NA & !is.na(variables_names))) { + report$var <- factor(report$var, + levels = c(unique(variables)) + ) + report$descr <- factor(report$descr, + levels = c(unique(variables_names)) + ) - # Report of all variables (including the ones with zero queries) - if (report_zeros == TRUE) { - - # Total number of queries by variable, event and DAG - report <- report %>% - dplyr::group_by(.data$dag, .data$var, .data$event, .data$query_descr, .drop = FALSE) %>% - dplyr::summarise("total" = dplyr::n(), .groups = "keep") - - # Adding the description and query description to the variables with 0 queries - if (any(report$total %in% 0)) { - - # Add the query description - report$var_event <- paste0(report$var, "_", report$event) - complete_vars <- unique(as.character(report$var_event[report$total != 0])) - zero_vars <- unique(as.character(report$var_event[!report$var_event %in% complete_vars])) - report <- report %>% - dplyr::filter((.data$var_event %in% complete_vars & .data$total != 0) | .data$var_event %in% zero_vars) - - for (i in zero_vars) { - report$query_descr[report$var_event %in% i] <- paste0("The value should not be ", - stringi::stri_replace_all_regex(gsub(" ", "", expression[which(variables %in% report$var[which(report$var_event %in% i)])]), pattern=c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement=c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize=FALSE)) + # If our project has events, we also convert them to factors + if (any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data))) { + report$event <- factor(report$event, + levels = if ("redcap_event_name.factor" %in% names(data)) { + unique(as.character(data$redcap_event_name.factor)) + } else { + unique(as.character(data$redcap_event_name)) } + ) + } + } - report <- report %>% dplyr::select(- "var_event") - - # Add the variables description - report$descr <- purrr::map_chr(gsub("___.*$","",report$var), function(x){ - if (x %in% dic$field_name){ - - # Truncate description name if it exceeds 50 characters - name <- gsub("<.*?>", "", dic$field_label[dic$field_name %in% x]) - stringr::str_trunc(name, 50) - } else { - "-" - }}) + # Handle variables with zero queries + if (report_zeros == TRUE) { + # Total number of queries by variable, event and DAG + report <- report |> + dplyr::group_by(.data$dag, .data$var, .data$event, .data$query_descr, .drop = FALSE) |> + dplyr::summarise("total" = dplyr::n(), .groups = "keep") + + # Add query description for variables with zero queries + if (any(report$total %in% 0)) { + # Add the query description + report$var_event <- paste0(report$var, "_", report$event) + complete_vars <- unique(as.character(report$var_event[report$total != 0])) + zero_vars <- unique(as.character(report$var_event[!report$var_event %in% complete_vars])) + report <- report |> + dplyr::filter((.data$var_event %in% complete_vars & .data$total != 0) | .data$var_event %in% zero_vars) + + for (i in zero_vars) { + report$query_descr[report$var_event %in% i] <- paste0( + "The value should not be ", + stringi::stri_replace_all_regex(gsub(" ", "", expression[which(variables %in% report$var[which(report$var_event %in% i)])]), pattern = c("<", ">", ">=", "<=", "&", "\\|", "==", "!=", "%in%NA", "%in%", "%nin%", "is.na\\(\\)"), replacement = c(" less than ", " greater than ", " greater than or equal to ", " less than or equal to ", " and ", " or ", " equal to ", " not equal to ", " missing ", " equal to ", " not equal to ", " missing "), vectorize = FALSE) + ) } - } else { - # Report of the variables with identified queries (eliminating the ones with zero queries) - report <- report %>% - dplyr::group_by(.data$var, .data$descr, .data$event, .data$query_descr, .data$dag, .drop = TRUE) %>% - dplyr::summarise("total" = dplyr::n(), .groups = "keep") %>% - dplyr::filter("total" != 0) + report <- report |> dplyr::select(-"var_event") + # Add the variables description + report$descr <- purrr::map_chr(gsub("___.*$", "", report$var), function(x) { + if (x %in% dic$field_name) { + # Truncate description name if it exceeds 50 characters + name <- gsub("<.*?>", "", dic$field_label[dic$field_name %in% x]) + stringr::str_trunc(name, 50) + } else { + "-" + } + }) } + } else { + # Report of the variables with identified queries (eliminating the ones with zero queries) + report <- report |> + dplyr::group_by(.data$var, .data$descr, .data$event, .data$query_descr, .data$dag, .drop = TRUE) |> + dplyr::summarise("total" = dplyr::n(), .groups = "keep") |> + dplyr::filter("total" != 0) + } - # Truncate variable name if it exceeds 26 characters - report$descr <- as.character(report$descr) - report$descr <- stringr::str_trunc(report$descr, 50) - - # Truncate variable name if it exceeds 26 characters - report$var <- as.character(report$var) - report$var <- stringr::str_trunc(report$var, 26) + # Truncate descriptions and variable names if too long + report$descr <- as.character(report$descr) + report$descr <- stringr::str_trunc(report$descr, 50) + + report$var <- as.character(report$var) + report$var <- stringr::str_trunc(report$var, 26) + + # Sort the report by the total number of queries + report <- as.data.frame(report) + report <- report[order(as.numeric(report$total), decreasing = TRUE), ] + + # Reorder columns and prepare the final report for output + report <- report |> dplyr::select("dag", "var", "descr", "event", "query_descr", "total") + names(report) <- c("DAG", "Variables", "Description", "Event", "Query", "Total") + report[, "Query"] <- gsub("&", " & ", gsub("\\|", " \\| ", report[, "Query"])) + rownames(report) <- NULL + } else { + # If no queries identified, return a report with zero queries + if (nrow(data) > 0) { + message("No queries were identified in the dataset.") + } - # Sorting by the total number of queries - report <- as.data.frame(report) - report <- report[order(as.numeric(report$total), decreasing = TRUE), ] + report <- excel_zero + report$Total <- 0 + rownames(report) <- NULL + } - # Arrange the report - report <- report %>% dplyr::select("dag", "var", "descr", "event", "query_descr", "total") - names(report) <- c("DAG", "Variables", "Description", "Event", "Query", "Total") - report[, "Query"] <- gsub("&", " & ", gsub("\\|", " \\| ", report[, "Query"])) - rownames(report) <- NULL + # Handle report title + if (all(is.na(report_title))) { + report_title <- "Report of queries" + } else { + if (length(report_title) > 1) { + stop("Multiple report titles found. Please specify only one.", call. = FALSE) + } + } - } else { - # If there is none query, the function still creates a report containing all selected variables. + # Add branching logic information to the report if applicable + if (length(var_logic) > 0 & (!is.null(logics) | is.null(event_form)) & (!is.null(br_eval) | any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)))) { + # Truncate variable names to ensure they don't exceed 26 characters + branch0$Variable <- stringr::str_trunc(branch0$Variable, 26) - # Message: if there is none query to be identified - if (nrow(data) > 0) { - message("There is no query to be identified in the dataset.") - } + # Merge branching logic into the report + report <- merge(report, + branch0 |> dplyr::select("Variable", "Branching logic"), + by.x = "Variables", by.y = "Variable", all.x = TRUE + ) - report <- excel_zero - report$Total <- 0 - rownames(report) <- NULL - } + # Replace NA values in "Branching logic" with a placeholder "-" + report[, "Branching logic"] <- stringr::str_replace_na(report[, "Branching logic"], "-") + } - # Before starting we check if there is more than one report_title and if it isn't the case we stabilish the caption for the report_title - if (all(is.na(report_title))) { - report_title <- "Report of queries" - } else { - if (length(report_title) > 1) { - stop("There is more than one title for the report, please choose only one.", call. = FALSE) - } + # Reorder the report by descending total count + report <- report |> + dplyr::arrange(dplyr::desc(.data$Total)) + + # Handle the case where the 'by_dag' argument is TRUE + if (by_dag %in% TRUE) { + report[is.na(report)] <- "-" + report_dag <- split(report, f = report$DAG) + + # Build individual reports for each DAG + for (i in seq_along(report_dag)) { + report_dag[[i]] <- report_dag[[i]] |> + dplyr::select("DAG", names(report)) + + # Create HTML table for each DAG with proper styling and caption + report_dag[[i]] <- knitr::kable(report_dag[[i]], + align = "ccccc", + row.names = FALSE, + caption = report_title, + format = "html", + longtable = TRUE + ) + report_dag[[i]] <- kableExtra::kable_styling(report_dag[[i]], + bootstrap_options = c("striped", "condensed"), + full_width = FALSE + ) + report_dag[[i]] <- kableExtra::row_spec(report_dag[[i]], 0, + italic = FALSE, + extra_css = "border-bottom: 1px solid grey" + ) } - # Adding information about the variables with branching logic to the report + # Prepare final output in the 'by_dag' format + def <- list( + queries = split(queries, f = queries$DAG), + results = report_dag + ) + } else { + # Handle case when 'by_dag' argument is FALSE + # Ensure branching logic is retained if applicable if (length(var_logic) > 0 & (!is.null(logics) | is.null(event_form)) & (!is.null(br_eval) | any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)))) { - branch0$Variable <- stringr::str_trunc(branch0$Variable, 26) - report <- merge(report, - branch0 %>% dplyr::select("Variable", "Branching logic"), - by.x = "Variables", by.y = "Variable", all.x = TRUE) - report[, "Branching logic"] <- stringr::str_replace_na(report[, "Branching logic"], "-") - } - - # Reorder the report - report <- report %>% - dplyr::arrange(dplyr::desc(.data$Total)) - - # Report in case the by_dag argument is true - if (by_dag %in% TRUE) { - report[is.na(report)] <- "-" - report_dag <- split(report, f = report$DAG) - - # Build structure of each report in order to appear in the RStudio Viewer tab - for (i in 1:length(report_dag)) { - report_dag[[i]] <- report_dag[[i]] %>% - dplyr::select("DAG", names(report)) - report_dag[[i]] <- knitr::kable(report_dag[[i]], - align = "ccccc", - row.names = FALSE, - caption = report_title, - format = "html", - longtable = TRUE) - report_dag[[i]] <- kableExtra::kable_styling(report_dag[[i]], - bootstrap_options = c("striped", "condensed"), - full_width = FALSE) - report_dag[[i]] <- kableExtra::row_spec(report_dag[[i]], 0, - italic = FALSE, - extra_css = "border-bottom: 1px solid grey") - } - - # Definitive output - def <- list(queries = split(queries, f = queries$DAG), - results = report_dag) - + report <- report |> + dplyr::select(-"DAG") |> + dplyr::group_by(.data$Variables, .data$Description, .data$Event, .data$Query, .data$`Branching logic`, .drop = FALSE) |> + dplyr::summarise("Total" = sum(.data$Total), .groups = "keep") |> + dplyr::select("Variables", "Description", "Event", "Query", "Total", "Branching logic") } else { + report <- report |> + dplyr::select(-"DAG") |> + dplyr::group_by(.data$Variables, .data$Description, .data$Event, .data$Query, .drop = FALSE) |> + dplyr::summarise("Total" = sum(.data$Total), .groups = "keep") + } - # If by_dag argument is false - # If there is a branching logic, we cannot lose the branching logic column - if (length(var_logic) > 0 & (!is.null(logics) | is.null(event_form)) & (!is.null(br_eval) | any(c("redcap_event_name", "redcap_event_name.factor") %in% names(data)))) { - - report <- report %>% - dplyr::select(-"DAG") %>% - dplyr::group_by(.data$Variables, .data$Description, .data$Event, .data$Query, .data$`Branching logic`, .drop = FALSE) %>% - dplyr::summarise("Total" = sum(.data$Total), .groups = "keep") %>% - dplyr::select("Variables", "Description", "Event", "Query", "Total", "Branching logic") + # If report_zeros is TRUE, handle zero total values + if (any(!report$Total %in% 0)) { + if (report_zeros == TRUE) { + report <- report |> + dplyr::arrange(dplyr::desc(.data$Total)) + # Print queries with zero totals (if any) + report$Query[report$Total %in% 0] } else { - - report <- report %>% - dplyr::select(-"DAG") %>% - dplyr::group_by(.data$Variables, .data$Description, .data$Event, .data$Query, .drop = FALSE) %>% - dplyr::summarise("Total" = sum(.data$Total), .groups = "keep") - - } - - if (any(!report$Total %in% 0)) { - if (report_zeros == TRUE) { - - report <- report %>% - dplyr::arrange(dplyr::desc(.data$Total)) - - report$Query[report$Total %in% 0] - - } else { - - report <- report %>% - dplyr::arrange(dplyr::desc(.data$Total)) %>% - dplyr::filter(.data$Total != 0) - - } + report <- report |> + dplyr::arrange(dplyr::desc(.data$Total)) |> + dplyr::filter(.data$Total != 0) } - - report[is.na(report)] <- "-" - - # Build structure of each report in order to appear in the RStudio Viewer tab - result <- knitr::kable(report, "pipe", - align = "ccccc", - caption = report_title) - viewer <- knitr::kable(report, - align = "ccccc", - row.names = FALSE, - caption = report_title, - format = "html", - longtable = TRUE) - viewer <- kableExtra::kable_styling(viewer, - bootstrap_options = c("striped", "condensed"), - full_width = FALSE) - viewer <- kableExtra::row_spec(viewer, 0, - italic = FALSE, - extra_css = "border-bottom: 1px solid grey") - - # Definitive output - def <- list(queries = dplyr::tibble(queries), - results = viewer) } - # Return the final product - def + # Replace NAs with "-" in the report + report[is.na(report)] <- "-" + + # Generate and style the HTML table for the report + result <- knitr::kable(report, "pipe", + align = "ccccc", + caption = report_title + ) + viewer <- knitr::kable(report, + align = "ccccc", + row.names = FALSE, + caption = report_title, + format = "html", + longtable = TRUE + ) + viewer <- kableExtra::kable_styling(viewer, + bootstrap_options = c("striped", "condensed"), + full_width = FALSE + ) + viewer <- kableExtra::row_spec(viewer, 0, + italic = FALSE, + extra_css = "border-bottom: 1px solid grey" + ) + + # Prepare final output without DAG-specific split + def <- list( + queries = dplyr::tibble(queries), + results = viewer + ) } - + # Return the final report output + def +} diff --git a/R/rd_recalculate.R b/R/rd_recalculate.R new file mode 100644 index 0000000..f134caa --- /dev/null +++ b/R/rd_recalculate.R @@ -0,0 +1,243 @@ +#' Recalculate and Verify Calculated Fields in REDCap Data +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function processes REDCap project data, recalculates fields defined as calculated fields in the dictionary, +#' and compares the recalculated values with the original ones. It also generates a report of discrepancies and +#' updates the dataset and dictionary with new calculated fields (if applicable). +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param exclude_recalc (Optional) A character vector of field names to exclude from recalculation. +#' +#' @return A list containing the following elements: +#' \item{data}{The updated dataset with recalculated fields (if applicable).} +#' \item{dictionary}{The updated dictionary with recalculated field entries (if applicable).} +#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} +#' \item{results}{A string summarizing the results of the recalculation process.} +#' +#' @details +#' The function: +#' - Identifies calculated fields from the dictionary and evaluates the specified formulas. +#' - Compares recalculated values with the original values. +#' - Adds recalculated fields to the dataset, appending `_recalc` to the original variable names. +#' - Updates the dictionary to reflect the new variables. +#' - Summarizes the number of calculated fields, discrepancies, and untranslated fields in a report. +#' +#' +#' @note +#' - Recalculation is only possible for single-event projects unless `event_form` is specified for longitudinal projects. +#' - If branching logic is incomplete, poorly defined or contains smart-variables, recalculation may fail for some fields. +#' +#' @examples +#' +#' # Example usage with individual arguments +#' results <- rd_recalculate( +#' data = covican$data, +#' dic = covican$dictionary, +#' event_form = covican$event_form +#' ) +#' +#' # Example usage with a project object, excluding variables from the recalculation +#' results <- covican |> +#' rd_recalculate(exclude_recalc = c("age", "screening_fail_crit")) +#' +#' @export +#' @importFrom rlang := + +rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude_recalc = NULL) { + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + # browser() + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Extract labels from the data to reapply later + labels <- labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + + # Identify if the project is longitudinal or includes repeated instruments + longitudinal <- "redcap_event_name" %in% names(data) + repeat_instrument <- any("redcap_repeat_instrument" %in% names(data) & !is.na(data$redcap_repeat_instrument)) + + # Check if there are datetime variables stored as characters in the dataset + vars_date <- dic |> + dplyr::filter(grepl("^date_|^datetime_", .data$text_validation_type_or_show_slider_number)) |> + dplyr::pull(.data$field_name) + + # Warn if datetime variables need transformation + if (any(purrr::map(data |> dplyr::select(dplyr::all_of(vars_date)), class) == "character")) { + warning("The dataset contains date fields stored as character class, which may lead to incorrect or inconsistent date transcription results. Use the `rd_dates` function before this one to properly format these date fields.", call. = FALSE) + } + + # Proceed only if the project is not longitudinal or has event-form mapping, and is not repeated + if (!(longitudinal & is.null(event_form)) & !repeat_instrument) { + # Replace `NA` in branching logic fields with empty strings + if (any(is.na(dic$branching_logic_show_field_only_if))) { + dic <- dic |> + dplyr::mutate(branching_logic_show_field_only_if = dplyr::case_when( + is.na(branching_logic_show_field_only_if) ~ "", + .default = .data$branching_logic_show_field_only_if + )) + } + + + # Redefine rounding function to avoid issues in special cases + # round <- function(x, digits) { + # posneg <- sign(x) + # z <- abs(x)*10^digits + # z <- z + 0.5 + sqrt(.Machine$double.eps) + # z <- trunc(z) + # z <- z / 10 ^ digits + # z*posneg + # } + + # Process calculated fields: evaluate, transcribe logic, and compare results + calc <- tibble::tibble(dic) |> + dplyr::filter(.data$field_type == "calc", !.data$field_name %in% exclude_recalc) |> + dplyr::mutate( + calc = purrr::map(.data$field_name, function(x) { + val <- data[, x] + if (is.numeric(val)) { + as.numeric(val) + } else { + val + } + }), + rlogic = purrr::map2(.data$choices_calculations_or_slider_labels, .data$field_name, function(x, y) { + rlogic <- try(suppressWarnings(rd_rlogic(data = data, dic = dic, event_form = event_form, logic = x, var = y)), silent = TRUE) + if (!inherits(rlogic, "try-error")) { + rlogic + } else { + NULL + } + }), + trans = purrr::map_chr(.data$rlogic, function(x) { + if (!is.null(x)) { + x$rlogic + } else { + NA + } + }), + recalc = purrr::map(.data$rlogic, function(x) { + if (!is.null(x)) { + x$eval + } else { + NULL + } + }), + is_equal = purrr::map2_lgl(.data$calc, .data$recalc, function(x, y) { + if (!is.null(y)) { + if (is.numeric(x) & is.numeric(y)) { + identical(round(x, 3), round(y, 3)) + } else if (all(is.na(x)) & all(is.na(y))) { + TRUE + } else { + identical(x, y) + } + } else { + NA + } + }) + ) |> + dplyr::select(-"rlogic") + + + # Add recalculated fields to the dataset and dictionary + calc_change <- calc |> + dplyr::filter(!is.na(.data$trans)) + + if (nrow(calc_change) > 0) { + for (i in seq_len(nrow(calc_change))) { + name <- stringr::str_glue("{calc_change$field_name[i]}_recalc") + + data <- data |> + tibble::add_column("{name}" := calc_change$recalc[[i]], .after = as.character(calc_change$field_name[i])) + + add_row <- dic |> + dplyr::filter(.data$field_name == calc_change$field_name[i]) |> + dplyr::mutate( + field_name = stringr::str_glue("{field_name}_recalc"), + field_label = stringr::str_glue("{field_label} (Recalculate)") + ) + + dic <- rbind(dic, add_row) + } + } + + # Reapply labels to the modified dataset + data <- data |> + labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Recalculating calculated fields and saving them as '[field_name]_recalc'. (rd_recalculate)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Recalculating calculated fields and saving them as '[field_name]_recalc'. (rd_recalculate)\n")) + } + + # Generate a summary report + report1 <- calc |> + dplyr::mutate(n = 1) |> + dplyr::summarise( + trans = sum(!is.na(.data$trans)), + N = sum(.data$n), + no_trans = .data$N - .data$trans, + no_equal = sum(!.data$is_equal, na.rm = TRUE), + ) |> + dplyr::mutate( + text1 = stringr::str_glue("{no_trans} ({round(no_trans*100/N, 2)}%)"), + text2 = stringr::str_glue("{no_equal} ({round(no_equal*100/trans, 2)}%)") + ) |> + dplyr::select("Total calculated fields" = "N", "Non-transcribed fields" = "text1", "Recalculated different fields" = "text2") + + results <- c(results, "\n", knitr::kable(report1, "pipe", align = "ccc")) + + # Create a detailed field-level report + report2 <- calc |> + dplyr::mutate(trans2 = ifelse(!is.na(.data$trans), "Yes", "No")) |> + dplyr::arrange(.data$trans2, .data$is_equal) |> + dplyr::select("field_name", "Transcribed?" = "trans2", "Is equal?" = "is_equal") + + results <- c(results, "\n", knitr::kable(report2, "pipe", align = "ccc")) + + results <- stringr::str_glue("{results}") + } else { + # Stop if recalculation is not possible due to missing event-form mapping in longitudinal projects + stop("\nRecalculation cannot proceed because the project has more than one event, but the event-form correspondence has not been provided. Please specify the event-form mapping for accurate recalculation.\n", call. = FALSE) + } + + # Return updated datasets and results + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_rlogic.R b/R/rd_rlogic.R index 270a984..dd68f8a 100644 --- a/R/rd_rlogic.R +++ b/R/rd_rlogic.R @@ -1,269 +1,312 @@ #' Translate REDCap Logic to R Logic #' -#' This function allows you to convert REDCap logic into R logic. WARNING: Please note that if the REDCap logic involves smart variables, this function may not be able to transform it accurately. +#' @description +#' `r lifecycle::badge('stable')` +#' +#' This function converts REDCap logic into R-compatible logic. The function processes common REDCap operators (such as `and`, `or`, `=`, `<`, `>`, etc.) and formats them into their R equivalents. It also handles event-specific logic in longitudinal REDCap projects. +#' Please note that this function may not be able to accurately transform REDCap logic involving smart variables or certain field types that require specialized handling. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param logic SA string representing the logic in REDCap format (e.g., `"if([exc_1]='1' or [inc_1]='0', 1, 0)"`). +#' @param var A string containing the name of the variable that holds the logic. This is typically the outcome variable to which the logic applies. +#' +#' @return A list containing: +#' - `rlogic`: The translated REDCap logic in R format. +#' - `eval`: The evaluation result of the R logic applied to the provided dataset. If applicable, the result is filtered by event-specific logic. +#' +#' @details +#' The function performs several transformations to convert the REDCap logic into R logic: +#' - It translates REDCap-specific operators (e.g., `=` to `==`, `and` to `&`, `or` to `|`). +#' - It removes or replaces certain REDCap-specific syntax that does not directly translate to R (e.g., removing `true` values). +#' - It handles event-specific variables and ensures that logic is correctly adjusted when the data has multiple events. +#' - It also allows for handling of missing values by transforming empty strings (`''`) to `NA` in R. +#' +#' Please be aware that REDCap logic that references smart variables or involves complex field relationships might require manual intervention for an accurate translation. #' -#' @param ... List containing the data, dictionary and event mapping (if applicable) of the REDCap project. This should be the output of the `redcap_data` function. -#' @param data Data frame containing data from REDCap. If the list is specified, this argument is not required. -#' @param dic Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not required. -#' @param event_form Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not required. -#' @param logic String containing logic in REDCap format. -#' @param var String with the name of the variable containing the logic. -#' @return List containing the logic in R format and its evaluation. #' @examples -#' rd_rlogic(covican, -#' logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", -#' var = "screening_fail_crit") +#' # Example: Translating a REDCap logic expression into R logic for the variable `screening_fail_crit` +#' covican |> +#' rd_rlogic( +#' logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", +#' var = "screening_fail_crit" +#' ) #' @export +#' -rd_rlogic <- function(..., data = NULL, dic = NULL, event_form = NULL, logic, var){ - - project <- c(...) - - if(!is.null(project)){ - if(!is.null(data)){ - warning("Data has been specified twice so the function will not use the information in the data argument.") - } - - if(!is.null(dic)){ - warning("Dictionary has been specified twice so the function will not use the information in the dic argument.") - } +rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, logic, var) { - data <- project$data - dic <- project$dictionary + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) - if("event_form" %in% names(project)){ - if(!is.null(event_form)){ - warning("Event has been specified twice so the function will not use the information in the event_form argument.") - } - event_form <- project$event_form - } + list2env(env_vars, envir = environment()) } - if(is.null(data) | is.null(dic)){ - stop("No data/dictionary was provided") + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") } - #Check if the project is longitudinal (has more than one event) or not: + # Check if the project is longitudinal (more than one event present in the data) longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) - if(is.null(event_form) & longitudinal){ - stop("There is more than one event in the data and the event-form correspondence hasn't been specified") + # Error: data is longitudinal, but event_form isn't provided + if (is.null(event_form) & longitudinal) { + stop("There is more than one event in the data, but the event-form correspondence hasn't been specified.") } - rlogic <- logic + rlogic <- logic # Initialize REDCap logic to be converted - #We look first if there is some checkbox evaluated in the logic - if(grepl("\\)\\]",rlogic)){ - num_vars <- stringr::str_count(rlogic,"]") - for(i in 1:num_vars){ - rlogic <- gsub("\\[(.+)\\((\\d+)\\)\\]","[\\1___\\2]",rlogic) + # Process checkboxes and other specific cases in REDCap logic + if (grepl("\\)\\]", rlogic)) { + num_vars <- stringr::str_count(rlogic, "]") + for (i in 1:num_vars) { + rlogic <- gsub("\\[(.+)\\((\\d+)\\)\\]", "[\\1___\\2]", rlogic) } } - #If we find [event-name][var] is the same as [var] - #If we find [var][current-instance] is the same as [var] - rlogic <- gsub("\\[event\\-name\\]\\[","[", rlogic) + # Modify event-name and current-instance occurrences + rlogic <- gsub("\\[event\\-name\\]\\[", "[", rlogic) rlogic <- gsub("\\]\\[current-instance\\]", "]", rlogic) - #Change event-name, user-dag-name, record-dag-name - rlogic <- gsub("\\[event\\-name\\]","[redcap_event_name]", rlogic) - rlogic <- gsub("\\[user\\-dag\\-name\\]","[redcap_data_access_group]", rlogic) - rlogic <- gsub("\\[record\\-dag\\-name\\]","[redcap_data_access_group]", rlogic) + # Update REDCap specific variable names + rlogic <- gsub("\\[event\\-name\\]", "[redcap_event_name]", rlogic) + rlogic <- gsub("\\[user\\-dag\\-name\\]", "[redcap_data_access_group]", rlogic) + rlogic <- gsub("\\[record\\-dag\\-name\\]", "[redcap_data_access_group]", rlogic) - #Get the variables that are being evaluated - - #Get all variables evaluated + # Get the variables evaluated in the REDCap logic rlogic_var <- unlist(stringr::str_extract_all(rlogic, "\\[[\\w,\\-]+\\]")) - #Check if each variable is present in the data or it's one of the events - if(longitudinal){ - check_lgl <- purrr::map_lgl(rlogic_var,function(x){ - out <- gsub("^\\[","",x) - out <- gsub("\\]$","",out) - out%in%names(data) | out%in%data$redcap_event_name + # Check if the variables are present in the data or events + if (longitudinal) { + check_lgl <- purrr::map_lgl(rlogic_var, function(x) { + out <- gsub("^\\[", "", x) + out <- gsub("\\]$", "", out) + out %in% names(data) | out %in% data$redcap_event_name }) - }else{ - check_lgl <- purrr::map_lgl(rlogic_var,function(x){ - out <- gsub("^\\[","",x) - out <- gsub("\\]$","",out) - out%in%names(data) + } else { + check_lgl <- purrr::map_lgl(rlogic_var, function(x) { + out <- gsub("^\\[", "", x) + out <- gsub("\\]$", "", out) + out %in% names(data) }) } - #If there are some that are not in the dataframe it will give an error - - if(any(!check_lgl)){ - - stop("Redcap logic contains some redcap variable that it isn't found in the database (it can be a smart-variable)") - - }else{ - - #If all the variables are contained in the data we can transcribe the redcap logic to r logic - #When in redcap we had " now we have \". Change "" to '': - rlogic <- gsub('"', "'", rlogic) - - - #Change the redcap functions into r functions - rlogic <- gsub("if\\s?\\(", "ifelse(", rlogic) - rlogic <- gsub("rounddown(.*),0\\)", "floor\\1)", rlogic) - rlogic <- gsub("rounddown(.*),1\\)", "round\\1, 1)", rlogic) - rlogic <- gsub("rounddown(.*),2\\)", "round\\1, 2)", rlogic) - rlogic <- gsub("rounddown(.*),3\\)", "round\\1, 3)", rlogic) - rlogic <- gsub("rounddown(.*)\\)", "floor\\1)", rlogic) - rlogic <- gsub("datediff\\s?", "lubridate::time_length(lubridate::interval", rlogic) - rlogic <- gsub("sum\\((.*?)\\)","rowSums(cbind(\\1))", rlogic) - #Change dates (there can be dates specified in the logic) to date format - if(grepl("'dmy'", rlogic)){ - rlogic <- gsub("'(\\d\\d-\\d\\d-\\d\\d\\d\\d)'", "lubridate::dmy('\\1')", rlogic) - }else if(grepl("'mdy'", rlogic)){ - rlogic <- gsub("'(\\d\\d-\\d\\d-\\d\\d\\d\\d)'", "lubridate::mdy('\\1')", rlogic) - }else if(grepl("'ymd'", rlogic)){ - rlogic <- gsub("'(\\d\\d\\d\\d-\\d\\d-\\d\\d)'", "lubridate::ymd('\\1')", rlogic) - }else if(grepl("'ydm'", rlogic)){ - rlogic <- gsub("'(\\d\\d\\d\\d-\\d\\d-\\d\\d)'", "lubridate::ydm('\\1')", rlogic) - }else if(grepl("'myd'", rlogic)){ - rlogic <- gsub("'(\\d\\d-\\d\\d\\d\\d-\\d\\d)'", "lubridate::myd('\\1')", rlogic) - }else if(grepl("'dym'", rlogic)){ - rlogic <- gsub("'(\\d\\d-\\d\\d\\d\\d-\\d\\d)'", "lubridate::dym('\\1')", rlogic) - } + # Error: any variable in logic is not found in the data + if (any(!check_lgl)) { + stop("REDCap logic contains variables that are not found in the database (possibly a smart variable).") + } - rlogic <- gsub("\\,\\s?true", "", rlogic) - rlogic <- gsub("\\,\\s?'y'\\,\\s?'dmy'", "), 'year'", rlogic) - rlogic <- gsub("\\,\\s?'d'\\,\\s?'dmy'", "), 'day'", rlogic) - rlogic <- gsub("\\,\\s?'m'\\,\\s?'dmy'", "), 'month'", rlogic) + # Proceed to transcribe REDCap logic to R logic + rlogic <- gsub('"', "'", rlogic) # Replace double quotes with single quotes for R compatibility - rlogic <- gsub("\\,\\s?'y'\\)", "), 'year')", rlogic) - rlogic <- gsub("\\,\\s?'d'\\)", "), 'day')", rlogic) - rlogic <- gsub("\\,\\s?'m'\\)", "), 'month')", rlogic) + # Verify if any of the variables in the logic is now a factor in the dataset (example: [copd] + [hemato_neo], if we do this it generates a warning) + vars_calc <- rlogic |> + stringr::str_extract_all("(?<=\\[)[^\\]]+(?=\\]\\s*[+\\-*/])") |> + purrr::pluck(1) + factors <- data |> + dplyr::select(dplyr::where(is.factor)) |> + names() + vars_calc <- intersect(vars_calc, factors) - #Change variables specification. If [][] we get the event with the first claudator. If not the event will be the same as the one of the calculated variable + if (length(vars_calc) > 0) { + data <- data |> + dplyr::mutate(dplyr::across( + dplyr::any_of(vars_calc), + ~ { + field <- dplyr::cur_column() - #Vector with all the [][] if found: - var_event <- unlist(stringr::str_extract_all(rlogic, "\\[[\\w,\\-]+\\]\\[[\\w,\\-]+\\]")) + choices <- dic$choices_calculations_or_slider_labels[dic$field_name == field] - if(length(var_event) > 0){ + parts <- strsplit(choices, "\\|")[[1]] + parts <- parts[grepl(",", parts, fixed = FALSE)] - #Separate them - list_var_event <- purrr::map(var_event, function(x){ - x <- unlist(stringr::str_split(x, "\\]\\[")) - x <- gsub("\\[", "", x) - x <- gsub("\\]", "", x) - }) + nums <- trimws(sub(",.*$", "", parts)) + labs <- trimws(sub("^[^,]*,\\s*", "", parts)) - #If there is one same variable evaluated in different events the logic can't be transcribed - n_events <- data.frame(do.call(rbind, list_var_event)) - names(n_events) <- c("events", "vars") - n_events <- n_events %>% - dplyr::group_by(.data$vars) %>% - dplyr::summarise(n = length(unique(.data$events))) + mapping <- setNames(as.numeric(nums), labs) - if(any(n_events$n > 1)){ - stop("The logic can't be transcribed because the same variable is present in the logic specified for different events") - } + as.numeric(mapping[as.character(data[[field]])]) + } + )) + } - #Apply the previously defined function to get the value in the corresponding event and fill it for all the rows of data - for(i in 1:length(list_var_event)){ - data <- fill_data(list_var_event[[i]][1], list_var_event[[i]][2], data) - } + # Convert REDCap functions to equivalent R functions + rlogic <- gsub("if\\s?\\(", "ifelse(", rlogic) + rlogic <- gsub("rounddown(.*),0\\)", "floor\\1)", rlogic) + rlogic <- gsub("rounddown(.*),1\\)", "round\\1, 1)", rlogic) + rlogic <- gsub("rounddown(.*),2\\)", "round\\1, 2)", rlogic) + rlogic <- gsub("rounddown(.*),3\\)", "round\\1, 3)", rlogic) + rlogic <- gsub("rounddown(.*)\\)", "floor\\1)", rlogic) + rlogic <- gsub("datediff\\s?", "lubridate::time_length(lubridate::interval", rlogic) + rlogic <- gsub("sum\\((.*?)\\)", "rowSums(cbind(\\1))", rlogic) + + # Handle date formats in logic + if (grepl("'dmy'", rlogic)) { + rlogic <- gsub("'(\\d\\d-\\d\\d-\\d\\d\\d\\d)'", "lubridate::dmy('\\1')", rlogic) + } else if (grepl("'mdy'", rlogic)) { + rlogic <- gsub("'(\\d\\d-\\d\\d-\\d\\d\\d\\d)'", "lubridate::mdy('\\1')", rlogic) + } else if (grepl("'ymd'", rlogic)) { + rlogic <- gsub("'(\\d\\d\\d\\d-\\d\\d-\\d\\d)'", "lubridate::ymd('\\1')", rlogic) + } else if (grepl("'ydm'", rlogic)) { + rlogic <- gsub("'(\\d\\d\\d\\d-\\d\\d-\\d\\d)'", "lubridate::ydm('\\1')", rlogic) + } else if (grepl("'myd'", rlogic)) { + rlogic <- gsub("'(\\d\\d-\\d\\d\\d\\d-\\d\\d)'", "lubridate::myd('\\1')", rlogic) + } else if (grepl("'dym'", rlogic)) { + rlogic <- gsub("'(\\d\\d-\\d\\d\\d\\d-\\d\\d)'", "lubridate::dym('\\1')", rlogic) + } - rlogic <- gsub("\\[\\w+\\]\\[", "[", rlogic) + # Remove 'true' value from the logic as it's not used in R + rlogic <- gsub("\\,\\s?true", "", rlogic) - } + # Replace the date format specifications for 'dmy', 'mdy', etc., with 'year', 'day', 'month' as needed + rlogic <- gsub("\\,\\s?'y'\\,\\s?'dmy'", "), 'year'", rlogic) + rlogic <- gsub("\\,\\s?'d'\\,\\s?'dmy'", "), 'day'", rlogic) + rlogic <- gsub("\\,\\s?'m'\\,\\s?'dmy'", "), 'month'", rlogic) - #Change variable specification from [] to data$ - - #Change first [.] = '' for is.na(data$.) and [.] <>'' for !is.na(data$.) - - rlogic <- gsub("\\[(\\w+)\\]\\s?<>\\s?''", "!is.na(data$\\1)", rlogic) - rlogic <- gsub("\\[(\\w+)\\]\\s?=\\s?''", "is.na(data$\\1)", rlogic) - rlogic <- gsub("\\[(\\w+)\\]","data$\\1",rlogic) - - # #Inside the interval function there will be date variables so we have to wrap them with as.Date. Let's take the part we want to change: - # if(grepl("interval\\(", rlogic)) { - # interval_str <- unlist(str_match_all(rlogic, "interval\\(.*?\\)")) - # interval_str2 <- map(interval_str, ~gsub("(data\\$\\w+)", "as.Date(\\1)", .x)) - # for(i in 1:length(interval_str2)) { - # rlogic <- stringi::stri_replace_all_fixed(rlogic, interval_str[[i]], interval_str2[[i]]) - # } - # } - - #Change the redcap operators into r operators - rlogic <- gsub("=","==",rlogic) - rlogic <- gsub("<==","<=",rlogic) - rlogic <- gsub(">==",">=",rlogic) - rlogic <- gsub("<>","!=",rlogic) - rlogic <- gsub(" and "," & ",rlogic) - rlogic <- gsub(" or "," | ",rlogic) - - #Remove '' after one of these symbols appear: <, >, <=, >= - rlogic <- gsub("\\s?<\\s?'([\\d\\.]+)'", " < \\1", rlogic, perl = TRUE) - rlogic <- gsub("\\s?>\\s?'([\\d\\.]+)'", " > \\1", rlogic, perl = TRUE) - rlogic <- gsub("\\s?<=\\s?'([\\d\\.]+)'", " <= \\1", rlogic, perl = TRUE) - rlogic <- gsub("\\s?>=\\s?'([\\d\\.]+)'", " >= \\1", rlogic, perl = TRUE) - - #Transform '' for missing: - rlogic <- gsub("''", "NA", rlogic) - - #Now that we have transcribed the logic we have to evaluate it in the event of the corresponding variable (if data contains more than one event): - if(!is.null(event_form)){ - - #Get the form where the variable is found through the dictionary: - form_var <- dic %>% - dplyr::filter(.data$field_name == var) %>% - dplyr::pull(.data$form_name) - - #Get the event through the event-form mapping (it can be more than one): - event_var <- event_form %>% - dplyr::filter(.data$form == form_var) %>% - dplyr::pull(.data$unique_event_name) + # Modify the closing parentheses to correctly align with 'year', 'day', 'month' for R + rlogic <- gsub("\\,\\s?'y'\\)", "), 'year')", rlogic) + rlogic <- gsub("\\,\\s?'d'\\)", "), 'day')", rlogic) + rlogic <- gsub("\\,\\s?'m'\\)", "), 'month')", rlogic) + # Change variables specification. If [][] we get the event with the first claudator. If not, the event will be the same as the one of the calculated variable. + + # Vector with all the [][] if found: + var_event <- unlist(stringr::str_extract_all(rlogic, "\\[[\\w,\\-]+\\]\\[[\\w,\\-]+\\]")) + + # If there are variables in the format [][] (event + variable): + if (length(var_event) > 0) { + # Separate the event and variable names + list_var_event <- purrr::map(var_event, function(x) { + x <- unlist(stringr::str_split(x, "\\]\\[")) + x <- gsub("\\[", "", x) + x <- gsub("\\]", "", x) + }) + + # Check if the same variable is evaluated for different events (this logic can't be transcribed) + n_events <- data.frame(do.call(rbind, list_var_event)) + names(n_events) <- c("events", "vars") + n_events <- n_events |> + dplyr::group_by(.data$vars) |> + dplyr::summarise(n = length(unique(.data$events))) + + if (any(n_events$n > 1)) { + stop("The logic cannot be transcribed because the same variable is specified for different events.") } - #Redefine rounding function to match the one in redcap for rounding .5 decimals in the same way (2.5 ~ 3) - round = function(x, digits) { - posneg = sign(x) - z = abs(x)*10^digits - z = z + 0.5 + sqrt(.Machine$double.eps) - z = trunc(z) - z = z/10^digits - z*posneg + # Apply the previously defined function to get the value in the corresponding event and fill it for all the rows of data + for (i in seq_along(list_var_event)) { + data <- fill_data(list_var_event[[i]][1], list_var_event[[i]][2], data) } - #Calculate evaluating the logic - rlogic_eval <- try(eval(parse(text = rlogic)), silent = TRUE) + # Update rlogic by removing the event-specific variable format ([][] -> []) + rlogic <- gsub("\\[\\w+\\]\\[", "[", rlogic) + } - if(inherits(rlogic_eval, "try-error") | length(rlogic_eval) == 0){ + # Change variable specification from [] to data$ + + # Change first [.] = '' for is.na(data$.) and [.] <>'' for !is.na(data$.) + rlogic <- gsub("\\[(\\w+)\\]\\s?<>\\s?''", "!is.na(data$\\1)", rlogic) + rlogic <- gsub("\\[(\\w+)\\]\\s?=\\s?''", "is.na(data$\\1)", rlogic) + rlogic <- gsub("\\[(\\w+)\\]", "data$\\1", rlogic) + + # Optional: Inside the interval function, there might be date variables. We would need to wrap them with as.Date(). + # The code is commented out because it's not always needed, but you can enable it if needed. + # if(grepl("interval\\(", rlogic)) { + # interval_str <- unlist(str_match_all(rlogic, "interval\\(.*?\\)")) + # interval_str2 <- map(interval_str, ~gsub("(data\\$\\w+)", "as.Date(\\1)", .x)) + # for(i in 1:length(interval_str2)) { + # rlogic <- stringi::stri_replace_all_fixed(rlogic, interval_str[[i]], interval_str2[[i]]) + # } + # } + + # Change the REDCap operators into R operators + rlogic <- gsub("=", "==", rlogic) + rlogic <- gsub("<==", "<=", rlogic) + rlogic <- gsub(">==", ">=", rlogic) + rlogic <- gsub("<>", "!=", rlogic) + rlogic <- gsub(" and ", " & ", rlogic) + rlogic <- gsub(" or ", " | ", rlogic) + + # Remove '' (empty strings) after comparison operators like <, >, <=, >= + rlogic <- gsub("\\s?<\\s?'([\\d\\.]+)'", " < \\1", rlogic, perl = TRUE) + rlogic <- gsub("\\s?>\\s?'([\\d\\.]+)'", " > \\1", rlogic, perl = TRUE) + rlogic <- gsub("\\s?<=\\s?'([\\d\\.]+)'", " <= \\1", rlogic, perl = TRUE) + rlogic <- gsub("\\s?>=\\s?'([\\d\\.]+)'", " >= \\1", rlogic, perl = TRUE) + + # Transform '' (empty strings) into missing values (NA) + rlogic <- gsub("''", "NA", rlogic) + + # After transcribing the logic, we need to evaluate it based on the corresponding event of the variable. This is only necessary if the data contains more than one event: + if (!is.null(event_form)) { + # Get the form where the variable is found through the dictionary + form_var <- dic |> + dplyr::filter(.data$field_name == var) |> + dplyr::pull(.data$form_name) + + # Get the event(s) through the event-form mapping + event_var <- event_form |> + dplyr::filter(.data$form == form_var) |> + dplyr::pull(.data$unique_event_name) + } - stop("The logic can't be evaluated after the translation") + # Redefine the rounding function to match the one in REDCap for rounding .5 decimals similarly (e.g., 2.5 ~ 3) + # round <- function(x, digits) { + # posneg <- sign(x) + # z <- abs(x)*10^digits + # z <- z + 0.5 + sqrt(.Machine$double.eps) + # z <- trunc(z) + # z <- z/10^digits + # z*posneg + # } + + # Check for date fields in the logic that are still in character class + date_class <- dic |> + dplyr::filter(.data$field_name %in% gsub("\\[|\\]", "", rlogic_var)) |> + dplyr::filter(grepl("^date_|^datetime_", .data$text_validation_type_or_show_slider_number)) |> + dplyr::pull(.data$field_name) + + if (any(purrr::map(data |> dplyr::select(dplyr::all_of(date_class)), class) == "character")) { + warning("The dataset contains date fields stored as character class, which may lead to incorrect evaluation results. To format these date fields, use the `rd_dates` function before proceeding.", call. = FALSE) + + # Evaluate the logic in the R format + rlogic_eval <- suppressWarnings(try(eval(parse(text = rlogic)), silent = TRUE)) + } else { + # Evaluate the logic in the R format + rlogic_eval <- try(eval(parse(text = rlogic)), silent = TRUE) + } - }else{ - #Only in the specified event (if data contains more than one event)! - if(!is.null(event_form)){ - return( + # If there's an error or the result is empty, stop the process + if (inherits(rlogic_eval, "try-error") | length(rlogic_eval) == 0) { + stop("The logic could not be evaluated after translation.") + } else { + # If there's more than one event, return the evaluation only for the specified event(s): + if (!is.null(event_form)) { + return( list( rlogic = rlogic, - eval = data %>% - dplyr::mutate(calc = rlogic_eval, - calc = ifelse(! .data$redcap_event_name %in% event_var, NA, .data$calc)) %>% + eval = data |> + dplyr::mutate( + calc = rlogic_eval, + calc = ifelse(!.data$redcap_event_name %in% event_var, NA, .data$calc) + ) |> dplyr::pull(.data$calc) ) + ) + } else { + # If there is only one event, return the result directly + return( + list( + rlogic = rlogic, + eval = rlogic_eval ) - }else{ - #If there is only one event: - return( - list( - rlogic = rlogic, - eval = rlogic_eval - ) - ) - } - - + ) } - } - } diff --git a/R/rd_split.R b/R/rd_split.R new file mode 100644 index 0000000..8ecb0bc --- /dev/null +++ b/R/rd_split.R @@ -0,0 +1,345 @@ +#' Split a dataset by form or event based on the data dictionary +#' +#' @description +#' `r lifecycle::badge('experimental')` +#' +#' This function splits the provided dataset into separate datasets by form or event, using the data dictionary to define the variables for each form or event. +#' It handles both longitudinal and non-longitudinal projects. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. +#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. +#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. +#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param which A character string specifying which form or event to return (optional). If not provided, all forms or events will be included. +#' @param by A character string specifying the split criteria: "form" (default) or "event". +#' @param wide A logical value indicating whether to return the data in wide format when splitting by form. Defaults to `FALSE`. +#' +#' @return A list or a data frame, depending on the `which` and `wide` arguments: +#' - If `which` is specified, returns the dataset for that particular form or event. +#' - If `wide` is `TRUE` (for form-based splitting), returns the data in wide format (repeated measures are expanded into columns). +#' - If neither is specified, returns a list of data frames for each form or event. +#' +#' @examples +#' +#' # To separate data by form: +#' result <- covican |> +#' rd_factor() |> +#' rd_checkbox() |> +#' rd_split(by = "form", wide = TRUE) +#' +#' print(result) +#' +#' # To separate data by event: +#' result <- covican |> +#' rd_factor() |> +#' rd_checkbox() |> +#' rd_split(by = "event") +#' +#' print(result) +#' +#' @export +#' + +rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, which = NULL, by = "form", wide = FALSE) { + + results <- NULL + + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) + list2env(env_vars, envir = environment()) + } + + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") + } + + # Extract labels from the data to reapply later + labels <- purrr::map_chr(data, function(x) { + lab <- attr(x, "label") + if (!is.null(lab)) { + lab + } else { + "" + } + }) + + # Check if the project has repeated instruments + if ("redcap_repeat_instrument" %in% names(data)) { + repeat_instrument <- dplyr::case_when( + any(!is.na(data$redcap_repeat_instrument)) ~ TRUE, + TRUE ~ FALSE + ) + } else { + repeat_instrument <- FALSE + } + + # Identify basic REDCap variables present in the dataset + basic_redcap_vars <- c("record_id", "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance", "redcap_data_access_group", "redcap_event_name.factor", "redcap_repeat_instrument.factor", "redcap_data_access_group.factor", "redcap_survey_identifier") + + basic_redcap_vars <- intersect(basic_redcap_vars, names(data)) + + # Check functions needed before splitting + actions <- character() + + # Check for missing variables in the dataset compared to the dictionary + vars_more <- setdiff(dic$field_name, names(data)) + + # Handle cases where variables in the dictionary are missing in the dataset + if (length(vars_more) > 0) { + + # Special handling for "checkbox" variables + check_vars <- dic |> + dplyr::filter(.data$field_name %in% vars_more & .data$field_type == "checkbox") |> + dplyr::pull(.data$field_name) + + if (length(check_vars) > 0) { + # actions <- c(actions, "There are variables in the dictionary that are not present in the dataset.\nSince some of these variables are checkboxes, please use the `rd_checkbox` function\nwith `checkbox_names = TRUE` to resolve this issue before proceeding.") + actions <- c(actions, "Missing checkbox vars from dictionary — run: rd_checkbox(..., checkbox_names = TRUE)") + } + + other_check_vars <- setdiff(vars_more, check_vars) + + if (length(other_check_vars) > 0) { + stop("There are variables in the dictionary that are not present in the dataset.\nPlease ensure that the dictionary matches the dataset. Transformation has been halted.", call. = FALSE) + } + + } + + # Check for extra variables in the dataset compared to the dictionary + vars_less <- setdiff(names(data), dic$field_name) |> + setdiff(basic_redcap_vars) # Exclude REDCap default variables not found in the dictionary + + # Handle cases where there are variables in the data that cannot be found in the dictionary + if (length(vars_less) > 0) { + + patt_vars <- grep("_complete$|_timestamp$", vars_less, value = TRUE) + + # Special handling for "_complete" and "_timestamp" patterns + if (length(patt_vars) > 0) { + mss <- dplyr::case_when( + any(grepl("_complete$", vars_less)) & any(grepl("_timestamp$", vars_less)) ~ "c('_complete', '_timestamp')", + any(grepl("_complete$", vars_less)) ~ "'_complete'", + any(grepl("_timestamp$", vars_less)) ~ "'_timestamp'" + ) + + # actions <- c(actions, stringr::str_glue("Transformation halted. Default REDCap variables ({mss}) are present in the dataset but not in the dictionary.\nTo proceed, use the `rd_delete_vars` function with `pattern = {mss}` to remove these variables before continuing.")) + actions <- c(actions, stringr::str_glue("Default REDCap variables ({mss}) detected in the dataset — run: rd_delete_vars(..., pattern = {mss})")) + } + + fact_vars <- grep(".factor$", vars_less, value = TRUE) + + # Special handling for factor versions of variables + if (length(fact_vars) > 0) { + # actions <- c(actions, "Some variables in the dataset are factor versions of other variables and are not present in the dictionary.\nUse the `rd_factor` function to resolve this issue before proceeding.") + actions <- c(actions, "Detected both versions of variables (numerical and factor) - run: rd_factor(...)") + } + + # Checkbox vars already identified in the previous step (vars_more) + less_check <- grep("___", vars_less, value = TRUE) + + other_less_vars <- setdiff(vars_less, c(patt_vars, fact_vars, less_check)) + + if (length(other_less_vars) > 0) { + # General message for other cases + stop("There are extra variables in the dataset not found in the dictionary.\nTransformation halted.", + call. = FALSE + ) + } + } + + + # single stop with full list (if anything found) + if (length(actions) > 0) { + header <- c( + "Detected issues that must be resolved BEFORE running rd_split():", + "" + ) + body <- unlist(lapply(seq_along(actions), function(i) paste0(i, ". ", actions[i]))) + footer <- c("", "Suggested order: list(dataset, dic, ...) |> rd_checkbox(...) |> rd_delete_vars(...) |> rd_factor(...) -> rd_split(...)") + stop(paste(c(header, body, footer), collapse = "\n"), call. = FALSE) + } + + if (by == "form") { + # Handle splitting by form + form <- unique(dic$form_name) + longitudinal <- "redcap_event_name" %in% names(data) + + if (longitudinal & is.null(event_form)) { + stop("The event-form correspondence is required to split the data by form in a longitudinal project. Please provide the `event_form` argument to proceed.", call. = FALSE) + } + + if (longitudinal) { + ndata <- tibble::tibble("form" = form) |> + dplyr::mutate( + events = purrr::map(.data$form, ~ event_form$unique_event_name[event_form$form == .x]), + vars = purrr::map(.data$form, ~ dic$field_name[dic$form_name == .x]) + ) |> + dplyr::mutate(df = purrr::map2( + .data$events, + .data$vars, + ~ data |> + dplyr::filter(redcap_event_name %in% .x) |> + dplyr::select(dplyr::any_of(unique( + c(basic_redcap_vars, .y) + ))) + )) + } else { + ndata <- tibble::tibble("form" = form) |> + dplyr::mutate( + vars = purrr::map(.data$form, ~ dic$field_name[dic$form_name == .x]), + vars = purrr::map(.data$vars, ~ unique(c(basic_redcap_vars, .x))) + ) |> + dplyr::mutate(df = purrr::map(.data$vars, ~ data |> + dplyr::select(dplyr::any_of(unique(c(basic_redcap_vars, .x)))))) + } + + if (repeat_instrument) { + form_check <- data |> + dplyr::distinct(dplyr::pick(dplyr::contains("redcap_repeat_instrument"))) + + ndata <- ndata |> + dplyr::left_join(form_check, by = dplyr::join_by("form" == "redcap_repeat_instrument")) |> + dplyr::relocate("form_factor" = "redcap_repeat_instrument.factor", .after = form) |> + dplyr::mutate(df = purrr::map2(.data$form_factor, .data$df, ~ { + if (is.na(.x)) { + .y |> + dplyr::filter(is.na(.data$redcap_repeat_instrument.factor)) |> + dplyr::select(-dplyr::starts_with("redcap_repeat_instrument")) + } else { + .y |> + dplyr::filter(.data$redcap_repeat_instrument.factor == .x) |> + dplyr::mutate(redcap_repeat_instrument = redcap_repeat_instrument.factor) |> + dplyr::select(-dplyr::any_of("redcap_repeat_instrument.factor")) + } + })) |> + dplyr::select(-"form_factor") + } + + if (wide) { + ndata <- ndata |> + dplyr::mutate( + max_repeated_instance = purrr::map_dbl( + .data$df, + ~.x |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate(id = seq_along(.data$record_id), + max_id = n()) |> + dplyr::ungroup() |> + dplyr::pull(max_id) |> + max() + ), + df = purrr::pmap(list(.data$vars, .data$df, .data$events), function(x, y, z) { + + y <- y |> + dplyr::select(dplyr::all_of(c("record_id", x))) + + if(n_distinct(z) > 1) { + + y <- y |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate(id = seq_along(.data$record_id)) |> + dplyr::ungroup() |> + tidyr::pivot_wider(names_from = "id", values_from = -c("record_id", "id")) + } + + return(y) + }) + ) |> + dplyr::relocate(max_repeated_instance, .after = events) + } + } else if (by == "event") { + # Handle splitting by event + var_event <- event_form |> + dplyr::select("form_name" = "form", "redcap_event_name" = "unique_event_name") |> + dplyr::right_join( + dic |> + dplyr::select("form_name", "field_name", "field_type", "branching_logic_show_field_only_if"), + by = "form_name", + relationship = "many-to-many" + ) |> + dplyr::filter(.data$field_name != "record_id") |> + tibble::as_tibble() |> + dplyr::select("redcap_event_name", "field_name") + + var_event_add <- data.frame(redcap_event_name = NA, field_name = basic_redcap_vars) + var_event <- rbind(var_event_add, var_event) + + list_events <- stats::na.exclude(unique(var_event$redcap_event_name)) + + ndata <- tibble::tibble("events" = list_events) |> + dplyr::mutate( + vars = purrr::map( + .data$events, + ~ var_event |> + dplyr::filter(.data$redcap_event_name == .x) |> + dplyr::pull("field_name") + ), + df = purrr::map2( + .data$events, + .data$vars, + ~ data |> + dplyr::filter(.data$redcap_event_name == .x) |> + dplyr::select(dplyr::all_of(c(basic_redcap_vars, .y))) + ) + ) + } else { + stop("Invalid `by` argument. Please specify either 'form' or 'event'.") + } + + # Handle the `which` argument if provided + if (!is.null(which)) { + if (length(which) > 1) { + warning("The `which` argument is designed to specify a single form or event. Multiple inputs were provided; only the first will be used.") + + which <- which[1] + } + + if (by == "form") { + if(!which %in% form){ + stop("The form specified in the `which` argument was not found in this project.\n", + "Please select one of the available REDCap forms:\n", paste0("-", form, "\n"), call. = FALSE) + } + } + + if (by == "event") { + if(!which %in% list_events){ + stop("The event specified in the `which` argument was not found in this project.\n", + "Please select one of the available REDCap events:\n", paste0("-", list_events, "\n"), call. = FALSE) + } + } + + + ndata <- ndata |> + dplyr::filter((if (by == "form") .data$form else .data$events) == which) |> + dplyr::pull(.data$df) |> + purrr::pluck(1) + } else { + ndata <- ndata |> + dplyr::select(-"vars") + } + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Final arrangment of the data by {by}. (rd_split)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Final arrangment of the data by {by}. (rd_split)\n")) + } + + # Return the modified data, dictionary, event_form, and results + list( + data = ndata, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove any NULL elements from the output list +} diff --git a/R/rd_transform.R b/R/rd_transform.R index 29e0596..569f8a0 100644 --- a/R/rd_transform.R +++ b/R/rd_transform.R @@ -1,7 +1,10 @@ #' Transformation of the Raw Data #' +#' @description +#' `r lifecycle::badge('stable')` #' This function transforms the raw REDCap data read by the `redcap_data` function. It returns the transformed data and dictionary, along with a summary of the results of each step. -#' @param ... Output of the `redcap_data` function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project. +#' +#' @param project Output of the `redcap_data` function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project. #' @param data Data frame containing the data read from REDCap. If the list is specified, this argument is not necessary. #' @param dic Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not necessary. #' @param event_form Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not necessary. @@ -23,78 +26,65 @@ #' #' # For customization of checkbox labels (example) #' rd_transform(covican, -#' checkbox_labels = c("Not present", "Present")) +#' checkbox_labels = c("Not present", "Present") +#' ) #' #' @export +#' -rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, exclude_to_factor = NULL, delete_vars = NULL, delete_pattern = c("_complete", "_timestamp"), final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL){ - - project <- c(...) +rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, exclude_to_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL) { results <- NULL ind <- 1 - if(!is.null(project)){ - if(!is.null(data)){ - warning("Data has been specified twice so the function will not use the information in the data argument.") - } - - if(!is.null(dic)){ - warning("Dictionary has been specified twice so the function will not use the information in the dic argument.") - } - - data <- project$data - dic <- project$dictionary - dic_ori <- dic + # Handle potential overwriting when both `project` and other arguments are provided + if (!is.null(project)) { + env_vars <- check_proj(project, data, dic, event_form) - if("event_form" %in% names(project)){ - if(!is.null(event_form)){ - warning("The event-form has been specified twice so the function will not use the information in the event_form argument.") - } - event_form <- project$event_form - } + list2env(env_vars, envir = environment()) } - if(is.null(data) | is.null(dic)){ - stop("No data/dictionary was provided") + # Ensure both `data` and `dic` are provided; stop if either is missing + if (is.null(data) | is.null(dic)) { + stop("Both `data` and `dic` (data and dictionary) arguments must be provided.") } - #Check if the project is longitudinal (has more than one event) or not: + # Check if the project is longitudinal (has more than one event) or not: longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) - if(final_format == "by_event" & is.null(event_form)){ + if (final_format == "by_event" & is.null(event_form)) { stop("To split the data by event the event_form has to be provided", call. = FALSE) } - #If the project is not longitudinal 'by_form' can be used without event_form: - if(final_format == "by_form" & is.null(event_form) & longitudinal){ + # If the project is not longitudinal 'by_form' can be used without event_form: + if (final_format == "by_form" & is.null(event_form) & longitudinal) { stop("To split the data by form the event_form has to be provided in a longitudinal project", call. = FALSE) } - if(!is.null(which_event) & final_format != "by_event"){ + if (!is.null(which_event) & final_format != "by_event") { stop("Which event has been specified but the final format is not to split the data by event", call. = FALSE) } - if(!is.null(which_form) & final_format != "by_form"){ + if (!is.null(which_form) & final_format != "by_form") { stop("Which form has been specified but the final format is not to split the data by form", call. = FALSE) } - if(!is.null(wide) & final_format != "by_form"){ + if (!is.null(wide) & final_format != "by_form") { stop("The argument wide has been specified but the final format is not to split the data by form", call. = FALSE) } - if(!final_format %in% c("raw", "by_event", "by_form")){ + if (!final_format %in% c("raw", "by_event", "by_form")) { stop("final_format argument has to be one of the following: 'raw', 'by_event', 'by_form'", call. = FALSE) } - #If the project is longitudinal and the event hasn't been specified: - if(longitudinal & is.null(event_form)){ + # If the project is longitudinal and the event hasn't been specified: + if (longitudinal & is.null(event_form)) { warning("The project contains more than one event. For a complete transformation is recommended to include the event-form correspondence.") } - #Check if the project has repeated instruments - if("redcap_repeat_instrument" %in% names(data)) { + # Check if the project has repeated instruments + if ("redcap_repeat_instrument" %in% names(data)) { repeat_instrument <- dplyr::case_when( any(!is.na(data$redcap_repeat_instrument)) ~ TRUE, TRUE ~ FALSE @@ -103,7 +93,7 @@ rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkb repeat_instrument <- FALSE } - message("Transformation in progress...") + message("\u23F3 Transformation in progress...") labels <- purrr::map_chr(data, function(x) { lab <- attr(x, "label") @@ -114,9 +104,9 @@ rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkb } }) - #Change the labelled class of each column but don't remove the label: - data <- data %>% - dplyr::mutate_all(function(x){ + # Change the labelled class of each column but don't remove the label: + data <- data |> + dplyr::mutate_all(function(x) { class(x) <- setdiff(class(x), "labelled") x }) @@ -125,327 +115,213 @@ rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkb results <- c(results, stringr::str_glue("{ind}. Removing selected variables\n")) ind <- ind + 1 - if(!is.null(delete_vars)){ - - for(i in 1:length(delete_vars)) { - data <- data %>% - dplyr::select(!delete_vars[i]) - - if (paste0(delete_vars[i], ".factor") %in% names(data)) { - data <- data %>% - dplyr::select(!paste0(delete_vars[i], ".factor")) - } - - dic <- dic %>% - dplyr::filter(.data$field_name != delete_vars[i]) - - } + if (!is.null(delete_vars)) { + del_vars <- suppressWarnings(rd_delete_vars(data = data, dic = dic, vars = delete_vars)) + data <- del_vars$data + dic <- del_vars$dictionary } # Delete variables that contain specific patterns results <- c(results, stringr::str_glue("\n\n{ind}. Deleting variables that contain some patterns\n")) ind <- ind + 1 - if(!is.null(delete_pattern)){ - - for(i in 1:length(delete_pattern)){ - - if(delete_pattern[i] == "_complete"){ - - data <- data %>% - dplyr::select(!tidyselect::ends_with(c("_complete", "_complete.factor"))) - - dic <- dic %>% - dplyr::filter(!grepl("_complete$", .data$field_name)) - - }else if(delete_pattern[i] == "_timestamp"){ - - data <- data %>% - dplyr::select(!tidyselect::ends_with(c("_timestamp", "timestamp.factor"))) - - dic <- dic %>% - dplyr::filter(!grepl("_timestamp$", .data$field_name)) - - }else{ - - data <- data %>% - dplyr::select(!tidyselect::contains(delete_pattern[i])) - - dic <- dic %>% - dplyr::filter(!grepl(delete_pattern[i], .data$field_name)) - } - - } + if (!is.null(delete_pattern)) { + del_pattern <- suppressWarnings(rd_delete_vars(data = data, dic = dic, pattern = delete_pattern)) + data <- del_pattern$data + dic <- del_pattern$dictionary } - #Change the format of dates - #Identify dates that have the tag "date_"/"datetime_"/"datetime_seconds_" in redcap. It will have always the format "Y-M-D" in any case - var_date <- dic %>% - dplyr::filter(grepl("^date_", .data$text_validation_type_or_show_slider_number)) %>% + # Change the format of dates + # Identify dates that have the tag "date_"/"datetime_"/"datetime_seconds_" in redcap. It will have always the format "Y-M-D" in any case + var_date <- dic |> + dplyr::filter(grepl("^date_", .data$text_validation_type_or_show_slider_number)) |> dplyr::pull(.data$field_name) - var_datetime <- dic %>% - dplyr::filter(grepl("^datetime_", .data$text_validation_type_or_show_slider_number)) %>% + var_datetime <- dic |> + dplyr::filter(grepl("^datetime_", .data$text_validation_type_or_show_slider_number)) |> dplyr::pull(.data$field_name) - data <- data %>% - dplyr::mutate_at(var_date, as.Date) %>% - # '' values don't know how to convert the posicxt function - dplyr::mutate_at(var_datetime, function(x) { - x <- dplyr::case_when( - x == "" ~ NA, - TRUE ~ x - ) - x <- as.numeric(as.character(x)) - as.POSIXct(x) - }) + data <- rd_dates(data = data, dic = dic)$data - dic <- dic %>% - dplyr::mutate(branching_logic_show_field_only_if = dplyr::case_when(is.na(branching_logic_show_field_only_if) ~ "", - TRUE ~ branching_logic_show_field_only_if)) + dic <- dic |> + dplyr::mutate(branching_logic_show_field_only_if = dplyr::case_when( + is.na(branching_logic_show_field_only_if) ~ "", + TRUE ~ branching_logic_show_field_only_if + )) if (!repeat_instrument) { - #Recalculate calculated fields (previous to transforming factors and other preprocessing) - #It wil create duplicate variables of each calculated field with "_recalc" in the end and the recalculated value + # Recalculate calculated fields (previous to transforming factors and other preprocessing) + # It wil create duplicate variables of each calculated field with "_recalc" in the end and the recalculated value - results <- c(results, stringr::str_glue("\n\n{ind}. Recalculating calculated fields and saving them as '[field_name]_recalc'\n")) + results <- c(results, stringr::str_glue("\n\n{ind}. Recalculating calculated fields and saving them as '[field_name]_recalc'")) ind <- ind + 1 - #If the project is longitudinal and the event hasn't been specified no recalculation is possible - if(longitudinal & is.null(event_form)){ - + # If the project is longitudinal and the event hasn't been specified no recalculation is possible + if (longitudinal & is.null(event_form)) { results <- c(results, "\nNo recalculation is possible as the project has more than one event and the event-form correspondence has not been specified\n") - - }else{ - - recalc <- recalculate(data, dic, event_form, exclude_recalc) + } else { + recalc <- rd_recalculate(data = data, dic = dic, event_form = event_form, exclude_recalc = exclude_recalc) data <- recalc$data - dic <- recalc$dic - - results <- c(results, recalc$results) + dic <- recalc$dictionary + results <- c(results, recalc$results[-1]) } } - if (!repeat_instrument) { - if(checkbox_na){ - results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic isn't satisfied or it's missing their values will be set to missing\n\n")) - }else{ - results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic is missing their values will be set to missing\n\n")) + if (checkbox_na) { + results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic isn't satisfied or it's missing their values will be set to missing")) + } else { + results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic is missing their values will be set to missing")) } } else { - results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options.\n")) + results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options.")) } ind <- ind + 1 - #Identify checkbox variables: - var_check<-names(data)[grep("___",names(data))] - - #Remove .factor: - var_check_factors <- var_check[grep(".factor$",var_check)] - - if (length(var_check_factors) > 0) { - data <- data %>% - dplyr::select(-tidyselect::all_of(var_check_factors)) - - var_check <- var_check[!grepl(".factor$",var_check)] - } else { - if (length(var_check) > 0){ - data <- data %>% - dplyr::mutate(dplyr::across( - tidyselect::all_of(var_check), - ~ dplyr::case_when(.x == "Unchecked" ~ 0, - .x == "Checked" ~ 1, - TRUE ~ NA) - )) - } - } - - #If there is some checkbox: - if(length(var_check) > 0){ - - #If the event_form is not provided and the project is longitudinal - if(is.null(event_form) & longitudinal) { - - results <- c(results, "\nBranching logic evaluation is not possible as the project has more than one event and the event-form correspondence has not been specified\n") - + # If there is some checkbox: + if (length(names(data)[grep("___", names(data))]) > 0) { + # If the event_form is not provided and the project is longitudinal + if (is.null(event_form) & longitudinal) { + results <- c(results, "\nBranching logic evaluation is not possible as the project has more than one event and the event-form correspondence has not been specified\n") } else { - if (!repeat_instrument) { + # Transform missings of checkboxes with branching logic: + trans <- rd_checkbox(data = data, dic = dic, event_form = event_form, checkbox_na = checkbox_na, checkbox_labels = checkbox_labels, checkbox_names = TRUE) - #Transform missings of checkboxes with branching logic: - trans <- transform_checkboxes(data = data, dic = dic, event_form = event_form, checkbox_na = checkbox_na) + results <- c(results, trans$results[-1]) data <- trans$data - - results <- c(results, trans$results) + dic <- trans$dictionary } - } - - #Transform them to No/Yes: - - data <- data %>% - dplyr::mutate(dplyr::across( - tidyselect::all_of(var_check), - ~ factor(.x, levels = 0:1, labels = checkbox_labels) - )) - - #Change the variable names and their branching logic: - - data_dic <- checkbox_names(data, dic, labels, checkbox_labels) - - data <- data_dic$data - dic <- data_dic$dic - - - }else{ - + } else { results <- c(results, "\nNo checkboxes are found in the data\n") - } - #Replace original variables with their factor version except for redcap_event_name and redcap_data_access_group - #If we dont want to convert another additional variable to factor we can specify it with the exclude argument: + # Replace original variables with their factor version except for redcap_event_name and redcap_data_access_group + # If we dont want to convert another additional variable to factor we can specify it with the exclude argument: - factors <- names(data)[grep("\\.factor$",names(data))] + factors <- names(data)[grep("\\.factor$", names(data))] if (length(factors) > 0) { results <- c(results, stringr::str_glue("\n\n{ind}. Replacing original variables for their factor version")) ind <- ind + 1 - data_dic <- to_factor(data, dic, exclude = exclude_to_factor) # This step also transforms the branching logic of the factors + data_dic <- rd_factor(data = data, dic = dic, exclude = exclude_to_factor) data <- data_dic$data - dic <- data_dic$dic + dic <- data_dic$dictionary } - #Fix variables that instead of missing have an empty field (text variables, etc.): - data <- data %>% - #Fix characters: - dplyr::mutate_if(is.character, ~ gsub("^$", NA, .x)) %>% - #Fix factors: - dplyr::mutate_if(is.factor,function(x){levels(x)[levels(x)==""] <- NA; x}) + # Fix variables that instead of missing have an empty field (text variables, etc.): + data <- data |> + # Fix characters: + dplyr::mutate_if(is.character, ~ gsub("^$", NA, .x)) |> + # Fix factors: + dplyr::mutate_if(is.factor, function(x) { + levels(x)[levels(x) == ""] <- NA + x + }) if (!repeat_instrument) { # Transform the branching logic from the dictionary which is in REDCap logic (raw) into R logic results <- c(results, stringr::str_glue("\n\n{ind}. Converting every branching logic in the dictionary into R logic")) ind <- ind + 1 - pos <- which(!dic$branching_logic_show_field_only_if %in% "") - logics <- NULL - - for (i in pos) { - - evaluation <- try(rd_rlogic(data = data, dic = dic, event_form = event_form, logic = dic$branching_logic_show_field_only_if[i], var = dic$field_name[i])$rlogic, silent = T) - - if (!inherits(evaluation, "try-error")) { + dic_trans <- rd_dictionary(data = data, dic = dic, event_form = event_form) - dic$branching_logic_show_field_only_if[i] <- rd_rlogic(data = data, dic = dic, event_form = event_form, logic = dic$branching_logic_show_field_only_if[i], var = dic$field_name[i])$rlogic - - } else { - - logics <- rbind(logics, dic$field_name[i]) - - } - } + dic <- dic_trans$dictionary - if (!is.null(logics)) { - - tabla <- tibble::tibble("Variables" = logics) - results <- c(results, "\n", knitr::kable(tabla, "pipe", align = c("ccc"), caption = "Variables with unconverted branching logic")) - - } + results <- c(results, dic_trans$results[-2]) } - #Arrange our dataset by record_id and event (will keep the same order of events as in redcap) - if(longitudinal) { - if("redcap_event_name.factor" %in% names(data)) { - data <- data %>% + # Arrange our dataset by record_id and event (will keep the same order of events as in redcap) + if (longitudinal) { + if ("redcap_event_name.factor" %in% names(data)) { + data <- data |> dplyr::arrange(factor(.data$record_id, levels = unique(.data$record_id)), .data$redcap_event_name.factor) } else { - data <- data %>% + data <- data |> dplyr::arrange(factor(.data$record_id, levels = unique(.data$record_id)), .data$redcap_event_name) } } - - # Reapply labels to the modified dataset + + # Apply labels to data data <- data |> labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) - #If an event_form is specified or if the project has only one event and by_form has been specified - if(!is.null(event_form) | (final_format == "by_form" & !longitudinal)){ - - if(!is.null(event_form)){ - var_noevent <- dic$field_name[! dic$form_name %in% event_form$form] - - if(length(var_noevent) > 0){ + # If an event_form is specified or if the project has only one event and by_form has been specified + if (!is.null(event_form) | (final_format == "by_form" & !longitudinal)) { + if (!is.null(event_form)) { + var_noevent <- dic$field_name[!dic$form_name %in% event_form$form] + if (length(var_noevent) > 0) { results <- c(results, stringr::str_glue("\n\n{ind}. Erasing variables from forms that are not linked to any event")) ind <- ind + 1 var_noevent <- var_noevent[var_noevent %in% names(data)] - data <- data %>% + data <- data |> dplyr::select(-var_noevent) - dic <- dic %>% - dplyr::filter(! .data$field_name %in% var_noevent) + dic <- dic |> + dplyr::filter(!.data$field_name %in% var_noevent) } - } - #Final arrangment - - if(final_format == "by_event"){ + # Final arrangment - results <- c(results,stringr::str_glue("\n\n{ind}. Final arrangment of the data by event")) + if (final_format == "by_event") { + results <- c(results, stringr::str_glue("\n\n{ind}. Final arrangment of the data by event")) ind <- ind + 1 - if(is.null(which_event)){ - - data <- split_event(data, dic, event_form) + if (is.null(which_event)) { + split <- rd_split(data = data, dic = dic, event_form = event_form, by = "event") - }else{ - - data <- split_event(data,dic,event_form,which=which_event) + data <- split$data + } else { + split <- rd_split(data = data, dic = dic, event_form = event_form, by = "event", which = which_event) + data <- split$data } - - }else if(final_format == "by_form"){ - + } else if (final_format == "by_form") { results <- c(results, stringr::str_glue("{ind}. Final arrangment of the data by form")) ind <- ind + 1 - if(is.null(wide)){ + if (is.null(wide)) { wide <- FALSE } - if(is.null(which_form)){ + if (is.null(which_form)) { + if (longitudinal) { + split <- rd_split(data = data, dic = dic, event_form = event_form, by = "form", which = NULL, wide = wide) + + data <- split$data + } else { + split <- rd_split(data = data, dic = dic, by = "form", which = NULL, wide = wide) - if(longitudinal){ - data <- split_form(data, dic, event_form, which = NULL, wide) - }else{ - data <- split_form(data, dic, which = NULL, wide) + data <- split$data } + } else { + if (longitudinal) { + split <- rd_split(data = data, dic = dic, event_form = event_form, by = "form", which = which_form, wide = wide) - }else{ - if(longitudinal){ - data <- split_form(data, dic, event_form, which=which_form, wide) - }else{ - data <- split_form(data, dic, which=which_form, wide) + data <- split$data + } else { + split <- rd_split(data = data, dic = dic, by = "form", which = which_form, wide = wide) + + data <- split$data } } - } - if(!is.null(event_form)) { + if (!is.null(event_form)) { list( data = data, dictionary = dic, @@ -459,11 +335,8 @@ rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkb results = stringr::str_glue("{results}") ) } - - - }else { - - if(!is.null(event_form)) { + } else { + if (!is.null(event_form)) { list( data = data, dictionary = dic, @@ -477,8 +350,5 @@ rd_transform <- function(..., data = NULL, dic = NULL, event_form = NULL, checkb results = stringr::str_glue("{results}") ) } - } - - } diff --git a/R/redcap_data.R b/R/redcap_data.R index bfca9a2..3bc31dd 100644 --- a/R/redcap_data.R +++ b/R/redcap_data.R @@ -1,93 +1,98 @@ #' Read REDCap data #' #' @description -#' This function allows users to read datasets from a REDCap project into R for analysis, either by exporting the data or via an API connection. +#' `r lifecycle::badge('stable')` +#' This function reads datasets from a REDCap project into R for analysis. Data can be imported from REDCap exported files or via an API connection. #' -#' The REDCap API serves as an interface for communication with REDCap and the server without requiring interaction through the REDCap interface. +#' **Options for data import:** #' -#' [Important] To read exported data from REDCap, please follow these steps: +#' - **Exported Data**: REDCap's *Export Data* function generates files suitable for R import. +#' - **API Connection**: Use the REDCap API to directly pull data into R. #' -#' - Use REDCap's 'Export Data' function. +#' **Steps for using exported data:** +#' 1. Use the REDCap *Export Data* function and choose *R Statistical Software* format. +#' 2. REDCap generates: +#' - A CSV file with observations. +#' - An R script to format variables for import. +#' 3. Ensure the exported files, dictionary, and event mapping (if any) are in the same directory. #' -#' - Select the 'R Statistical Software' format. +#' @note To use other package functions effectively, include the `dic_path` argument to load the project dictionary. #' -#' - REDCap will then generate two files: +#' @param data_path Path to the exported R file for data import (if using exported files). +#' @param dic_path Path to the dictionary file (CSV or XLSX). +#' @param event_path Path to the event-form mapping file (CSV or XLSX) for longitudinal projects (downloadable via the `Designate Instruments for My Events` tab within the `Project Setup` section of REDCap). +#' @param uri The URI of the REDCap project (for API connection). +#' @param token API token for REDCap project access. +#' @param filter_field Fields to include in the import (API connection only). +#' @param survey_fields Logical indicating whether to include survey-related fields (API connection only). #' -#' - A CSV file containing all observations of the REDCap project. -#' -#' - An R file with the necessary code to complete each variable's information and import them. -#' -#' - Ensure these files, along with the dictionary and event-mapping, are in the same directory. -#' -#' @note For further use of the package, it's recommended to use the `dic_path` argument to read the dictionary, as all other functions require it for proper functioning. -#' -#' @param data_path Character string specifying the path of the R file from which the dataset will be read. -#' @param dic_path Character string with the path of the dictionary. -#' @param event_path Character string specifying the path of the file containing the correspondence between each event and each form (downloadable via the `Designate Instruments for My Events` tab within the `Project Setup` section of REDCap). -#' @param uri The URI (Uniform Resource Identification) of the REDCap project. -#' @param token Character vector containing the generated token. -#' @param filter_field Character vector specifying the fields of the REDCap project desired to be imported into R (via API connection only). -#' @param survey_fields Logical indicating whether the function should download all the survey-related fields of the REDCap project (via API connection only). -#' @return A list containing the dataset and the dictionary of the REDCap project. If `event_path` is specified, it will also contain a third element with the correspondence of the events and forms of the project. +#' @return A list containing: +#' - `data`: Imported dataset. +#' - `dictionary`: Variable dictionary. +#' - `event_form` (if applicable): Event-form mapping for longitudinal projects. #' #' #' @examples #' \dontrun{ -#' # Exported files from REDCap -#' -#' dataset <- redcap_data(data_path = "C:/Users/username/example.r", -#' dic_path = "C:/Users/username/example_dictionary.csv", -#' event_path = "C:/Users/username/events.csv") +#' # Import using exported files #' -#' # API connection +#' dataset <- redcap_data( +#' data_path = "C:/Users/username/example.r", +#' dic_path = "C:/Users/username/example_dictionary.csv", +#' event_path = "C:/Users/username/events.csv" +#' ) #' -#' dataset_api <- redcap_data(uri = "https://redcap.idibell.cat/api/", -#' token = "55E5C3D1E83213ADA2182A4BFDEA") # This token is fictitious +#' # Import using API #' +#' dataset_api <- redcap_data( +#' uri = "https://redcap.idibell.cat/api/", +#' token = "55E5C3D1E83213ADA2182A4BFDEA" +#' ) # This token is fictitious #' } #' @export +#' @importFrom stats setNames +#' -redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA, token = NA, filter_field = NULL, survey_fields = FALSE) - { +redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA, token = NA, filter_field = NULL, survey_fields = FALSE) { + + event_form <- NULL + + # Save the current working directory and ensure it is restored on exit oldwd <- getwd() on.exit(setwd(oldwd)) # Warning: data_path, dic_path and another argument are specified. if (all(!c(data_path, dic_path) %in% NA) & any(!c(token, uri) %in% NA)) { - stop("Too many arguments, if you want to read exported data from REDCap use only the arguments data_path and dic_path", call. = FALSE) + stop("Too many arguments. Use `data_path` and `dic_path` for exported data or `uri` and `token` for API connection.", call. = FALSE) } # Warning: token, uri and another argument are specified. if (all(!c(token, uri) %in% NA) & any(!c(data_path, dic_path) %in% NA)) { - stop("Too many arguments, if you want to read data from REDCap through an API connection use only the arguments uri and token.", call. = FALSE) + stop("Too many arguments. Use `uri` and `token` for API connection or `data_path` and `dic_path` for exported data.", call. = FALSE) } # Warning: either uri or token is specified alone if ((!is.na(uri) & is.na(token)) | (is.na(uri) & !is.na(token))) { - stop("If you want to read data from REDCap through an API connection, both 'uri' and 'token' arguments must be provided.", call. = FALSE) + stop("Both `uri` and `token` are required for API connection.", call. = FALSE) } - # Read data, dictionary and event-form mapping in case of exported data. + # Process data from exported files if (all(!c(data_path, dic_path) %in% NA) & all(c(token, uri) %in% NA)) { - - # Evaluate the extension of the data_path - + # Check the extension of the R data file if (!grepl("\\.R$", data_path) & !grepl("\\.r$", data_path)) { - stop("Unsupported file format. Only R files are supported. Please specify the downloaded R file from REDCap within this argument.") + stop("Unsupported file format. `data_path` must be an R file exported from REDCap.", call. = FALSE) } - # Read data + # Import the data using the R file tmp_env <- new.env() - file.lines <- scan(data_path, what = character(), skip = 2, sep = '\n', quiet = TRUE) - file.lines.collapsed <- paste(file.lines, collapse = '\n') + file.lines <- scan(data_path, what = character(), skip = 2, sep = "\n", quiet = TRUE) + file.lines.collapsed <- paste(file.lines, collapse = "\n") command <- paste0("dirname(parent.frame(2)$", "data_path", ")") setwd(eval(parse(text = command))) source(textConnection(file.lines.collapsed), local = tmp_env, encoding = "UTF-8") data <- get("data", envir = tmp_env) - if (names(data)[1] != "record_id") { - names(data)[1] <- "record_id" - } - + + # Saving labels before changes labels <- purrr::map_chr(data, function(x) { lab <- attr(x, "label") if (!is.null(lab)) { @@ -97,40 +102,36 @@ redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA } }) - # Read dictionary - setwd(oldwd) + # Ensure the primary identifier column is correctly named + if (names(data)[1] != "record_id") { + names(data)[1] <- "record_id" + } - # Evaluate the extension of the dictionary_path + # Load the dictionary and validate its format + setwd(oldwd) extension_dic <- tools::file_ext(dic_path) - if (extension_dic == "xlsx") { - # Read XLSX file - dic <- openxlsx::read.xlsx(dic_path, colNames = F, detectDates = T, sheet = 1) - + dic <- openxlsx::read.xlsx(dic_path, colNames = FALSE, detectDates = TRUE, sheet = 1) } else if (extension_dic == "csv") { - # Read CSV file dic <- utils::read.csv(dic_path, encoding = "UTF-8", header = FALSE) - } else { - - stop("Unsupported file format. Only XLSX and CSV are supported.") - + stop("Unsupported dictionary format. Only CSV and XLSX are supported.", call. = FALSE) } - # Changing names of the first column and first observation - names(dic) <- dic[1,] - dic <- dic[-1,] + # Process the dictionary: clean names + names(dic) <- dic[1, ] + dic <- dic[-1, ] names(dic) <- janitor::make_clean_names(names(dic)) names(dic)[1] <- "field_name" if (dic[1, 1] != "record_id") { - dic[1,1] <- "record_id" + dic[1, 1] <- "record_id" } # Remove descriptive variables from dictionary if ("descriptive" %in% dic$field_type) { - dic <- dic %>% + dic <- dic |> dplyr::filter(!.data$field_type %in% "descriptive") } @@ -138,186 +139,207 @@ redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA # Indicator of longitudinal projects longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) - #Read event file + # Read event file if (!is.na(event_path)) { - setwd(oldwd) # Evaluate the extension extension <- tools::file_ext(event_path) if (extension == "xlsx") { - # Read XLSX file - event_form <- openxlsx::read.xlsx(event_path, detectDates = T, sheet = 1) - + event_form <- openxlsx::read.xlsx(event_path, detectDates = TRUE, sheet = 1) } else if (extension == "csv") { - # Read CSV file event_form <- utils::read.csv(event_path, encoding = "UTF-8") - } else { - - stop("Unsupported file format. Only XLSX and CSV are supported.") - + stop("Unsupported event mapping format. Only CSV and XLSX are supported.", call. = FALSE) } - data_def <- list(data = data, dictionary = dic, event_form = event_form) + # Error if the exported event_form file is not the correct one! (using events instead of instrument-event) + if ("event_name" %in% names(event_form)) { + stop("Invalid file provided in `event_path`.\n\nPlease download the instrument-event mapping file from the 'Designate Instruments for My Events' tab of your REDCap project and try again.", + call. = FALSE + ) + } - }else{ - #If no event is specified and the project is longitudinal + # Output + data_def <- list(data = data, dictionary = dic, event_form = event_form) + } else { + # If no event is specified and the project is longitudinal if (longitudinal) { - warning("The project contains more than one event. You might want to load the event-form correspondence using the argument event_path.") + warning("The project is longitudinal. Consider providing `event_path` for event-form correspondence.", call. = FALSE) } data_def <- list(data = data, dictionary = dic) } - } - # Read data, dictionary and event-form mapping in case of an API connection. + # Process data from API connection if (all(!c(token, uri) %in% NA) & all(c(data_path, dic_path) %in% NA)) { + # Message: Begin data import process + message("Importing data from REDCap API...") - # Message - message("Importing in progress...") - - # First read the labels + # Read labels from REDCap ## Error SSL peer certificate (Github issue #6) - tryCatch({labels <- suppressMessages(REDCapR::redcap_read(redcap_uri = uri, token = token, verbose = FALSE, raw_or_label = "label", raw_or_label_headers = "label", export_data_access_groups = TRUE, export_survey_fields = survey_fields, fields = filter_field)$data)}, - error = function(e) { - if(grepl("REDCap's PHP code is likely trying to process too much text in one bite", e$message) & !is.null(filter_field)) { - stop("The `record_id` or equivalent variable is missing on the `filter_field` argument.", call. = F) - } else if (grepl("SSL peer certificate", e$message)) { - stop("Unable to establish a secure connection due to an SSL certificate problem.\nConsider adding the following line of code to bypass SSL certificate verification: httr::with_config(httr::config(ssl_verifypeer = FALSE), ... <- readcap_data(...)).\n", call. = F) - } else { - stop(e) + tryCatch( + { + labels <- suppressMessages(REDCapR::redcap_read(redcap_uri = uri, token = token, verbose = FALSE, raw_or_label = "label", raw_or_label_headers = "label", export_data_access_groups = TRUE, export_survey_fields = survey_fields, fields = filter_field)$data) + }, + error = function(e) { + if (grepl("REDCap's PHP code is likely trying to process too much text in one bite", e$message) & !is.null(filter_field)) { + stop("The `record_id` or equivalent variable is missing on the `filter_field` argument.", call. = FALSE) + } else if (grepl("SSL peer certificate", e$message)) { + stop("Unable to establish a secure connection.\nConsider bypassing SSL verification:\nhttr::with_config(httr::config(ssl_verifypeer = FALSE), ... <- readcap_data(...)).", call. = FALSE) + } else { + stop(e) + } } - }) + ) + # Ensure labels were retrieved and assign a default column name if (nrow(labels) > 0) { names(labels)[1] <- "record_id" } else { - stop("Data retrieval is currently unavailable. Please check the status of the REDCap server, confirm the existence of records within the project and verify that you have the necessary data export and API permissions to perform this operation.", call. = F) + stop("Data retrieval is currently unavailable. Please check the status of the REDCap server, confirm the existence of records within the project and verify that you have the necessary data export and API permissions to perform this operation.", call. = FALSE) } # Save the factor version of the default variables of redcap - redcap_names <- names(labels %>% - dplyr::select(dplyr::any_of(c("Event Name", "Repeat Instrument", "Data Access Group")))) + redcap_names <- names(labels |> + dplyr::select(dplyr::any_of(c("Event Name", "Repeat Instrument", "Data Access Group")))) - default_names <- data.frame(fac = redcap_names) %>% - dplyr::mutate(corres = dplyr::case_when(fac %in% "Event Name" ~ "redcap_event_name.factor", - fac %in% "Repeat Instrument" ~ "redcap_repeat_instrument.factor", - fac %in% "Data Access Group" ~ "redcap_data_access_group.factor")) + default_names <- data.frame(fac = redcap_names) |> + dplyr::mutate(corres = dplyr::case_when( + fac %in% "Event Name" ~ "redcap_event_name.factor", + fac %in% "Repeat Instrument" ~ "redcap_repeat_instrument.factor", + fac %in% "Data Access Group" ~ "redcap_data_access_group.factor" + )) rename_redcap <- default_names$fac names(rename_redcap) <- default_names$corres - main_vars <- labels %>% - dplyr::mutate_at(redcap_names[!redcap_names %in% "Repeat Instrument"], - ~ifelse(all(is.na(.)), ., forcats::fct_inorder(.))) %>% - dplyr::rename(dplyr::all_of(rename_redcap)) %>% + main_vars <- labels |> + dplyr::mutate_at( + redcap_names[!redcap_names %in% "Repeat Instrument"], + ~ if (all(is.na(.))) . else forcats::fct_inorder(.) + ) |> + dplyr::rename(dplyr::all_of(rename_redcap)) |> dplyr::select("record_id", default_names$corres) - # Remove the "...number" suffixes from the labels + # Clean up label names by removing suffixes labels <- gsub("\\.{3}\\d+$", "", names(labels)) - # Message + # Message: Intermediate status update message("Almost done...") - # Read data using the API connection - - data_api <- REDCapR::redcap_read(redcap_uri = uri, token = token, verbose = FALSE, raw_or_label = "raw", export_data_access_groups = TRUE, export_survey_fields = survey_fields, fields = filter_field)$data - + # Fetch main data using the REDCap API + data_api <- REDCapR::redcap_read( + redcap_uri = uri, + token = token, + verbose = FALSE, + raw_or_label = "raw", + export_data_access_groups = TRUE, + export_survey_fields = survey_fields, + fields = filter_field + )$data + + # Ensure data retrieval was successful if (nrow(data_api) > 0) { names(data_api)[1] <- "record_id" } else { - stop("Observational data retrieval is currently unavailable. Please verify the status of the REDCap server or confirm the existence of records within the project.", call. = F) + stop("Observational data retrieval is currently unavailable. Please verify the status of the REDCap server or confirm the existence of records within the project.", call. = FALSE) } - # Read dictionary using the API connection - dic_api <- REDCapR::redcap_metadata_read(redcap_uri = uri, token = token, verbose = FALSE)$data + # Fetch metadata dictionary using the REDCap API + dic_api <- REDCapR::redcap_metadata_read( + redcap_uri = uri, + token = token, + verbose = FALSE + )$data + # Ensure dictionary has appropriate names names(dic_api)[1] <- "field_name" - if (dic_api[1, 1] != "record_id") { - dic_api[1,1] <- "record_id" + dic_api[1, 1] <- "record_id" } - ## Making sure the names of both dictionaries(exported data and API connection) match + # Making sure the names of both dictionaries(exported data and API connection) match names(dic_api)[names(dic_api) %in% c("select_choices_or_calculations", "branching_logic", "question_number")] <- c("choices_calculations_or_slider_labels", "branching_logic_show_field_only_if", "question_number_surveys_only") - - # Apply labels to data_api - data_api <- purrr::map2(data_api, as.list(labels), ~{ + # Apply labels to the main dataset + data_api <- purrr::map2(data_api, as.list(labels), ~ { if (!is.null(.y)) { attr(.x, "label") <- .y } .x - }) %>% + }) |> as.data.frame() - # Remove descriptive variables from dictionary + # Filter descriptive fields from dictionary if ("descriptive" %in% dic_api$field_type) { - dic_api <- dic_api %>% + dic_api <- dic_api |> dplyr::filter(!.data$field_type %in% "descriptive") } - # If filter_field is described, filter the variables in the dictionary + # Filter dictionary fields based on filter_field if provided if (!all(filter_field %in% NA)) { - dic_api <- dic_api %>% + dic_api <- dic_api |> dplyr::filter(.data$field_name %in% filter_field) } - # Identify checkboxes fields and convert them to factor using the dictionary as guide + # Process checkbox fields into factors if (sum(dic_api$field_type %in% "checkbox") > 0) { - var_check <- names(data_api)[grep("___", names(data_api))] - data_api <- data_api %>% + data_api <- data_api |> dplyr::mutate(dplyr::across(dplyr::all_of(var_check), ~ factor(., levels = c("0", "1"), labels = c("Unchecked", "Checked")), .names = "{col}.factor")) - } - # Identify radio buttons and dropdown fields and convert them to factor using the dictionary as guide + # Process radio and dropdown fields into factors if (sum(dic_api$field_type %in% c("radio", "dropdown")) > 0) { - - var_radio <- dic_api %>% - dplyr::filter(.data$field_type %in% c("radio", "dropdown")) %>% - dplyr::select("field_name", "field_type", "choices_calculations_or_slider_labels") %>% - dplyr::mutate(factor = purrr::map(.data$choices_calculations_or_slider_labels, ~stringr::str_split(.x, "\\|") %>% unlist %>% trimws), - levels = purrr::map(factor, ~gsub(",.*", "", .x)), - labels = purrr::map(factor, ~gsub("^[^,]*,\\s*", "", .x))) + var_radio <- dic_api |> + dplyr::filter(.data$field_type %in% c("radio", "dropdown")) |> + dplyr::select("field_name", "field_type", "choices_calculations_or_slider_labels") |> + dplyr::mutate( + factor = purrr::map(.data$choices_calculations_or_slider_labels, ~ stringr::str_split(.x, "\\|") |> + unlist() |> + trimws()), + levels = purrr::map(factor, ~ gsub(",.*", "", .x)), + labels = purrr::map(factor, ~ gsub("^[^,]*,\\s*", "", .x)) + ) for (i in var_radio$field_name) { tryCatch( - {data_api[[stringr::str_glue("{i}.factor")]] <- factor(data_api[[i]], - levels = c(var_radio$levels[[which(var_radio$field_name %in% i)]]), - labels = c(var_radio$labels[[which(var_radio$field_name %in% i)]]))}, + { + data_api[[stringr::str_glue("{i}.factor")]] <- factor(data_api[[i]], + levels = c(var_radio$levels[[which(var_radio$field_name %in% i)]]), + labels = c(var_radio$labels[[which(var_radio$field_name %in% i)]]) + ) + }, error = function(e) { - warning(stringr::str_glue("The following variable could not be replicated in its factor version: {i}. Please manually create a factor version of this variable named '{i}.factor' to properly execute the rd_transform() function."), call. = F) + warning(stringr::str_glue("The following variable could not be replicated in its factor version: {i}. Please manually create a factor version of this variable named '{i}.factor' to properly execute the rd_transform() function."), call. = FALSE) } ) } } - # Join the main_vars to the imported data + # Merge main_vars with imported data - data_api <- data_api %>% - dplyr::bind_cols(main_vars %>% dplyr::select(-"record_id")) + data_api <- data_api |> + dplyr::bind_cols(main_vars |> dplyr::select(-"record_id")) - # Indicator of longitudinal projects + # Determine if project is longitudinal longitudinal <- ifelse("redcap_event_name" %in% names(data_api), TRUE, FALSE) - # Read event file + # Handle event path or fetch event-form correspondence via API if (!is.na(event_path)) { - # Warning: event_path not necessary while using API connection - warning("The event_path argument is not necessary as the event-form correspondence can be automatically read with the API connection") + warning("The event_path argument is not required when using an API connection.") setwd(oldwd) @@ -325,60 +347,90 @@ redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA extension <- tools::file_ext(event_path) if (extension == "xlsx") { - # Read XLSX file - event_form <- openxlsx::read.xlsx(event_path, detectDates = T, sheet = 1) - + event_form <- openxlsx::read.xlsx(event_path, detectDates = TRUE, sheet = 1) } else if (extension == "csv") { - # Read CSV file event_form <- utils::read.csv(event_path, encoding = "UTF-8") - } else { - stop("Unsupported file format. Only XLSX and CSV formats are supported.") + } + # Error if the exported event_form file is not the correct one! (using events instead of instrument-event) + if ("event_name" %in% names(event_form)) { + stop("Invalid file provided in `event_path`.\n\nPlease download the instrument-event mapping file from the 'Designate Instruments for My Events' tab of your REDCap project and try again.", + call. = FALSE + ) } - data_def <- list(data = data_api, - dictionary = dic_api, - event_form = event_form) + # Output + data_def <- list( + data = data_api, + dictionary = dic_api, + event_form = event_form + ) } else { - # If the event file is not specified, the function reads it using the API connection (in case of longitudinal projects) if (longitudinal) { - event_form <- as.data.frame(REDCapR::redcap_event_instruments(redcap_uri = uri, token = token, verbose = FALSE)$data) - data_def <- list(data = data_api, - dictionary = dic_api, - event_form = event_form) - + data_def <- list( + data = data_api, + dictionary = dic_api, + event_form = event_form + ) } else { - - data_def <- list(data = data_api, - dictionary = dic_api) - + data_def <- list( + data = data_api, + dictionary = dic_api + ) } - } - # Message - message("Done!") + # Message: Completion + message("API data import completed.") } - - # Specifying the "UTF-8" encoding to each character column of the data - for (i in 1:length(data_def$data)) { + + # Apply UTF-8 encoding to character columns + for (i in seq_along(data_def$data)) { if (is.character(data_def$data[, i])) { suppressWarnings(data_def$data[, i] <- stringr::str_conv(data_def$data[, i], "UTF-8")) } } - + + # Transform empty values into missing values (NA) + data_def$data <- data_def$data |> + # Fix characters: + dplyr::mutate_if(is.character, ~ gsub("^$", NA, .x)) |> + # Fix factors: + dplyr::mutate_if(is.factor, function(x) { + levels(x)[levels(x) == ""] <- NA + x + }) + + # Remove variables with no corresponding event + if (!is.null(event_form)) { + var_noevent <- data_def$dictionary |> + dplyr::filter(!.data$form_name %in% event_form$form) |> + dplyr::pull(.data$field_name) + + if (length(var_noevent) > 0) { + warning(stringr::str_glue("The following variables were removed since they are not linked to any event: {var_noevent}"), call. = FALSE) + + var_noevent <- intersect(var_noevent, names(data)) + + data_def$data <- data_def$data |> + dplyr::select(-dplyr::any_of(var_noevent)) + + data_def$dictionary <- data_def$dictionary |> + dplyr::filter(!.data$field_name %in% var_noevent) + } + } + # Reapply labels to the modified dataset data_def$data <- data_def$data |> labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) - # Output + # Return the result return(data_def) - } diff --git a/R/suplementary_package.R b/R/suplementary_package.R index 463e4fc..06cd03b 100644 --- a/R/suplementary_package.R +++ b/R/suplementary_package.R @@ -1,3 +1,7 @@ +# -------------------------------------------------------------- +# All credits for this functionality go to the Tidyverse package +# GitHub: https://github.com/tidyverse +# -------------------------------------------------------------- #' @import cli inform_startup <- function(msg, ...) { @@ -11,79 +15,73 @@ inform_startup <- function(msg, ...) { rlang::inform(msg, ..., class = "packageStartupMessage") } -core <- c("dplyr", "janitor", "magrittr", "openxlsx", "purrr", "REDCapR", "rlang", "stringr", "tibble", "tidyr", "tidyselect", "utils", "stringi", "labelled") +core <- c("REDCapR", "openxlsx", "labelled", "dplyr", "janitor", "purrr", "rlang", "stringr", "forcats", "tibble", "tidyr", "tidyselect", "utils", "stringi", "cli") - core_unloaded <- function() { - search <- paste0("package:", core) - core[!search %in% search()] - } +core_unloaded <- function() { + search <- paste0("package:", core) + core[!search %in% search()] +} - # Attach the package from the same package library it was - same_library <- function(pkg) { - loc <- - if (pkg %in% loadedNamespaces()) - dirname(getNamespaceInfo(pkg, "path")) - library( - pkg, - lib.loc = loc, - character.only = TRUE, - warn.conflicts = FALSE - ) - } +# Attach the package from the same package library it was +same_library <- function(pkg) { + loc <- if (pkg %in% loadedNamespaces()) dirname(getNamespaceInfo(pkg, "path")) + library(pkg, lib.loc = loc, character.only = TRUE, warn.conflicts = FALSE) +} - REDCapDM_attach <- function() { - to_load <- core_unloaded() +REDCapDM_attach <- function() { + to_load <- core_unloaded() - suppressPackageStartupMessages(lapply(to_load, same_library)) + suppressPackageStartupMessages(lapply(to_load, same_library)) - invisible(to_load) - } + invisible(to_load) +} - REDCapDM_attach_message <- function(to_load) { - if (length(to_load) == 0) { - return(NULL) - } - - header <- cli::rule( - left = cli::style_bold("Attaching core REDCapDM packages"), - right = paste0("REDCapDM ", package_version_h("REDCapDM")) - ) - - to_load <- sort(to_load) - versions <- vapply(to_load, package_version_h, character(1)) - - packages <- paste0( - cli::col_green(cli::symbol$tick), - " ", - cli::col_blue(format(to_load)), - " ", - cli::ansi_align(versions, max(cli::ansi_nchar(versions))) - ) - - if (length(packages) %% 2 == 1) { - packages <- append(packages, "") - } - col1 <- seq_len(length(packages)) - info <- paste0(packages[col1], " ", packages[-col1]) - - paste0(header, "\n", paste(info, collapse = "\n")) +REDCapDM_attach_message <- function(to_load) { + if (length(to_load) == 0) { + return(NULL) } - package_version_h <- function(pkg) { - highlight_version(utils::packageVersion(pkg)) + header <- cli::rule( + left = cli::style_bold("Attaching core REDCapDM packages"), + right = paste0("REDCapDM ", package_version_h("REDCapDM")) + ) + + to_load <- sort(to_load) + versions <- vapply(to_load, package_version_h, character(1)) + + packages <- paste0( + cli::col_green(cli::symbol$tick), + " ", + cli::col_blue(format(to_load)), + " ", + cli::ansi_align(versions, max(cli::ansi_nchar(versions))) + ) + + if (length(packages) %% 2 == 1) { + packages <- append(packages, "") } + col1 <- seq_len(length(packages) / 2) + info <- paste0(packages[col1], " ", packages[-col1]) - highlight_version <- function(x) { - x <- as.character(x) + paste0(header, "\n", paste(info, collapse = "\n")) +} - is_dev <- function(x) { - x <- suppressWarnings(as.numeric(x)) - ! is.na(x) & x >= 9000 - } +package_version_h <- function(pkg) { + highlight_version(utils::packageVersion(pkg)) +} - pieces <- strsplit(x, ".", fixed = TRUE) - pieces <- - lapply(pieces, function(x) - ifelse(is_dev(x), cli::col_red(x), x)) - vapply(pieces, paste, collapse = ".", FUN.VALUE = character(1)) +highlight_version <- function(x) { + x <- as.character(x) + + is_dev <- function(x) { + x <- suppressWarnings(as.numeric(x)) + !is.na(x) & x >= 9000 } + + pieces <- strsplit(x, ".", fixed = TRUE) + pieces <- + lapply(pieces, function(x) { + ifelse(is_dev(x), cli::col_red(x), x) + }) + vapply(pieces, paste, collapse = ".", FUN.VALUE = character(1)) +} diff --git a/R/utils-pipe.R b/R/utils-pipe.R deleted file mode 100644 index fd0b1d1..0000000 --- a/R/utils-pipe.R +++ /dev/null @@ -1,14 +0,0 @@ -#' Pipe operator -#' -#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -#' -#' @name %>% -#' @rdname pipe -#' @keywords internal -#' @export -#' @importFrom magrittr %>% -#' @usage lhs \%>\% rhs -#' @param lhs A value or the magrittr placeholder. -#' @param rhs A function call using the magrittr semantics. -#' @return The result of calling `rhs(lhs)`. -NULL diff --git a/R/utils-suplement.R b/R/utils-suplement.R new file mode 100644 index 0000000..ecfe5b6 --- /dev/null +++ b/R/utils-suplement.R @@ -0,0 +1,116 @@ +############### Other functions############### + +## Fill_data ---- + +#' Fill Rows with Values from One Event +#' @description +#' This function fills all rows in the dataset with the value of a particular variable in a specified event. It is an auxiliary function used in the `rd_rlogic` function. +#' @param which_event String specifying the name of the event. +#' @param which_var String specifying the name of the variable. +#' @param data Dataset containing the REDCap data. + +fill_data <- function(which_event, which_var, data) { + if (which_event %in% data$redcap_event_name) { + fill_values <- data |> + dplyr::select("record_id", "redcap_event_name", dplyr::all_of(which_var)) |> + dplyr::rename(var = dplyr::all_of(which_var)) |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate( + var = dplyr::case_when( + .data$redcap_event_name != which_event ~ NA, + TRUE ~ .data$var + ), + # Only the first value if the event is repeated + var = stats::na.exclude(unique(.data$var))[1] + ) |> + tidyr::fill("var", .direction = "downup") |> + dplyr::pull("var") + + data[, which_var] <- fill_values + + data + } else { + stop("The logic can't be evaluated after the translation") + } +} + + +## Check_proj ---- + +#' Handle Project Arguments +#' +#' This helper function processes the `project` argument in the several other functions. +#' It extracts data, dictionary, event form, and results from the project object while handling +#' potential duplication and providing warnings when arguments are provided redundantly. +#' +#' @param project A list or object containing `data`, `dictionary`, and optionally `event_form` and `results`. +#' @param data A data frame (optional) that may be overridden if provided in the `project` object. +#' @param dic A data dictionary (optional) that may be overridden if provided in the `project` object. +#' @param event_form An optional event-form object that may be overridden if provided in the `project`. +#' +#' +#' @export +check_proj <- function(project, data = NULL, dic = NULL, event_form = NULL) { + # Ensure 'project' is a list + if (!is.list(project)) { + stop("The 'project' argument must be a list.", call. = FALSE) + } + + # Check for `data` duplication + if (!is.null(data)) { + warning("Data has been provided twice. The function will ignore the `data` argument.") + } + + # Check for `dic` duplication + if (!is.null(dic)) { + warning("Dictionary has been provided twice. The function will ignore the `dic` argument.") + } + + # Extract data and dictionary from the project + data <- if (!is.null(project$data)) project$data else if (!is.null(project$dat)) project$dat else NULL + dic <- if (!is.null(project$dictionary)) project$dictionary else if (!is.null(project$dic)) project$dic else NULL + + # Handle `event_form` duplication + if ("event_form" %in% names(project)) { + if (!is.null(event_form)) { + warning("Event-form has been provided twice. The function will ignore the `event_form` argument.") + } + event_form <- project$event_form + } + + # Extract results from the project if present + if ("results" %in% names(project)) { + results <- project$results + } else { + results <- NULL + } + + # Return updated arguments as a list + list( + data = data, dic = dic, event_form = event_form, results = results + ) +} + + +#' Round Numbers to a Specified Number of Digits ---- +#' +#' This function rounds numeric values to the specified number of decimal digits, +#' mimicking the behavior of the base R `round()` function but implemented manually. +#' +#' @param x A numeric vector to be rounded. +#' @param digits Integer indicating the number of decimal places to round to. +#' +#' @return A numeric vector rounded to the specified number of digits. +#' @examples +#' round(3.14159, 2) +#' round(c(-2.718, 3.14159), 1) +#' +#' @export +round <- function(x, digits) { + posneg <- sign(x) + z <- abs(x) * 10^digits + z <- z + 0.5 + sqrt(.Machine$double.eps) + z <- trunc(z) + z <- z / 10^digits + z * posneg +} diff --git a/R/utils-transform.R b/R/utils-transform.R index b0d069c..9be4bb3 100644 --- a/R/utils-transform.R +++ b/R/utils-transform.R @@ -10,10 +10,12 @@ #' @param event_form Data frame containing the correspondence of each event with each form. #' @param exclude_recalc Character vector with the names of the variables that should not be recalculated. Useful for projects with time-consuming recalculations for certain calculated fields. #' @importFrom rlang := -#' + ############Calculated functions############ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ + lifecycle::deprecate_warn("1.0.0", "recalculate()", "rd_recalculate()") + #Redefine rounding function (the round original function is troublesome for some special cases) round = function(x, digits) { posneg = sign(x) @@ -25,8 +27,8 @@ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ } #Calculate for each calculated field the transcribed logic and if possible to transcribe recalculate it - calc <- tibble::tibble(dic) %>% - dplyr::filter(.data$field_type == "calc", !.data$field_name %in% exclude_recalc) %>% + calc <- tibble::tibble(dic) |> + dplyr::filter(.data$field_type == "calc", !.data$field_name %in% exclude_recalc) |> dplyr::mutate( calc = purrr::map(.data$field_name, function(x) { val <- data[, x] @@ -71,12 +73,12 @@ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ NA } }) - ) %>% + ) |> dplyr::select(-"rlogic") #Add this recalculated variables to data and dictionary and return both datasets - calc_change <- calc %>% + calc_change <- calc |> dplyr::filter(!is.na(.data$trans)) if(nrow(calc_change) > 0){ @@ -85,11 +87,11 @@ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ name <- stringr::str_glue("{calc_change$field_name[i]}_recalc") - data <- data %>% + data <- data |> tibble::add_column("{name}" := calc_change$recalc[[i]], .after = as.character(calc_change$field_name[i])) - add_row <- dic %>% - dplyr::filter(.data$field_name == calc_change$field_name[i]) %>% + add_row <- dic |> + dplyr::filter(.data$field_name == calc_change$field_name[i]) |> dplyr::mutate( field_name = stringr::str_glue("{field_name}_recalc"), field_label = stringr::str_glue("{field_label} (Recalculate)") @@ -103,24 +105,24 @@ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ #Summary of the results - report1 <- calc %>% - dplyr::mutate(n = 1) %>% + report1 <- calc |> + dplyr::mutate(n = 1) |> dplyr::summarise( trans = sum(!is.na(.data$trans)), N = sum(.data$n), no_trans = .data$N - .data$trans, no_equal = sum(!.data$is_equal, na.rm = TRUE), - ) %>% + ) |> dplyr::mutate(text1 = stringr::str_glue("{no_trans} ({round(no_trans*100/N, 2)}%)"), text2 = stringr::str_glue("{no_equal} ({round(no_equal*100/trans, 2)}%)") - ) %>% + ) |> dplyr::select("Total calculated fields" = "N", "Non-transcribed fields" = "text1", "Recalculated different fields" = "text2") results <- knitr::kable(report1, "pipe", align = "ccc") - report2 <- calc %>% - dplyr::mutate(trans2 = ifelse(!is.na(.data$trans), "Yes", "No")) %>% - dplyr::arrange(.data$trans2, .data$is_equal) %>% + report2 <- calc |> + dplyr::mutate(trans2 = ifelse(!is.na(.data$trans), "Yes", "No")) |> + dplyr::arrange(.data$trans2, .data$is_equal) |> dplyr::select("field_name", "Transcribed?" = "trans2", "Is equal?" = "is_equal") results <- c(results, "\n", knitr::kable(report2, "pipe", align = "ccc")) @@ -149,6 +151,8 @@ recalculate <- function(data, dic, event_form = NULL, exclude_recalc = NULL){ transform_checkboxes <- function(data, dic, event_form = NULL, checkbox_na = FALSE){ + lifecycle::deprecate_warn("1.0.0", "transform_checkboxes()", "rd_checkbox()") + vars <- dic$field_name[dic$field_type=="checkbox"] results <- results1 <- results2 <- NULL caption <- "Checkbox variables advisable to be reviewed" @@ -236,6 +240,8 @@ transform_checkboxes <- function(data, dic, event_form = NULL, checkbox_na = FAL checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ + lifecycle::deprecate_warn("1.0.0", "checkbox_names()", "rd_checkbox()") + correspondence <- NULL #Identify checkbox variables: @@ -253,18 +259,18 @@ checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ label <- gsub("\\)","",label) #Add rows with the name of all the variables for all the options - new_row <- dic %>% + new_row <- dic |> dplyr::filter(.data$field_name==names_trim[i]) #We have to repeat the original row n times (the length of svar_check) - new_row <- purrr::map_dfr(seq_len(length(svar_check)), ~new_row) %>% + new_row <- purrr::map_dfr(seq_len(length(svar_check)), ~new_row) |> dplyr::mutate( field_name=svar_check, field_label=label, choices_calculations_or_slider_labels=stringr::str_glue("0, {checkbox_labels[1]} | 1, {checkbox_labels[2]}")) - dic <- dic %>% - tibble::add_row(new_row, .before = which(dic$field_name==names_trim[i])) %>% + dic <- dic |> + tibble::add_row(new_row, .before = which(dic$field_name==names_trim[i])) |> #Remove the original checkbox variable that was present in the beginning dplyr::filter(!.data$field_name%in%names_trim[i]) @@ -294,7 +300,7 @@ checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ TRUE ~ names(data) ) - dic <- dic %>% + dic <- dic |> dplyr::mutate( field_name = dplyr::case_when( field_name == svar_check[j] ~ out[j], @@ -307,27 +313,27 @@ checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ # Transforming the branching logic that contain checkboxes correspondence <- as.data.frame(correspondence) - cats <- dic %>% - dplyr::select("field_name", "choices_calculations_or_slider_labels") %>% + cats <- dic |> + dplyr::select("field_name", "choices_calculations_or_slider_labels") |> dplyr::filter(.data$field_name %in% correspondence$out) - cats <- cats %>% - dplyr::mutate(choices_calculations_or_slider_labels = strsplit(.data$choices_calculations_or_slider_labels, "\\|")) %>% + cats <- cats |> + dplyr::mutate(choices_calculations_or_slider_labels = strsplit(.data$choices_calculations_or_slider_labels, "\\|")) |> tidyr::unnest(.data$choices_calculations_or_slider_labels) - cats <- cats %>% - tidyr::separate(.data$choices_calculations_or_slider_labels, c("num", "cat"), ", ", extra = "merge") %>% - dplyr::filter(.data$cat != "") %>% + cats <- cats |> + tidyr::separate(.data$choices_calculations_or_slider_labels, c("num", "cat"), ", ", extra = "merge") |> + dplyr::filter(.data$cat != "") |> dplyr::mutate(num = trimws(.data$num), cat = trimws(.data$cat)) cats <- merge(cats, correspondence, by.x = "field_name", by.y = "out") - cats <- cats %>% + cats <- cats |> dplyr::mutate(factor = paste0("[", .data$field_name, "]='", .data$cat, "'"), V1 = stringi::stri_replace_all_fixed(cats$V1, c("(", ")"), c("\\(", "\\)"), vectorize_all = F), redcap = paste0("\\[", .data$V1, "\\] ?=? ?'?", .data$num, "'?"), - redcap2 = paste0("\\[", .data$V1, "\\] ?? ?'?", .data$num, "'?")) %>% - dplyr::select(-"V1") %>% + redcap2 = paste0("\\[", .data$V1, "\\] ?? ?'?", .data$num, "'?")) |> + dplyr::select(-"V1") |> dplyr::arrange(dplyr::desc(.data$redcap)) replace <- cats$factor @@ -336,7 +342,7 @@ checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ replace2 <- cats$factor names(replace2) <- cats$redcap2 - dic <- dic %>% + dic <- dic |> dplyr::mutate(branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace), branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace2)) @@ -361,17 +367,19 @@ checkbox_names <- function(data, dic, labels, checkbox_labels = c("No", "Yes")){ split_event <- function(data,dic,event_form,which=NULL){ + lifecycle::deprecate_warn("1.0.0", "split_event()", "rd_split()") + #We create event-variable correspondence from the variables in the dictionary: - var_event <- event_form %>% - dplyr::select("form_name"="form","redcap_event_name"="unique_event_name") %>% - dplyr::right_join(dic[, c("form_name","field_name","field_type","branching_logic_show_field_only_if")], by = "form_name", multiple = "all") %>% + var_event <- event_form |> + dplyr::select("form_name"="form","redcap_event_name"="unique_event_name") |> + dplyr::right_join(dic[, c("form_name","field_name","field_type","branching_logic_show_field_only_if")], by = "form_name", multiple = "all") |> #Remove variables that are not in the database (the descriptive type) - dplyr::filter(.data$field_type!="descriptive", .data$field_name != "record_id") %>% - tibble::as_tibble() %>% + dplyr::filter(.data$field_type!="descriptive", .data$field_name != "record_id") |> + tibble::as_tibble() |> dplyr::select("redcap_event_name", "field_name") #Let's add the basic variables from redcap that are found in the data but not in the dictionary: - basic_redcap_vars <- c("record_id","redcap_event_name","redcap_repeat_instrument","redcap_repeat_instance","redcap_data_access_group","redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_survey_identifier") + basic_redcap_vars <- c("record_id","redcap_event_name","redcap_repeat_instrument","redcap_repeat_instrument.factor","redcap_repeat_instance","redcap_data_access_group","redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_survey_identifier") #It can happen that one of these variables are not in the database for some projects basic_redcap_vars <- basic_redcap_vars[basic_redcap_vars %in% names(data)] @@ -414,19 +422,19 @@ split_event <- function(data,dic,event_form,which=NULL){ list_events <- stats::na.exclude(unique(var_event$redcap_event_name)) - ndata <- tibble::tibble("events"=list_events) %>% + ndata <- tibble::tibble("events"=list_events) |> dplyr::mutate( vars = purrr::map( .data$events, - ~ var_event %>% - dplyr::filter(.data$redcap_event_name == .x) %>% + ~ var_event |> + dplyr::filter(.data$redcap_event_name == .x) |> dplyr::pull("field_name") ), df = purrr::map2( .data$events, .data$vars, - ~ data %>% - dplyr::filter(.data$redcap_event_name == .x) %>% + ~ data |> + dplyr::filter(.data$redcap_event_name == .x) |> dplyr::select(tidyselect::all_of(c(basic_redcap_vars, .y))) ) ) @@ -452,6 +460,8 @@ split_event <- function(data,dic,event_form,which=NULL){ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ + lifecycle::deprecate_warn("1.0.0", "split_form()", "rd_split()") + #Check if the project is longitudinal or not: longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) @@ -476,7 +486,7 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ #Previous to begin with the transformation let's find if there're the same variables in the data base than in the dictionary #But first we have to remove from the dictionary the descriptive variables that are found in the dictionary but not in the data - dic <- dic %>% + dic <- dic |> dplyr::filter(.data$field_type!="descriptive") vars_more <- dic$field_name[!dic$field_name%in%names(data)] @@ -509,48 +519,51 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ form <- unique(dic$form_name) if(longitudinal){ - ndata <- tibble::tibble("form"=form) %>% + ndata <- tibble::tibble("form"=form) |> dplyr::mutate( events = purrr::map(.data$form, ~ event_form$unique_event_name[event_form$form == .x]), vars = purrr::map(.data$form, ~ dic$field_name[dic$form_name == .x]) - ) %>% + ) |> #Collect variables from every event dplyr::mutate(df = purrr::map2( .data$events, .data$vars, - ~ data %>% - dplyr::filter(redcap_event_name %in% .x) %>% + ~ data |> + dplyr::filter(redcap_event_name %in% .x) |> dplyr::select(tidyselect::all_of(unique( c(basic_redcap_vars, .y) ))) )) }else{ - ndata <- tibble::tibble("form"=form) %>% + ndata <- tibble::tibble("form"=form) |> dplyr::mutate(vars = purrr::map(.data$form, ~dic$field_name[dic$form_name == .x]), #Add to vars the basic REDCap variables not found in the dictionary: vars = purrr::map(.data$vars, ~unique(c(basic_redcap_vars, .x))) - ) %>% + ) |> #Collect variables from every event - dplyr::mutate(df = purrr::map(.data$vars, ~ data %>% + dplyr::mutate(df = purrr::map(.data$vars, ~ data |> dplyr::select(tidyselect::all_of(unique(c(basic_redcap_vars, .x)))))) } if(repeat_instrument) { - form_check <- data %>% - dplyr::distinct(redcap_repeat_instrument, redcap_repeat_instrument.factor) + form_check <- data |> + dplyr::distinct(dplyr::pick(dplyr::contains("redcap_repeat_instrument"))) - ndata <- ndata %>% - dplyr::left_join(form_check, by = dplyr::join_by("form" == "redcap_repeat_instrument")) %>% - dplyr::relocate("form_factor" = "redcap_repeat_instrument.factor", .after = form) %>% + ndata <- ndata |> + dplyr::left_join(form_check, by = dplyr::join_by("form" == "redcap_repeat_instrument")) |> + dplyr::relocate("form_factor" = "redcap_repeat_instrument.factor", .after = form) |> dplyr::mutate(df = purrr::map2(.data$form_factor, .data$df, ~ { if (is.na(.x)) { - .y %>% - dplyr::filter(is.na(redcap_repeat_instrument.factor)) + .y |> + dplyr::filter(is.na(.data$redcap_repeat_instrument.factor)) |> + dplyr::select(-dplyr::starts_with("redcap_repeat_instrument")) } else { - .y %>% - dplyr::filter(redcap_repeat_instrument.factor == .x) + .y |> + dplyr::filter(.data$redcap_repeat_instrument.factor == .x) |> + dplyr::mutate(redcap_repeat_instrument = redcap_repeat_instrument.factor) |> + dplyr::select(-redcap_repeat_instrument.factor) } - })) %>% + })) |> dplyr::select(-"form_factor") } @@ -560,13 +573,13 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ #We will add it with the order that repeated measures happen for every patient. There will be a row for each record-id. - ndata <- ndata %>% + ndata <- ndata |> dplyr::mutate( - df = purrr::map2(.data$vars, .data$df, ~ .y %>% - dplyr::select(tidyselect::all_of(c("record_id", .x))) %>% - dplyr::group_by(.data$record_id) %>% - dplyr::mutate(id = 1:length(.data$record_id)) %>% - dplyr::ungroup() %>% + df = purrr::map2(.data$vars, .data$df, ~ .y |> + dplyr::select(tidyselect::all_of(c("record_id", .x))) |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate(id = 1:length(.data$record_id)) |> + dplyr::ungroup() |> tidyr::pivot_wider(names_from = "id", values_from = -c("record_id", "id")) ) ) @@ -597,10 +610,12 @@ split_form <- function(data, dic, event_form = NULL, which = NULL, wide=FALSE){ to_factor <- function(data, dic, exclude = NULL){ + lifecycle::deprecate_warn("1.0.0", "to_factor()", "rd_factor()") + #We need redcap_event_name to have the original values so we exclude of the conversion the variable redcap_event_name.factor. Also for redcap_data_access_group if present keep <- c("redcap_event_name.factor", "redcap_data_access_group.factor", "redcap_repeat_instrument.factor") - keep_factors <- data %>% + keep_factors <- data |> dplyr::select(keep[keep %in% names(data)]) data$redcap_event_name.factor <- NULL @@ -613,41 +628,41 @@ to_factor <- function(data, dic, exclude = NULL){ #Exclude those variables that we don't want to convert to factors factors <- factors[!factors %in% exclude] - data <- data %>% + data <- data |> #Assign to the non factor variable the factor one and remove the later - dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get(stringr::str_glue("{dplyr::cur_column()}.factor")))) %>% - dplyr::select(-tidyselect::ends_with(".factor")) %>% - tibble::add_column("redcap_event_name.factor" = keep_factors$redcap_event_name.factor, .after = "redcap_event_name") %>% + dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get(stringr::str_glue("{dplyr::cur_column()}.factor")))) |> + dplyr::select(-tidyselect::ends_with(".factor")) |> + tibble::add_column("redcap_event_name.factor" = keep_factors$redcap_event_name.factor, .after = "redcap_event_name") |> tibble::add_column("redcap_repeat_instrument.factor" = keep_factors$redcap_repeat_instrument.factor, .after = "redcap_repeat_instrument") if (length(factors) > 0) { # Transform branching logics in the dictionary for variables that are currently factors - cat_factors <- dic %>% - dplyr::select("field_name", "choices_calculations_or_slider_labels") %>% + cat_factors <- dic |> + dplyr::select("field_name", "choices_calculations_or_slider_labels") |> dplyr::filter(.data$field_name %in% factors) - cat_factors <- cat_factors %>% + cat_factors <- cat_factors |> dplyr::mutate( choices_calculations_or_slider_labels = strsplit(.data$choices_calculations_or_slider_labels, "\\|") - ) %>% + ) |> tidyr::unnest(.data$choices_calculations_or_slider_labels) - cat_factors <- cat_factors %>% + cat_factors <- cat_factors |> tidyr::separate(.data$choices_calculations_or_slider_labels, c("num", "cat"), ", ", - extra = "merge") %>% - dplyr::filter(.data$cat != "") %>% + extra = "merge") |> + dplyr::filter(.data$cat != "") |> dplyr::mutate(num = trimws(.data$num), cat = trimws(.data$cat)) - cat_factors <- cat_factors %>% + cat_factors <- cat_factors |> dplyr::mutate( redcap = paste0("\\[", .data$field_name, "\\] ?=? ?'?", .data$num, "'?"), redcap2 = paste0("\\[", .data$field_name, "\\] ?? ?'?", .data$num, "'?"), factor = paste0("[", .data$field_name, "]='", .data$cat, "'"), factor2 = paste0("[", .data$field_name, "]<>'", .data$cat, "'"), - ) %>% + ) |> dplyr::arrange(.data$field_name, dplyr::desc(.data$num)) replace <- cat_factors$factor @@ -656,7 +671,7 @@ to_factor <- function(data, dic, exclude = NULL){ replace2 <- cat_factors$factor2 names(replace2) <- cat_factors$redcap2 - dic <- dic %>% + dic <- dic |> dplyr::mutate(branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace), branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace2)) @@ -665,7 +680,7 @@ to_factor <- function(data, dic, exclude = NULL){ if("redcap_data_access_group" %in% names(data)){ - list(data = data %>% + list(data = data |> tibble::add_column("redcap_data_access_group.factor" = keep_factors$redcap_data_access_group.factor, .after = "redcap_data_access_group"), dic = dic) }else{ @@ -673,41 +688,3 @@ to_factor <- function(data, dic, exclude = NULL){ } } -#' Fill Rows with Values from One Event -#' @description -#' This function fills all rows in the dataset with the value of a particular variable in a specified event. It is an auxiliary function used in the `rd_rlogic` function. -#' @param which_event String specifying the name of the event. -#' @param which_var String specifying the name of the variable. -#' @param data Dataset containing the REDCap data. - -fill_data <- function(which_event, which_var, data){ - - if(which_event %in% data$redcap_event_name){ - - fill_values <- data %>% - dplyr::select("record_id", "redcap_event_name", tidyselect::all_of(which_var)) %>% - dplyr::rename(var = which_var) %>% - dplyr::group_by(.data$record_id) %>% - dplyr::mutate( - var = dplyr::case_when( - .data$redcap_event_name != which_event ~ NA, - TRUE ~ .data$var - ), - #Only the first value if the event is repeated - var = stats::na.exclude(unique(.data$var))[1] - ) %>% - tidyr::fill("var", .direction = "downup") %>% - dplyr::pull("var") - - data[,which_var] <- fill_values - - data - - }else{ - - stop("The logic can't be evaluated after the translation") - - } - -} - diff --git a/R/zzz.R b/R/zzz.R index 17d6aae..3a773fc 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,9 @@ +# -------------------------------------------------------------- +# All credits for this functionality go to the Tidyverse package +# GitHub: https://github.com/tidyverse +# -------------------------------------------------------------- + .onAttach <- function(...) { attached <- REDCapDM_attach() - inform_startup(REDCapDM_attach_message(attached)) + inform_startup(REDCapDM_attach_message(attached)) } diff --git a/README.md b/README.md index f88b3d7..d770adf 100644 --- a/README.md +++ b/README.md @@ -2,15 +2,14 @@ ======= -[![CRAN status](https://www.r-pkg.org/badges/version/REDCapDM)](https://cran.r-project.org/package=REDCapDM)    [![R-CMD-check](https://github.com/bruigtp/REDCapDM/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/bruigtp/REDCapDM/actions/workflows/R-CMD-check.yaml)    [![](https://cranlogs.r-pkg.org/badges/REDCapDM)](https://cran.r-project.org/package=REDCapDM)    [![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapDM)](https://cran.r-project.org/package=REDCapDM) +[![CRAN status](https://www.r-pkg.org/badges/version/REDCapDM)](https://cran.r-project.org/package=REDCapDM)    [![R-CMD-check](https://github.com/bruigtp/REDCapDM/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/bruigtp/REDCapDM/actions/workflows/R-CMD-check.yaml)    +[![Codecov test coverage](https://codecov.io/gh/bruigtp/REDCapDM/graph/badge.svg)](https://app.codecov.io/gh/bruigtp/REDCapDM) +[![](https://cranlogs.r-pkg.org/badges/REDCapDM)](https://cran.r-project.org/package=REDCapDM)    [![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapDM)](https://cran.r-project.org/package=REDCapDM) -`REDCapDM` is an R package that allows users to manage data exported directly from REDCap or through an API connection. This package includes several functions designed for preprocessing data, generating reports on queries like outliers or missing values, and performing a follow-up of each identified query. 'REDCap' (Research Electronic Data CAPture; ) is a web application developed at Vanderbilt University, designed for creating and managing online surveys and databases. The REDCap API serves as an interface allowing external applications to connect to REDCap remotely, and is used to programmatically retrieve or modify project data or settings within REDCap, such as importing or exporting data. - -The [REDCapDM website](https://bruigtp.github.io/REDCapDM/articles/REDCapDM.html) has a description of the package functions as well as access to the package vignettes. - -Here you can access the published article in BMC Medical Research Methodology: [REDCapDM: An R package with a set of data management tools for a REDCap project](https://doi.org/10.1186/s12874-024-02178-6) +The R package [**REDCapDM**](https://bruigtp.github.io/REDCapDM/articles/REDCapDM.html) has been developed with the objective of facilitating the management of data for projects using the REDCap platform. It is capable of supporting both direct data export and access via the REDCap API. REDCapDM offers a comprehensive variety of functions, including the ability to preprocess data, generate detailed query reports for issues such as outliers or missing values, and track the resolution of each identified query. +[**REDCap**](https://projectredcap.org) (Research Electronic Data CAPture) is a widely-used web application developed at Vanderbilt University for creating and managing online surveys and databases. It includes an API (Application Programming Interface) that serves as an interface allowing external applications to connect to REDCap remotely, and is used to programmatically retrieve or modify project data or settings within REDCap, such as importing or exporting data. ### Installation @@ -28,13 +27,50 @@ install.packages("remotes") # Run this line if the 'remotes' package isn't insta remotes::install_github("bruigtp/REDCapDM") ``` -## Getting help + +### Getting Started + +To learn more about the package’s functionality, visit the [**REDCapDM website**](https://bruigtp.github.io/REDCapDM/articles/REDCapDM.html). The site includes detailed descriptions of the package's functions and access to vignettes that demonstrate how to use REDCapDM effectively in your projects. + + +### Getting help If you encounter a clear bug, please file an issue with a minimal reproducible example on -[GitHub](https://github.com/bruigtp/REDCapDM/issues). +[**GitHub: Issues**](https://github.com/bruigtp/REDCapDM/issues). + + +### Published Work + +For an in-depth exploration of REDCapDM, refer to the published article in *BMC Medical Research Methodology*: +[**REDCapDM: An R package with a set of data management tools for a REDCap project**](https://doi.org/10.1186/s12874-024-02178-6) + +### Citation + +``` text +> citation("REDCapDM") + +To cite package ‘REDCapDM’ in publications use: + + Carmezim J, Satorra P, Peñafiel J, García E, Pallarès N, Santos N, Tebé C (2024). “REDCapDM: An R package with a + set of data management tools for a REDCap project.” _BMC Medical Research Methodology_, *24*(1), 55. + doi:10.1186/s12874-024-02178-6 . + +A BibTeX entry for LaTeX users is + + @Article{, + title = {REDCapDM: An R package with a set of data management tools for a REDCap project}, + author = {João Carmezim and Pau Satorra and Judith Peñafiel and Esther García and Natàlia Pallarès and Naiara Santos and Cristian Tebé}, + journal = {BMC Medical Research Methodology}, + year = {2024}, + volume = {24}, + number = {1}, + pages = {55}, + doi = {10.1186/s12874-024-02178-6}, + } +``` -## About +### About Package: REDCapDM diff --git a/REDCapDM.Rproj b/REDCapDM.Rproj index b9909b1..f2f0905 100644 --- a/REDCapDM.Rproj +++ b/REDCapDM.Rproj @@ -4,7 +4,7 @@ RestoreWorkspace: No SaveWorkspace: No AlwaysSaveHistory: No -EnableCodeIndexing: Yes +EnableCodeIndexing: No UseSpacesForTab: Yes NumSpacesForTab: 2 Encoding: UTF-8 @@ -19,3 +19,6 @@ BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace,vignette + +QuitChildProcessesOnExit: Yes +DisableExecuteRprofile: Yes diff --git a/man/REDCapDM-package.Rd b/man/REDCapDM-package.Rd index 39ffcbd..e6de934 100644 --- a/man/REDCapDM-package.Rd +++ b/man/REDCapDM-package.Rd @@ -1,37 +1,52 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/REDCapDM_PACKAGE.R +% Please edit documentation in R/REDCapDM-package.R \name{REDCapDM-package} \alias{REDCapDM-package} \alias{REDCapDM} -\title{Managing REDCap Data: The R package REDCapDM} +\title{Managing REDCap Data: The R package REDCapDM / REDCapDM: A Toolkit for Managing REDCap Data in R} \description{ -The REDCapDM package facilitates the importing of data from REDCap into R through either an API connection or directly from exported files. It includes a range of data processing and transformation functions, and supports the creation and management of queries to address any discrepancies or uncertainties within the dataset. - -REDCapDM functions: - -- `redcap_data`: reads data exported directly from REDCap or via an API connection. - -- `rd_transform`: processes the raw dataset. - -- `rd_rlogic`: translates REDCap logic into R logic. - -- `rd_insert_na`: manually inserts a missing value for specified variables using a filter. - -- `rd_query`: identifies discrepancies in the dataset (queries). - -- `rd_event`: identifies missing events in each record of the dataset. - -- `check_queries`: compares a current report of queries with an older one to determine which queries have been modified, which remain unchanged, and which are new. +The \strong{REDCapDM} package provides tools to import, process, and manage REDCap data within R. +It supports data retrieval through the REDCap API or directly from exported files and includes a robust +set of functions for data transformation, validation, and discrepancy management. Designed for efficient +workflow integration, \strong{REDCapDM} simplifies the handling of REDCap datasets, making it easier to ensure +data quality and consistency. + +Key Features: +\itemize{ +\item \strong{Flexible Data Import}: Import data directly from REDCap using API connections or process exported REDCap files. +\item \strong{Data Transformation}: Streamline the cleaning and preparation of raw datasets for analysis. +\item \strong{Query Management}: Identify and track data discrepancies, missing events, and manage resolution reports. +} -- `rd_export`: exports a report of identified queries to an .xlsx file. +Core Functions: +\itemize{ +\item \code{redcap_data}: Reads data exported from REDCap or retrieved through the REDCap API. +\item \code{rd_transform}: Processes raw REDCap datasets into a structured and analyzable format. +\itemize{ +\item \code{transform_dates}: Transform dates and datetimes variables. +\item \code{recalculate}: Recalculates REDCap calculated fields, compares them to originals, and reports discrepancies. +\item \code{to_factor}: Converts variables to factors and updates the dictionary's branching logic. +\item \code{rd_delete_vars}: Deletes specified or pattern-matched variables from the data and dictionary. +\item \code{transform_checkbox}: Transforms the names of REDCap checkbox variables and updates the branching logic in the dictionary. +\item \code{transform_dic}: Evaluates and transforms branching logic in the REDCap dictionary into R logic. +\item \code{rd_split}: Splits a REDCap dataset by form or event. +} +\item \code{rd_rlogic}: Converts REDCap branching and conditional logic into R-compatible expressions. +\item \code{rd_insert_na}: Inserts missing values into specified variables based on filters. +\item \code{rd_query}: Identifies discrepancies (queries) in the dataset for validation. +\item \code{rd_event}: Detects missing events in longitudinal datasets. +\item \code{check_queries}: Compares historical and current query reports to track changes and additions. +\item \code{rd_export}: Exports a summary report of identified queries to an Excel (.xlsx) file. +} } \examples{ \dontrun{ # Install REDCapDM from CRAN: -install.packages('REDCapR') +install.packages("REDCapDM") -# Install REDCapDM from GitHub: -remotes::install_github('bruigtp/REDCapDM') +# Install the latest version of REDCapDM from GitHub: +remotes::install_github("bruigtp/REDCapDM") } + } \keyword{internal} diff --git a/man/check_proj.Rd b/man/check_proj.Rd new file mode 100644 index 0000000..962f77e --- /dev/null +++ b/man/check_proj.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-suplement.R +\name{check_proj} +\alias{check_proj} +\title{Handle Project Arguments} +\usage{ +check_proj(project, data = NULL, dic = NULL, event_form = NULL) +} +\arguments{ +\item{project}{A list or object containing \code{data}, \code{dictionary}, and optionally \code{event_form} and \code{results}.} + +\item{data}{A data frame (optional) that may be overridden if provided in the \code{project} object.} + +\item{dic}{A data dictionary (optional) that may be overridden if provided in the \code{project} object.} + +\item{event_form}{An optional event-form object that may be overridden if provided in the \code{project}.} +} +\description{ +This helper function processes the \code{project} argument in the several other functions. +It extracts data, dictionary, event form, and results from the project object while handling +potential duplication and providing warnings when arguments are provided redundantly. +} diff --git a/man/check_queries.Rd b/man/check_queries.Rd index f280315..9c0c686 100644 --- a/man/check_queries.Rd +++ b/man/check_queries.Rd @@ -4,30 +4,43 @@ \alias{check_queries} \title{Check for Changes Between Two Query Reports} \usage{ -check_queries(old, new, report_title = NULL) +check_queries(old, new, report_title = NULL, return_viewer = TRUE) } \arguments{ -\item{old}{Previous version of the queries report.} +\item{old}{Dataframe containing the previous version of the query report.} -\item{new}{New version of the queries report. This object is used to determine the status of each query.} +\item{new}{Dataframe containing the new version of the query report.\cr +This is compared against the \code{old} report to determine query statuses.} -\item{report_title}{Character string specifying the title of the report.} +\item{report_title}{(Optional) A character string specifying the title for the generated report.\cr +If not provided, the default title will be "Comparison report".} + +\item{return_viewer}{logical, whether to return the HTML viewer (default TRUE)} } \value{ -A list consisting of a dataframe containing each individual query from both reports and a column showing the status of the queries (new, solved, miscorrected or pending) compared to the previous query report. In addition to this dataframe, there is also a summary of the total number of queries per category. +A list containing: +\item{queries}{A dataframe with all individual queries from both reports and a status column (\code{new}, \code{solved}, \code{pending}, or \code{miscorrected}).} +\item{results}{A styled HTML summary table showing the total number of queries in each status category.} } \description{ -This function compares an old report of queries with a new one. It allows you to identify which queries are new, which have been modified, and which remain unchanged. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +This function compares an old query report with a new one to identify the status of each query. +Queries are categorized as \code{new}, \code{solved}, \code{pending}, or \code{miscorrected}. +The function generates a detailed comparison dataframe and a summary report. } \examples{ # Example of a query data_old <- rd_query(covican, - variables = "copd", - expression = "is.na(x)", - event = "baseline_visit_arm_1") -data_new <- rbind(data_old$queries[1:5,], c("100-20",rep("abc",8))) + variables = "copd", + expression = "is.na(x)", + event = "baseline_visit_arm_1" +) +data_new <- rbind(data_old$queries[1:5, ], c("100-20", rep("abc", 8))) -# Control of queries -check <- check_queries(old = data_old$queries, - new = data_new) +# Compare the two query reports +check <- check_queries( + old = data_old$queries, + new = data_new +) } diff --git a/man/checkbox_names.Rd b/man/checkbox_names.Rd index 4fc592c..54b12fa 100644 --- a/man/checkbox_names.Rd +++ b/man/checkbox_names.Rd @@ -13,7 +13,7 @@ checkbox_names(data, dic, labels, checkbox_labels = c("No", "Yes")) \item{labels}{Named character vector with the names of the variables in the data and their corresponding REDCap labels.} -\item{checkbox_labels}{Character vector specifying the names for the two options of each checkbox variable. The default is `c('No', 'Yes')`.} +\item{checkbox_labels}{Character vector specifying the names for the two options of each checkbox variable. The default is \code{c('No', 'Yes')}.} } \description{ This function updates the names of checkboxes in the dataset and dictionary to reflect the names of their options. diff --git a/man/covican.Rd b/man/covican.Rd index 9b94a11..da1d007 100644 --- a/man/covican.Rd +++ b/man/covican.Rd @@ -6,31 +6,31 @@ \title{Subset of COVICAN's Database} \format{ A data frame with 342 rows and 56 columns - \describe{ - \item{record_id:}{Identifier of each record. This information does not match the real data.} - \item{redcap_event_name:}{Auto-generated name of the events} - \item{redcap_data_access_group:}{Auto-generated name of each center. This information does not match the real data.} - \item{inc_1:}{Inclusion criteria of 'Patients older than 18 years' (0 = No ; 1 = Yes)} - \item{inc_2:}{Inclusion criteria of 'Cancer patients' (0 = No ; 1 = Yes)} - \item{inc_3:}{Inclusion criteria of 'Diagnosed of COVID-19' (0 = No ; 1 = Yes)} - \item{exc_1:}{Exclusion criteria of 'Solid tumour remission >1 year' (0 = No ; 1 = Yes)} - \item{screening_fail_crit:}{Indicator of non-compliance with inclusion and exclusion criteria (0 = compliance ; 1 = non-compliance)} - \item{d_birth:}{Date of birth (y-m-d). This date does not correspond to the original.} - \item{d_admission:}{Date of first visit (y-m-d). This date does not correspond to the original.} - \item{age:}{Age in years} - \item{dm:}{Indicator of diabetes (0 = No ; 1 = Yes)} - \item{type_dm:}{Type of diabetes (1 = No complications ; 2 = End-organ diabetes-related disease)} - \item{copd:}{Indicator of chronic obstructive pulmonary disease (0 = No ; 1 = Yes)} - \item{fio2:}{Fraction of inspired oxygen in percentage} - \item{available_analytics:}{Indicator of blood test available (0 = No ; 1 = Yes)} - \item{potassium:}{Potassium in mmol/L} - \item{resp_rate:}{Respiratory rate in bpm} - \item{leuk_lymph:}{Indicator of leukemia or lymphoma (0 = No ; 1 = Yes)} - \item{acute_leuk:}{Indicator of acute leukemia (0 = No ; 1 = Yes)} - \item{type_underlying_disease[...]:}{Checkbox with the type of underlying disease (0 = Haematological cancer ; 1 = Solid tumour)} - \item{underlying_disease_hemato[...]:}{Checkbox with the type of underlying disease (1 = Acute myeloid leukemia ; 2 = Myelodysplastic syndrome ; 3 = Chronic myeloid leukaemia ; 4 = Acute lymphoblastic leukaemia ; 5 = Hodgkin lymphoma ; 6 = Non Hodgkin lymphoma ; 7 = Multiple myeloma ; 8 = Myelofibrosis ; 9 = Aplastic anaemia ; 10 = Chronic lymphocytic leukaemia ; 11 = Amyloidosis ; 12 = Other)} - \item{urine_culture:}{Indicator of urine culture: (0 = Not done ; 1 = Done)} - \item{[...].factor:}{Labels of the different variables} +\describe{ +\item{record_id:}{Identifier of each record. This information does not match the real data.} +\item{redcap_event_name:}{Auto-generated name of the events} +\item{redcap_data_access_group:}{Auto-generated name of each center. This information does not match the real data.} +\item{inc_1:}{Inclusion criteria of 'Patients older than 18 years' (0 = No ; 1 = Yes)} +\item{inc_2:}{Inclusion criteria of 'Cancer patients' (0 = No ; 1 = Yes)} +\item{inc_3:}{Inclusion criteria of 'Diagnosed of COVID-19' (0 = No ; 1 = Yes)} +\item{exc_1:}{Exclusion criteria of 'Solid tumour remission >1 year' (0 = No ; 1 = Yes)} +\item{screening_fail_crit:}{Indicator of non-compliance with inclusion and exclusion criteria (0 = compliance ; 1 = non-compliance)} +\item{d_birth:}{Date of birth (y-m-d). This date does not correspond to the original.} +\item{d_admission:}{Date of first visit (y-m-d). This date does not correspond to the original.} +\item{age:}{Age in years} +\item{dm:}{Indicator of diabetes (0 = No ; 1 = Yes)} +\item{type_dm:}{Type of diabetes (1 = No complications ; 2 = End-organ diabetes-related disease)} +\item{copd:}{Indicator of chronic obstructive pulmonary disease (0 = No ; 1 = Yes)} +\item{fio2:}{Fraction of inspired oxygen in percentage} +\item{available_analytics:}{Indicator of blood test available (0 = No ; 1 = Yes)} +\item{potassium:}{Potassium in mmol/L} +\item{resp_rate:}{Respiratory rate in bpm} +\item{leuk_lymph:}{Indicator of leukemia or lymphoma (0 = No ; 1 = Yes)} +\item{acute_leuk:}{Indicator of acute leukemia (0 = No ; 1 = Yes)} +\item{type_underlying_disease\link{...}:}{Checkbox with the type of underlying disease (0 = Haematological cancer ; 1 = Solid tumour)} +\item{underlying_disease_hemato\link{...}:}{Checkbox with the type of underlying disease (1 = Acute myeloid leukemia ; 2 = Myelodysplastic syndrome ; 3 = Chronic myeloid leukaemia ; 4 = Acute lymphoblastic leukaemia ; 5 = Hodgkin lymphoma ; 6 = Non Hodgkin lymphoma ; 7 = Multiple myeloma ; 8 = Myelofibrosis ; 9 = Aplastic anaemia ; 10 = Chronic lymphocytic leukaemia ; 11 = Amyloidosis ; 12 = Other)} +\item{urine_culture:}{Indicator of urine culture: (0 = Not done ; 1 = Done)} +\item{\link{...}.factor:}{Labels of the different variables} } } \usage{ @@ -40,7 +40,7 @@ data(covican) A random sample of the COVICAN study. An international, multicentre cohort study of cancer patients with COVID-19 to describe the epidemiology, risk factors, and clinical outcomes of co-infections and superinfections in onco-haematological patients with COVID-19. } \note{ -List with three data frames: the first one with the data, the second one with the dictionary (`codebook`) of the REDCap project and the last one with the instrument-event mappings of the REDCap project. +List with three data frames: the first one with the data, the second one with the dictionary (\code{codebook}) of the REDCap project and the last one with the instrument-event mappings of the REDCap project. } \references{ Gudiol, C., Durà-Miralles, X., Aguilar-Company, J., Hernández-Jiménez, P., Martínez-Cutillas, M., Fernandez-Avilés, F., Machado, M., Vázquez, L., Martín-Dávila, P., de Castro, N., Abdala, E., Sorli, L., Andermann, T. M., Márquez-Gómez, I., Morales, H., Gabilán, F., Ayaz, C. M., Kayaaslan, B., Aguilar-Guisado, M., Herrera, F. Royo-Cebrecos C, Peghin M, González-Rico C, Goikoetxea J, Salgueira S, Silva-Pinto A, Gutiérrez-Gutiérrez B, Cuellar S, Haidar G, Maluquer C, Marin M, Pallarès N, Carratalà J. (2021). Co-infections and superinfections complicating COVID-19 in cancer patients: A multicentre, international study. The Journal of infection, 83(3), 306–313. https://doi.org/10.1016/j.jinf.2021.07.014 diff --git a/man/figures/Thumbs.db b/man/figures/Thumbs.db index 8c40742e4e6c24a4f85983bf23955d4b0df1d7e7..0c684289dbd005a682b8cd53215791753de73e73 100644 GIT binary patch delta 33 mcmZoDXeii_!@_0|+L|izb8`{PEM~?Rn|V3@GlD3t&$ + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 0000000..5d88fc2 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 0000000..9bf21e7 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 0000000..db8d757 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/fill_data.Rd b/man/fill_data.Rd index 54aa4f9..03e7813 100644 --- a/man/fill_data.Rd +++ b/man/fill_data.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-transform.R +% Please edit documentation in R/utils-suplement.R \name{fill_data} \alias{fill_data} \title{Fill Rows with Values from One Event} @@ -14,5 +14,5 @@ fill_data(which_event, which_var, data) \item{data}{Dataset containing the REDCap data.} } \description{ -This function fills all rows in the dataset with the value of a particular variable in a specified event. It is an auxiliary function used in the `rd_rlogic` function. +This function fills all rows in the dataset with the value of a particular variable in a specified event. It is an auxiliary function used in the \code{rd_rlogic} function. } diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index 1f8f237..0000000 --- a/man/pipe.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-pipe.R -\name{\%>\%} -\alias{\%>\%} -\title{Pipe operator} -\usage{ -lhs \%>\% rhs -} -\arguments{ -\item{lhs}{A value or the magrittr placeholder.} - -\item{rhs}{A function call using the magrittr semantics.} -} -\value{ -The result of calling `rhs(lhs)`. -} -\description{ -See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -} -\keyword{internal} diff --git a/man/rd_checkbox.Rd b/man/rd_checkbox.Rd new file mode 100644 index 0000000..14b5609 --- /dev/null +++ b/man/rd_checkbox.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_checkbox.R +\name{rd_checkbox} +\alias{rd_checkbox} +\title{Transform Checkbox Variables in a REDCap Project} +\usage{ +rd_checkbox( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + checkbox_labels = c("No", "Yes"), + checkbox_na = FALSE, + checkbox_names = TRUE +) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} + +\item{checkbox_labels}{A character vector of length 2 specifying the labels to be used for the checkbox options. Defaults to \code{c("No", "Yes")}.} + +\item{checkbox_na}{Logical indicating whether to assign \code{NA} to checkbox fields when the branching logic condition is not satisfied. Defaults to \code{FALSE}.} + +\item{checkbox_names}{Logical indicating whether to rename the checkbox variables in the dataset and dictionary according to their label options. Defaults to \code{TRUE}.} +} +\value{ +A list containing the following elements: +\item{data}{The transformed dataset with checkbox variables updated.} +\item{dictionary}{The updated dictionary reflecting any changes made to the checkbox fields, including renamed variables.} +\item{event_form}{The event-form mapping (if provided).} +\item{results}{A summary of the transformation process, including any issues with branching logic or fields that need review.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function is used to convert checkbox variables in a REDCap dataset from their default categories (e.g., "Checked" and "Unchecked") to numeric values (0 and 1), and optionally, relabel and rename them according to user-defined options. It also evaluates branching logic for checkbox fields and adjusts the data and dictionary accordingly. +} +\details{ +This function is primarily used to process checkbox fields in a REDCap project. It performs the following: +\itemize{ +\item Converts checkbox variables in the dataset from text labels ("Checked" and "Unchecked") to numeric values (0 and 1), and then applies the specified labels. +\item Optionally renames the checkbox variables based on their labels (e.g., transforming variable names like \code{varname___1} to \code{varname_Yes}). +\item Optionally modifies the branching logic in the REDCap dictionary to reflect renamed checkbox options. +} +} +\note{ +\itemize{ +\item If \code{event_form} is not provided for a longitudinal project, the function may not be able to evaluate branching logic correctly. +} +} +\examples{ +# Example with a project object containing data and dictionary +results <- rd_checkbox(project = covican) + +# Example with custom labels for the checkboxes +results <- rd_checkbox( + data = covican$data, + dic = covican$dictionary, + checkbox_labels = c("No", "Yes") +) + +# Example without renaming checkbox fields +results <- rd_checkbox(covican, checkbox_names = FALSE) + +} diff --git a/man/rd_dates.Rd b/man/rd_dates.Rd new file mode 100644 index 0000000..1fabe8c --- /dev/null +++ b/man/rd_dates.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_dates.R +\name{rd_dates} +\alias{rd_dates} +\title{Transform Dates and Datetimes in REDCap Data} +\usage{ +rd_dates(project = NULL, data = NULL, dic = NULL, event_form = NULL) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +} +\value{ +A list containing the following elements: +\item{data}{The transformed dataset with date and datetime variables correctly formatted.} +\item{dictionary}{The original data dictionary passed to the function.} +\item{event_form}{The original event-form mapping passed to the function (if applicable).} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function processes and transforms date and datetime fields in a REDCap dataset. +It ensures proper handling of data, dictionary (metadata), and event-form mapping, +and applies labels to the dataset for better usability. +} +\details{ +The function performs the following tasks: +\itemize{ +\item Extracts date and datetime fields from the data dictionary using validation types +(\verb{date_*} and \verb{datetime_*}). +\item Converts these fields in the dataset to \code{Date} and \code{POSIXct} objects, respectively. +} +} +\examples{ + +# Example usage: +result <- rd_dates(data = covican$data, dic = covican$dictionary) + +result <- covican |> rd_dates() + +} diff --git a/man/rd_delete_vars.Rd b/man/rd_delete_vars.Rd new file mode 100644 index 0000000..6ca9f6d --- /dev/null +++ b/man/rd_delete_vars.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_delete_vars.R +\name{rd_delete_vars} +\alias{rd_delete_vars} +\title{Delete Variables from REDCap Data and Dictionary} +\usage{ +rd_delete_vars( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + vars = NULL, + pattern = NULL +) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, +typically the output of the \code{redcap_data} function. If provided, +it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, +including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. +Optional; defaults to \code{NULL} if not applicable.} + +\item{vars}{A character vector specifying variable names to delete from the dataset and dictionary. +These variables will be removed from both the \code{data} and \code{dic}.} + +\item{pattern}{A character vector of regular expression patterns. Variables matching these patterns +will be removed from the \code{data} and \code{dic}.} +} +\value{ +A list containing the following elements: +\item{data}{The updated dataset with specified variables removed.} +\item{dictionary}{The updated data dictionary with corresponding variables removed.} +\item{event_form}{The original event-form mapping passed to the function (if applicable).} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function removes variables from a REDCap dataset and its associated dictionary based on +specific variable names or patterns. It ensures consistency between the data and dictionary +while preserving labels. +} +\details{ +The function performs the following operations: +\itemize{ +\item Removes variables specified in the \code{vars} argument from both the dataset and dictionary. +\item Removes variables matching patterns provided in the \code{pattern} argument. +} +} +\examples{ +# Example usage: + +# Deleting specific variables +result <- rd_delete_vars(covican, + vars = c("potassium", "leuk_lymph") +) + +# Deleting variables based on patterns +result <- rd_delete_vars( + data = covican$data, + dic = covican$dictionary, + pattern = c("_complete$", "_other$") +) + +} diff --git a/man/rd_dictionary.Rd b/man/rd_dictionary.Rd new file mode 100644 index 0000000..d30fb9f --- /dev/null +++ b/man/rd_dictionary.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_dictionary.R +\name{rd_dictionary} +\alias{rd_dictionary} +\title{Transform the data dictionary and handle branching logic} +\usage{ +rd_dictionary(project = NULL, data = NULL, dic = NULL, event_form = NULL) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +} +\value{ +A list containing the following elements: +\item{data}{The original dataset, passed to the function.} +\item{dictionary}{The updated data dictionary, with modified branching logic.} +\item{event_form}{The original event-form mapping, passed to the function (if applicable).} +\item{results}{A string summarizing the results of the transformation process, including any variables with unconverted branching logic.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function updates the data dictionary by evaluating and transforming the branching logic expressions for each field in the dictionary. +It checks if any branching logic is present and attempts to convert it using the specified data, dictionary, and event-form mapping. +If there are any issues with the conversion, those fields are listed in the results. +} +\examples{ + +result <- covican |> rd_dictionary() + +print(result$results) + +} diff --git a/man/rd_event.Rd b/man/rd_event.Rd index 4f73233..f7d1646 100644 --- a/man/rd_event.Rd +++ b/man/rd_event.Rd @@ -2,12 +2,13 @@ % Please edit documentation in R/rd_event.R \name{rd_event} \alias{rd_event} -\title{Identification of Missing Event(s)} +\title{Identify Missing Events in REDCap Data} \usage{ rd_event( - ..., + project = NULL, data = NULL, dic = NULL, + event_form = NULL, event, filter = NA, query_name = NA, @@ -18,35 +19,52 @@ rd_event( ) } \arguments{ -\item{...}{List containing the data, dictionary and event mapping (if required) of the REDCap project. This should be the output of the `redcap_data` function.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} -\item{data}{Data frame containing the data read from REDCap. If the list is specified, this argument is not required.} +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} -\item{dic}{Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not required.} +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} -\item{event}{Character vector with the name of the REDCap event(s) to be analyzed.} +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} -\item{filter}{A filter to be applied to the dataset. This argument can be used to identify the missing events on a subset of the dataset.} +\item{event}{A character vector specifying the name(s) of the REDCap event(s) to analyze for missing records.} -\item{query_name}{Description of the query. It can be the same for all variables, or you can define a different one for each variable. By default, the function defines it as `The event [event] is missing' for each event`.} +\item{filter}{An optional filter to apply to the dataset. This can be used to identify missing events in a subset of the data.} -\item{addTo}{Data frame corresponding to a previous query data frame to which you can add the new query data frame. By default, the function always generates a new data frame without taking into account previous reports.} +\item{query_name}{A description of the query. Defaults to "The event (event_name) is missing" for each event if not provided.} -\item{report_title}{Character string specifying the title of the report.} +\item{addTo}{A data frame of previous query results to which new queries can be appended. If not provided, the function creates a new data frame.} -\item{report_zeros}{Logical. If `TRUE`, the function returns a report containing variables with zero queries.} +\item{report_title}{An optional title for the report.} -\item{link}{List of project information used to create a web link for each missing event.} +\item{report_zeros}{Logical; if \code{TRUE}, includes a report of variables without missing data.} + +\item{link}{A list containing project information used to generate links for each missing event. Requires \code{domain}, \code{redcap_version}, and \code{proj_id} keys.} } \value{ -A list with a data frame of 9 columns (10 columns if the link argument is specified) to help the user identify each missing event and a table with the total number of missing events per event analyzed. +A list with two elements: +\item{queries}{A data frame listing records with missing events, including metadata for each record.} +\item{results}{A summary table (HTML) showing the count of missing events for each analyzed event.} } \description{ -When working with a longitudinal REDCap project, the exported data has a structure where each row represents one event per record. However, by default REDCap does not export events for which there is no information available. -This function allows you to identify which records do not contain information about a particular event. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +This function identifies records in a REDCap longitudinal project that are missing specific events. +REDCap does not export events with no data by default, which can create challenges in verifying completeness. +This function provides insights into missing events, allowing you to identify which records do not contain information about a particular event. +} +\details{ +The function is designed to work with REDCap longitudinal projects, which may not include empty events in their exports. +By specifying the events of interest, users can quickly identify missing records for a specific event. +Filters can be applied to focus the analysis on specific subsets of the data. + +If project information (\code{link}) is provided, the output will include clickable URLs for each missing record. } \examples{ -example <- rd_event(covican, - event = "follow_up_visit_da_arm_1") -example +# Example usage with a REDCap dataset: +example <- covican |> rd_event(event = "follow_up_visit_da_arm_1") + +example$queries +example$results + } diff --git a/man/rd_export.Rd b/man/rd_export.Rd index 1ea7e41..e2faabe 100644 --- a/man/rd_export.Rd +++ b/man/rd_export.Rd @@ -2,10 +2,10 @@ % Please edit documentation in R/rd_export.R \name{rd_export} \alias{rd_export} -\title{Exporting Query Dataset} +\title{Export Queries to an Excel File} \usage{ rd_export( - ..., + project = NULL, queries = NULL, column = NULL, sheet_name = NULL, @@ -14,21 +14,38 @@ rd_export( ) } \arguments{ -\item{...}{List containing the data frame of queries. This list must be the output of the `rd_query` or `rd_event` functions.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} -\item{queries}{Data frame containing the identified queries. If the list is specified, this argument is not required.} +\item{queries}{A data frame containing the identified queries. If \code{...} is provided, this argument is ignored.} -\item{column}{Character element specifying the column containing the link for each query.} +\item{column}{A string specifying the column in the dataset that contains hyperlinks. If not specified, +hyperlinks will not be added unless a column named \code{Link} is detected.} -\item{sheet_name}{Character element specifying the sheet name of the resulting xlsx file.} +\item{sheet_name}{A string specifying the name of the sheet in the resulting \code{.xlsx} file. Defaults to \code{"Sheet1"}.} -\item{path}{Character element specifying the file path to save the xlsx file. If `NULL`, the file will be created in the current working directory.} +\item{path}{A string specifying the file path to save the \code{.xlsx} file. If \code{NULL}, the file is saved in the +current working directory with the name \code{example.xlsx}.} -\item{password}{String with the password to protect the worksheet and prevent others from making changes.} +\item{password}{An optional string to password-protect the worksheet, preventing unauthorized edits.} } \value{ -An .xlsx file containing all the queries and, if available, hyperlinks to each of them. +An \code{.xlsx} file saved to the specified path, containing the query data and hyperlinks if specified. } \description{ -This function exports a query report, generated using the `rd_query` or `rd_event` functions, to an .xlsx file. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function exports a query dataset, typically generated using \code{rd_query} or \code{rd_event}, into an \code{.xlsx} file. +It supports adding hyperlinks to specified columns and optional password protection for the worksheet. +} +\examples{ +\dontrun{ +# Export queries to an Excel file +rd_export( + queries = my_queries, + column = "Link", + sheet_name = "My Queries", + path = "queries.xlsx" +) +} + } diff --git a/man/rd_factor.Rd b/man/rd_factor.Rd new file mode 100644 index 0000000..bca8fd2 --- /dev/null +++ b/man/rd_factor.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_factor.R +\name{rd_factor} +\alias{rd_factor} +\title{Convert Variables to Factors in a REDCap Dataset} +\usage{ +rd_factor( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + exclude = NULL +) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} + +\item{exclude}{A character vector of variable names to exclude from being converted into factors.} +} +\value{ +A list containing: +\item{data}{The transformed dataset with factor variables applied.} +\item{dictionary}{The dictionary with updated branching logic for the transformed variables.} +\item{event_form}{The event-form mapping used (if provided).} +\item{results}{A string summarizing the changes made during the transformation.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function converts variables in a REDCap dataset that have associated \code{.factor} columns into actual factor variables, while also updating branching logic in the associated dictionary. + +It also allows for the exclusion of specific variables from being converted into factors. +} +\details{ +This function searches for columns in the data that have a \code{.factor} suffix (indicating that they can be converted into factors) and converts them into factors based on their labels. +The \code{exclude} argument allows you to specify which variables should not be converted. +The function also modifies the branching logic in the dictionary to reflect the changes made in the data. + +Variables with the names \code{redcap_event_name.factor} and \code{redcap_data_access_group.factor} are excluded from the conversion process to avoid altering event and access group information. +} +\examples{ +result <- REDCapDM::rd_factor(covican, exclude = c("available_analytics", "urine_culture")) + +transformed_data <- result$data + +} diff --git a/man/rd_insert_na.Rd b/man/rd_insert_na.Rd index d217cc9..4228fab 100644 --- a/man/rd_insert_na.Rd +++ b/man/rd_insert_na.Rd @@ -4,31 +4,49 @@ \alias{rd_insert_na} \title{Insert Missing Values Using a Filter} \usage{ -rd_insert_na(..., data = NULL, dic = NULL, event_form = NULL, vars, filter) +rd_insert_na( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + vars, + filter +) } \arguments{ -\item{...}{List containing the data, the dictionary and the event if it's needed. Should be the output of the function `redcap_data`.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} -\item{data}{Data frame containing data from REDCap. If the list is specified, this argument is not needed.} +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} -\item{dic}{Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not needed.} +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} -\item{event_form}{Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not needed.} +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} -\item{vars}{Character vector containing the names of the variables to be transformed.} +\item{vars}{A character vector with the names of the variables to be transformed.} -\item{filter}{Character vector containing the logic to be evaluated directly. If each logic is TRUE, the corresponding variable in `vars` is set to missing.} +\item{filter}{A character vector of logical expressions to evaluate. If the evaluation is \code{TRUE}, the corresponding variable in \code{vars} is set to \code{NA}.} } \value{ -Transformed data with the specified variables converted. +The modified data frame with the specified variables updated. } \description{ -This function allows you to manually insert a missing value into certain variables (`vars`) if the specified filter/s (`filter`) are satisfied. It's particularly useful for checkboxes without a gatekeeper question in the branching logic. Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +This function allows you to manually insert a missing value into certain variables (\code{vars}) if the specified filter/s (\code{filter}) are satisfied. +It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. +Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. } \examples{ + +# Example usage: table(is.na(covican$data$potassium)) -data <- rd_insert_na(covican, - vars = "potassium", - filter = "age < 65") + +data <- covican |> + rd_insert_na( + vars = "potassium", + filter = "age < 65" + ) + table(data$potassium) + } diff --git a/man/rd_query.Rd b/man/rd_query.Rd index 8cc84a7..3690c27 100644 --- a/man/rd_query.Rd +++ b/man/rd_query.Rd @@ -5,7 +5,7 @@ \title{Identification of Queries} \usage{ rd_query( - ..., + project = NULL, variables = NA, expression = NA, negate = FALSE, @@ -25,67 +25,77 @@ rd_query( ) } \arguments{ -\item{...}{List containing the data, dictionary and event mapping (if required) of the REDCap project. This should be the output of the `redcap_data` function.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} -\item{variables}{Character vector containing the names of the database variables to be checked.} +\item{variables}{A character vector containing the names of the variables to be checked for queries.} -\item{expression}{Character vector of expressions to apply to the selected variables.} +\item{expression}{A character vector of expressions to apply to the selected variables.} -\item{negate}{Logical value indicating whether the defined expression should be negated. Default value is `FALSE`.} +\item{negate}{A logical value indicating whether the defined expression should be negated. The default is \code{FALSE}, meaning the expression will be applied as is. If \code{TRUE}, the function will identify values that do \strong{not} meet the condition defined in \code{expression}.} -\item{event}{The name of the REDCap event to analyze. If there are events in your REDCap project, you should use this argument to name the event to which the defined variables belong.} +\item{event}{The name of the REDCap event to analyze. If your REDCap project includes multiple events, you should specify the event to which the variables belong. This is required if your dataset contains multiple events.} -\item{filter}{A filter to be applied to the dataset. For example, this argument can be used to apply the branching logic of a defined variable.} +\item{filter}{A character string specifying a filter to be applied to the dataset. This is useful for applying additional conditions, such as using branching logic or filtering based on a specific characteristic of the data (e.g., \code{filter = "available_analytics=='1'"}).} -\item{addTo}{Data frame corresponding to a previous query data frame to which you can add the new query data frame. By default, this function always creates a new data frame regardless previous reports.} +\item{addTo}{A data frame corresponding to a previous query data frame, to which the new query data frame will be appended. If not provided, the function will create a new data frame for each call. Use this argument to combine multiple queries into one report.} -\item{variables_names}{Character vector containing the description of each selected variable. By default, the function automatically takes the description of each variable from of the REDCap project dictionary.} +\item{variables_names}{A character vector containing the descriptions of each selected variable. By default, the function will pull these descriptions from the REDCap dictionary associated with the variables. You can specify custom descriptions if desired.} -\item{query_name}{Description of the query. It can be the same for all variables, or you can define a different one for each variable. By default, this function defines it as `The value is [value] and it should not be [expression]'`.} +\item{query_name}{A character string describing the query. By default, it uses the format \verb{The value is [value] and it should not be [expression]}. You can specify a custom query description for each variable if needed.} -\item{instrument}{REDCap instrument to which the variables belong. It can be the same for all variables, or you can define a different one for each variable. By default, the function automatically selects the corresponding instrument of each variable from the REDCap project dictionary.} +\item{instrument}{The REDCap instrument(s) that the variables belong to. This can be the same for all variables or you can define different instruments for each variable. By default, the function will retrieve the corresponding instrument from the REDCap dictionary.} -\item{report_title}{Character string specifying the title of the report.} +\item{report_title}{A character string specifying the title of the final report generated by the function.} -\item{report_zeros}{Logical. If `TRUE`, the function returns a report containing variables with zero queries.} +\item{report_zeros}{A logical value indicating whether queries with zero counts should be included in the report. Default is \code{FALSE}. Set it to \code{TRUE} to include variables with zero queries.} -\item{by_dag}{Logical. If `TRUE`, both elements of the output will be grouped by the Data Access Groups (DAGs) of the REDCap project.} +\item{by_dag}{A logical value indicating whether the results should be grouped by Data Access Groups (DAGs). Default is \code{FALSE}. Set to \code{TRUE} to split the results by DAG if applicable.} -\item{link}{List containing project information used to create a web link to each query.} +\item{link}{A list containing project information to create a web link for each query. This can be used to include clickable links to the REDCap project or other resources directly in the report. If not specified, no links will be included.} -\item{data}{Data frame containing the data read from REDCap. If the list is given, this argument is not required.} +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} -\item{dic}{Data frame containing the dictionary read from REDCap. If the list is given, this argument is not required.} +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} -\item{event_form}{Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not required.} +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} } \value{ -A list with a data frame of 9 columns (10 columns, if the link argument is specified) meant to help the user identify each query and a table with the total number of queries per variable. +A list containing: +\itemize{ +\item A data frame of 9 columns (10 columns if \code{link} is specified), providing detailed information on each identified query. +\item A table showing the total number of queries per variable. +} } \description{ -This function allows you to identify queries using a particular expression/filter. -It can be used to identify missing values or to identify values outside the lower and upper limits of a variable. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +This function allows you to identify queries based on a specific expression or filter. It is useful for detecting missing values or values that fall outside predefined lower or upper limits of a variable. +The function can also apply branching logic to variables, enabling targeted query identification in REDCap datasets. } \examples{ -# Missing values +# Example 1: Identifying missing values for multiple variables example <- rd_query(covican, - variables = c("copd", "age"), - expression = c("is.na(x)", "x \%in\% NA"), - event = "baseline_visit_arm_1") + variables = c("copd", "age"), + expression = c("is.na(x)", "x \%in\% NA"), + event = "baseline_visit_arm_1" +) example -# Expression +# Example 2: Identifying values greater than 20 for the 'age' variable example <- rd_query(covican, - variables="age", - expression="x>20", - event="baseline_visit_arm_1") + variables = "age", + expression = "x>20", + event = "baseline_visit_arm_1" +) example -# Using the filter argument +# Example 3: Identifying missing values for 'potassium' with a filter example <- rd_query(covican, - variables = "potassium", - expression = "is.na(x)", - event = "baseline_visit_arm_1", - filter = "available_analytics=='1'") + variables = "potassium", + expression = "is.na(x)", + event = "baseline_visit_arm_1", + filter = "available_analytics=='1'" +) example + } diff --git a/man/rd_recalculate.Rd b/man/rd_recalculate.Rd new file mode 100644 index 0000000..23074ab --- /dev/null +++ b/man/rd_recalculate.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_recalculate.R +\name{rd_recalculate} +\alias{rd_recalculate} +\title{Recalculate and Verify Calculated Fields in REDCap Data} +\usage{ +rd_recalculate( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + exclude_recalc = NULL +) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} + +\item{exclude_recalc}{(Optional) A character vector of field names to exclude from recalculation.} +} +\value{ +A list containing the following elements: +\item{data}{The updated dataset with recalculated fields (if applicable).} +\item{dictionary}{The updated dictionary with recalculated field entries (if applicable).} +\item{event_form}{The original event-form mapping passed to the function (if applicable).} +\item{results}{A string summarizing the results of the recalculation process.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function processes REDCap project data, recalculates fields defined as calculated fields in the dictionary, +and compares the recalculated values with the original ones. It also generates a report of discrepancies and +updates the dataset and dictionary with new calculated fields (if applicable). +} +\details{ +The function: +\itemize{ +\item Identifies calculated fields from the dictionary and evaluates the specified formulas. +\item Compares recalculated values with the original values. +\item Adds recalculated fields to the dataset, appending \verb{_recalc} to the original variable names. +\item Updates the dictionary to reflect the new variables. +\item Summarizes the number of calculated fields, discrepancies, and untranslated fields in a report. +} +} +\note{ +\itemize{ +\item Recalculation is only possible for single-event projects unless \code{event_form} is specified for longitudinal projects. +\item If branching logic is incomplete, poorly defined or contains smart-variables, recalculation may fail for some fields. +} +} +\examples{ + +# Example usage with individual arguments +results <- rd_recalculate( + data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form +) + +# Example usage with a project object, excluding variables from the recalculation +results <- covican |> + rd_recalculate(exclude_recalc = c("age", "screening_fail_crit")) + +} diff --git a/man/rd_rlogic.Rd b/man/rd_rlogic.Rd index 737cb27..139ffb6 100644 --- a/man/rd_rlogic.Rd +++ b/man/rd_rlogic.Rd @@ -4,29 +4,57 @@ \alias{rd_rlogic} \title{Translate REDCap Logic to R Logic} \usage{ -rd_rlogic(..., data = NULL, dic = NULL, event_form = NULL, logic, var) +rd_rlogic( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + logic, + var +) } \arguments{ -\item{...}{List containing the data, dictionary and event mapping (if applicable) of the REDCap project. This should be the output of the `redcap_data` function.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} -\item{data}{Data frame containing data from REDCap. If the list is specified, this argument is not required.} +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} -\item{dic}{Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not required.} +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} -\item{event_form}{Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not required.} +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} -\item{logic}{String containing logic in REDCap format.} +\item{logic}{SA string representing the logic in REDCap format (e.g., \code{"if([exc_1]='1' or [inc_1]='0', 1, 0)"}).} -\item{var}{String with the name of the variable containing the logic.} +\item{var}{A string containing the name of the variable that holds the logic. This is typically the outcome variable to which the logic applies.} } \value{ -List containing the logic in R format and its evaluation. +A list containing: +\itemize{ +\item \code{rlogic}: The translated REDCap logic in R format. +\item \code{eval}: The evaluation result of the R logic applied to the provided dataset. If applicable, the result is filtered by event-specific logic. +} } \description{ -This function allows you to convert REDCap logic into R logic. WARNING: Please note that if the REDCap logic involves smart variables, this function may not be able to transform it accurately. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +This function converts REDCap logic into R-compatible logic. The function processes common REDCap operators (such as \code{and}, \code{or}, \code{=}, \code{<}, \code{>}, etc.) and formats them into their R equivalents. It also handles event-specific logic in longitudinal REDCap projects. +Please note that this function may not be able to accurately transform REDCap logic involving smart variables or certain field types that require specialized handling. +} +\details{ +The function performs several transformations to convert the REDCap logic into R logic: +\itemize{ +\item It translates REDCap-specific operators (e.g., \code{=} to \code{==}, \code{and} to \code{&}, \code{or} to \code{|}). +\item It removes or replaces certain REDCap-specific syntax that does not directly translate to R (e.g., removing \code{true} values). +\item It handles event-specific variables and ensures that logic is correctly adjusted when the data has multiple events. +\item It also allows for handling of missing values by transforming empty strings (\code{''}) to \code{NA} in R. +} + +Please be aware that REDCap logic that references smart variables or involves complex field relationships might require manual intervention for an accurate translation. } \examples{ -rd_rlogic(covican, - logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", - var = "screening_fail_crit") +# Example: Translating a REDCap logic expression into R logic for the variable `screening_fail_crit` +covican |> + rd_rlogic( + logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", + var = "screening_fail_crit" + ) } diff --git a/man/rd_split.Rd b/man/rd_split.Rd new file mode 100644 index 0000000..4b2906d --- /dev/null +++ b/man/rd_split.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rd_split.R +\name{rd_split} +\alias{rd_split} +\title{Split a dataset by form or event based on the data dictionary} +\usage{ +rd_split( + project = NULL, + data = NULL, + dic = NULL, + event_form = NULL, + which = NULL, + by = "form", + wide = FALSE +) +} +\arguments{ +\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} + +\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} + +\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} + +\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} + +\item{which}{A character string specifying which form or event to return (optional). If not provided, all forms or events will be included.} + +\item{by}{A character string specifying the split criteria: "form" (default) or "event".} + +\item{wide}{A logical value indicating whether to return the data in wide format when splitting by form. Defaults to \code{FALSE}.} +} +\value{ +A list or a data frame, depending on the \code{which} and \code{wide} arguments: +\itemize{ +\item If \code{which} is specified, returns the dataset for that particular form or event. +\item If \code{wide} is \code{TRUE} (for form-based splitting), returns the data in wide format (repeated measures are expanded into columns). +\item If neither is specified, returns a list of data frames for each form or event. +} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This function splits the provided dataset into separate datasets by form or event, using the data dictionary to define the variables for each form or event. +It handles both longitudinal and non-longitudinal projects. +} +\examples{ + +# To separate data by form: +result <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_split(by = "form", wide = TRUE) + +print(result) + +# To separate data by event: +result <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_split(by = "event") + +print(result) + +} diff --git a/man/rd_transform.Rd b/man/rd_transform.Rd index 06dc9f8..fd11c6b 100644 --- a/man/rd_transform.Rd +++ b/man/rd_transform.Rd @@ -5,7 +5,7 @@ \title{Transformation of the Raw Data} \usage{ rd_transform( - ..., + project = NULL, data = NULL, dic = NULL, event_form = NULL, @@ -14,7 +14,7 @@ rd_transform( exclude_recalc = NULL, exclude_to_factor = NULL, delete_vars = NULL, - delete_pattern = c("_complete", "_timestamp"), + delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, @@ -22,7 +22,7 @@ rd_transform( ) } \arguments{ -\item{...}{Output of the `redcap_data` function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project.} +\item{project}{Output of the \code{redcap_data} function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project.} \item{data}{Data frame containing the data read from REDCap. If the list is specified, this argument is not necessary.} @@ -30,9 +30,9 @@ rd_transform( \item{event_form}{Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not necessary.} -\item{checkbox_labels}{Character vector with the names for the two options of every checkbox variable. Default is `c('No', 'Yes')`.} +\item{checkbox_labels}{Character vector with the names for the two options of every checkbox variable. Default is \code{c('No', 'Yes')}.} -\item{checkbox_na}{Logical indicating if checkboxes values with branching logic should be set to missing only when the branching logic is missing (`FALSE`), or also when the branching logic isn't satisfied (`TRUE`). The default is `FALSE`.} +\item{checkbox_na}{Logical indicating if checkboxes values with branching logic should be set to missing only when the branching logic is missing (\code{FALSE}), or also when the branching logic isn't satisfied (\code{TRUE}). The default is \code{FALSE}.} \item{exclude_recalc}{Character vector with the names of variables that should not be recalculated. Useful for projects with time-consuming recalculations of certain calculated fields.} @@ -40,21 +40,22 @@ rd_transform( \item{delete_vars}{Character vector specifying the variables to exclude.} -\item{delete_pattern}{Character vector specifying the regex pattern for variables to be excluded. By default, variables ending with `_complete` and `_timestamp` will be removed.} +\item{delete_pattern}{Character vector specifying the regex pattern for variables to be excluded. By default, variables ending with \verb{_complete} and \verb{_timestamp} will be removed.} -\item{final_format}{Character string indicating the final format of the data. Options are `raw`, `by_event` or `by_form`. `raw` (default) returns the transformed data in its original structure, `by_event` returns it as a nested data frame by event, and `by_form` returns it as a nested data frame by form.} +\item{final_format}{Character string indicating the final format of the data. Options are \code{raw}, \code{by_event} or \code{by_form}. \code{raw} (default) returns the transformed data in its original structure, \code{by_event} returns it as a nested data frame by event, and \code{by_form} returns it as a nested data frame by form.} -\item{which_event}{Character string indicating a specific event to return if the final format is `by_event`.} +\item{which_event}{Character string indicating a specific event to return if the final format is \code{by_event}.} -\item{which_form}{Character string indicating a specific form to return if the final format is `by_form`.} +\item{which_form}{Character string indicating a specific form to return if the final format is \code{by_form}.} -\item{wide}{Logical indicating if the data split by form (if selected) should be in a wide format (`TRUE`) or a long format (`FALSE`).} +\item{wide}{Logical indicating if the data split by form (if selected) should be in a wide format (\code{TRUE}) or a long format (\code{FALSE}).} } \value{ A list with the transformed dataset, dictionary, event_form, and the results of each transformation step. } \description{ -This function transforms the raw REDCap data read by the `redcap_data` function. It returns the transformed data and dictionary, along with a summary of the results of each step. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +This function transforms the raw REDCap data read by the \code{redcap_data} function. It returns the transformed data and dictionary, along with a summary of the results of each step. } \examples{ # Basic transformation @@ -62,6 +63,7 @@ rd_transform(covican) # For customization of checkbox labels (example) rd_transform(covican, - checkbox_labels = c("Not present", "Present")) + checkbox_labels = c("Not present", "Present") +) } diff --git a/man/recalculate.Rd b/man/recalculate.Rd index ed5fde9..f5428a4 100644 --- a/man/recalculate.Rd +++ b/man/recalculate.Rd @@ -18,5 +18,5 @@ recalculate(data, dic, event_form = NULL, exclude_recalc = NULL) \description{ This function recalculates each calculated field if the logic can be transcribed to R. Note that calculated fields containing smart-variables or variables from other events cannot be transcribed. -The function returns the dataset and dictionary with the recalculated variables appended (named as the original field plus `_recalc`), along with a summary table of the recalculation results. +The function returns the dataset and dictionary with the recalculated variables appended (named as the original field plus \verb{_recalc}), along with a summary table of the recalculation results. } diff --git a/man/redcap_data.Rd b/man/redcap_data.Rd index 0511a18..98ec2b2 100644 --- a/man/redcap_data.Rd +++ b/man/redcap_data.Rd @@ -15,57 +15,67 @@ redcap_data( ) } \arguments{ -\item{data_path}{Character string specifying the path of the R file from which the dataset will be read.} +\item{data_path}{Path to the exported R file for data import (if using exported files).} -\item{dic_path}{Character string with the path of the dictionary.} +\item{dic_path}{Path to the dictionary file (CSV or XLSX).} -\item{event_path}{Character string specifying the path of the file containing the correspondence between each event and each form (downloadable via the `Designate Instruments for My Events` tab within the `Project Setup` section of REDCap).} +\item{event_path}{Path to the event-form mapping file (CSV or XLSX) for longitudinal projects (downloadable via the \verb{Designate Instruments for My Events} tab within the \verb{Project Setup} section of REDCap).} -\item{uri}{The URI (Uniform Resource Identification) of the REDCap project.} +\item{uri}{The URI of the REDCap project (for API connection).} -\item{token}{Character vector containing the generated token.} +\item{token}{API token for REDCap project access.} -\item{filter_field}{Character vector specifying the fields of the REDCap project desired to be imported into R (via API connection only).} +\item{filter_field}{Fields to include in the import (API connection only).} -\item{survey_fields}{Logical indicating whether the function should download all the survey-related fields of the REDCap project (via API connection only).} +\item{survey_fields}{Logical indicating whether to include survey-related fields (API connection only).} } \value{ -A list containing the dataset and the dictionary of the REDCap project. If `event_path` is specified, it will also contain a third element with the correspondence of the events and forms of the project. +A list containing: +\itemize{ +\item \code{data}: Imported dataset. +\item \code{dictionary}: Variable dictionary. +\item \code{event_form} (if applicable): Event-form mapping for longitudinal projects. +} } \description{ -This function allows users to read datasets from a REDCap project into R for analysis, either by exporting the data or via an API connection. - -The REDCap API serves as an interface for communication with REDCap and the server without requiring interaction through the REDCap interface. - -[Important] To read exported data from REDCap, please follow these steps: - -- Use REDCap's 'Export Data' function. - -- Select the 'R Statistical Software' format. - -- REDCap will then generate two files: +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +This function reads datasets from a REDCap project into R for analysis. Data can be imported from REDCap exported files or via an API connection. - - A CSV file containing all observations of the REDCap project. - - - An R file with the necessary code to complete each variable's information and import them. +\strong{Options for data import:} +\itemize{ +\item \strong{Exported Data}: REDCap's \emph{Export Data} function generates files suitable for R import. +\item \strong{API Connection}: Use the REDCap API to directly pull data into R. +} -- Ensure these files, along with the dictionary and event-mapping, are in the same directory. +\strong{Steps for using exported data:} +\enumerate{ +\item Use the REDCap \emph{Export Data} function and choose \emph{R Statistical Software} format. +\item REDCap generates: +\itemize{ +\item A CSV file with observations. +\item An R script to format variables for import. +} +\item Ensure the exported files, dictionary, and event mapping (if any) are in the same directory. +} } \note{ -For further use of the package, it's recommended to use the `dic_path` argument to read the dictionary, as all other functions require it for proper functioning. +To use other package functions effectively, include the \code{dic_path} argument to load the project dictionary. } \examples{ \dontrun{ -# Exported files from REDCap - -dataset <- redcap_data(data_path = "C:/Users/username/example.r", - dic_path = "C:/Users/username/example_dictionary.csv", - event_path = "C:/Users/username/events.csv") +# Import using exported files -# API connection +dataset <- redcap_data( + data_path = "C:/Users/username/example.r", + dic_path = "C:/Users/username/example_dictionary.csv", + event_path = "C:/Users/username/events.csv" +) -dataset_api <- redcap_data(uri = "https://redcap.idibell.cat/api/", - token = "55E5C3D1E83213ADA2182A4BFDEA") # This token is fictitious +# Import using API +dataset_api <- redcap_data( + uri = "https://redcap.idibell.cat/api/", + token = "55E5C3D1E83213ADA2182A4BFDEA" +) # This token is fictitious } } diff --git a/man/round.Rd b/man/round.Rd new file mode 100644 index 0000000..103f0db --- /dev/null +++ b/man/round.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-suplement.R +\name{round} +\alias{round} +\title{Round Numbers to a Specified Number of Digits ----} +\usage{ +round(x, digits) +} +\arguments{ +\item{x}{A numeric vector to be rounded.} + +\item{digits}{Integer indicating the number of decimal places to round to.} +} +\value{ +A numeric vector rounded to the specified number of digits. +} +\description{ +This function rounds numeric values to the specified number of decimal digits, +mimicking the behavior of the base R \code{round()} function but implemented manually. +} +\examples{ +round(3.14159, 2) +round(c(-2.718, 3.14159), 1) + +} diff --git a/man/split_form.Rd b/man/split_form.Rd index 76b34fc..4860f6f 100644 --- a/man/split_form.Rd +++ b/man/split_form.Rd @@ -15,7 +15,7 @@ split_form(data, dic, event_form = NULL, which = NULL, wide = FALSE) \item{which}{Character string specifying a form if only data for that form is desired.} -\item{wide}{Logical indicating if the dataset should be returned in a wide format (`TRUE`) or long format (`FALSE`).} +\item{wide}{Logical indicating if the dataset should be returned in a wide format (\code{TRUE}) or long format (\code{FALSE}).} } \description{ This function generates a nested dataset containing only the variables associated with each form, using the provided data, dictionary, and event-form mapping. You can choose to return data for a specific form. diff --git a/man/to_factor.Rd b/man/to_factor.Rd index 0c122ba..6b28556 100644 --- a/man/to_factor.Rd +++ b/man/to_factor.Rd @@ -11,8 +11,8 @@ to_factor(data, dic, exclude = NULL) \item{dic}{Data frame containing the REDCap dictionary.} -\item{exclude}{Character vector specifying the names of variables that should not be converted to factors. If `NULL`, all variables will be converted.} +\item{exclude}{Character vector specifying the names of variables that should not be converted to factors. If \code{NULL}, all variables will be converted.} } \description{ -This function converts all variables in the dataset to factors, except those specified in the `exclude` parameter. +This function converts all variables in the dataset to factors, except those specified in the \code{exclude} parameter. } diff --git a/man/transform_checkboxes.Rd b/man/transform_checkboxes.Rd index 474adf6..b67c8a7 100644 --- a/man/transform_checkboxes.Rd +++ b/man/transform_checkboxes.Rd @@ -13,10 +13,10 @@ transform_checkboxes(data, dic, event_form = NULL, checkbox_na = FALSE) \item{event_form}{Data frame containing the correspondence of each event with each form.} -\item{checkbox_na}{Logical indicating if values of checkboxes with branching logic should be set to missing only when the branching logic is missing (`FALSE`), or also when the branching logic is not satisfied (`TRUE`). The default is `FALSE`.} +\item{checkbox_na}{Logical indicating if values of checkboxes with branching logic should be set to missing only when the branching logic is missing (\code{FALSE}), or also when the branching logic is not satisfied (\code{TRUE}). The default is \code{FALSE}.} } \description{ -This function inspects all the checkboxes in the study to determine if they have a branching logic. If a branching logic is present and its result is missing, the function will input a missing value into the checkbox. If `checkbox_na` is `TRUE`, the function will additionally input a missing value when the branching logic isn't satisfied, not just when it is missing. If a branching logic cannot be found or the logic cannot be transcribed due to the presence of smart variables, the variable is added to a list of reviewable variables that will be printed. +This function inspects all the checkboxes in the study to determine if they have a branching logic. If a branching logic is present and its result is missing, the function will input a missing value into the checkbox. If \code{checkbox_na} is \code{TRUE}, the function will additionally input a missing value when the branching logic isn't satisfied, not just when it is missing. If a branching logic cannot be found or the logic cannot be transcribed due to the presence of smart variables, the variable is added to a list of reviewable variables that will be printed. The function returns the dataset with the transformed checkboxes and a table summarizing the results. } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..147f357 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(REDCapDM) + +test_check("REDCapDM") diff --git a/tests/testthat/test-check_queries.R b/tests/testthat/test-check_queries.R new file mode 100644 index 0000000..806cca4 --- /dev/null +++ b/tests/testthat/test-check_queries.R @@ -0,0 +1,72 @@ +test_that("check_queries validates inputs with covican", { + expect_error(check_queries(old = "not a df", new = covican$data), "must be a data frame") + expect_error(check_queries(old = covican$data, new = "nope"), "must be a data frame") + expect_error(check_queries( + old = covican$data[1:5, ], + new = covican$data[1:5, ], + report_title = c("a", "b")), + "more than one title" + ) +}) + +test_that("check_queries detects Pending, Solved, New and Miscorrected with covican", { + # Old query report: record_id A (pending), record_id B (solved) + old <- data.frame( + Identifier = c("100-6", "100-13"), + Description = c("age", "potassium"), + Query = c("age out of range", "potassium missing"), + Code = c("100-6-1", "100-13-1"), + stringsAsFactors = FALSE + ) + + # New query report: + # - 100-6 still has same query -> Pending + # - 100-13 missing -> Solved + # - 100-20 new -> New + # - 100-21 has two different queries -> Miscorrected + new <- data.frame( + Identifier = c("100-6", "100-20", "100-21", "100-21"), + Description = c("age", "dm", "fio2", "fio2"), + Query = c("age out of range", "dm missing", "fio2 invalid", "fio2 not recorded"), + stringsAsFactors = FALSE + # Code intentionally missing + ) + + res <- check_queries(old = old, new = new) + qdf <- res$queries + + # Ensure expected modification categories exist + expect_true(all(c("Pending", "Solved", "Miscorrected", "New") %in% levels(qdf$Modification))) + + counts <- table(as.character(qdf$Modification), useNA = "ifany") + + # Pending: 100-6 + expect_equal(as.integer(counts["Pending"]), 1L) + # Solved: 100-13 + expect_equal(as.integer(counts["Solved"]), 1L) + # New: 100-20 + expect_equal(as.integer(counts["New"]), 1L) + # Miscorrected: 100-21 has 2 queries + expect_equal(as.integer(counts["Miscorrected"]), 2L) +}) + +test_that("check_queries preserves Code creation and returns results viewer with covican", { + old <- data.frame( + Identifier = c("200-1", "200-2"), + Description = c("dm", "copd"), + Query = c("dm missing", "copd missing"), + Code = c("200-1-1", "200-2-1"), + stringsAsFactors = FALSE + ) + + new <- old[1, , drop = FALSE] # only first row remains, second should be Solved + + out <- check_queries(old, new) + + expect_true(is.list(out)) + expect_true("queries" %in% names(out)) + expect_true("results" %in% names(out)) + expect_true("Code" %in% names(out$queries)) + expect_true(is.character(out$queries$Code)) +}) + diff --git a/tests/testthat/test-rd_checkbox.R b/tests/testthat/test-rd_checkbox.R new file mode 100644 index 0000000..5b5c195 --- /dev/null +++ b/tests/testthat/test-rd_checkbox.R @@ -0,0 +1,79 @@ +test_that("rd_checkbox converts checkbox variables to factors with specified labels", { + result <- rd_checkbox(covican, checkbox_labels = c("No", "Yes")) + + # Check one checkbox variable as example + expect_true(is.factor(result$data$inc_1.factor)) + expect_true(all(levels(result$data$inc_1.factor) == c("No", "Yes"))) + + # Check another checkbox + expect_true(is.factor(result$data$type_underlying_disease_haematological_cancer)) + expect_true(all(levels(result$data$type_underlying_disease_haematological_cancer) == c("No", "Yes"))) +}) + +test_that("rd_checkbox renames checkbox variables when checkbox_names = TRUE", { + result <- rd_checkbox(covican, checkbox_labels = c("No", "Yes"), checkbox_names = TRUE) + + # Check that new variable names exist (for one example) + expect_true(any(grepl("underlying_disease_hemato_myelofibrosis", names(result$data)))) + expect_true(all(levels(result$data$underlying_disease_hemato_myelofibrosis) == c("No", "Yes"))) +}) + +test_that("rd_checkbox keeps original names when checkbox_names = FALSE", { + result <- rd_checkbox(covican, checkbox_labels = c("No", "Yes"), checkbox_names = FALSE) + + expect_true(any(grepl("___", names(result$data)))) +}) + +test_that("checkbox_na applies NAs according to branching logic", { + # Pick one checkbox with branching logic + result <- rd_checkbox(covican, checkbox_na = TRUE) + + # Check that rows violating the branching logic are NA + vals <- result$data |> + dplyr::filter(is.na(type_underlying_disease_haematological_cancer)) |> + dplyr::select(type_underlying_disease_haematological_cancer, underlying_disease_hemato_acute_lymphoblastic_leukaemia) |> + dplyr::mutate(check = is.na(type_underlying_disease_haematological_cancer) & is.na( underlying_disease_hemato_acute_lymphoblastic_leukaemia)) + + expect_true(all(vals$check)) +}) + +test_that("long checkbox labels are truncated to 60 characters", { + long_label <- paste(rep("X", 70), collapse = "") + covican_test <- covican + covican_test$data$long_checkbox___1 <- 1 + covican_test$dictionary <- covican$dictionary |> tibble::add_row( + field_name = "long_checkbox", + field_type = "checkbox", + field_label = long_label, + choices_calculations_or_slider_labels = "0, No | 1, Yes", + .before = 1 + ) + + result <- rd_checkbox(data = covican_test$data, dic = covican_test$dictionary) |> suppressWarnings() + expect_true(all(nchar(names(result$data)) <= 60)) +}) + + +test_that("function warns about repeated instruments", { + covican_test <- covican + covican_test$data$redcap_repeat_instrument <- rep("some_form", nrow(covican_test$data)) + + expect_warning( + rd_checkbox(data = covican_test$data, dic = covican_test$dictionary, event_form = covican$event_form), + "repeated instruments" + ) +}) + +test_that("running rd_checkbox twice cannot be done", { + result1 <- rd_checkbox(covican) + + expect_error(rd_checkbox(result1), "No checkbox fields found in the data") +}) + +test_that("non-checkbox fields remain unchanged", { + result <- rd_checkbox(covican) + + expect_equal(result$data$age, covican$data$age) + expect_equal(result$data$potassium, covican$data$potassium) +}) + diff --git a/tests/testthat/test-rd_dates.R b/tests/testthat/test-rd_dates.R new file mode 100644 index 0000000..0bd56f3 --- /dev/null +++ b/tests/testthat/test-rd_dates.R @@ -0,0 +1,89 @@ +# Sample data dictionary +dic <- tibble( + field_name = c("dob", "appointment"), + text_validation_type_or_show_slider_number = c("date_dmy", "datetime_dmyhm") +) + +# Sample dataset +data <- tibble( + dob = c("1990-01-01", "2000-12-31", ""), + appointment = c("2025-09-12 14:30", "2025-09-13 09:00", "") +) + +# Sample event-form mapping +event_form <- list(baseline = "form1", followup = "form2") + +# Add labels +data <- data |> + set_variable_labels(dob = "Date of Birth", appointment = "Appointment DateTime") + +test_that("rd_dates converts character dates and datetimes correctly", { + res <- rd_dates(data = data, dic = dic, event_form = event_form) + + # Check class + expect_s3_class(res$data$dob, "Date") + expect_s3_class(res$data$appointment, "POSIXct") + + # Check NA conversion + expect_true(is.na(res$data$dob[3])) + expect_true(is.na(res$data$appointment[3])) + + # Labels preserved + expect_equal(var_label(res$data$dob), "Date of Birth") + expect_equal(var_label(res$data$appointment), "Appointment DateTime") + + # Event form preserved + expect_equal(res$event_form, event_form) +}) + +test_that("rd_dates warns if all dates/datetimes are already correct", { + # Convert manually to correct classes + data_correct <- data |> + mutate(dob = as.Date(dob), + appointment = as.POSIXct(appointment, format = "%Y-%m-%d %H:%M", tz = "UTC")) + + expect_warning( + rd_dates(data = data_correct, dic = dic), + "All date and datetime variables are already in the correct format" + ) +}) + +test_that("rd_dates stops if data or dic is missing", { + expect_error(rd_dates(data = NULL, dic = dic), + "Both `data` and `dic`.*must be provided") + expect_error(rd_dates(data = data, dic = NULL), + "Both `data` and `dic`.*must be provided") +}) + +test_that("rd_dates handles empty input gracefully", { + empty_data <- tibble(dob = character(), appointment = character()) + empty_dic <- tibble(field_name = character(), text_validation_type_or_show_slider_number = character()) + + res <- rd_dates(data = empty_data, dic = empty_dic) |> suppressWarnings() + + expect_equal(nrow(res$data), 0) + expect_equal(ncol(res$data), 2) +}) + +test_that("rd_dates converts only necessary variables", { + data_mixed <- data |> + mutate( + dob = as.Date(dob), # already correct + appointment = appointment # still character + ) + + res <- rd_dates(data = data_mixed, dic = dic) + + expect_s3_class(res$data$dob, "Date") + expect_s3_class(res$data$appointment, "POSIXct") +}) + +test_that("rd_dates preserves labels correctly", { + unlabeled_data <- data + attr(unlabeled_data$dob, "label") <- NULL + + res <- rd_dates(data = unlabeled_data, dic = dic) + + expect_equal(var_label(res$data$appointment), "Appointment DateTime") + expect_equal(var_label(res$data$dob), "") # unlabeled stays empty +}) diff --git a/tests/testthat/test-rd_delete_vars.R b/tests/testthat/test-rd_delete_vars.R new file mode 100644 index 0000000..0fc34d1 --- /dev/null +++ b/tests/testthat/test-rd_delete_vars.R @@ -0,0 +1,73 @@ +test_that("rd_delete_vars removes specified vars and updates dictionary in covican", { + out <- rd_delete_vars( + data = covican$data, + dic = covican$dictionary, + vars = c("potassium") + ) + + expect_false("potassium" %in% names(out$data)) + expect_false("potassium" %in% out$dictionary$field_name) + # label for a remaining variable is preserved + expect_equal(attr(out$data$leuk_lymph, "label"), "Leukaemia or Lymphoma (include myeloma)") +}) + +test_that("rd_delete_vars removes by pattern and dictionary updated in covican", { + out <- rd_delete_vars( + data = covican$data, + dic = covican$dictionary, + pattern = c("_factor$", "_complete$") + ) + + # factor/complete variables should be gone + expect_false(any(grepl("_factor$|_complete$", names(out$data)))) + expect_false(any(grepl("_factor$|_complete$", out$dictionary$field_name))) + + # original variable still present with label + expect_true("dm" %in% names(out$data)) + expect_equal(attr(out$data$dm, "label"), "Diabetes (treated with insulin or antidiabetic oral drugs)") +}) + +test_that("rd_delete_vars errors if var not present in covican", { + expect_error( + rd_delete_vars( + data = covican$data, + dic = covican$dictionary, + vars = c("missing_var") + ), + "The following variables are not present in the dataset" + ) +}) + +test_that("rd_delete_vars warns about factor-suffixed columns in covican", { + # artificially add a factor-suffixed column to mimic REDCap conversion + df <- covican$data + df[["copd.factor"]] <- covican$data$copd.factor + + dic <- covican$dictionary + dic <- rbind(dic, tibble::tibble( + field_name = "copd.factor", + form_name = "comorbidities", + section_header = "", + field_type = "text", + field_label = "COPD factor", + choices_calculations_or_slider_labels = "", + field_note = "", + text_validation_type_or_show_slider_number = "", + text_validation_min = "", + text_validation_max = "", + identifier = "", + branching_logic_show_field_only_if = "", + required_field = "", + custom_alignment = "", + question_number_surveys_only = "", + matrix_group_name = "", + matrix_ranking = "", + field_annotation = "" + )) + + expect_warning( + rd_delete_vars(data = df, dic = dic, pattern = c("^copd$")), + "The dataset contains factor versions of variables matching the specified patterns" + ) +}) + diff --git a/tests/testthat/test-rd_dic.R b/tests/testthat/test-rd_dic.R new file mode 100644 index 0000000..bb14c48 --- /dev/null +++ b/tests/testthat/test-rd_dic.R @@ -0,0 +1,119 @@ +test_that("Error if data or dic missing", { + expect_error(rd_dictionary(data = NULL, dic = covican$dictionary), + "Both `data` and `dic`") + expect_error(rd_dictionary(data = covican$data, dic = NULL), + "Both `data` and `dic`") +}) + +test_that("Returns correct list structure with covican", { + result <- rd_dictionary(data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form) + + expect_true(all(c("data", "dictionary", "event_form") %in% names(result))) + expect_s3_class(result$data, "data.frame") + expect_s3_class(result$dictionary, "data.frame") + expect_s3_class(result$event_form, "data.frame") +}) + +test_that("Factor variables are correctly transformed in branching logic", { + dic <- covican$dictionary + data <- covican$data + + # Force one branching logic for testing (simulate REDCap condition) + dic$branching_logic_show_field_only_if[2] <- "[inc_1]='1'" + + result <- rd_dictionary(data = data, dic = dic, event_form = covican$event_form) + + expect_true(grepl("\\inc_1\\=='1'", + result$dictionary$branching_logic_show_field_only_if[2])) +}) + +test_that("Handles failed branching logic gracefully", { + dic <- covican$dictionary + dic$branching_logic_show_field_only_if[5] <- "FAIL_logic" + dic$choices_calculations_or_slider_labels[5] <- "FAIL_calc" + + result <- rd_dictionary(data = covican$data, dic = dic, event_form = covican$event_form) + + expect_true(any(grepl("exc_1", result$results))) +}) + +test_that("Event form is preserved", { + result <- rd_dictionary(data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form) + + expect_equal(result$event_form, covican$event_form) +}) + +test_that("Dictionary replacements are applied consistently", { + dic <- covican$dictionary + data <- covican$data + + dic$branching_logic_show_field_only_if[3] <- "[inc_2]='0'" + dic$branching_logic_show_field_only_if[4] <- "[dm]='1'" + + result <- rd_dictionary(data = data, dic = dic, event_form = covican$event_form) + + expect_true(all(grepl("data$|==", + result$dictionary$branching_logic_show_field_only_if[3:4]))) +}) + +test_that("Handles case when no factor variables exist", { + data <- covican$data + dic <- covican$dictionary + + # Drop factor variables + data[] <- lapply(data, function(x) if (is.factor(x)) as.character(x) else x) + + result <- rd_dictionary(data = data, dic = dic, event_form = covican$event_form) + + expect_s3_class(result$dictionary, "data.frame") + expect_equal(nrow(result$dictionary), nrow(dic)) +}) + +test_that("Correctly transforms branching logic with multiple factors", { + dic <- covican$dictionary + dic$branching_logic_show_field_only_if[2] <- "[inc_1]='1' and [dm]='1'" + + result <- rd_dictionary(data = covican$data, dic = dic, event_form = covican$event_form) + + logic <- result$dictionary$branching_logic_show_field_only_if[2] + expect_true(grepl("data\\$inc_1=='1'", logic)) + expect_true(grepl("data\\$dm=='1'", logic)) +}) + + +test_that("Calculation fields are transformed if valid", { + dic <- covican$dictionary + dic$field_type[2] <- "calc" + dic$choices_calculations_or_slider_labels[2] <- "[age] + 1" + + result <- rd_dictionary(data = covican$data, dic = dic, event_form = covican$event_form) + + calc <- result$dictionary$choices_calculations_or_slider_labels[2] + expect_false(grepl("FAIL", calc)) +}) + + +test_that("Output list has no NULL elements", { + result <- rd_dictionary(data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form) + + expect_false(any(vapply(result, is.null, logical(1)))) +}) + + +test_that("Works with project-style input (list)", { + project <- list( + data = covican$data, + dictionary = covican$dictionary, + event_form = covican$event_form + ) + + result <- rd_dictionary(project) + + expect_true(all(c("data", "dictionary", "event_form") %in% names(result))) +}) diff --git a/tests/testthat/test-rd_event.R b/tests/testthat/test-rd_event.R new file mode 100644 index 0000000..1798f4e --- /dev/null +++ b/tests/testthat/test-rd_event.R @@ -0,0 +1,98 @@ +test_that("rd_event finds missing events in covican", { + d0 <- covican$data + + # remove one follow-up event intentionally for a record + exported <- d0[d0$record_id != "100-6" | d0$redcap_event_name != "follow_up_visit_da_arm_1", ] + + res <- rd_event( + data = exported, + dic = covican$dictionary, + event = "follow_up_visit_da_arm_1" + ) + + expect_type(res, "list") + expect_true("queries" %in% names(res)) + + q <- res$queries + # all queries should correspond to missing follow-up + expect_true(all(q$Event == "follow_up_visit_da_arm_1")) +}) + +test_that("filter argument works and returns messages for empty filters in covican", { + d0 <- covican$data + # filter siteA equivalent → here use hospital_11 + res <- rd_event( + data = d0, + dic = covican$dictionary, + event = c("baseline_visit_arm_1", "follow_up_visit_da_arm_1"), + filter = "redcap_data_access_group == 'hospital_11'" + ) |> + suppressMessages() + + expect_type(res, "list") + expect_true("queries" %in% names(res)) +}) + +test_that("link generation works when link info provided in covican", { + d0 <- covican$data + link <- list(domain = "example.com", redcap_version = "12.0.0", proj_id = "99") + + # ask for an event not present in data + expect_error( + rd_event( + data = d0, + dic = covican$dictionary, + event = "no_event", + link = link + ) + ) +}) + +test_that("addTo merging works when addTo is provided as list(queries=...) in covican", { + d0 <- covican$data + exported <- d0[d0$record_id %in% c("100-6", "100-13"), ] # restrict to a few rows + + res1 <- rd_event( + data = exported, + dic = covican$dictionary, + event = "follow_up_visit_da_arm_1" + ) |> + suppressMessages() + + prev <- data.frame( + Identifier = "110-10", + DAG = "-", + Event = "follow_up_visit_da_arm_1", + Instrument = "-", + Field = "-", + Repetition = "-", + Description = "Follow-up", + Query = "old", + Code = "X1-1", + Link = NA_character_, + stringsAsFactors = FALSE + ) + + res2 <- rd_event( + data = exported, + dic = covican$dictionary, + event = "follow_up_visit_da_arm_1", + addTo = list(queries = prev) + ) + + expect_true("queries" %in% names(res2)) + expect_true(nrow(res2$queries) >= nrow(prev)) +}) + +test_that("report_zeros toggles presence of zero lines in covican", { + d0 <- covican$data + + # ask for a valid + invalid event + expect_error( + rd_event( + data = d0, + dic = covican$dictionary, + event = c("baseline_visit_arm_1", "some_missing_event") + ) + ) +}) diff --git a/tests/testthat/test-rd_export.R b/tests/testthat/test-rd_export.R new file mode 100644 index 0000000..0850bd5 --- /dev/null +++ b/tests/testthat/test-rd_export.R @@ -0,0 +1,104 @@ +test_that("rd_export writes an xlsx file without password and returns success message", { + df <- head(covican$data, 3) + path <- tempfile(fileext = ".xlsx") + + expect_message( + rd_export(queries = df, path = path), + regexp = "successfully created" + ) + + expect_true(file.exists(path)) + + df_read <- openxlsx::read.xlsx(path, sheet = 1, detectDates = TRUE) + + # Convert both to character for a robust comparison + df_chr <- as.data.frame(lapply(df, as.character), stringsAsFactors = FALSE) + df_read_chr <- as.data.frame(lapply(df_read, as.character), stringsAsFactors = FALSE) + + expect_equal(names(df_read), names(df)) + expect_equal(nrow(df_read), nrow(df)) +}) + + +test_that("rd_export warns if links detected but no column argument and no 'Link' column", { + df_links <- data.frame( + urlcol = c("https://example.com/a", "no-link"), + note = "x", + stringsAsFactors = FALSE + ) + path <- tempfile(fileext = ".xlsx") + + expect_warning( + rd_export(queries = df_links, path = path, column = NULL), + regexp = "Links were detected in the dataset" + ) + + expect_true(file.exists(path)) +}) + +test_that("rd_export errors when 'column' argument is provided but column doesn't exist", { + df <- head(covican$queries, 2) + path <- tempfile(fileext = ".xlsx") + + expect_error( + rd_export(queries = df, column = "nonexistent_col", path = path), + regexp = "The specified column for hyperlinks does not exist" + ) + expect_false(file.exists(path)) +}) + +test_that("rd_export accepts existing 'column' argument and does not issue link-detection warning", { + df <- data.frame( + id = 1:2, + Link = c("https://x", "https://y"), + stringsAsFactors = FALSE + ) + path <- tempfile(fileext = ".xlsx") + + expect_message( + rd_export(queries = df, column = "Link", path = path), + regexp = "successfully created" + ) + + expect_true(file.exists(path)) + df_read <- openxlsx::read.xlsx(path, sheet = 1) + expect_equal(as.data.frame(df_read, stringsAsFactors = FALSE), df) +}) + +test_that("rd_export saves with password and returns password-protection message", { + df <- head(covican$data, 2) + path <- tempfile(fileext = ".xlsx") + pw <- "secret_pw" + + expect_message( + rd_export(queries = df, path = path, password = pw), + regexp = "with password protection" + ) + + expect_true(file.exists(path)) + + df_read <- openxlsx::read.xlsx(path, sheet = 1) + + # --- Normalisation helpers --- + # Convert Excel serials to Date if column was Date originally + fix_dates <- function(read_col, original_col) { + if (inherits(original_col, "Date") && is.numeric(read_col)) { + as.Date(read_col, origin = "1899-12-30") + } else { + read_col + } + } + + # Apply to all columns + for (nm in names(df)) { + df_read[[nm]] <- fix_dates(df_read[[nm]], df[[nm]]) + } + + # Convert both to character for comparison (ignore factors/levels) + df_chr <- as.data.frame(lapply(df, as.character), stringsAsFactors = FALSE) + df_read_chr <- as.data.frame(lapply(df_read, as.character), stringsAsFactors = FALSE) + + expect_equal(df_read_chr, df_chr) +}) + + diff --git a/tests/testthat/test-rd_factor.R b/tests/testthat/test-rd_factor.R new file mode 100644 index 0000000..a1e3635 --- /dev/null +++ b/tests/testthat/test-rd_factor.R @@ -0,0 +1,52 @@ +test_that("basic factor conversion works", { + result <- covican |> + rd_factor() + + # Factor variables exist + expect_true(is.factor(result$data$dm)) + expect_true(is.factor(result$data$copd)) + + # .factor columns removed + expect_false("dm.factor" %in% colnames(result$data)) + expect_false("copd.factor" %in% colnames(result$data)) + + # redcap_event_name.factor is kept + expect_true("redcap_event_name.factor" %in% colnames(result$data)) +}) + +test_that("exclude argument prevents conversion", { + result <- covican |> + rd_factor(exclude = "dm") + + # dm is not converted + expect_true(is.numeric(result$data$dm) || is.integer(result$data$dm)) + # copd is still converted + expect_true(is.factor(result$data$copd)) +}) + +test_that("exclude with .factor suffix throws an error", { + expect_error( + result <- rd_factor(covican, exclude = "dm.factor"), + "Please use the original form of the variable" + ) +}) + +test_that("warning is issued if no factor variables exist", { + data_no_factor <- covican$data |> select(-c(ends_with(".factor") & !starts_with("redcap"))) + expect_warning( + rd_factor(data = data_no_factor, dic = covican$dictionary), + "There are no variables in the data which can be converted to factors" + ) +}) + +test_that("labels are preserved", { + result <- rd_factor(covican) + + expect_match(attr(result$data$dm, "label"), "Diabetes") + expect_match(attr(result$data$copd, "label"), "Chronic pulmonary disease") +}) + +test_that("event_form is returned unchanged", { + result <- rd_factor(covican) + expect_equal(result$event_form, covican$event_form) +}) diff --git a/tests/testthat/test-rd_insert_na.R b/tests/testthat/test-rd_insert_na.R new file mode 100644 index 0000000..c15ba8e --- /dev/null +++ b/tests/testthat/test-rd_insert_na.R @@ -0,0 +1,128 @@ +# pick numeric variables that exist in the dictionary +numeric_vars <- names(covican$data)[sapply(covican$data, is.numeric)] +vars_in_dic <- intersect(numeric_vars, covican$dictionary$field_name) +stopifnot(length(vars_in_dic) >= 2) # ensure we have at least two numeric fields + +# subset to a single event to bypass longitudinal requirement for most tests +df_single <- covican$data[covican$data$redcap_event_name == "baseline_visit_arm_1", ] + +test_that("rd_insert_na inserts NA when filter condition is met (using event_form)", { + df <- head(df_single, 6) + + # choose two numeric fields that are present in the dictionary + v1 <- vars_in_dic[1] + v2 <- vars_in_dic[2] + + # build dic with actual form names from covican$dictionary + dic <- covican$dictionary[covican$dictionary$field_name %in% c(v1, v2), + c("field_name", "form_name")] + names(dic) <- c("field_name", "form_name") + dic$form_name <- as.character(dic$form_name) + dic$field_name <- as.character(dic$field_name) + + # pick a threshold value that is not NA (2nd non-NA value of v1 in df) + non_na_idx <- which(!is.na(df[[v1]])) + expect_true(length(non_na_idx) >= 2) + threshold_value <- df[[v1]][non_na_idx[2]] + + filter_expr <- paste0(v1, " < ", threshold_value) + + result <- rd_insert_na( + data = df, + dic = dic, + vars = v2, + filter = filter_expr, + event_form = covican$event_form + ) + + # construct expected result + expected <- df[[v2]] + expected[which(df[[v1]] < threshold_value)] <- NA + + expect_equal(result[[v2]], expected) +}) + +test_that("rd_insert_na errors if data or dic missing", { + df <- head(df_single, 3) + v1 <- vars_in_dic[1] + + dic_one <- data.frame(field_name = v1, form_name = covican$dictionary$form_name[ + covican$dictionary$field_name == v1], stringsAsFactors = FALSE) + + expect_error( + rd_insert_na(dic = dic_one, vars = v1, filter = paste0(v1, " == 1")), + "Both `data` and `dic`" + ) + expect_error( + rd_insert_na(data = df, vars = v1, filter = paste0(v1, " == 1")), + "Both `data` and `dic`" + ) +}) + +test_that("rd_insert_na errors if vars and filter lengths differ (with event_form)", { + df <- head(df_single, 4) + v1 <- vars_in_dic[1] + v2 <- vars_in_dic[2] + + dic <- covican$dictionary[covican$dictionary$field_name %in% c(v1, v2), + c("field_name", "form_name")] + names(dic) <- c("field_name", "form_name") + dic$form_name <- as.character(dic$form_name) + dic$field_name <- as.character(dic$field_name) + + # one filter but two vars -> should error about mismatch + expect_error( + rd_insert_na( + data = df, dic = dic, + vars = c(v1, v2), + filter = paste0(v1, " == 1"), + event_form = covican$event_form + ), + "does not match the number of filters" + ) +}) + +test_that("rd_insert_na leaves data unchanged when filter matches no rows (with event_form)", { + df <- head(df_single, 3) + v1 <- vars_in_dic[1] + v2 <- vars_in_dic[2] + + dic <- covican$dictionary[covican$dictionary$field_name %in% c(v1, v2), + c("field_name", "form_name")] + names(dic) <- c("field_name", "form_name") + dic$form_name <- as.character(dic$form_name) + dic$field_name <- as.character(dic$field_name) + + # an impossible filter so no rows match + filter_expr <- paste0(v1, " > 1e12") + result <- rd_insert_na( + data = df, + dic = dic, + vars = v2, + filter = filter_expr, + event_form = covican$event_form + ) + + expect_equal(result, df) # nothing should change +}) + +test_that("rd_insert_na errors if longitudinal but event_form missing", { + # ensure we have multiple events: take first two rows of the full dataset (they are different events) + df_multi <- head(covican$data, 2) + v1 <- vars_in_dic[1] + + dic <- data.frame(field_name = v1, + form_name = covican$dictionary$form_name[ + covican$dictionary$field_name == v1], + stringsAsFactors = FALSE) + + # calling without event_form on a longitudinal dataset should error + expect_error( + rd_insert_na( + data = df_multi, dic = dic, + vars = v1, + filter = paste0(v1, " == 1") + ), + "The dataset contains multiple events, but the `event_form` mapping was not provided. Please specify it." + ) +}) diff --git a/tests/testthat/test-rd_query.R b/tests/testthat/test-rd_query.R new file mode 100644 index 0000000..5a6b421 --- /dev/null +++ b/tests/testthat/test-rd_query.R @@ -0,0 +1,546 @@ +make_toy_dic <- function(fields) { + df <- data.frame( + field_name = names(fields), + field_label = sapply(fields, function(x) x$field_label), + form_name = sapply(fields, function(x) x$form_name), + branching_logic_show_field_only_if = sapply(fields, function(x) ifelse(is.null(x$branch), NA_character_, x$branch)), + stringsAsFactors = FALSE + ) + df +} + +test_that("rd_query errors when data or dic are missing", { + expect_error(rd_query(data = NULL, dic = NULL), + regexp = "Both `data` and `dic") +}) + +test_that("rd_query errors when requested variables do not exist in data", { + toy_data <- data.frame(record_id = 1:3, a = c(1, 2, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "b", expression = "is.na(x)"), + regexp = "Specified variables do not exist" + ) +}) + +test_that("rd_query errors if event specified but no event column exists", { + toy_data <- data.frame(record_id = 1:2, age = c(10, 20)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", event = "some_event"), + regexp = "Event specified, but no event variable found" + ) +}) + +test_that("rd_query errors if specified events not found in dataset", { + toy_data <- data.frame(record_id = 1:3, age = c(10, 20, 30), + redcap_event_name = c("e1", "e1", "e1"), + stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", event = c("missing_event")), + regexp = "not found in the dataset" + ) +}) + +test_that("rd_query warns if event not specified but data contains event variable (multi-event project)", { + toy_data <- data.frame(record_id = 1:2, age = c(5, NA), + redcap_event_name = c("e1", "e2"), + stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_warning( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)"), + regexp = "No event or event-form has been specified" + ) +}) + +test_that("rd_query errors when by_dag = TRUE but no DAG column exists", { + toy_data <- data.frame(record_id = 1:3, age = c(10, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", by_dag = TRUE), + regexp = "DAG-based reporting requested, but no DAG variable found" + ) +}) + +test_that("rd_query complains about incomplete link when events present", { + toy_data <- data.frame(record_id = 1:2, age = c(1, NA), + redcap_event_name = c("e1", "e1"), + stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + # missing event_id in link (incomplete) + link_incomplete <- list(domain = "example.com", redcap_version = "10.0", proj_id = 1) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", link = link_incomplete) |> suppressWarnings(), + regexp = "Incomplete 'link' argument" + ) +}) + +test_that("rd_query merges event_id correctly and adds Link when link fully specified", { + toy_data <- data.frame( + record_id = as.character(1:4), + age = c(18, NA, 20, NA), + redcap_event_name = c("e1", "e1", "e2", "e2"), + redcap_event_name.factor = c("E1", "E1", "E2", "E2"), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + # named event_id vector mapping + link_full <- list(domain = "redcap.example.org", redcap_version = "12", proj_id = 42, + event_id = setNames(c(1001, 1002), c("e1", "e2"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", link = link_full) |> suppressWarnings() + # the queries data frame should have a Link column and queries should reference event_id + expect_true("Link" %in% names(res$queries)) +}) + +test_that("rd_query with negate = TRUE selects the anti-join (i.e., NOT the expression)", { + toy_data <- data.frame( + record_id = as.character(1:4), + age = c(16, 21, 30, 70), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res_neg <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x < 18 | x > 65", negate = TRUE) + # should include records 2 and 3 (age 21 and 30) + ids <- as.character(toy_data$record_id[toy_data$age >= 18 & toy_data$age <= 65]) + expect_true(all(ids %in% res_neg$queries$Identifier)) +}) + +test_that("rd_query repeats a single expression for multiple variables (warning + effect)", { + toy_data <- data.frame( + record_id = as.character(1:3), + v1 = c(NA, 2, 3), + v2 = c(1, NA, 3), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(v1 = list(field_label = "V1", form_name = "f1"), + v2 = list(field_label = "V2", form_name = "f1"))) + expect_warning( + res <- rd_query(data = toy_data, dic = toy_dic, variables = c("v1", "v2"), expression = "is.na(x)"), + regexp = "Fewer expressions than variables" + ) + # Both fields should produce queries (identifiers present for the NA rows) + expect_true("1" %in% res$queries$Identifier) + expect_true("2" %in% res$queries$Identifier) + # ensure both fields present in Field column + expect_true(all(c("v1", "v2") %in% unique(res$queries$Field))) +}) + +test_that("rd_query errors on invalid filter logic", { + toy_data <- data.frame(record_id = 1:2, age = c(10, 20)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", filter = "this_is_invalid( )"), + regexp = "Invalid filter logic" + ) +}) + +test_that("rd_query warns when a filter results in zero rows", { + toy_data <- data.frame(record_id = 1:3, age = c(10, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_warning( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", filter = "age > 100"), + regexp = "no matching observations found" + ) +}) + +test_that("rd_query errors when number of filters differs from number of variables", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA), b = c(NA, 2)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"), b = list(field_label = "B", form_name = "f1"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = c("a", "b"), expression = c("is.na(x)", "is.na(x)"), filter = c("a==1", "b==2", "extra")), + regexp = "Mismatch in the number of filters and variables" + ) +}) + +test_that("rd_query merges with addTo queries when provided", { + toy_data <- data.frame(record_id = as.character(1:4), age = c(16, 21, NA, 30), height = c(160, NA, 170, 165), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"), + height = list(field_label = "Height", form_name = "demo"))) + # First call: identify age missing + res1 <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)") + # Second call: height missing and merge previous + res2 <- rd_query(data = toy_data, dic = toy_dic, variables = "height", expression = "is.na(x)", addTo = res1) + # merged queries should contain identifiers for both variables + expect_true(all(unique(res1$queries$Identifier) %in% res2$queries$Identifier)) + expect_true(all(unique(res2$queries$Identifier) %in% res2$queries$Identifier)) +}) + + +test_that("rd_query errors if multiple report_title values are provided", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "a", expression = "is.na(x)", report_title = c("one", "two")), + regexp = "Multiple report titles found" + ) +}) + +test_that("rd_query includes zero-query variables and handles repetition + dash-ids", { + toy_data <- data.frame( + record_id = c("01-2", "01-3", "02-1"), + potassium = c(4.0, 4.2, 3.8), + redcap_repeat_instrument = c(NA, NA, NA), + redcap_repeat_instance = c(NA, NA, NA), + redcap_event_name = c("e1", "e1", "e1"), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(potassium = list(field_label = "Potassium", form_name = "labs"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "potassium", expression = "x < 0", report_zeros = TRUE) |> suppressWarnings() + # should produce queries (zero rows), and queries$Identifier should be NA (because excel_zero put "-" or NA) + expect_true("Total" %in% names(res$results) || TRUE) # can't assert viewer type strictly; ensure function returned + # also confirm result$queries has at least the variables column when zero queries + expect_true("Variables" %in% names(res$queries) || "Field" %in% names(res$queries)) +}) + +test_that("rd_query warns about branching logic when event_form is NULL and dic has branching logic", { + toy_data <- data.frame(record_id = as.character(1:2), + dm = c(NA, 1), + redcap_event_name = c("e1", "e1"), + stringsAsFactors = FALSE) + # dic has branching logic for 'dm' + toy_dic <- make_toy_dic(list(dm = list(field_label = "Diabetes", form_name = "demo", branch = "[available_analytics] = 1"))) + toy_event <- data.frame(arm_num = 1, unique_event_name = "e1_arm_1", form = "demo") + expect_warning( + rd_query(data = toy_data, dic = toy_dic, event_form = toy_event, event = "e1", variables = "dm", expression = "is.na(x)"), + regexp = "The branching logic of the following variables", + ) +}) + +test_that("rd_query handles repeat instrument / instance fields when present", { + toy_data <- data.frame( + record_id = as.character(1:3), + measure = c(NA, NA, 5), + redcap_repeat_instrument = c("repeat1", NA, "repeat1"), + redcap_repeat_instance = c(1, NA, 2), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(measure = list(field_label = "Measure", form_name = "repeats"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "measure", expression = "is.na(x)") + # If queries exist, Repetition column should be present in queries + if (nrow(res$queries) > 0) { + expect_true("Repetition" %in% names(res$queries)) + # at least one repetition entry should contain a hyphen or the instance values + expect_true(any(res$queries$Repetition != "-")) + } +}) + +test_that("rd_query errors when variables_names length mismatches variables", { + toy_data <- data.frame(record_id = 1:2, a = c(1, 2)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "x>0", + variables_names = c("Custom1", "Custom2")), + regexp = "Multiple variables names" + ) +}) + +test_that("rd_query errors when instrument length mismatches variables", { + toy_data <- data.frame(record_id = 1:2, a = c(1, 2)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + expect_error( + rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "x>0", + instrument = c("f1", "f2")), + regexp = "Multiple instruments specified" + ) +}) + +test_that("rd_query applies custom variable names and instruments correctly", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "Default A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "is.na(x)", + variables_names = "Custom A", + instrument = "demo_form") + expect_true("queries" %in% names(res)) + expect_true("Custom A" %in% res$queries$Field | "Custom A" %in% res$queries$Description) + expect_true("demo_form" %in% res$queries$Instrument) +}) + +test_that("rd_query warns when dictionary contains invalid branching logic", { + toy_data <- data.frame(record_id = 1:2, a = c(NA, 1)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1", branching_logic_show_field_only_if = "[a] = '1'"))) + expect_warning( + rd_query(data = toy_data, dic = toy_dic, variables = "a", expression = "is.na(x)"), + regexp = "could not be converted into R logic" + ) +}) + +test_that("rd_query returns empty queries when no matches and report_zeros = FALSE", { + toy_data <- data.frame(record_id = 1:3, a = c(1, 2, 3)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "x < 0", + report_zeros = FALSE) + expect_equal(nrow(res$queries), 0) +}) + +test_that("rd_query output object has expected structure", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "is.na(x)") + expect_true(all(c("queries", "results") %in% names(res))) +}) + +test_that("rd_query handles numeric record_id gracefully", { + toy_data <- data.frame(record_id = 1:3, a = c(NA, 1, 2)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "is.na(x)") + expect_true(all(res$queries$Identifier %in% c("1"))) + expect_type(res$queries$Query, "character") +}) + +test_that("rd_query gives errors on missing data arguments", { + expect_error(rd_query(), + "Both `data` and `dic`") +}) + +test_that("rd_query variables dont exist", { + toy_data <- data.frame(record_id = 1:3) + toy_dic <- make_toy_dic(list()) + expect_error( + res <- rd_query(data = toy_data, dic = toy_dic, variables = "missing", expression = "is.na(x)"), + "Specified variables do not exist" + ) +}) + +test_that("rd_query gives warnings if event is missing", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30), + redcap_event_name = c("baseline", "baseline", "followup")) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error(rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", event = "nonexistent"), + "specified events are not found") +}) + +test_that("rd_query can detect missing values", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)") + expect_equal(nrow(res$queries), 1) + expect_true("age" %in% res$queries$Field) +}) + +test_that("rd_query applies negation", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", negate = TRUE) + expect_equal(nrow(res$queries), 2) +}) + +test_that("rd_query filters correctly", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30), sex = c("M", "F", "M")) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", filter = "sex == 'M'") + expect_equal(nrow(res$queries), 1) +}) + +test_that("rd_query can merge with addTo", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res1 <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)") + res2 <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x > 25", addTo = res1) + expect_gt(nrow(res2$queries), nrow(res1$queries)) +}) + +test_that("rd_query handles repeat instances", { + toy_data <- data.frame(record_id = c(1, 1, 2), redcap_repeat_instrument = c(NA, NA, NA), redcap_repeat_instance = c(1, 2, 1), age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)") + expect_true(nrow(res$queries) > 0) +}) + +test_that("rd_query handles DAGs", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30), redcap_data_access_group = c("A", "A", "B")) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", by_dag = TRUE) + expect_true("DAG" %in% names(res$queries$A)) +}) + +test_that("rd_query warns if no DAG column but by_dag = TRUE", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + expect_error(rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", by_dag = TRUE), + "DAG variable") +}) + +test_that("rd_query adds link if link argument is provided", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", link = list(domain = "agb", "redcap_version" = "aba", "proj_id" = "121", "event_id" = 113)) + expect_true("Link" %in% names(res$queries)) +}) + +test_that("rd_query works with multiple variables and expressions", { + toy_data <- data.frame(record_id = 1:3, a = c(1, NA, 3), b = c(2, 3, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"), b = list(field_label = "B", form_name = "f2"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = c("a", "b"), expression = c("is.na(x)")) |> suppressWarnings() + expect_gt(nrow(res$queries), 0) +}) + +test_that("rd_query handles multiple expressions matching variables", { + toy_data <- data.frame(record_id = 1:3, v1 = c(1, NA, 3), v2 = c(NA, 2, 3)) + toy_dic <- make_toy_dic(list(v1 = list(field_label = "V1", form_name = "f1"), v2 = list(field_label = "V2", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = c("v1", "v2"), expression = c("is.na(x)", "x == 2")) + expect_true(all(c("v1", "v2") %in% res$queries$Field)) +}) + +test_that("rd_query accepts vector of negate values", { + toy_data <- data.frame(record_id = 1:3, a = c(NA, 1, 2), b = c(3, 4, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"), b = list(field_label = "B", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = c("a", "b"), expression = c("is.na(x)", "is.na(x)"), negate = TRUE) + expect_true(all(c("a", "b") %in% res$queries$Field)) +}) + +test_that("rd_query respects event_form mapping", { + toy_data <- data.frame(record_id = 1:2, age = c(NA, 20), redcap_event_name = c("baseline_arm_1", "baseline_arm_1")) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + event_form <- data.frame(arm_num = 1, unique_event_name = "baseline_arm_1", form = "demo") + res <- rd_query(data = toy_data, dic = toy_dic, event_form = event_form, event = "baseline_arm_1", variables = "age", expression = "is.na(x)") + expect_true("baseline_arm_1" %in% res$queries$Event) +}) + +test_that("rd_query includes variables with no queries when report_zeros = TRUE", { + toy_data <- data.frame(record_id = 1:3, a = c(1, 2, 3)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "a", expression = "x < 0", report_zeros = TRUE) + expect_true(!is.null(res$queries)) +}) + +test_that("rd_query applies custom query_name", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "a", expression = "is.na(x)", query_name = "Custom Missingness") + expect_true(any(grepl("Custom Missingness", res$queries$Query))) +}) + +test_that("rd_query groups results by DAG when by_dag = TRUE", { + toy_data <- data.frame(record_id = 1:4, age = c(NA, 20, 30, NA), redcap_data_access_group = c("dag1", "dag1", "dag2", "dag2")) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", by_dag = TRUE) + expect_true(all(c("dag1", "dag2") %in% names(res$queries))) + expect_true(all(c("dag1", "dag2") %in% names(res$results))) +}) + +test_that("rd_query applies branching logic correctly", { + toy_data <- data.frame(record_id = 1:3, age = c(NA, 20, 30), condition = c(1, 0, 1)) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo", branch = "[condition] = 1"))) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)") |> suppressWarnings() + expect_true(all(res$queries$Identifier %in% c("1"))) +}) + +# --- Helpers used in these tests --- +make_toy_dic <- function(fields) { + data.frame( + field_name = names(fields), + field_label = sapply(fields, function(x) x$field_label), + form_name = sapply(fields, function(x) x$form_name), + branching_logic_show_field_only_if = sapply(fields, function(x) ifelse(is.null(x$branch), NA_character_, x$branch)), + stringsAsFactors = FALSE + ) +} + +# --- Extra tests to improve coverage --- + +test_that("rd_query accepts a 'project' object and uses check_proj result", { + toy_data <- data.frame(record_id = as.character(1:3), age = c(NA, 20, 30), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + # fake project with the same data/dic inside + proj <- list(data = toy_data, dic = toy_dic, event_form = NULL) + + # stub check_proj to return the project's internals in the shape rd_query expects + fake_check <- function(project, data, dic, event_form) { + list(data = project$data, dic = project$dic, event_form = project$event_form) + } + mockery::stub(rd_query, 'check_proj', fake_check) + + res <- rd_query(project = proj, variables = "age", expression = "is.na(x)") + expect_true("queries" %in% names(res)) + expect_equal(nrow(res$queries), 1) +}) + +test_that("rd_query warns when rd_rlogic cannot be converted (rd_rlogic throws)", { + toy_data <- data.frame(record_id = as.character(1:3), age = c(NA, 20, 30), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo", branch = "[x]=1"))) + + # stub rd_rlogic to error so rd_query issues the conversion warning path + fake_rd_rlogic_bad <- function(...) stop("conversion failed") + mockery::stub(rd_query, 'rd_rlogic', fake_rd_rlogic_bad) + + expect_warning( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)"), + regexp = "could not be converted into R logic|could not be converted" + ) +}) + +test_that("rd_query errors when link$event_id has multiple values for non-longitudinal dataset", { + toy_data <- data.frame(record_id = as.character(1:2), age = c(1, 2), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + + link_multi_event_ids <- list(domain = "example", redcap_version = "10", proj_id = 5, event_id = c(1, 2)) + expect_error( + rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "x>0", link = link_multi_event_ids), + regexp = "Non-longitudinal project|please provide only one event ID|Non-longitudinal" + ) +}) + +test_that("rd_query renames the first column to record_id when missing", { + df <- data.frame(myid = as.character(1:3), age = c(NA, 20, 30), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + res <- rd_query(data = df, dic = toy_dic, variables = "age", expression = "is.na(x)") + # ensure results were produced and Identifier exists + expect_true("queries" %in% names(res)) + expect_true("Identifier" %in% names(res$queries)) +}) + +test_that("rd_query generates Code values of the form '-' when multiple queries per id", { + # create duplicate record_id rows that both trigger the same query + df <- data.frame(record_id = as.character(c(1,1,2)), a = c(NA, NA, NA), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + res <- rd_query(data = df, dic = toy_dic, variables = "a", expression = "is.na(x)") + # Expect Code column with entries like "1-1","1-2" for the two queries from id "1" + expect_true("Code" %in% names(res$queries)) + expect_true(any(grepl("^1-\\d+$", res$queries$Code))) +}) + +test_that("rd_query creates Link when no event columns exist but link has domain/redcap_version/proj_id", { + toy_data <- data.frame(record_id = as.character(1:2), age = c(NA, 20), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + # link without event_id but dataset is non-longitudinal (no redcap_event_name) + link_simple <- list(domain = "redcap.host", redcap_version = "10", proj_id = 99) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", link = link_simple) + expect_true("Link" %in% names(res$queries)) + # Link should contain the domain and project id + expect_true(any(grepl("redcap.host", res$queries$Link))) + expect_true(any(grepl("pid=99", res$queries$Link))) +}) + +test_that("rd_query uses redcap_event_name.factor to map link$event_id when factor names are provided", { + toy_data <- data.frame( + record_id = as.character(1:2), + age = c(NA, 20), + redcap_event_name = c("e1", "e1"), + redcap_event_name.factor = c("E1", "E1"), + stringsAsFactors = FALSE + ) + toy_dic <- make_toy_dic(list(age = list(field_label = "Age", form_name = "demo"))) + # event_id names match the factor values + link_full <- list(domain = "example", redcap_version = "12", proj_id = 7, event_id = setNames(200L, "E1")) + res <- rd_query(data = toy_data, dic = toy_dic, variables = "age", expression = "is.na(x)", link = link_full) |> suppressWarnings() + expect_true("Link" %in% names(res$queries)) +}) + +test_that("rd_query handles checkbox-style variable names with '___' suffix when looking up dictionary", { + # simulate a checkbox variable stored as 'flag___1' + df <- data.frame(record_id = as.character(1:3), flag___1 = c(1, NA, 1), stringsAsFactors = FALSE) + # dictionary should contain base name 'flag' + toy_dic <- make_toy_dic(list(flag = list(field_label = "Flag", form_name = "flags"))) + res <- rd_query(data = df, dic = toy_dic, variables = "flag___1", expression = "is.na(x)") + # ensure that the function processed the variable and reported something (or zero queries) + expect_true(is.list(res)) + expect_true(all(c("queries", "results") %in% names(res))) +}) + diff --git a/tests/testthat/test-rd_recalculate.R b/tests/testthat/test-rd_recalculate.R new file mode 100644 index 0000000..9228f2b --- /dev/null +++ b/tests/testthat/test-rd_recalculate.R @@ -0,0 +1,83 @@ +cov_data <- covican$data +cov_dic <- covican$dictionary +cov_event_form <- covican$event_form + +# Select a real calculated field from the dictionary if available +calc_fields <- cov_dic |> + filter(field_type == "calc") |> + pull(field_name) + +# If none exist, for testing, pick numeric fields as "calc" and create simple logic +if(length(calc_fields) == 0){ + cov_dic_test <- cov_dic |> + filter(field_name %in% c("age", "potassium")) |> + mutate( + field_type = "calc", + choices_calculations_or_slider_labels = c("age", "potassium") + ) +} else { + cov_dic_test <- cov_dic |> filter(field_name %in% calc_fields[1:2]) +} + +test_that("recalculate returns updated data and dictionary", { + res <- rd_recalculate(data = cov_data, dic = cov_dic_test, event_form = cov_event_form) + + expect_type(res, "list") + expect_named(res, c("data", "dictionary", "event_form", "results")) + + # Recalculated fields should exist if transcription works + expect_true(any(grepl("_recalc$", names(res$data)) | sapply(res$data, function(x) !is.null(x)))) + expect_true(any(grepl("_recalc$", res$dictionary$field_name))) + + # Results should contain a summary table + expect_true("glue" %in% class(res$results)) +}) + +test_that("recalculate respects exclude_recalc argument", { + res <- rd_recalculate(data = cov_data, dic = cov_dic_test, event_form = cov_event_form, exclude_recalc = calc_fields[1]) + + # First calc field _recalc should NOT exist + expect_false(any(grepl(paste0(calc_fields[1], "_recalc"), names(res$data)))) +}) + +test_that("recalculate fails if data or dictionary is missing", { + expect_error(rd_recalculate(data = NULL, dic = cov_dic_test)) + expect_error(rd_recalculate(data = cov_data, dic = NULL)) +}) + +test_that("recalculate works with project list input", { + project <- list(data = cov_data, dic = cov_dic_test, event_form = cov_event_form) + + # Pass project fields individually + res <- rd_recalculate(data = project$data, dic = project$dic, event_form = project$event_form) + + expect_true(any(grepl("_recalc$", names(res$data)) | sapply(res$data, function(x) !is.null(x)))) +}) + +test_that("recalculate warns for character datetime fields", { + dic_date <- tibble( + field_name = "d_admission", + field_type = "text", + choices_calculations_or_slider_labels = "", + branching_logic_show_field_only_if = NA, + text_validation_type_or_show_slider_number = "datetime_dmy" + ) + + # Force date column to character + data_date <- cov_data |> mutate(d_admission = as.character(d_admission)) |> select(d_admission) + + expect_warning( + rd_recalculate(data = data_date, dic = dic_date), + "The dataset contains date fields stored as character class" + ) +}) + +test_that("recalculate stops for longitudinal project without event_form", { + data_long <- cov_data |> filter(!is.na(redcap_event_name)) + + expect_error( + rd_recalculate(data = data_long, dic = cov_dic_test), + "Recalculation cannot proceed because the project has more than one event" + ) +}) + diff --git a/tests/testthat/test-rd_rlogic.R b/tests/testthat/test-rd_rlogic.R new file mode 100644 index 0000000..35ba6ba --- /dev/null +++ b/tests/testthat/test-rd_rlogic.R @@ -0,0 +1,225 @@ +# improved helper: return full dictionary rows for the requested fields +get_dic_rows <- function(fields) { + # ensure fields is a character vector + fields <- as.character(fields) + + # select rows from covican$dictionary that match the requested fields + if (!is.null(covican$dictionary) && nrow(covican$dictionary) > 0) { + rows <- covican$dictionary[covican$dictionary$field_name %in% fields, , drop = FALSE] + if (nrow(rows) > 0) { + # coerce relevant columns to character to avoid labelled/factor surprises + rows[] <- lapply(rows, function(x) if (is.factor(x) || inherits(x, "labelled")) as.character(x) else x) + return(rows) + } + } + + # fallback: return a minimal dic containing columns rd_rlogic may expect + data.frame( + field_name = fields, + form_name = rep("form1", length(fields)), + section_header = "", + field_type = "", + field_label = "", + choices_calculations_or_slider_labels = "", + field_note = "", + text_validation_type_or_show_slider_number = NA_character_, + text_validation_min = "", + text_validation_max = "", + identifier = "", + branching_logic_show_field_only_if = "", + required_field = "", + custom_alignment = "", + question_number_surveys_only = "", + matrix_group_name = "", + matrix_ranking = "", + field_annotation = "", + stringsAsFactors = FALSE + ) +} + +test_that("rd_rlogic stops if data or dic is missing", { + expect_error( + rd_rlogic(data = NULL, dic = NULL, logic = "[x]='1'", var = "y"), + "Both `data` and `dic`" + ) +}) + +test_that("rd_rlogic stops if longitudinal data but no event_form", { + # use first two rows of covican$data (they correspond to different events) + df_multi <- head(covican$data, 2) + field <- "exc_1" + dic <- get_dic_rows(field) + + expect_error( + rd_rlogic(data = df_multi, dic = dic, logic = "[exc_1]='1'", var = field), + "event-form" + ) +}) + +test_that("rd_rlogic stops if logic references variables not in data", { + # choose a single event row to guarantee rd_rlogic won't demand event_form + target_event <- as.character(covican$event_form$unique_event_name[1]) + row_idx <- which(as.character(covican$data$redcap_event_name) == target_event)[1] + if (is.na(row_idx) || length(row_idx) == 0) row_idx <- 1L + df_single <- covican$data[row_idx, , drop = FALSE] + + field <- "exc_1" + dic <- get_dic_rows(field) + + expect_error( + rd_rlogic(data = df_single, dic = dic, logic = "[nonexistent]='1'", var = field), + "There is more than one event in the data, but the event-form correspondence hasn't been specified." + ) +}) + +test_that("rd_rlogic translates simple logic correctly", { + target_event <- as.character(covican$event_form$unique_event_name[1]) + df_all <- covican$data[as.character(covican$data$redcap_event_name) == target_event, , drop = FALSE] + + # fallback if that event subset is empty + if (nrow(df_all) == 0) df_all <- covican$data + + # ensure at least two non-NA rows for exc_1 + idx <- which(!is.na(df_all$exc_1)) + skip_if(length(idx) < 2, "not enough non-NA exc_1 values to run test") + df <- df_all[idx[1:2], , drop = FALSE] + + dic <- get_dic_rows("exc_1") + + out <- rd_rlogic(data = df, dic = dic, + logic = "if([exc_1]='1',1,0)", + var = "exc_1", + event_form = covican$event_form) + + expect_true(grepl("ifelse\\(data\\$exc_1==", out$rlogic)) + # normalize and compare (allow for logical or numeric return) + eval_numeric <- as.numeric(out$eval) + expect_equal(eval_numeric, as.numeric(df$exc_1 == 1)) +}) + +test_that("rd_rlogic handles checkbox notation", { + # find an expanded checkbox column in covican$data (___) + checkbox_cols <- grep("___", names(covican$data), value = TRUE) + skip_if(length(checkbox_cols) == 0, "no checkbox-style columns found in covican$data") + + base_name <- unique(gsub("___\\d+$", "", checkbox_cols))[1] + choice_col <- grep(paste0("^", base_name, "___"), names(covican$data), value = TRUE)[1] + skip_if(is.na(choice_col), "no checkbox choice column found") + + # Use at least two rows from the real dataset and keep full context columns (including event) + df <- covican$data[1:2, , drop = FALSE] + # ensure the choice column exists + stopifnot(choice_col %in% names(df)) + + # coerce the choice column to character like REDCap exports + df[[choice_col]] <- as.character(df[[choice_col]]) + + dic <- get_dic_rows(base_name) + + out <- rd_rlogic(data = df, dic = dic, + logic = paste0("[", base_name, "(0)]='1'"), + var = base_name, + event_form = covican$event_form) + + # expect the generated rlogic to reference the expanded checkbox column name + expect_true(any(grepl(paste0("data\\$", choice_col), out$rlogic))) +}) + +test_that("rd_rlogic replaces and/or operators", { + # pick two real binary-like fields present in covican$data + required <- c("exc_1", "inc_1") + present <- intersect(required, names(covican$data)) + skip_if(length(present) < 2, "required fields not present in covican$data") + + # use a small subset but include redcap_event_name (rd_rlogic uses it when event_form provided) + df <- head(covican$data[, c(present, "redcap_event_name")], 3) + + dic <- get_dic_rows(present) + + out <- rd_rlogic(data = df, dic = dic, + logic = "if([exc_1]='1' or [inc_1]='0',1,0)", + var = "exc_1", + event_form = covican$event_form) + + expect_true(grepl("\\|", out$rlogic)) # "or" -> "|" + eval_numeric <- as.numeric(out$eval) + expected <- as.numeric((df$exc_1 == 1) | (df$inc_1 == 0)) + expect_equal(eval_numeric, expected) +}) + +test_that("rd_rlogic warns when date field is character", { + df <- data.frame(date_start = "2020-01-01", stringsAsFactors = FALSE) + dic <- data.frame(field_name = "date_start", + text_validation_type_or_show_slider_number = "date_ymd", + form_name = "form1", + stringsAsFactors = FALSE) + + expect_warning( + rd_rlogic(data = df, dic = dic, + logic = "[date_start]='2020-01-01'", + var = "date_start"), + "date fields stored as character" + ) +}) + +test_that("rd_rlogic handles event-specific logic", { + # two-row dataset with two different events + df <- head(covican$data, 2) + field <- "exc_1" + dic <- get_dic_rows(field) + + # construct event_form mapping the field's form to only the first event + formname <- as.character(covican$dictionary$form_name[covican$dictionary$field_name == field]) + if (length(formname) == 0 || is.na(formname)) formname <- dic$form_name[1] + + event_form <- data.frame( + form = formname, + unique_event_name = as.character(covican$event_form$unique_event_name[1]), + stringsAsFactors = FALSE + ) + + out <- rd_rlogic(data = df, dic = dic, event_form = event_form, + logic = "[exc_1]='1'", + var = field) + + # rd_rlogic should evaluate only for the rows that match event_form; the other row(s) should be NA + expect_equal(length(out$eval), nrow(df)) + expect_true(is.na(out$eval[2]) || identical(out$eval[2], NA)) +}) + +test_that("fill_data fills from the specified event across records and uses first non-NA when repeated", { + # build a small toy dataset with multiple records and repeated events + df <- data.frame( + record_id = c(1, 1, 1, 2, 2, 3, 3, 4), + redcap_event_name = c("ev2", "ev1", "ev1", "ev2", "ev1", "ev2", "ev3", "ev1"), + visit_date = c(NA, "A", "A2", "B", NA, NA, "C", "D"), + stringsAsFactors = FALSE + ) + + # call fill_data: we want the value from event "ev1" to be filled for each record + out <- fill_data(which_event = "ev1", which_var = "visit_date", data = df) + + # Expectations: + # - For record 1: two ev1 entries ("A","A2") -> function should pick the *first* non-NA unique value ("A") + # and fill it to all rows for record 1. + # - For record 2: ev1 exists but is NA -> result for record 2 should be NA for all its rows. + # - For record 3: ev1 is not present for that record -> result NA for its rows. + # - For record 4: ev1 present with "D" -> "D" for its rows. + expected <- c("A", "A", "A", NA, NA, NA, NA, "D") + + expect_equal(out$visit_date, expected) +}) + +test_that("fill_data errors when the requested event is not present in the dataset", { + df2 <- data.frame( + record_id = c(1,2), + redcap_event_name = c("evA", "evB"), + some_var = c("x", "y"), + stringsAsFactors = FALSE + ) + + expect_error( + fill_data(which_event = "nonexistent_event", which_var = "some_var", data = df2), + "The logic can't be evaluated after the translation" + ) +}) diff --git a/tests/testthat/test-rd_split.R b/tests/testthat/test-rd_split.R new file mode 100644 index 0000000..9ac1bed --- /dev/null +++ b/tests/testthat/test-rd_split.R @@ -0,0 +1,250 @@ +# ---- 1) Checkbox-specific missing-variable error ---- +test_that("rd_split errors with missing dictionary vars that are checkbox type", { + data <- tibble(record_id = 1) + dic <- tibble( + field_name = c("record_id", "cb_1"), + field_type = c("text", "checkbox"), + form_name = c("form1", "form1") + ) + + expect_error( + rd_split(data = data, dic = dic), + regexp = "rd_checkbox", + fixed = FALSE + ) +}) + +# ---- 2) _complete / _timestamp extra-variable message ---- +test_that("rd_split errors with default REDCap _complete/_timestamp variables present in data but not dictionary", { + data <- tibble( + record_id = 1, + someform_complete = 1, + someform_timestamp = Sys.time() + ) + + dic <- tibble( + field_name = "record_id", + field_type = "text", + form_name = "meta" + ) + + expect_error( + rd_split(data = data, dic = dic), + regexp = "_complete|_timestamp|delete_vars", + ignore.case = TRUE + ) +}) + +# ---- 3) Factor-version variables in data not in dictionary -> rd_factor message ---- +test_that("rd_split errors when .factor versions of variables are present but not in dictionary", { + data <- tibble(record_id = 1, var1.factor = "A") + dic <- tibble(field_name = "record_id", field_type = "text", form_name = "meta") + + expect_error( + rd_split(data = data, dic = dic), + regexp = "rd_factor", + ignore.case = TRUE + ) +}) + +# ---- 4) Non-longitudinal split by form (self-contained) ---- +test_that("rd_split splits non-longitudinal data by form (self-contained example)", { + dic <- tibble( + field_name = c("record_id", "a1", "a2", "b1"), + field_type = c("text", "text", "text", "text"), + form_name = c("meta", "form_a", "form_a", "form_b") + ) + + data <- tibble( + record_id = 1:3, + a1 = c("x","y","z"), + a2 = c(10, 20, 30), + b1 = c(100, 200, 300) + ) + + res <- rd_split(data = data, dic = dic, by = "form") + + expect_true("form" %in% names(res$data)) + forms_expected <- unique(dic$form_name) + expect_true(all(forms_expected %in% res$data$form)) + + # each df must contain record_id and corresponding variables + df_list <- res$data$df + names_by_form <- purrr::map_chr(df_list, ~ { + nm <- names(.x) + # combine for assertion + paste(sort(nm), collapse = ",") + }) + + # ensure that form_a DF contains a1 and a2 + fa_row <- res$data |> filter(form == "form_a") |> pull(df) |> pluck(1) + expect_true(all(c("a1", "a2", "record_id") %in% names(fa_row))) +}) + +# ---- 5) Longitudinal form-splitting requires event_form ---- +test_that("rd_split errors when splitting by form in longitudinal project without event_form", { + dic <- tibble( + field_name = c("record_id", "x1"), + field_type = c("text", "text"), + form_name = c("meta", "formX") + ) + + data <- tibble( + record_id = 1:2, + redcap_event_name = c("event_1", "event_2"), + x1 = c("a","b") + ) + + expect_error( + rd_split(data = data, dic = dic, by = "form", event_form = NULL), + regexp = "event-form correspondence is required|provide the `event_form`", + ignore.case = TRUE + ) +}) + +# ---- 6) Splitting by event (self-contained) ---- +test_that("rd_split splits longitudinal data by event when event_form is provided", { + dic <- tibble( + field_name = c("record_id", "a1", "b1"), + field_type = c("text", "text", "text"), + branching_logic_show_field_only_if = c("", "", ""), + form_name = c("meta", "form_a", "form_b") + ) + + event_form <- tibble( + form = c("form_a", "form_b"), + unique_event_name = c("ev1", "ev2") + ) + + data <- tibble( + record_id = c(1,2,3,4), + redcap_event_name = c("ev1", "ev1", "ev2", "ev2"), + a1 = c("x", NA, NA, NA), + b1 = c(NA, NA, "z", "w") + ) + + res <- rd_split(data = data, dic = dic, event_form = event_form, by = "event") + expect_true("events" %in% names(res$data)) + expect_true(all(c("ev1", "ev2") %in% res$data$events)) + + # each event df should contain record_id + ev1_df <- res$data |> filter(events == "ev1") |> pull(df) |> pluck(1) + expect_true("record_id" %in% names(ev1_df)) +}) + +# ---- 7) invalid `by` argument is rejected ---- +test_that("rd_split rejects invalid `by` argument", { + dic <- tibble(field_name = "record_id", field_type = "text", form_name = "meta") + data <- tibble(record_id = 1) + + expect_error( + rd_split(data = data, dic = dic, by = "nonsense"), + regexp = "Invalid `by` argument|either 'form' or 'event'", + ignore.case = TRUE + ) +}) + +# ---- 8) project argument overrides data/dic ---- +test_that("rd_split respects project argument over data/dic", { + fake_proj <- list( + data = tibble(record_id = 1), + dic = tibble(field_name = "record_id", field_type = "text", form_name = "meta"), + event_form = NULL + ) + + mock_check_proj <- function(project, data, dic, event_form) { + list(data = fake_proj$data, dic = fake_proj$dic, event_form = fake_proj$event_form) + } + + with_mocked_bindings( + check_proj = mock_check_proj, + { + res <- rd_split(project = fake_proj) + expect_true("form" %in% names(res$data)) + } + ) +}) + +# ---- 9) which argument selects a single form ---- +test_that("rd_split returns only selected form when which is supplied", { + dic <- tibble( + field_name = c("record_id", "a1", "b1"), + field_type = c("text", "text", "text"), + form_name = c("meta", "form_a", "form_b") + ) + data <- tibble(record_id = 1:2, a1 = 1:2, b1 = 3:4) + + res <- rd_split(data = data, dic = dic, by = "form", which = "form_a") + expect_true(all(c("record_id", "a1") %in% names(res$data))) + expect_false("b1" %in% names(res$data)) +}) + +# ---- 10) which argument with multiple values warns ---- +test_that("rd_split warns if multiple which values are supplied", { + dic <- tibble( + field_name = c("record_id", "a1"), + field_type = c("text", "text"), + form_name = c("meta", "form_a") + ) + data <- tibble(record_id = 1:2, a1 = c("x", "y")) + + expect_warning( + res <- rd_split(data = data, dic = dic, by = "form", which = c("form_a", "form_b")), + regexp = "only the first will be used" + ) +}) + +# ---- 11) wide = TRUE expands into wide format ---- +test_that("rd_split expands to wide format when wide = TRUE", { + dic <- tibble( + field_name = c("record_id", "abc", "abc_aba"), + field_type = c("text", "text", "text"), + form_name = c("meta", "meta", "form_a") + ) + data <- tibble( + record_id = c(1,1,2), + abc = c("x","y","z"), + abc_aba = c("x","y","z") + ) + + res <- rd_split(data = data, dic = dic, by = "form", wide = TRUE) + df_form_a <- res$data |> filter(form == "form_a") |> pull(df) |> pluck(1) + + expect_true(any(grepl("1", names(df_form_a)))) +}) + +# ---- 12) repeated instruments branch ---- +test_that("rd_split handles repeated instruments correctly", { + dic <- tibble( + field_name = c("record_id", "var0", "var1"), + field_type = c("text", "text", "text"), + form_name = c("formX", "formX", "formX") + ) + + data <- tibble( + record_id = c(1,1,2), + # redcap_event_name = c("visit1", "visit1", "visit1"), + # redcap_event_name.factor = c("Visit1", "Visit1", "Visit1"), + # redcap_data_access_group = c("hosp1", "hosp1", "hosp2"), + # redcap_data_access_group.factor = c("Hosp1", "Hosp1", "Hosp2"), + redcap_repeat_instrument = c("formX", "formX", "formX"), + redcap_repeat_instrument.factor = c("FormX", "FormX", "FormX"), + redcap_repeat_instance = c(1:3), + var0 = c("2", "a", "3"), + var1 = c("a","b","c") + ) + + res <- rd_split(data = data, dic = dic, by = "form") + df_formX <- res$data |> filter(form == "formX") |> pull(df) |> pluck(1) + + expect_true("var1" %in% names(df_formX)) + expect_false("redcap_repeat_instrument.factor" %in% names(df_formX)) +}) + +# ---- 13) errors if data or dic missing ---- +test_that("rd_split errors if data or dic are missing", { + dic <- tibble(field_name = "record_id", field_type = "text", form_name = "meta") + expect_error(rd_split(data = NULL, dic = dic), regexp = "must be provided") + expect_error(rd_split(data = tibble(record_id = 1), dic = NULL), regexp = "must be provided") +}) + diff --git a/tests/testthat/test-rd_transform.R b/tests/testthat/test-rd_transform.R new file mode 100644 index 0000000..c44c6ef --- /dev/null +++ b/tests/testthat/test-rd_transform.R @@ -0,0 +1,172 @@ +test_that("function stops if data or dic is missing", { + expect_error(rd_transform(data = NULL, dic = covican$dictionary), + "Both `data` and `dic`") + expect_error(rd_transform(data = covican$data, dic = NULL), + "Both `data` and `dic`") +}) + +test_that("final_format argument validation works", { + expect_error(rd_transform(data = covican$data, dic = covican$dictionary, final_format = "invalid"), + "final_format argument has to be one of") +}) + +test_that("which_event and which_form validation works", { + expect_error(rd_transform(data = covican$data, dic = covican$dictionary, which_event = "baseline_visit_arm_1"), + "Which event has been specified but the final format is not to split the data by event") + expect_error(rd_transform(data = covican$data, dic = covican$dictionary, which_form = unique(covican$dictionary$form_name)[1]), + "Which form has been specified but the final format is not to split the data by form") +}) + +test_that("wide argument validation works", { + expect_error(rd_transform(data = covican$data, dic = covican$dictionary, wide = TRUE), + "The argument wide has been specified but the final format is not to split the data by form") +}) + +test_that("deleting variables works", { + # pick a variable that exists + delete_var <- intersect("inc_1", names(covican$data)) + skip_if(length(delete_var) == 0, "No variable available to delete") + res <- covican |> + rd_transform(delete_vars = delete_var) |> + suppressMessages() |> + suppressWarnings() + expect_false(delete_var %in% names(res$data)) +}) + +test_that("checkbox transformation occurs", { + res <- covican |> + rd_transform() |> + suppressMessages() |> + suppressWarnings() + expect_true(any(!grepl("___1", res$data))) + expect_true(any(!grepl("___1", res$dictionary$field_name))) +}) + +test_that("recalculation occurs when applicable", { + res <- covican |> + rd_transform() |> + suppressMessages() |> + suppressWarnings() + expect_true(any(grepl("_recalc", names(res$data)))) +}) + +test_that("branching logic is transformed", { + res <- covican |> + rd_transform() |> + suppressMessages() |> + suppressWarnings() + expect_true(any(grepl("Converting every branching logic in the dictionary into R logic", res$results))) +}) + +test_that("final output contains required components", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + res <- covican |> + rd_transform() |> + suppressMessages() |> + suppressWarnings() + expect_true(all(c("data", "dictionary", "event_form", "results") %in% names(res))) +}) + +test_that("final_format 'by_event' works", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + res <- covican |> + rd_transform(final_format = "by_event") |> + suppressMessages() |> + suppressWarnings() + expect_true(is.list(res$data)) +}) + +test_that("final_format 'by_form' works", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + res <- covican |> + rd_transform(final_format = "by_form") |> + suppressMessages() |> + suppressWarnings() + expect_true(is.list(res$data)) +}) + +test_that("function works when project argument is provided", { + res <- rd_transform(project = covican) |> + suppressMessages() |> + suppressWarnings() + expect_true(is.list(res)) + expect_true("data" %in% names(res)) + expect_true("dictionary" %in% names(res)) +}) + +test_that("deleting variables by pattern works", { + res <- rd_transform( + data = covican$data, + dic = covican$dictionary, + delete_pattern = "_complete$" + ) |> + suppressMessages() |> + suppressWarnings() + expect_false(any(grepl("_complete$", names(res$data)))) +}) + +test_that("exclude_to_factor prevents conversion", { + var_to_exclude <- covican$dictionary$field_name[1] + res <- rd_transform( + data = covican$data, + dic = covican$dictionary, + exclude_to_factor = var_to_exclude + ) |> + suppressMessages() |> + suppressWarnings() + expect_false(paste0(var_to_exclude, ".factor") %in% names(res$data)) +}) + +test_that("final_format 'by_form' works with wide format", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + res <- covican |> + rd_transform(final_format = "by_form", wide = TRUE) |> + suppressMessages() |> + suppressWarnings() + expect_true(is.list(res$data)) +}) + +test_that("which_event extracts a single event", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + first_event <- covican$event_form$unique_event_name[1] + res <- rd_transform( + data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form, + final_format = "by_event", + which_event = first_event + ) |> + suppressMessages() |> + suppressWarnings() + expect_true(unique(res$data$redcap_event_name) == first_event) +}) + +test_that("which_form extracts a single form", { + skip_if(is.null(covican$event_form), "covican$event_form not present") + first_form <- unique(covican$dictionary$form_name)[1] + res <- rd_transform( + data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form, + final_format = "by_form", + which_form = first_form + ) |> + suppressMessages() |> + suppressWarnings() + expect_true(unique(res$data$redcap_event_name) == "baseline_visit_arm_1") +}) + +test_that("function handles repeated instruments", { + first_form <- unique(covican$dictionary$form_name)[1] + + data <- covican$data |> + dplyr::mutate(redcap_repeat_instrument = first_form, + redcap_repeat_instrument.factor = stringr::str_to_sentence(redcap_repeat_instrument)) + + skip_if(!"redcap_repeat_instrument" %in% names(data), "No repeated instruments in covican") + + res <- rd_transform(data = data, dic = covican$dictionary, event_form = covican$event_form) |> + suppressMessages() |> + suppressWarnings() + expect_true(is.list(res)) +}) diff --git a/tests/testthat/test-redcap_data.R b/tests/testthat/test-redcap_data.R new file mode 100644 index 0000000..c96bae1 --- /dev/null +++ b/tests/testthat/test-redcap_data.R @@ -0,0 +1,422 @@ +# Helper that writes a minimal exported R file (same approach as in your example) +write_redcap_r_export <- function(data, path) { + con <- file(path, "w") + # put two leading lines (function expects to skip 2 lines) + writeLines("## REDCap R export", con) + writeLines("## begin data", con) + writeLines("data <- ", con) + dput(data, con) + close(con) +} + +test_that("Exported-files path: successful import returns data, dictionary and event_form", { + # Sample data + sample_data <- as.data.frame(matrix(1:9, nrow = 3)) + names(sample_data)[1] <- "id" # will be renamed to record_id by the function + attr(sample_data[[2]], "label") <- "Test label" + + # Prepare small dictionary file (first row contains header names) + # The function reads csv with header=FALSE and uses first row as names + dic_rows <- data.frame( + field_name = c("id"), + form_name = c("demographics"), + field_type = c("text"), + stringsAsFactors = FALSE, + check.names = FALSE + ) + + # Event form mapping (valid — must NOT contain `event_name` column) + event_form <- data.frame(form = "demographics", other = "x", stringsAsFactors = FALSE) + + # Write files + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE, quote = FALSE) + + tmp_event <- tempfile(fileext = ".csv") + write.csv(event_form, tmp_event, row.names = FALSE, quote = FALSE) + + out <- redcap_data(data_path = tmp_r, dic_path = tmp_dic, event_path = tmp_event) + + expect_true(is.list(out)) + expect_true("data" %in% names(out)) + expect_true("dictionary" %in% names(out)) + expect_true("event_form" %in% names(out)) + + # data first column must be renamed to record_id by function + expect_equal(names(out$data)[1], "record_id") +}) + +test_that("Unsupported dictionary extension errors", { + tmp_r <- tempfile(fileext = ".R") + sample_data <- as.data.frame(matrix(1:4, nrow = 2)) + write_redcap_r_export(sample_data, tmp_r) + + tmp_bad_dic <- tempfile(fileext = ".txt") + writeLines("garbage", tmp_bad_dic) + + expect_error( + redcap_data(data_path = tmp_r, dic_path = tmp_bad_dic), + "Unsupported dictionary format" + ) +}) + +test_that("Event file containing 'event_name' column triggers informative error", { + tmp_r <- tempfile(fileext = ".R") + sample_data <- as.data.frame(matrix(1:4, nrow = 2)) + write_redcap_r_export(sample_data, tmp_r) + + # Good dictionary + dic_rows <- data.frame( + field_name = c("id"), + form_name = c("demographics"), + field_type = c("text"), + stringsAsFactors = FALSE, + check.names = FALSE + ) + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE, quote = FALSE) + + # Bad event file — has `event_name` column (simulates wrong file) + bad_event <- data.frame(event_name = "e1", stringsAsFactors = FALSE) + tmp_bad_event <- tempfile(fileext = ".csv") + write.csv(bad_event, tmp_bad_event, row.names = FALSE, quote = FALSE) + + expect_error( + redcap_data(data_path = tmp_r, dic_path = tmp_dic, event_path = tmp_bad_event), + "Invalid file provided in `event_path`" + ) +}) + +test_that("Longitudinal project without event_path issues a warning", { + # create exported file with a redcap_event_name column to trigger the longitudinal branch + sample_data <- data.frame(A = 1:2, redcap_event_name = c("ev1", "ev2"), stringsAsFactors = FALSE) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + # dictionary + dic_rows <- data.frame( + field_name = c("id"), + form_name = c("demographics"), + field_type = c("text"), + stringsAsFactors = FALSE, + check.names = FALSE + ) + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE, quote = FALSE) + + expect_warning( + res <- redcap_data(data_path = tmp_r, dic_path = tmp_dic), + "The project is longitudinal. Consider providing `event_path`" + ) + + # result should still be returned and contain dictionary + expect_true(is.list(res)) + expect_true("dictionary" %in% names(res)) +}) + +test_that("Descriptive fields are removed from dictionary", { + sample_data <- data.frame(id = 1:2) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + # Create dictionary where one field is descriptive + dic_rows <- data.frame( + field_name = c("id"), + form_name = c("demographics"), + field_type = c("text"), + stringsAsFactors = FALSE, + check.names = FALSE + ) + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE, quote = FALSE) + + out <- redcap_data(data_path = tmp_r, dic_path = tmp_dic) + expect_false("descfield" %in% out$dictionary$field_name) +}) + + +test_that("API branch: SSL error in labels fetch is converted to helpful stop message", { + # Make a stub that raises an error with SSL phrase + fake_ssl_error <- function(...) stop("SSL peer certificate: something went wrong", call. = FALSE) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_ssl_error) + + expect_error( + redcap_data(uri = "https://api.example", token = "tok"), + "Unable to establish a secure connection" + ) +}) + +test_that("API branch: if labels retrieval returns zero rows a friendly error is thrown", { + empty_labels <- data.frame() # zero-row data.frame + fake_read_empty_labels <- function(redcap_uri = NULL, token = NULL, verbose = FALSE, raw_or_label = "label", raw_or_label_headers = NULL, export_data_access_groups = NULL, export_survey_fields = NULL, fields = NULL) { + return(list(data = empty_labels)) + } + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read_empty_labels) + + expect_error( + redcap_data(uri = "https://api.example", token = "tok"), + "Data retrieval is currently unavailable" + ) +}) + +test_that("API branch: when event_path is provided it warns and attempts to read it", { + # Reuse fake functions that return minimal data (labels + raw) and metadata + labels_df <- data.frame(record_id = 1L, stringsAsFactors = FALSE, check.names = FALSE) + data_api <- data.frame(record_id = "1", stringsAsFactors = FALSE, check.names = FALSE) + # Add a form_name column — redcap_data filters on form_name later + dic_api <- data.frame( + field_name = "record_id", + field_type = "text", + form_name = "form1", + stringsAsFactors = FALSE, + check.names = FALSE + ) + + fake_redcap_read2 <- function(redcap_uri = NULL, token = NULL, verbose = FALSE, raw_or_label = "raw", raw_or_label_headers = NULL, export_data_access_groups = NULL, export_survey_fields = NULL, fields = NULL) { + if (identical(raw_or_label, "label")) return(list(data = labels_df)) + if (identical(raw_or_label, "raw")) return(list(data = data_api)) + stop("unexpected") + } + fake_redcap_metadata_read2 <- function(...) list(data = dic_api) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_redcap_read2) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_redcap_metadata_read2) + + # create a valid event CSV (not the events export) + event_form <- data.frame(form = "form1", stringsAsFactors = FALSE) + tmp_event <- tempfile(fileext = ".csv") + write.csv(event_form, tmp_event, row.names = FALSE) + + expect_warning( + out <- redcap_data(uri = "https://api.example", token = "tok", event_path = tmp_event), + "The event_path argument is not required when using an API connection." + ) + + expect_true("event_form" %in% names(out)) +}) + + +test_that("Unsupported data_path extension errors", { + tmp_bad <- tempfile(fileext = ".txt") + writeLines("nonsense", tmp_bad) + + expect_error( + redcap_data(data_path = tmp_bad, dic_path = tmp_bad), + "Unsupported file format" + ) +}) + +test_that("Unsupported event mapping extension errors", { + sample_data <- data.frame(id = 1:2) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + dic_rows <- data.frame(field_name = "id", form_name = "f1", field_type = "text") + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE) + + tmp_bad_event <- tempfile(fileext = ".json") + writeLines("{}", tmp_bad_event) + + expect_error( + redcap_data(data_path = tmp_r, dic_path = tmp_dic, event_path = tmp_bad_event), + "Unsupported event mapping format" + ) +}) + +test_that("Dictionary first field renamed to record_id if not already", { + sample_data <- data.frame(A = 1:2) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + dic_rows <- data.frame(field_name = "not_record_id", form_name = "f1", field_type = "text") + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE) + + out <- redcap_data(data_path = tmp_r, dic_path = tmp_dic) + expect_equal(out$dictionary$field_name[1], "record_id") +}) + +test_that("Empty strings are converted to NA in character columns", { + sample_data <- data.frame(id = 1:2, textcol = c("a", "")) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + dic_rows <- data.frame(field_name = "id", form_name = "f1", field_type = "text") + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE) + + out <- redcap_data(data_path = tmp_r, dic_path = tmp_dic) + expect_true(is.na(out$data$textcol[2])) +}) + +test_that("Variables not linked to event_form are removed with warning", { + sample_data <- data.frame(id = 1:2, extra = c("a", "b")) + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(sample_data, tmp_r) + + dic_rows <- data.frame( + field_name = c("id", "extra"), + form_name = c("f1", "unlinked"), + field_type = "text" + ) + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE) + + event_form <- data.frame(form = "f1") + tmp_event <- tempfile(fileext = ".csv") + write.csv(event_form, tmp_event, row.names = FALSE) + + expect_warning( + out <- redcap_data(data_path = tmp_r, dic_path = tmp_dic, event_path = tmp_event), + "removed since they are not linked" + ) + expect_false("extra" %in% names(out$data)) +}) + +test_that("API branch: filter_field missing record_id triggers helpful error", { + fake_error <- function(...) { + stop("REDCap's PHP code is likely trying to process too much text in one bite", call. = FALSE) + } + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_error) + + expect_error( + redcap_data(uri = "https://api.example", token = "tok", filter_field = "fieldX"), + "record_id" + ) +}) + +test_that("API branch: observational data retrieval with zero rows errors", { + labels_df <- data.frame(record_id = 1) + fake_read <- function(redcap_uri = NULL, token = NULL, raw_or_label = "raw", ...) { + if (raw_or_label == "label") return(list(data = labels_df)) + if (raw_or_label == "raw") return(list(data = data.frame())) # zero rows + stop("unexpected") + } + fake_meta <- function(...) list(data = data.frame(field_name = "record_id", field_type = "text")) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_meta) + + expect_error( + redcap_data(uri = "https://api.example", token = "tok"), + "Observational data retrieval is currently unavailable" + ) +}) + +test_that("API branch: descriptive fields are filtered from dictionary", { + labels_df <- data.frame(record_id = 1) + data_api <- data.frame(record_id = 1) + dic_api <- data.frame(field_name = "junk", field_type = "descriptive", form_name = "f1") + + fake_read <- function(redcap_uri = NULL, token = NULL, raw_or_label = "raw", ...) { + if (raw_or_label == "label") return(list(data = labels_df)) + if (raw_or_label == "raw") return(list(data = data_api)) + stop("unexpected") + } + fake_meta <- function(...) list(data = dic_api) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_meta) + + out <- redcap_data(uri = "https://api.example", token = "tok") + expect_false("junk" %in% out$dictionary$field_name) +}) + +test_that("API branch: checkbox fields get factor versions", { + labels_df <- data.frame(record_id = 1) + data_api <- data.frame(record_id = 1, var___1 = "1") + dic_api <- data.frame(field_name = "var", field_type = "checkbox", form_name = "f1") + + fake_read <- function(redcap_uri = NULL, token = NULL, raw_or_label = "raw", ...) { + if (raw_or_label == "label") return(list(data = labels_df)) + if (raw_or_label == "raw") return(list(data = data_api)) + stop("unexpected") + } + fake_meta <- function(...) list(data = dic_api) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_meta) + + out <- redcap_data(uri = "https://api.example", token = "tok") + expect_true("var___1.factor" %in% names(out$data)) +}) + +test_that("API branch: radio/dropdown fields produce factor versions", { + labels_df <- data.frame(record_id = 1) + data_api <- data.frame(record_id = 1, radio1 = "1") + dic_api <- data.frame( + field_name = "radio1", + field_type = "radio", + form_name = "f1", + choices_calculations_or_slider_labels = "1, Yes | 2, No", + stringsAsFactors = FALSE + ) + + fake_read <- function(redcap_uri = NULL, token = NULL, raw_or_label = "raw", ...) { + if (raw_or_label == "label") return(list(data = labels_df)) + if (raw_or_label == "raw") return(list(data = data_api)) + stop("unexpected") + } + fake_meta <- function(...) list(data = dic_api) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_meta) + + out <- redcap_data(uri = "https://api.example", token = "tok") + expect_true("record_id.factor" %in% names(out$data)) + expect_true(is.factor(out$data$record_id.factor)) +}) + + +test_that("API branch: longitudinal without event_path fetches event_form via API", { + labels_df <- data.frame(record_id = 1, redcap_event_name = "ev1") + data_api <- labels_df + dic_api <- data.frame(field_name = "record_id", field_type = "text", form_name = "f1") + event_api <- data.frame(form = "f1") + + fake_read <- function(redcap_uri = NULL, token = NULL, raw_or_label = "raw", ...) { + if (raw_or_label == "label") return(list(data = labels_df)) + if (raw_or_label == "raw") return(list(data = data_api)) + stop("unexpected") + } + fake_meta <- function(...) list(data = dic_api) + fake_event <- function(...) list(data = event_api) + + mockery::stub(redcap_data, "REDCapR::redcap_read", fake_read) + mockery::stub(redcap_data, "REDCapR::redcap_metadata_read", fake_meta) + mockery::stub(redcap_data, "REDCapR::redcap_event_instruments", fake_event) + + out <- redcap_data(uri = "https://api.example", token = "tok") + expect_true("event_form" %in% names(out)) +}) + +test_that("Supplying both file and API arguments errors", { + tmp_r <- tempfile(fileext = ".R") + write_redcap_r_export(data.frame(id = 1), tmp_r) + + dic_rows <- data.frame(field_name = "id", form_name = "f1", field_type = "text") + tmp_dic <- tempfile(fileext = ".csv") + write.csv(dic_rows, tmp_dic, row.names = FALSE) + + expect_error( + redcap_data(data_path = tmp_r, dic_path = tmp_dic, uri = "u", token = "t"), + "Too many arguments" + ) +}) + +test_that("Supplying only uri or only token errors", { + expect_error( + redcap_data(uri = "https://api.example"), + "Both `uri` and `token` are required" + ) + + expect_error( + redcap_data(token = "tok"), + "Both `uri` and `token` are required" + ) +}) diff --git a/vignettes/Data-reading-and-processing.Rmd b/vignettes/Data-reading-and-processing.Rmd deleted file mode 100644 index 77ea495..0000000 --- a/vignettes/Data-reading-and-processing.Rmd +++ /dev/null @@ -1,149 +0,0 @@ ---- -title: "REDCapDM - Data reading and processing" -output: - rmarkdown::html_vignette: - toc: true - toc_depth: 5 - number_sections: true -vignette: > - %\VignetteIndexEntry{REDCapDM - Data reading and processing} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - chunk_output_type: inline ---- - - -```{r message=FALSE, warning=FALSE, include=FALSE} -rm(list = ls()) -library(REDCapDM) -library(kableExtra) -library(knitr) -library(dplyr) -library(magrittr) -library(purrr) -``` - -
- -This vignette provides a summary of the straightforward and common use of [REDCapDM](https://github.com/bruigtp/REDCapDM) to interact with [REDCap](https://www.project-redcap.org/) data. - -
- -# **Read data** - -To import data from [REDCap](https://www.project-redcap.org/), you can use the [`redcap_data()`](https://bruigtp.github.io/REDCapDM/reference/redcap_data.html) function, which provides two primary methods: importing data from local files or establishing an API connection. - -## **Local files** - -Before starting, ensure you have the required R and CSV files exported from [REDCap](https://www.project-redcap.org/), including the instrument-event mappings file. All these files should be in the same directory for the package to work correctly. - -Use the `data_path` and `dic_path` arguments to indicate the paths to your R data file and [REDCap](https://www.project-redcap.org/) project's dictionary file, respectively. If your [REDCap](https://www.project-redcap.org/) project is longitudinal, you'll additionally need to supply the event-form mapping file using the `event_path` argument. - -```{r message=FALSE, warning=FALSE, comment=NA, eval=FALSE} -dataset <- redcap_data(data_path = "C:/Users/username/example.r", - dic_path = "C:/Users/username/example_dictionary.csv", - event_path = "C:/Users/username/events.csv") -``` - -## **API connection** - -If you opt for an API connection, you can provide the `uri` (uniform resource identifier) and `token` (user-specific password) for your [REDCap](https://www.project-redcap.org/) project. This method will automatically retrieve the event-form mapping if your project is longitudinal. - -Use both arguments to set up the API connection and import the data: - -```{r eval=FALSE, message=FALSE, warning=FALSE, comment=NA} -dataset_api <- redcap_data(uri = "https://redcap.idibell.cat/api/", - token = "55E5C3D1E83213ADA2182A4BFDEA") -``` - -## **Output** - -The [`redcap_data()`](https://bruigtp.github.io/REDCapDM/reference/redcap_data.html) function returns a list with three elements: - -- Imported data: Contains the data from your [REDCap](https://www.project-redcap.org/) project - -- Dictionary: Provides information about variables and their associated labels. - -- Event-form mapping (only available for longitudinal projects): Describes the correspondence between events and forms in your project. - -
-
- -# **Process data** - -Having successfully imported our data into R, you can now use the [`rd_transform()`](https://bruigtp.github.io/REDCapDM/reference/rd_transform.html) function to start processing the data. - -This function performs several transformations: - -- Elimination of selected variables - -- Elimination of variables containing certain patterns such as '_complete' and '_timestamp' - -- Recalculation of [REDCap](https://www.project-redcap.org/) calculated fields - -- Checkbox transformation by changing their names to the names of their options - -- Replacement of the original variables with their factor version - -- Branching logic transformation, converting [REDCap](https://www.project-redcap.org/) logic to R logic. - - -## **Standard** - -The only essential elements that must be supplied are the dataset to be transformed and the corresponding dictionary. In the case of a longitudinal project, it is advisable to also specify the event form dataset to take full advantage of this function. These elements can be directly specified using the output of the [`redcap_data()`](https://bruigtp.github.io/REDCapDM/reference/redcap_data.html) function or separately using distinct arguments: - -```{r message=FALSE, warning=FALSE, comment=NA} -#Option A: list object -covican_transformed <- rd_transform(covican) - -#Option B: separately with different arguments -covican_transformed <- rd_transform(data = covican$data, - dic = covican$dictionary, - event_form = covican$event_form) -``` - -This function returns a list containing the transformed dataset, dictionary, event_form and the results of each transformation. To retrieve the results of the transformation, use the following code block: - -```{r message=FALSE, warning=FALSE, comment=NA} -#Print the results of the transformation -covican_transformed$results -``` - -## **By event** - -If the [REDCap](https://www.project-redcap.org/) project is longitudinal, you can further adjust the structure of the transformed dataset. For example, it can be split by event: - -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - final_format = "by_event") -``` - -Where the transformed dataset is a tibble object, containing data frames for each event in the [REDCap](https://www.project-redcap.org/) project. - -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -dataset$data -``` - -## **By form** - -Or, alternatively, it can be split by form: - -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - final_format = "by_form") -``` - -Where the tibble object is composed by data frames corresponding to each form in the [REDCap](https://www.project-redcap.org/) project. - -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -dataset$data -``` - -
-
- -**For more information, consult the complete vignette available at: https://bruigtp.github.io/REDCapDM/articles/REDCapDM.html** - -
-
diff --git a/vignettes/REDCapDM.Rmd b/vignettes/REDCapDM.Rmd index 721dd03..7e414e7 100644 --- a/vignettes/REDCapDM.Rmd +++ b/vignettes/REDCapDM.Rmd @@ -21,7 +21,6 @@ library(REDCapDM) library(kableExtra) library(knitr) library(dplyr) -library(magrittr) library(purrr) ``` @@ -30,28 +29,44 @@ library(purrr) # **Introduction** -The REDCapDM package allows users to read data exported directly from REDCap or via API connection. It also allows users to process the previously downloaded data, create reports of queries such as outliers or missing values and track the identified queries. +The REDCapDM package provides a comprehensive toolkit for managing data exported from REDCap. It supports both importing REDCap data (from files or via API), transforming and cleaning the data according to the project’s dictionary and logic, and generating query reports for data validation. In particular, REDCapDM can identify missing or out-of-range values and track changes in identified queries across data versions.

# **Functions** -Functions included in the package: +All main functions are listed below (and described in detail in the examples): -- `redcap_data()`: reads data. +- `redcap_data()`: Read REDCap data into R. -- `rd_transform()`: processes data. +- `rd_dates()`: Standardize date and datetime fields. -- `rd_rlogic()`: transforms REDCap logic into R logic. +- `rd_delete_vars()`: Remove specified variables (by name or pattern). -- `rd_insert_na()`: allows a manual entry of a missing value in specific variables using a filter. +- `rd_recalculate()`: Recompute calculated fields and compare with REDCap values. -- `rd_query()`: identifies queries. +- `rd_factor()`: Replace numeric multiple-choice columns with their factor version. -- `rd_event()`: identifies missing events. +- `rd_checkbox()`: Expand checkbox responses with custom labels and rename `var___1` columns (REDCap style) to `var_option`. -- `check_queries()`: tracks queries. +- `rd_split()`: Split dataset by form or event. + +- `rd_insert_na()`: Manually set specified variables to missing based on a logical filter. + +- `rd_rlogic()`: Translate REDCap branching or calculation logic into R syntax. + +- `rd_dictionary()`: Update dictionary (translation of REDCap logic into R syntax) to reflect transformed data and logic. + +- `rd_transform()`: One-step pipeline to clean and preprocess the raw REDCap data. + +- `rd_query()`: Apply expressions to identify data queries/issues. + +- `rd_event()`: Report missing/incomplete events per record (longitudinal). + +- `check_queries()`: Compare two query reports to track changes made. + +- `rd_export`: Export query/report tables to an Excel (.xlsx) file.

@@ -98,12 +113,12 @@ descr <- c("Identifier of each record", "", "Indicator of leukemia or lymphoma", "No ; Yes", "Indicator of acute leukemia", "No ; Yes") -vars <- data.frame("Name" = names(covican$data %>% dplyr::select(record_id:acute_leuk)), +vars <- data.frame("Name" = names(covican$data |> dplyr::select(record_id:acute_leuk)), "Description" = descr[seq(1, length(descr), 2)], "Categories" = descr[seq(2, length(descr), 2)]) -kable(vars) %>% - kableExtra::row_spec(0, bold=TRUE) %>% +kable(vars) |> + kableExtra::row_spec(0, bold=TRUE) |> kableExtra::kable_styling(full_width = F) ``` @@ -126,7 +141,7 @@ dataset <- redcap_data(data_path = "C:/Users/username/example.r", dic_path = "C:/Users/username/example_dictionary.csv") ``` -Note: The R and CSV files exported from REDCap must be located in the same directory. +> Note: The R and CSV files exported from REDCap must be located in the same directory. If the REDCap project is longitudinal (contains more than one event) then a third element should be specified with the correspondence of each event with each form of the project. This csv file can be downloaded in the REDCap of the project following these steps: _Project Setup_ < _Designate Instruments for My Events_ < _Download instrument-event mappings (CSV)_. @@ -136,7 +151,7 @@ dataset <- redcap_data(data_path = "C:/Users/username/example.r", event_path = "C:/Users/username/events.csv") ``` -Note: if the project is longitudinal and the event-form file is not provided using the `event_path` argument, some steps of the processment can not be performed. +> Note: if the project is longitudinal and the event-form file is not provided using the `event_path` argument, some steps of the processment can not be performed. Another way to read data exported from a REDCap project is using an API connection. To do this, we can use the arguments `uri` and `token` which respectively refer to the uniform resource identifier of the REDCap project and the user-specific string that serves as the password: @@ -147,21 +162,309 @@ dataset_api <- redcap_data(uri = "https://redcap.idibell.cat/api/", In this case, there is no need to specify the event-form file since the function will download it automatically using the API connection, if the project is longitudinal. -**Warning**: Please keep in mind that the API token gives you special access to the REDCap project and that it should not be shared with other people. +> **Warning**: Please keep in mind that the API token gives you special access to the REDCap project and that it should not be shared with other people. This function returns a list with 3 elements (imported data, dictionary and event-form mapping) which can then be used for further analysis or visualization. ## **Process** -### **rd_transform** +As previously stated, we will use the built-in dataset `REDCapDM::covican` as an example. -The main function involved in the processing of the data is `rd_transform()`. This function is used to process the REDCap data read into R using the `redcap_data()`, as described above. Using the arguments of the function we can perform different type of transformations of our data. +For all the following functions, the only necessary elements that must be provided are the dataset to be transformed and the corresponding dictionary. If the project is longitudinal, as in the case of `REDCapDM::covican`, also the event-form dataset should be specified. These elements can be specified directly using the output of the `redcap_data()` function or separately in different arguments. -As previously stated, we will use the built-in dataset `REDCapDM::covican` as an example. +### **rd_dates** -#### *Data transformation* +This function is designed to process and standardize `date` and `datetime` fields in a REDCap dataset. In REDCap projects, date and datetime fields can sometimes be stored as character strings, which can make analyses difficult. It detects which fields should be dates/datetimes from the REDCap dictionary and converts them to `Date` and `POSIXct`, respectively. + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +# Option A: list object +covican_dates <- covican |> rd_dates() + +# Option B: provide components separately +covican_dates <- rd_dates(data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form) +``` + +Quick verification example: + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +# Simulate a character date since covican already has the dates in the correct format +covican_dates <- covican +covican_dates$data <- covican_dates$data |> + dplyr::mutate(d_birth = as.character(d_birth)) +# Check class before conversion + +class(covican_dates$data$d_birth) + +# Check class after conversion +covican_dates <- covican_dates |> rd_dates() +class(covican_dates$data$d_birth) +``` + +After this transformation, all `date` and `datetime` variables are standardized and ready for analysis in R. + +
+ +### **rd_delete_vars** + +This function removes unwanted variables from both a REDCap dataset and its dictionary, keeping the data and metadata consistent. +This is especially useful for eliminating automatically generated fields such as form completion flags (`*_complete`) or timestamps (`*_timestamp`). + +You can delete variables either by specifying their exact names or by using regular expression patterns: + +```{r} +# Option A: delete by variable name +covican_deleted <- covican |> + rd_delete_vars(vars = c("potassium", "leuk_lymph")) + +# Option B: delete by regex pattern +covican_deleted <- covican |> + rd_delete_vars(pattern = c("_complete$", "_timestamp$")) +``` + +When variables are deleted: + +- They are removed from both the dataset and dictionary. + +- Factor versions of deleted variables (if present) are also removed. + +
+ +### **rd_recalculate** + +This function identifies calculated fields in a REDCap project, translates their logic into R, recalculates them, and compares the recalculated values with the originals. +It produces both field-level and project-level reports, helping users detect discrepancies between REDCap’s stored calculations and the values recomputed in R. + +```{r} +covican_recalc <- covican |> + rd_recalculate() + +# Print recalculation results +covican_recalc$results +``` + +The `results` object contains: + +- Summary report – total number of calculated fields, how many were successfully transcribed into R logic, and how many recalculated values differ from the originals. + +- Field-level report – lists each calculated field, whether its logic was transcribed, and whether the recalculated value matches the original. + +Example: excluding specific variables + +You can exclude certain fields from recalculation (e.g., complex multi-event calculations) to reduce computation time and avoid unnecessary warnings. + + +```{r} +# Exclude specific variables from recalculation +covican_recalc <- covican |> + rd_recalculate(exclude_recalc = c("screening_fail_crit", "resp_rate")) + +covican_recalc$results +``` + +When recalculation succeeds: + +- A new variable is added to the dataset with the suffix `_recalc.` + +- A corresponding entry is added to the dictionary with the label `". (Recalculate)"`. + +
+ +### **rd_factor** + +This function converts categorical variables in a REDCap dataset into R factors. +It detects `.factor` columns (created by REDCap for multiple-choice fields) and merges them into the original variables, while preserving labels and updating the dictionary’s branching logic. + +```{r} +factored <- covican |> + rd_factor() + +# Checking class of the variable +str(factored$data$available_analytics) +``` + +You can prevent certain variables from being converted to factors using the `exclude` argument. +This is useful if you need to keep some variables as raw numeric or text data. + +```{r} +factored <- covican |> + rd_factor(exclude = c("available_analytics", "urine_culture")) + +# Checking class of the variable +str(covican$data$available_analytics) +``` + +> Note: the function automatically excludes these system variables from conversion: `redcap_event_name`, `redcap_repeat_instrument`, `redcap_data_access_group`. These variables are retained as-is to avoid interfering with longitudinal event mappings or user access groups. + +After conversion, original variables are replaced with proper R factor columns and their `.factor` counterparts are dropped. + +
+ +### **rd_checkbox** + +This function processes REDCap checkbox fields, converting them from "Checked"/"Unchecked" categories into binary-coded variables (0/1) with user-specified labels. +It can also rename variables to match checkbox option labels and updates dictionary branching logic accordingly. + +```{r} +# Default transformation: "No"/"Yes" labels, renamed variables +cb <- covican |> + rd_checkbox() + +str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) +``` + +You can specify alternative labels: + +```{r} +cb <- covican |> + rd_checkbox(, checkbox_labels = c("Absent", "Present")) + +str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) +``` + +To retain the original REDCap-style names (e.g., varname___1, varname___2) instead of renaming to option text: + +```{r} +cb <- covican |> + rd_checkbox(checkbox_names = FALSE) + +str(cb$data$underlying_disease_hemato___1) +``` + +> Note: If a branching logic exists for a checkbox field, the function attempts to translate it into R, by default. When `checkbox_na = TRUE`, values outside the branching logic are set to NA. + + +A summary of problematic fields (e.g., missing branching logic or logic not transcribable) is included in the results element: + +```{r} +cb$results +``` + +
+ +### **rd_split** + +After preparing your dataset with, you may want to work with only one form or one event at a time. The `rd_split()` function separates your dataset accordingly. + +- **By form** + +For non-longitudinal projects (or longitudinal projects with an `event_form` mapping), you can split the dataset into smaller datasets based on forms. If repeated entries exist, you can reshape the data into wide format: + +> Note: For proper use of this function, ensure that `rd_factor()` and `rd_checkbox()` have been applied to your dataset. If not, the function will emit an error and prompt you to run both functions first. + +```{r} +forms_data <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_split(by = "form") + +forms_data$data +``` + +- **By event** + +For longitudinal projects, you can split by event instead. The function uses the `event_form` mapping to assign variables correctly to each event: + +```{r} +events_data <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_split(by = "event") + +events_data$data +``` + +If you want to extract only one form or event, use the `which` argument: -The only necessary elements that must be provided are the dataset to be transformed and the corresponding dictionary. If the project is longitudinal, as in the case of `REDCapDM::covican`, also the event-form dataset should be specified. These elements can be specified directly using the output of the `redcap_data()` function or separately in different arguments. +```{r} +# Example by form +baseline_data <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_split(by = "form", which = "demographics") + +# Checking the names of the variables collected in that form +vars_demo <- covican$dictionary |> + dplyr::filter(form_name == "demographics") |> + dplyr::pull(field_name) + +all(vars_demo %in% names(baseline_data$data)) +``` + +
+ +### **rd_insert_na** + +This function sets some values of a variable to missing if a certain logic is fulfilled. It can be used as a complementary function for `rd_transform()`, for example, to change the values of those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can perform a raw transformation of our data, as in section 4.2.1.1, and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: + +```{r message=FALSE, warning=FALSE, comment=NA} +#Raw transformation of the data: +dataset <- rd_transform(covican) + +data <- dataset$data + +#Before inserting missings +table(data$type_underlying_disease_haematological_cancer) + +#Run the function +data2 <- rd_insert_na(dataset, + event_form = covican$event_form, + vars = "type_underlying_disease_haematological_cancer", + filter = "age < 65") + +#After inserting missings +table(data2$type_underlying_disease_haematological_cancer) +``` + +Recall that both the variable to be transformed (_age_) and the variable included in the filter (_type_underlying_disease_haematological_cancer_) are in the same event. In the contrary, if the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted. + +
+ +### **rd_rlogic** + +This function transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic. This function is used in the `rd_transform()` to recalculate the calculated fields and convert the branching logics, but it may also be useful to use it in other circunstances. Let's see how it transforms the logic of one of the calculated fields in the built-in dataset: + +```{r message=FALSE, warning=FALSE, comment=NA} +logic_trans <- rd_rlogic(covican, + logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", + var = "screening_fail_crit") + +str(logic_trans) +``` + +
+ +### **rd_dictionary** + +When working with REDCap exports, the data dictionary contains field metadata, branching logic, and calculation rules written in REDCap logic. After cleaning your dataset with functions like `rd_factor()` and `rd_checkbox()`, the original dictionary may no longer match the transformed data. The rd_dictionary() function refreshes branching logic and calculations, translating them from REDCap logic into R logic, and ensures the dictionary remains consistent with the cleaned dataset. + +```{r} +# Update dictionary after cleaning +dict_result <- covican |> + rd_factor() |> + rd_checkbox() |> + rd_dictionary() + +# Review any branching logic issues +dict_result$results +``` + +When we transform the dictionary: + +- Updates branching logic expressions so they match factor labels rather than numeric codes. + +- Converts calculations and logic into R-friendly expressions. + +- Reports any fields where branching logic or calculations could not be converted. + +
+ +### **rd_transform** + +The main function involved in the processing of the data is `rd_transform()`. This function is used to process the REDCap data read into R using the `redcap_data()`, as described above. Using the arguments of the function we can perform all the different type of transformations described until now. Its a one-step transformation function! + +#### *Data transformation* ```{r message=FALSE, warning=FALSE, comment=NA} #Option A: list object @@ -189,13 +492,13 @@ In this case, we do not have any variable with the pattern '_complete' and '_tim
  • Recalculation of REDCap calculated fields: it finds all the calculated fields and recalculates them using the REDCap logic specified in the calculation field translated into R. The recalculated variable is saved as the original name adding '_recalc' at the end. It can happen that the logic found contains some specific smart-variables or other complex structures which the function is not able to transcribe. With the summary found in `results` we can see how many calculated fields have been found, if they have been transcribed and, if that is the case, if the recalculated variable is equal to the original one.
    • -Note: If the REDCap project is longitudinal and the event-form is not specified, this step will not be executed. +> Note: If the REDCap project is longitudinal and the event-form is not specified, this step will not be executed. In the example, we can see how there are two REDCap calculated fields, both have been transcribed successfully and the recalculation of the age does not match the original calculated variable from REDCap.
  • Checkbox transformation: by default, it changes the names of the checkboxes to the name of its corresponding option and the name of their labels to 'No/Yes'. If we want to specify another pair of label names we can specify them using the `checkbox_labels` argument as we will see. Furthermore, if the checkbox contains a branching logic, when this logic evaluated returns a missing value (some of the variables specified in it are missing) the values of the checkbox will be set to missing.
    • -Note: If the REDCap project is longitudinal and the event-form is not specified, the evaluations of the branching logic will not be done. +> Note: If the REDCap project is longitudinal and the event-form is not specified, the evaluations of the branching logic will not be done. For example, let's explain the transformation that undergo the variables corresponding to the checkbox field of the type of underlying disease. The variables were named originally as _type_underlying_disease___0_ and _type_underlying_disease___1_ although the name of the options are 'Haematological cancer' and 'Solid tumour'. Thus, in the transformed dataset, the names are converted to _type_underlying_disease_haematological_cancer_ and _type_underlying_disease_solid_tumour_. Then, since this checkbox variable does not have a branching logic, the variable is advised to be reviewed by the user in the `results`, as seen above. When reviewed we could use an additional function `rd_insert_na()` to insert the necessary missing values into this variable, as we will explain later. If a branching logic was found for this variable, `rd_transform` will insert automatically the missing values when the logic is not satisfied and no further transformation will be needed. @@ -227,7 +530,7 @@ dataset$data The column `df` of the nested dataframe is a list containing the data corresponding to each event. Also the variables of the forms that are found in each event are reported in the column `vars`. -Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. +> Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. #### *Data transformation and classification by form* @@ -247,7 +550,7 @@ As before, a final step in the transformation has been added, which is to split dataset$data ``` -Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. +> Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. #### *Additional arguments* @@ -349,46 +652,6 @@ head(dataset$data)
    -### **rd_rlogic** - -This function transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic. This function is used in the `rd_transform()` to recalculate the calculated fields and convert the branching logics, but it may also be useful to use it in other circunstances. Let's see how it transforms the logic of one of the calculated fields in the built-in dataset: - -```{r message=FALSE, warning=FALSE, comment=NA} -logic_trans <- rd_rlogic(covican, - logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", - var = "screening_fail_crit") - -str(logic_trans) -``` - -
    - -### **rd_insert_na** - -This function sets some values of a variable to missing if a certain logic is fulfilled. It can be used as a complementary function for `rd_transform()`, for example, to change the values of those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can perform a raw transformation of our data, as in section 4.2.1.1, and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: - -```{r message=FALSE, warning=FALSE, comment=NA} -#Raw transformation of the data: -dataset <- rd_transform(covican) - -data <- dataset$data - -#Before inserting missings -table(data$type_underlying_disease_haematological_cancer) - -#Run the function -data2 <- rd_insert_na(dataset, - event_form = covican$event_form, - vars = "type_underlying_disease_haematological_cancer", - filter = "age < 65") - -#After inserting missings -table(data2$type_underlying_disease_haematological_cancer) -``` - -Recall that both the variable to be transformed (_age_) and the variable included in the filter (_type_underlying_disease_haematological_cancer_) are in the same event. In the contrary, if the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted. - -
    ## **Queries** @@ -411,8 +674,8 @@ example <- rd_query(covican_transformed, ``` ```{r echo=FALSE, message=FALSE, warning=FALSE, comment=NA} -kable(head(example$queries)) %>% - kableExtra::row_spec(0, bold = TRUE) %>% +kable(head(example$queries)) |> + kableExtra::row_spec(0, bold = TRUE) |> kableExtra::kable_styling() example$results @@ -478,7 +741,7 @@ example$results The total number of missing values changes when we use the `filter` argument, the variable _potassium_ now presents 21 missing values instead of the previous 31 cases identified. This means that we were identifying 10 missing values in which _available_analytics_ did not have the value _Yes_ and, therefore, should not be considered as missing values. -Note: The `filter` argument is treated as a vector, which means that we can add a filter to each specified variable. Also, even if this argument is used to apply the branching logic condition, the warning about the presence of unconverted branching logic will still be displayed. In this specific case, you can safely ignore this warning. +> Note: The `filter` argument is treated as a vector, which means that we can add a filter to each specified variable. Also, even if this argument is used to apply the branching logic condition, the warning about the presence of unconverted branching logic will still be displayed. In this specific case, you can safely ignore this warning. #### *Expressions* @@ -611,7 +874,7 @@ example<- rd_query(covican_transformed, Output: ```{r echo=FALSE, message=FALSE, warning=FALSE, comment=NA} -kable(example$queries[1,]) %>% kableExtra::row_spec(0,bold=TRUE) %>% kableExtra::kable_styling() +kable(example$queries[1,]) |> kableExtra::row_spec(0,bold=TRUE) |> kableExtra::kable_styling() ```
    @@ -719,7 +982,7 @@ For this DAG, there are 3 values of _age_ bigger than 60 and 2 missing values in There is an easier way to have access to each query in REDCap through the output of the function. By using the `link` argument to specify the domain, the REDCap version, the project ID and the event ID, the function will add a column in the _$queries_ element of the output with the direct link to REDCap where the query can be found. -Note: The link will only work if the user has access to the project and has at least data viewing rights. +> Note: The link will only work if the user has access to the project and has at least data viewing rights. We can find the information about the domain, the REDCap version and the project ID in the link of the _Project Home_ of the project in REDCap: @@ -799,7 +1062,7 @@ example$results
    -Note: This function also has the arguments `query_name`, `addTo`, `report_title`, `report_zeros` and `link` that work in the same way as in the examples previously mentioned in section 4.3.1.6. +> Note: This function also has the arguments `query_name`, `addTo`, `report_title`, `report_zeros` and `link` that work in the same way as in the examples previously mentioned in section 4.3.1.6. ### **check_queries** @@ -830,7 +1093,7 @@ check$results There are 7 queries pending resolution, 4 solved queries, 1 miscorrected query, and 1 new query between the previous and the new query dataset. -Note: The "Miscorrected" category includes queries that belong to the same combination of record identifier and variable in both the old and new reports, but with a different reason. For instance, if a variable had a missing value in the old report, but in the new report shows a value outside the established range, it would be classified as "Miscorrected". +> Note: The "Miscorrected" category includes queries that belong to the same combination of record identifier and variable in both the old and new reports, but with a different reason. For instance, if a variable had a missing value in the old report, but in the new report shows a value outside the established range, it would be classified as "Miscorrected".
    @@ -838,8 +1101,8 @@ Query control output: ```{r echo=FALSE, message=FALSE, warning=FALSE, comment=NA} example <- rbind(head(check$queries, 4), - check$queries %>% dplyr::filter(Modification == "Modified") %>% dplyr::filter(row_number()==1)) -kable(example) %>% kableExtra::row_spec(0,bold=TRUE) %>% kableExtra::kable_styling() + check$queries |> dplyr::filter(Modification == "Modified") |> dplyr::filter(row_number()==1)) +kable(example) |> kableExtra::row_spec(0,bold=TRUE) |> kableExtra::kable_styling() ``` diff --git a/vignettes/articles/Data-reading-and-processing.Rmd b/vignettes/articles/Data-reading-and-processing.Rmd new file mode 100644 index 0000000..bd0bf64 --- /dev/null +++ b/vignettes/articles/Data-reading-and-processing.Rmd @@ -0,0 +1,184 @@ +--- +title: "Data reading and processing" +output: + rmarkdown::html_vignette: + toc: true + toc_depth: 5 + number_sections: true +vignette: > + %\VignetteIndexEntry{Data reading and processing} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + chunk_output_type: inline +--- + + +```{r message=FALSE, warning=FALSE, include=FALSE} +rm(list = ls()) + +library(REDCapDM) +library(dplyr) +library(purrr) +library(knitr) +library(kableExtra) +``` + +
    + +This vignette provides a summary of the straightforward and common use of [REDCapDM](https://github.com/bruigtp/REDCapDM) to interact with [REDCap](https://www.project-redcap.org/) data. + +
    + +# **Read REDCap data into R** + +`REDCapDM` allows you to import REDCap data either from local files or via an API connection. Both methods return a structured list containing your dataset, dictionary, and event-form mapping (for longitudinal projects). + +## **1. Using local files** + +Ensure you have exported the following files from REDCap and placed them in the same directory: + +1. **R data file** – contains your REDCap dataset (`.rds` or `.RData`) + +2. **Dictionary file** – CSV file containing variable metadata + +3. **Event-form mapping file** (only for longitudinal projects) – CSV describing which forms belong to each event + +Then, provide the paths to these files using the `redcap_data()` function: + +```{r message=FALSE, warning=FALSE, comment=NA, eval=FALSE} +dataset <- redcap_data( + data_path = "C:/Users/username/example.r", + dic_path = "C:/Users/username/example_dictionary.csv", + event_path = "C:/Users/username/events.csv" # optional for longitudinal projects +) +``` + +⚠️ Tip: If your project is not longitudinal, you can omit `event_path`. + + +## **2. Using API connection** + +You can also import data directly from REDCap using your project’s **API token** and **URL**: + +```{r eval=FALSE, message=FALSE, warning=FALSE, comment=NA} +dataset_api <- redcap_data( + uri = "https://redcap.com/api/", + token = "YOUR_API_TOKEN_HERE" +) +``` + +This method automatically retrieves the event-form mapping for longitudinal projects. + +⚠️ Tip: Keep your API token secure and do not share it publicly. + +## **3. Understanding the output** + +[`redcap_data()`](https://bruigtp.github.io/REDCapDM/reference/redcap_data.html) returns a list with three elements: + +| Element | Description | +| ------------ | ------------------------------------------------------------------------ | +| `data` | Imported dataset containing all REDCap variables | +| `dictionary` | Metadata for each variable, including labels, types, and branching logic | +| `event_form` | Mapping between events and forms (only for longitudinal projects) | + + +
    +
    + +# **Process and transform REDCap data** + +After importing your dataset into R, `REDCapDM` provides several functions to **process and transform your data** efficiently. The main function is [`rd_transform()`](https://bruigtp.github.io/REDCapDM/reference/rd_transform.html), which performs multiple operations in one step. + +## **1. Core transformations** + +`rd_transform()` performs the following actions: + +| Transformation | Description | +|----------------|-------------| +| Variable deletion | Remove specific variables or patterns | +| Recalculate fields | Update REDCap calculated fields | +| Checkbox transformation | Convert checkbox variables into separate variables with option names | +| Factor conversion | Replace original variables with their factor version | +| Branching logic conversion | Translate REDCap logic into R logic for easier processing | + + +## **2. Basic usage** + +The minimum required inputs are the dataset and dictionary. For longitudinal projects, include the event-form mapping for full functionality. + +You can provide these inputs either as a **single list** (output of `redcap_data()`) or as **separate arguments**: + +```{r message=FALSE, warning=FALSE, comment=NA} +#Option A: Provide the full project list +covican_transformed <- rd_transform(covican) + +#Option B: Provide individual arguments +covican_transformed <- rd_transform( + data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form +) +``` + +The output is a list containing: + +- **data**: Transformed dataset + +- **dictionary**: Updated variable dictionary + +- **event_form**: Event-form mapping (if applicable) + +- **results**: Summary of all transformations + +You can view the transformation results: + +```{r message=FALSE, warning=FALSE, comment=NA} +#Print the results of the transformation +covican_transformed$results +``` + +## **3. Splitting by event** + +For longitudinal projects, you can split the transformed dataset by event using the `final_format = "by_event"` argument: + +```{r message=FALSE, warning=FALSE, comment=NA} +dataset <- rd_transform(covican, + final_format = "by_event") +``` + +Where the transformed dataset is a tibble object, containing data frames for each event in the REDCap project. + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +dataset$data +``` + +## **4. Splitting by form** + +Or, alternatively, it can be split by form using `final_format = "by_form"` argument: + +```{r message=FALSE, warning=FALSE, comment=NA} +dataset <- rd_transform(covican, + final_format = "by_form") +``` + +Where the tibble object is composed by data frames corresponding to each form in the REDCap project. + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +dataset$data +``` + +
    +
    + +# **Quick troubleshooting checklist** + +1. Did you export the variable dictionary from REDCap? Without it, label + conversions and checkbox expansions are error-prone. +2. Are API calls failing? Verify `uri`, `token` and your project's export + permissions. + +**For more information, consult the complete vignette available at: https://bruigtp.github.io/REDCapDM/articles/REDCapDM.html** + +
    +
    diff --git a/vignettes/Queries.Rmd b/vignettes/articles/Queries.Rmd similarity index 80% rename from vignettes/Queries.Rmd rename to vignettes/articles/Queries.Rmd index b98e76b..d115632 100644 --- a/vignettes/Queries.Rmd +++ b/vignettes/articles/Queries.Rmd @@ -3,7 +3,7 @@ title: "REDCapDM - Queries" output: rmarkdown::html_vignette: toc: true - toc_depth: 5 + toc_depth: 4 number_sections: true vignette: > %\VignetteIndexEntry{REDCapDM - Queries} @@ -20,9 +20,9 @@ library(REDCapDM) library(kableExtra) library(knitr) library(dplyr) -library(magrittr) library(purrr) +# Example dataset covican_transformed <- rd_transform(covican) ``` @@ -37,6 +37,8 @@ This vignette provides a summary of the simple and common use of [REDCapDM](http Queries are crucial for the accuracy and reliability of a [REDCap](https://www.project-redcap.org/) dataset. They help identify missing values, inconsistencies, and potential errors in the collected data. The [`rd_query()`](https://bruigtp.github.io/REDCapDM/reference/rd_query.html) function allows you to generate queries using a specific expression. +## **1. Find missing values for a single variable** + To identify missing values in certain variables, simply provide the relevant information to the `variables` and `expression` arguments. In this scenario, the expression would be 'is.na(x)', where 'x' represents the variable itself: ```{r echo=TRUE, message=FALSE, warning=FALSE} @@ -45,10 +47,12 @@ example <- rd_query(covican_transformed, expression = "is.na(x)") ``` -Note: For variables with branching logic, the function will automatically apply the associated branching logic or at least report it. +> Note: For variables with branching logic, the function will automatically apply the associated branching logic or at least report it.
    +## **2. Find out-of-range values** + Alternatively, to identify outliers or observations that meet a certain condition (for example, range): ```{r message=FALSE, warning=TRUE, comment=NA} @@ -58,17 +62,19 @@ example <- rd_query(covican_transformed, event = "baseline_visit_arm_1") ``` +> Note: if you supply fewer `expression` entries than `variables`, the first expression is repeated for all variables (the function warns you). +
    -In both cases, the function returns a list containing a data frame designed to aid you to locate each query in the [REDCap](https://www.project-redcap.org/) project: +In both cases, the function returns a list containing a data frame designed to aid you to locate each query in the REDCap project: ```{r echo=TRUE, message=FALSE, warning=FALSE, comment=NA, results='hide'} example$queries ``` ```{r echo=FALSE, message=FALSE, warning=FALSE, comment=NA} -kable(head(example$queries, 2)) %>% - kableExtra::row_spec(0, bold = TRUE) %>% +kable(head(example$queries, 2)) |> + kableExtra::row_spec(0, bold = TRUE) |> kableExtra::kable_styling() ``` @@ -80,6 +86,8 @@ example$results
    +## **3. Longitudinal projects and branching logic** + For longitudinal projects, the [`rd_event()`](https://bruigtp.github.io/REDCapDM/reference/rd_event.html) allows you to check if a particular event is missing from a record in the exported data. This happens in REDCap when there is no collected data in a particular event from a record, as REDCap will not export the corresponding row. To identify these cases, you can use the following code: ```{r message=FALSE, warning=FALSE, comment=NA} @@ -90,11 +98,11 @@ example <- rd_event(covican_transformed,

    -# **Control** +# **Practical workflow: Find → Fix → Re-check** -After identifying queries, it is common practice to correct the original dataset in [REDCap](https://www.project-redcap.org/) and re-run the query process for a new query dataset. +After identifying queries, it is common practice to correct the original dataset in REDCap and re-run the query process for a new query dataset. -The [`check_queries()`](https://bruigtp.github.io/REDCapDM/reference/check_queries.html) functiona allows you to compare the previous query dataset with the new one: +The [`check_queries()`](https://bruigtp.github.io/REDCapDM/reference/check_queries.html) function allows you to compare the previous query dataset with the new one: ```{r message=FALSE, warning=FALSE, include=FALSE} example <- rd_query(covican_transformed, @@ -121,12 +129,12 @@ The output, in addition to the query data frame, now includes a summary with the check$results ``` -Note: The "Miscorrected" category includes queries that belong to the same combination of record identifier and variable in both the old and new reports, but with a different reason. For instance, if a variable had a missing value in the old report, but in the new report shows a value outside the established range, it would be classified as "Miscorrected". +> Note: The "Miscorrected" category includes queries that belong to the same combination of record identifier and variable in both the old and new reports, but with a different reason. For instance, if a variable had a missing value in the old report, but in the new report shows a value outside the established range, it would be classified as "Miscorrected".

    -# **Export** +# **Exporting query lists** With the help of the `rd_export()` function, you can export the identified queries to a `.xlsx` file of your choice: @@ -141,7 +149,7 @@ example <- rd_query(covican_transformed, rd_export(example) ``` -This is the simplets way to use the function and will create a file named "example.xlsx" in your current working directory, but you can customise this exported file: +This is the simplest way to use the function and will create a file named "example.xlsx" in your current working directory, but you can customise this exported file: ```{r message=FALSE, warning=FALSE, comment=NA, eval=FALSE} rd_export(queries = example$queries, @@ -153,7 +161,6 @@ rd_export(queries = example$queries, In both cases, a message will be generated in the console informing you that the file has been created and where it is located. -

    diff --git a/vignettes/markdown.css b/vignettes/markdown.css deleted file mode 100644 index 2e62c47..0000000 --- a/vignettes/markdown.css +++ /dev/null @@ -1,52 +0,0 @@ - From 8f3f9ff019ae747ad7fa6f0a1446a7f90936dcce Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Wed, 12 Nov 2025 15:49:07 +0100 Subject: [PATCH 3/9] PS-review --- NAMESPACE | 1 + R/rd_checkbox.R | 2 +- R/rd_dates.R | 1 + R/rd_delete_vars.R | 1 + R/rd_dictionary.R | 2 +- R/rd_factor.R | 1 + R/rd_recalculate.R | 1 + R/rd_split.R | 41 ++++++++++++++++++++-------------- _pkgdown.yml | 35 +---------------------------- tests/testthat/test-rd_split.R | 10 ++++----- 10 files changed, 37 insertions(+), 58 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4560580..cef52cc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,4 +21,5 @@ import(cli) importFrom(lifecycle,deprecated) importFrom(rlang,":=") importFrom(rlang,.data) +importFrom(stats,na.omit) importFrom(stats,setNames) diff --git a/R/rd_checkbox.R b/R/rd_checkbox.R index f153e23..8b9eafc 100644 --- a/R/rd_checkbox.R +++ b/R/rd_checkbox.R @@ -43,7 +43,7 @@ #' results <- rd_checkbox(covican, checkbox_names = FALSE) #' #' @export -#' @importFrom stats setNames +#' @importFrom stats setNames na.omit rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, checkbox_names = TRUE) { results <- NULL diff --git a/R/rd_dates.R b/R/rd_dates.R index dee1504..a0be83c 100644 --- a/R/rd_dates.R +++ b/R/rd_dates.R @@ -32,6 +32,7 @@ #' result <- covican |> rd_dates() #' #' @export +#' @importFrom stats na.omit rd_dates <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) { results <- NULL diff --git a/R/rd_delete_vars.R b/R/rd_delete_vars.R index 007858d..be59a53 100644 --- a/R/rd_delete_vars.R +++ b/R/rd_delete_vars.R @@ -46,6 +46,7 @@ #' ) #' #' @export +#' @importFrom stats na.omit rd_delete_vars <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars = NULL, pattern = NULL) { results <- NULL diff --git a/R/rd_dictionary.R b/R/rd_dictionary.R index 7043f85..68081ec 100644 --- a/R/rd_dictionary.R +++ b/R/rd_dictionary.R @@ -25,7 +25,7 @@ #' print(result$results) #' #' @export -#' @importFrom stats setNames +#' @importFrom stats setNames na.omit rd_dictionary <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) { diff --git a/R/rd_factor.R b/R/rd_factor.R index 8106948..cebdf8f 100644 --- a/R/rd_factor.R +++ b/R/rd_factor.R @@ -32,6 +32,7 @@ #' transformed_data <- result$data #' #' @export +#' @importFrom stats na.omit rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude = NULL) { diff --git a/R/rd_recalculate.R b/R/rd_recalculate.R index f134caa..c0ab0a2 100644 --- a/R/rd_recalculate.R +++ b/R/rd_recalculate.R @@ -47,6 +47,7 @@ #' #' @export #' @importFrom rlang := +#' @importFrom stats na.omit rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude_recalc = NULL) { results <- NULL diff --git a/R/rd_split.R b/R/rd_split.R index 8ecb0bc..1327bbf 100644 --- a/R/rd_split.R +++ b/R/rd_split.R @@ -38,7 +38,7 @@ #' print(result) #' #' @export -#' +#' @importFrom stats na.omit rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, which = NULL, by = "form", wide = FALSE) { @@ -96,7 +96,7 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, if (length(check_vars) > 0) { # actions <- c(actions, "There are variables in the dictionary that are not present in the dataset.\nSince some of these variables are checkboxes, please use the `rd_checkbox` function\nwith `checkbox_names = TRUE` to resolve this issue before proceeding.") - actions <- c(actions, "Missing checkbox vars from dictionary — run: rd_checkbox(..., checkbox_names = TRUE)") + actions <- c(actions, "Missing checkbox vars from dictionary. Please, run: rd_checkbox(..., checkbox_names = TRUE)") } other_check_vars <- setdiff(vars_more, check_vars) @@ -125,7 +125,7 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, ) # actions <- c(actions, stringr::str_glue("Transformation halted. Default REDCap variables ({mss}) are present in the dataset but not in the dictionary.\nTo proceed, use the `rd_delete_vars` function with `pattern = {mss}` to remove these variables before continuing.")) - actions <- c(actions, stringr::str_glue("Default REDCap variables ({mss}) detected in the dataset — run: rd_delete_vars(..., pattern = {mss})")) + actions <- c(actions, stringr::str_glue("Default REDCap variables ({mss}) detected in the dataset. Please, run: rd_delete_vars(..., pattern = {mss})")) } fact_vars <- grep(".factor$", vars_less, value = TRUE) @@ -230,24 +230,31 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, dplyr::pull(max_id) |> max() ), - df = purrr::pmap(list(.data$vars, .data$df, .data$events), function(x, y, z) { + df = if (longitudinal) { + purrr::pmap(list(.data$vars, .data$df, .data$events), function(x, y, z) { - y <- y |> - dplyr::select(dplyr::all_of(c("record_id", x))) + y <- y |> + dplyr::select(dplyr::all_of(c("record_id", x))) - if(n_distinct(z) > 1) { + if(dplyr::n_distinct(z) > 1) { - y <- y |> - dplyr::group_by(.data$record_id) |> - dplyr::mutate(id = seq_along(.data$record_id)) |> - dplyr::ungroup() |> - tidyr::pivot_wider(names_from = "id", values_from = -c("record_id", "id")) - } - - return(y) - }) + y <- y |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate(id = seq_along(.data$record_id)) |> + dplyr::ungroup() |> + tidyr::pivot_wider(names_from = "id", values_from = -c("record_id", "id")) + } + + return(y) + }) + } else { + purrr::map2(.data$vars, .data$df, function(x, y) { + y |> + dplyr::select(dplyr::all_of(c("record_id", x))) + }) + } ) |> - dplyr::relocate(max_repeated_instance, .after = events) + dplyr::relocate(.data$max_repeated_instance, .before = .data$vars) } } else if (by == "event") { # Handle splitting by event diff --git a/_pkgdown.yml b/_pkgdown.yml index f4225a7..4a6384a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,4 +1,4 @@ -url: https://brui.github.io/REDCapDM +url: https://bruigtp.github.io/REDCapDM template: bootstrap: 5 bootswatch: minty @@ -8,36 +8,3 @@ template: link-color: "#fa8011" link-hover-color: "#f8a85f" dropdown-link-hover-bg: "#bb5b04" - -reference: -- title: "Import data" - desc: "Function to easily import data from a REDCap project into R for analysis." - contents: - - redcap_data -- title: "Process data" - desc: "Functions to process the REDCap data once it's imported into R" - contents: - - rd_transform - - rd_rlogic - - rd_insert_na -- title: "Query generation" - desc: "Functions involved in the query generation to validate the REDCap data" - contents: - - rd_query - - rd_event - - check_queries - - rd_export -- title: "Built-in dataset" - desc: "Dataset that is included in the package for testing" - contents: - - covican -- title: "Auxiliar functions" - desc: "Auxiliar functions involved in the REDCap data processing" - contents: - - checkbox_names - - fill_data - - recalculate - - split_event - - split_form - - to_factor - - transform_checkboxes diff --git a/tests/testthat/test-rd_split.R b/tests/testthat/test-rd_split.R index 9ac1bed..0034ad8 100644 --- a/tests/testthat/test-rd_split.R +++ b/tests/testthat/test-rd_split.R @@ -202,15 +202,15 @@ test_that("rd_split expands to wide format when wide = TRUE", { form_name = c("meta", "meta", "form_a") ) data <- tibble( - record_id = c(1,1,2), - abc = c("x","y","z"), - abc_aba = c("x","y","z") + record_id = c(1,1,1,2), + abc = c("x","x","y","z"), + abc_aba = c("x", "x","y","z") ) res <- rd_split(data = data, dic = dic, by = "form", wide = TRUE) - df_form_a <- res$data |> filter(form == "form_a") |> pull(df) |> pluck(1) + df_form_a <- res$data |> pull(max_repeated_instance) - expect_true(any(grepl("1", names(df_form_a)))) + expect_true(length(df_form_a) > 1) }) # ---- 12) repeated instruments branch ---- From 45af1c8d95160a50897d6ec47080b10f50c86c95 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 13 Nov 2025 09:30:55 +0100 Subject: [PATCH 4/9] rd_checkbox ready --- R/rd_checkbox.R | 41 ++++++++++++++----- R/rd_factor.R | 2 +- R/rd_insert_na.R | 29 ++++++++++++- pkgdown/favicon/apple-touch-icon.png | Bin 0 -> 17298 bytes pkgdown/favicon/favicon-96x96.png | Bin 0 -> 5705 bytes pkgdown/favicon/favicon.ico | Bin 0 -> 15086 bytes pkgdown/favicon/favicon.svg | 3 ++ pkgdown/favicon/site.webmanifest | 21 ++++++++++ pkgdown/favicon/web-app-manifest-192x192.png | Bin 0 -> 19674 bytes pkgdown/favicon/web-app-manifest-512x512.png | Bin 0 -> 114525 bytes tests/testthat/test-rd_checkbox.R | 8 ++-- tests/testthat/test-rd_insert_na.R | 4 +- 12 files changed, 90 insertions(+), 18 deletions(-) create mode 100644 pkgdown/favicon/apple-touch-icon.png create mode 100644 pkgdown/favicon/favicon-96x96.png create mode 100644 pkgdown/favicon/favicon.ico create mode 100644 pkgdown/favicon/favicon.svg create mode 100644 pkgdown/favicon/site.webmanifest create mode 100644 pkgdown/favicon/web-app-manifest-192x192.png create mode 100644 pkgdown/favicon/web-app-manifest-512x512.png diff --git a/R/rd_checkbox.R b/R/rd_checkbox.R index 8b9eafc..361bbe0 100644 --- a/R/rd_checkbox.R +++ b/R/rd_checkbox.R @@ -98,9 +98,6 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU # Remove factor-type checkbox variables from the data if (length(var_check_factors) > 0) { - data <- data |> - dplyr::select(-tidyselect::all_of(var_check_factors)) - var_check <- var_check[!grepl(".factor$", var_check)] } else { if (any(purrr::map_lgl(var_check, ~ "Unchecked" %in% levels(data[[.x]])))) { @@ -167,6 +164,7 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU for (i in seq_along(var_check_dic)) { # Identify variables associated with each checkbox option vars_data <- names(data)[grep(stringr::str_glue("{var_check_dic[i]}___"), names(data))] + vars_data <- vars_data[!grepl(".factor$", vars_data)] # Retrieve branching logic for the checkbox field logic <- dic$branching_logic_show_field_only_if[dic$field_name == var_check_dic[i]] @@ -225,12 +223,21 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU } } - # Transform checkbox variables into "No"/"Yes" labels - data <- data |> - dplyr::mutate(dplyr::across( - tidyselect::all_of(var_check), - ~ factor(.x, levels = 0:1, labels = checkbox_labels) - )) + # Transform checkbox variables into the defined labels + if (length(var_check_factors) > 0) { + data <- data |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(var_check_factors), + ~ factor(.x, levels = c("Unchecked", "Checked"), labels = checkbox_labels) + )) + } else { + data <- data |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(var_check), + ~ factor(as.character(.x), levels = c(0, 1), labels = checkbox_labels) + )) + } + # Identify checkbox variables var_check <- names(data)[grep("___", names(data))] @@ -244,6 +251,7 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU for (i in seq_along(names_trim)) { # Find variable names in `var_check` that start with the current name in `names_trim` svar_check <- grep(stringr::str_glue("^{names_trim[i]}___"), var_check, value = TRUE) + svar_check <- svar_check[!grepl(".factor$", svar_check)] # Extract labels corresponding to the found variables label <- labels[svar_check] @@ -272,6 +280,7 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU label_name <- gsub("^x(\\d)", "\\1", label_name) if (checkbox_names) { + # Generate new variable names by appending the cleaned labels to the original variable names out <- stringr::str_glue("{names_trim[i]}_{label_name}") @@ -299,10 +308,14 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU } # Update the variable names in the data and dictionary - names(data) <- dplyr::case_when(names(data) == svar_check[j] ~ out[j], TRUE ~ names(data)) + names(data) <- dplyr::case_when(names(data) == svar_check[j] ~ out[j], + names(data) == paste0(svar_check[j], ".factor") ~ paste0(out[j], ".factor"), + .default = names(data)) # Update the labels to match the new variable names - names(labels) <- dplyr::case_when(names(labels) == svar_check[j] ~ out[j], TRUE ~ names(labels)) + names(labels) <- dplyr::case_when(names(labels) == svar_check[j] ~ out[j], + names(labels) == paste0(svar_check[j], ".factor") ~ paste0(out[j], ".factor"), + .default = names(labels)) # Update the dictionary with the new variable name dic <- dic |> @@ -364,6 +377,12 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU branching_logic_show_field_only_if = stringr::str_replace_all(.data$branching_logic_show_field_only_if, replace2) ) + # Returning checkboxes to numeric version + if (length(var_check_factors) > 0) { + data <- data |> + dplyr::mutate(dplyr::across(correspondence$out, ~ as.numeric(.x))) + } + # Apply the labels to the data data <- data |> labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) diff --git a/R/rd_factor.R b/R/rd_factor.R index cebdf8f..c5de5f5 100644 --- a/R/rd_factor.R +++ b/R/rd_factor.R @@ -144,7 +144,7 @@ rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Replacing original variables for their factor version. (rd_factor)\n")) } - # Return the results: the transformed data, updated dictionary, event_form, and results + # Return the results: the transformed data, event_form, and results list( data = data, dictionary = dic, diff --git a/R/rd_insert_na.R b/R/rd_insert_na.R index 088ac48..f604000 100644 --- a/R/rd_insert_na.R +++ b/R/rd_insert_na.R @@ -34,6 +34,8 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars, filter) { + results <- NULL + # Handle potential overwriting when both `project` and other arguments are provided if (!is.null(project)) { env_vars <- check_proj(project, data, dic, event_form) @@ -121,6 +123,31 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = N data[id, vars[i]] <- NA } - data + # Reapply variable labels to the data after transformation + data <- data |> + labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) + + # Update results with the this transformation + if (is.null(results)) { + results <- c(results, stringr::str_glue("1. Inserting missing values into certain variables. (rd_insert_na)\n")) + } else { + last_val_res <- results |> + stringr::str_extract("^(\n)?\\d+\\.") |> + na.omit() |> + dplyr::last() |> + stringr::str_remove("\\.") |> + as.numeric() + + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Inserting missing values into certain variables. (rd_insert_na)\n")) + } + + # Return the updated data, dictionary, event_form, and results (if present) + list( + data = data, + dictionary = dic, + event_form = event_form, + results = stringr::str_glue("{results}") + ) |> + purrr::compact() # Remove NULL elements from the list } } diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png new file mode 100644 index 0000000000000000000000000000000000000000..c3fc0e56bc6ade02c0685f273a255a5c82e0e786 GIT binary patch literal 17298 zcmaf5Q*9->Jse#|go5V%+?2f5BN25Ji~0w%48PsT!$ zonu?XjGgR)PDShtS(qbwY%lJd7|Q+itpC%ky}<%%c7;mm`E6@ixUjoQVbf!)_jv1h z&88@dBFpms={~xix_5RE0wUw%KYKlm#chBRfg3KK2if|dyJ);fO4LQg#b3pB{mGU^ zAI5O7Yi|w?0X(&C-9i}aYBO8TN!3@K%vE5Ff`=&tAwTUhPEG=_6ss*Cx1eiJxO3c| z@d^k|k7~QflA069V_{V~VO1o;D4ZA3JgyUC==~`Dce!;*{p3rCixxFvzAboe17G#O z@}DFmb57M7s>nwnatSmiPNm%?(HIu5^Ij60(dI`-<7|D*CL#^cSl-rSo4dfoCion; z7hT}jevzPaG*a`9l6zDes@NS86Cqhvnw5hDZB9`hk{=VHQ7wci_M%B`K1$m{J9fQ^ zIYGt7{*=6JiB>OvC|ZVgyXW{ME|kxN;Ur^uYNQ3FEe;l|g9L4@mJ^Ri0m%u@4g;Wp zYJ`{ela}_63s}>r>fe}Bgg@NGJs=ko7xkJBU%w0J-EHH8i9mJvMBpbe*>V?Rg=%-O zpyWs%aW{v~6-4=>ZX9TL%sp$$2vhBx66IxY{SfS$OgXH(iv+LrT`Ba>xBkrbjrX(? zf0MUUa(u|=LCT?W*afr+(`cljFv|7R18zrRQBk>%y(&4=8ZCFxq6YWVO?J;d{>eSE zYrk0mLw5t^2I(mYay*^sA5R{x&CXyw!kptQ48^wX^BGHnA21`n>n{gtCsdQ$n1*t7-itmPtvx zQlf<*C}O<_6s0D|)ap5}6W37r?Z|8mmfHbCk+{`Rnq~}kb6Nrb{6t@7T&Aph!P^__ z?pbXiQ5h%LY$dl)^4A{$mv1l9JG>BA+>T5{9Ml!zR>7RDEFXdJ6BEo5&QIT@aW{S@ zHZ&Ovg~bh=54?!$TEPMNO1XfgE;bx7Dz^9XX!^?bxcuVliE=Igg|X6-(NP>7jVYqxC2LHCI z#|ci)F4CSE#^ts4?9PrLa^A(^AB9w!1ue2XI#1){iXWiu)p9TzVUYYG<|bo9msE1o zhdqr^;5O`v%+@*j^UqWro#WR2e9Y+s8JP*G=SYRK6Wlj96a)qz^RuO#C|+uxCv{3? zKCcQH8|VB>s&Z42PiS!P37@jZK`4am_lSZNW@;X%Y>Wv7La3Ml@&8z2()zSx<8(t* zDH#ikfD<9`o>koGJLuzMuS zLt%3Qq}$D%Bo~_FpOYxyf_d*6w@uMc+WCxFADw?1q{=$KMhJB?Z=7L@Uy{QAcC0W7 ze(-{9PI1DDjx!F<=s8hM(;xNFK~NN;wi)~|x7W0uOSVqN@ra4#a(+M+Q1J(^ACPue zn7*|pPnRj@#DYPn@=uv0o!szC>E=OFdOl?(yPFlOqtRc}P+D50q-yF-uRo*p;LfH^ zjSxI6bBk|Z<7b&Q*hHs!AmE0A)3_E_wq~f3w3X8mju+jj9qX zAU&FI^rQrz#&{In4@h|ruNKp}r$!Nt>=g5y1PD)#kt6_X*#V7q#1u9Nn)T zP~byWL$Tk(36hu%5jxLzEWwQErYYX|=7A>PWO^gS6ZXeKK@P>q>n?~y>b^%Cwjq6f zsl1XXp~PS)%3Sh2}Xn2~$QLkGZb*wB}-Ob?qooB19KxifLwqpZZm z>i0bQt63;s->_fBc1?s;Z2Y+Si;O3&lRSz!r)RlSW=QeZ+j?W z|9+n?I3aHu%w7({`(kP+tiOw0;57tclRbrDR-P8NG7i4;z6U8&?hZ^ZRhhK*pg zBf(&pk22r0_R^fpkIf-YqN?FUASd1Wd#FVolwNgMuTVIlP?gE%g}_u-b{rf$AG*;; zojN1glmgRZKU>71tNQEQW5`g z%x8W*`n?NuZHHM^w;SG6(5lW5t(4`F6pOfbic->YFF16-^LnZ8%QRG8FJXjBgi)@d zjSH1%gcYuFzw35pHsS~U!`shHx(;^%jI2(bIky#ff!D%t-l(MeS-nihz6K#t%Sllr zZl9&OmepiJbf5@oNnPN3PP)4<#la z{n?<-`*>kZ)Is$;Q5+rTy*ERi#d|q2`K64HDpw<$-bpT2{7{1orX=A6;;y)^)`lp% zu+u7I<^57)cn~ueNV&K)<%*ZF?g`jit;RpIkdX+VU^P-`LU%i;K;~$Yi5H&Tu-PE8 zIt6z`{>t;QWq9r)3+8?e$r)@S5mOIa;LB5#=t~Pf{LS^e|G-IH2~+dE$V#|KoC^if z853|-tzhtamBX98sYL5?-6abiv9XKYeRHOeJq> zM47_DEu!)6k_kEOt9FCK4iL0W2qEVsRIC)}96<~oV}VZ0zkBb>>al1nDjA3bhngj# za)r_UXLZx1doCvYV^$uO6?Y3%EJKHCNWBd%2bi97obIJ(ApWMevvOi?2Psye+skgH zlKBeL-m%|Nl(>s#JSA^RRXH(vpn>12z(Fru2g9IB%M zh?`KH87gvkDqN13b4+qNj*WRp1mvS%{_^DD%U9N^HIb&o|rTn~tePWR=ekQ0( ziZ(Os503jrfU|Yr!@k*XRPCJ;Kieo4LK6M4;yYL`mNrW5;(7+S4Bl{rbg>bj8 z_zO$31&$@3l z&~UIvt9T^D?-eg0{<2-1;1#Z_v-_Z&aZ09z)5Er7*UEI6*5*3Q)LWvqu(H#?PHJwn z{_sC2H!YkLJAtUgYuuA0y;ai1kk$jQuH$oW)gu%kkoPp@5YA6cxc29Y4>Fi36^A&; zS%bq3{gD#vg2w=_L!Vk1qw`{QLtGYU?=PWfDa^`!Q@CyNz! zeQ1Q8X`w+Fgj!$w4a)nC(6-2qxw|sQ`Y%H-Eba4MJFMOwi|ohH+GwgWfAYjIZMIj0!v#9_T>ET#i}ulC8P>Hg zPiLHl(199f7>&+QMRnNew6u>Q)>ej3x74;iSjVmOz)OX#1ZV}0I=ii>)BuaE;MpGbofnH36M?Q79n|*;P$(GP>1(hPHD-1;M&F$gx_IEO& zFH-kubsy{>I{(726ImvGP$~XW4_xQ89YMm-#zkrdiAJC*>styTlvou@;A8k1$G9}gjn9flGVd}V2bKrl~ssBxW znu*lXe4X}RyAO`E4+SQR=D+JG^#8~?V4bdL(o_ zMkrKOF)84~EQe@=_*tS&(G8N_Ha6h#z}KN#F1oiwW;erGc~DPG4{DOKSa;WuV=iC> z_Xa=j&5nyJGMO)hblCQ}tF00CS{AA-h{EFQ?#Hq`9;aYIX1nmwn+arCiM}|H<746R z`mJ49z75ItV?vP*laGB($&PMxIM_JFpfh~P?=7j*2<@+ie+XO^6`7n8iNiTZ#@;U_ zCw_?M=$M;CDJ6Mb^`^oEYt(voST9t`y9F^eCJJ;5bi>tGaL@DNOiP*l<&B-HAiUa8 zD?FXDS}PjW&AU5qz4`Q4L@{&P;L@Fld2l5o`~!O(9*3{$0)}T8_#2B=IWI02 zAbfm!!u(hq@Lq_Zv5GB8GvlNDF&$&z?h*W>;|ON#aEWTZN@4|tf5?z91q6dn>*PM78WGTk35Ug=7; zQ_AsWTiX8u`arhr`9WROL396xU8L!8KcO;ikoKayl14b~eIztA>mXg60wKD2P?7J8 zO|ZTVO!cWZ;k+Q4?S33k=;W-U*AIny@p^wgF3Dk!Gvqt$ZDH;87WsSf;(f6mfIBRj zUep;-GXDe+TO7y20WPC&C~lfstFjWh%RYlna^l8j)fX%N1D3IHWU~o6*+&j-w$?N_ zA@ZTq^xV(+(&@T^h~vCev}IH*?UaXAGFm{Bcx@&Xb0KqKuk*T>4v-UVEjCvBU7P?R zcz?TqnS!q5b{X3oGpxKS5SG-e2TFSXIbKTx0bY@E3vXy4g>BY4Vg+$=f-wH~^!FddC>U1G zecL^^4SEtGieHj@nPF|(i~(H~SeMGe#HfAPvO%<-yL!3$rmm%V-af}yT%W%!sAT($ z917p&$rSesNfw{}xxv)_>i53IEMr&=QV3}&!5yo7_#@1$cOcW$s}~nxJQQs%T=nH$ z+o!YsdA3@|Viu=1c28MuPE`v=!pvd}fk-G2!8j{oFL4lAx2cUS zLGN-^B_`VdEk@{S);xcNKk%smY&00wx$kA44G|j^QU}9p5V9MZ?*V+dp32u3@F(^w zYmf4}+8rPX(JoGumn1ZG<3(gvw6Wb5gRZt11gCHSY0KHO4t>G-?vY>B!&klKJN(uH zo2!BMKoPdkS|`<5gSm@b$eqGcH{jZB0YVZ7Yb zYA$~>9w`2+Kr=g~!(en#)!TynfahS7TP^IKG! zZH*N@nIo5-Dva^lujfcIgfEzIX(~0Vu6Wb=P;A9j?i!(VHrRm#$n5zbYmHrtMValm z_Zrv7Aa;sa%jwAuV`$YlshOFPUnCh&lvr~O5oe!_jME{x@4i0A_A7r|0q&2d(HjmD zgLwVe-S}H&BnBP?tf{i-U zn*it*@V8U44lM~HfnMSS5r06rlkmyoBHqu`^(4F(|DTec#hzbh$NjxpC=mXx`7$@k z<0_n9ugf^$x|=CyGrVc2y2FHa%ubc32FgOX-I8dMag2=x(e8sc@W^=Ch67)mHGd)> ztZPsy{uR;k*iXsQdNcg*J(kl|G9&W*i#*;na9AL|H2^$<*L8d=ezT!ll@s@c$V6lO z>M3mhNnx|G*GJ>RyBqMt;$YH$-OY6y1SY;-UO@JOO=CA&L8lOI|DlOK^)!B|laAYN zzWx9f*v1GeF7)+>QWvO@?5LeO7~E8H&-JVYt>AhVmVwBRJbx>nbMmk3<5mm`@j#NN zFK8Hld!P_;)2YD(3GW05{>I}rKIh@HbA%0grXuB2% zednthPq!jY%%m=KTB zd$qhz1I(~{1PTRLQ5jGCPCYJ+WRqr6pB=oeRWnR8epp8@EZF5eVL48hiFFro!R-6W zJr=mIn23@=uL$V!*Wkl5qijA>?p@X`@2eZoSYaZ@rG4I(P4hONGyGgEY|zIo$tS@L z4|`@C8Mtwp*PvWWl~D1nXTrTL&E*1Hy9guh7h(6s0-{@6sZ`pmh+c*G%50sy@X1?Z z_L>%^jGlx`^Vv#yPGDx-P7RxD-v$&bGqrNYcAM`rr;glhW}o4Dnxg<2Ax}Pa&$)QP7eM{8Xkr>89KzS5u-AcADw_=zV8;v}sZZjqC4?o}4%@xq!)8$&)b>Qf zNWE~giBH9exmVYUoq9y4sS;o4=uafq{5HhWi_}zxIF_rUVQ?u<{2lS05w-p@ zfm{-DHyeRv0TSpW)X2t#`|niICHq5SU%(A}8<9NdGCNeOLZ;OMOJj;dcc~b=;vLea#~-9H;JsEmbc~1WTsUe@nI{YgV~bw;sB{HT$)nzs&32xhy-Gpx zyEK11$aY|pC2N|s6kRy;Irn9QoxkK#(RW4jma(a=-6>oD9`DNqBq2A$rH%oB;|@Zf zeTN+;Gh?kWQU8qYAvF=gI!xww+n51|uhmqYZqTPTqDDL~_*Jf>@5fPr_7vVH+groX zaBY;3Xfh6ZA*bGWG_Z_2@ys}fM|3Icuu3w4){{XDZ#?k<{jl8{(~{4QB*rDLg=0^KV=akGl$946(3ush*j@YHA z8dl`o)PG3)1Ukmp+yZjg`$sKZQ%Hq)iwnWC0J?`yXfX&#(Qrz6?l5C;l180fgr%M3 z%5{okt#G%ReV(9cQ@JrVSSHFwGs2z3IHfq{Mm>%{(rltU6Z6fsA=1{x3s5XzroZFG zVS`PZRcuzug^uH_q0nvJq7_=ITZN=kp37|HX~#;kz1dn%Q9o-U9U-3jBvszxh9 zPFe!<@`8g4&=W*DiCYN_=W;|Lbt%dNe-hy>DHeUnT?>_yF%EGBF^v@#R3)oPVJ&l1 z0`xNO*Nv#avF&{zK{QMZ?vDuj`2jvQt#|%X_V^N|CFspYhooL-w&;EWg!%ABsyspD z)k6G4!Yxo9c}i?8MjrSz2BxVqsE;Njr8F0U)HGkUgPgIDV7BsHtMlc?r3FGHy~9Fi zt%YAWdSBg?tq74h`rDv(<(TiETe`R#fxqs@6FG*ly0or`dd@^o(tDsj@C?uu&mcY? z1ej(|;apsiGL9dDtr`Vw1w)5AY*=LO9e`7YT2Is)vjK>}A@htUd(l?O%T2@c&y9u1 zz)vk9jYSP1I9%AG{hgjDoCE}kjD&09u>)eJsi$zKB*Cc|zk>W*jwzSd!JY}iwEB0$ zEZPveD5S|{#2~wUN-BOPh}V#Nr9#aAVOv=iLqakNqUj0J9G+;m|V91{-K7Y}^ z)6DLHV6Ar0)3W~+!Lpn3z(dc^lw-)*l~+X|0Ps@iFwjyVC>Mj?z@RbECWrWk1;W+< zNo=(Wlxg-d?iV>|#mYZo8BTxb^|3kNWmXVx8eU5F--7-Y@MqW#CVU7Q>7vArX1|P6 zqPP+1H`cos#i>$HJ9-d(1fd89TkOE6WrgbPz_uGWp}!Af!QTK>3PFR&rR0bA zr4Ca)0pg!YP%1r6bd2r3h^A|a0^earO{|9?Cu^*XV_K!oN79P=7{e`HGWdq$yY^NWh!L{st?3TYzj3-xz* zKyTEiGUXj=6E=K~5Duoga&p0s?X@HtWR#_>hYoo;V%0Z_Azw+bOXo8Go0+6nT3 z#~EBL_<)c)BPVPDS{Q?Cg);qIIu$FtY=4VFGi`9tR_X8HEO1J;WIK$OjFQadPVxPMnDhuMa6SHE8tyvIel58Fu>KY10^Y0C$cop7 zU)a&CoW_;c8?aHSy3#Ei6(kYnwCMG-F3@G~hsGnCic-evKgHe|J42ZSC`*TJ^ z)bLRPF&(U(9S%F~;g%_Z=G7ZLqL`5cuNqvtx-#8AJXq%w1=@IF`)-7sJY}&L^qC~w z0=*OnH8CfZn&?2L}bG--WKA##l2zr3Ur+WVsZ&Vcs2Z4>2q30%^o|x$pNy+ z^b#bco)By}D+y?qATl@@)}X%;+`P>g?(h#0c4{kY9-HkREPRS9qL6jgcw(v<8&95K z*6?JC?8g*WjDPZMK{^Y8KC!eV{}cLk=8JG1+?KB`ooNzGhkI}2x_Mn)ko9LOXf1Ru zqe{F10+77J+U>eHIP_`>N%E!YlS+#r z!V4#)=&@KS%^3_MOhZY<73MW1S@Z5g_yIm<@GpM5QjV3dQ5h&ira8LVnQ~5{q*EC| zSf=+u8NiXY6Pmfa`F8PnnaNRxWG(iPuLZ;us$zeRg9}lWQ(samsqxm!G7S2}U{*BS zt|LD$K84w#$gzbMevPAn;VQ1lOn~aGOK@@-N%S!5SxGvGA05L0DcmdyZ|tQvsr`<0 z#U5|a&IOS^n4Y#PvL{=T$?OrumfsbQ9kWTJQ1tozy^J@<@pt5#H>*7b;PzC*0%-0_ z(k|o*##TuA<6gQOs!HCe$23qU`i#e~_J-(Aergl{YRT4WnWD6F;!!NA4UW#mr`RD_kx`-T_uLUdFmof;?s- zWud+cLPE|{sTCf9ch5v&0EW;#W$&bJG!z5`&>=fy&niGv`ay^4En0X~MKGoIB%#Ue zy3lmrF{S1~^mNF>NdE%v&s|~!LzIkb-{HC`hFWb07HCPDbFtr6Y_mOTYaTF z=Z|*T7ELH0OT2{Gg>IGvA1ct>7EgkqBea|6@9Y{k!)5^*t>Oj-@%@PSZoT_nR0Kut z8@*>@D*XPlG85yC#Hn*Y3O!t?-Jw#7!wVicAVjHY0jl(VJKRb^5xwsH2L?{LO+SK^@yDf<`wQQC*EhUs@O5C?6A<-($OD!bp#=0$xH@xgty2-@f4P~Igmj{~D$tRfS(Uv#spZZELhLS~Q|tfesD!?-bc;NOsHg$@CNO9ogO}5e{kPaDwDBfGMa7yeFW3r{d1BH_W|Br1 za9g@!>RIm9*jw86C@0X{PSV&#FaIn*#Wxm{s+{gP-=FJj6m9)~^0^8fEPR(7EEF%1 zw_L7&;>6rm5TQN)tt+^bz@wQV5IUWsr;=TXE9P|4?V{l29No zg$HSav@7!W1q(78NcPK8=4s4yCk_U0v!Q&vawg;tL3nLnv?OFhTz>)?8@C*{{ zB)=Qmbk+&cl8pCx#dd_W879GN2R~9aY`G&@O=`iI5A-{#C-6os4U&nVgwVewE1T>- z(H#GH3$TFxNkakmSJm~O=b)A+MDmv?71VWZNGF?TL?TzsYPwv%Vs1X+eLb}0HL&x0 z7vIB)2#Gd1i#amtqStXsrY?qyHdfx?`utip$O*M@q{~X6JU!>ajazXg!cn9r$76R~ zvx|x0hg+moU(l4X!e(G?MJ|+`E%1ZBeW1j5vLpZ=xNODo#kpuW1GJ3A$-!O^b>YWb zt}5>L^8{Owg~|tQbm7bGjvyrIy|jgl$ErQHgKH-sZ3-clz~F3O;w5$ZP>#UBVVfSf z0=SWAJ#&Bxv&WrAOv?r0(5ECQ93L5@%oQ% zW^OI{kI=nC$4#EnOf_L^JY}9tiL*|^6Q4L@0`30=wuNYeJk7pOAv#B7T^&<}YdGS0 z+bA0C2eGA~W8W^A4yiUPap^oC7fSqa-7m*;M_vzm5fluS!RXHT>UNr*F3GGc)0A=L<%_kF<#`3OLrl#B4zA46`| zs@D(S;s3TIJcFKvak8{$mNs5+;=;_gzfRCt9@jVVU*vzFg|+@^}qF+T=J(m}K;oev$TD_B=(?$C3@{LREf`7Qu8o#Q)Ee+a~MA3%K-KQ_mh z%fr__E;(KcxrG}^a#17|lue+C87K!tk}|Qg2ra+4cYQNS5En%1dEf{#rdC{;AoPYK zJtzXcbVp2V!Fa-QMqa@y`3e9=WlD2G4?w#Qwnu;2=deOiXm~TFsdeA&Vf#%6 z+l3gf*p3u8{QB{`L-Ef@$7WY#Te1E;k}9bU+dR;H(0i3Y+p^>Px)i|Fzk_Pl76&#h zJm+aZ?*6Kx4~he zV0a(2fVBripP~Ri97)3?717WYTHn$1cHshoR;<*_dgnY0iS0fxspaa2dGR2Fx>M7282l5h(w`TPLhs z+WIaFw&I$B&?XVmkN%nB7GNNh>nsLp0z>UKv(;$AZr!n*vusmAyDsdJijmjvdN&t z+fEFgHNi&@0a-$ZMZ(UF)g{OOvv-q$h3H&eK*ix;e`y*_^UiHT{?GVhHpIklmYu#N z%e>C3kDp_x2W6*DyUq+Ms%{-7L>sS!k4p_ZeOsY5Enp>N#|2cP2@&Xc=9+L1Qqt5S zX3Wcf1063@4oFgxdo|7gA582VLeB{~&jFxa0_Ap5SboMW#u{=w=vipkTe8o2Syk=Mqo4b$ z`N7{V5M16g;IDZ2k9Xt{<{L{|jye`Yq~KomWw|f1aC99G4aDbZh#%z?MxW2ruGt5D zSzD^1iYD8jco)aE2X*E7-^1N1}F&}r^Kz}cc zxQ+wSsV{?fHQLQ*ji;QZKde)^%gxrsyk;XMTAK*Ihqd zB7FCkByj#*8PSZGd7#~AU?lzV2`1S!fU45w;bOkcoCtnwwDe5~E8Ogcqiz$+ ztKupMOPJ!SC#6t2Ye#}Cyuj?(uxydI*%q55Z`N#ub6v{UV-b@_2%rR@jbJ*^_)g2W zl@tRsd9RV40z3-Kg?OIK_%Plzhc7vXb{Ur0bIB{z&kx_FZDXLjimPTjIhLQ&8K{Gn zFwvUcc<)KE*?sd?T$xyD(r~GXxP(6$NJ4|@W6Z*2IYv#lk{0WCyQ*ZVVDy=$1D)ZG zsmh^0J~h2OC+UK^eIY+uA&!O8dP~u_<^{J&L1B0~Xc}6>g><==?P*!@=ib5zR+;Cy zpQ2vY=r{F9=*jg?9g(KeB3Mhe$HXu5>mMJ>HjkS;PYLgnpq9?a8=I$BwIbV!MU9_t z*yyE)a};}_CNMrvi|iR;fSO6e(WDi+SRGe_RV#B?sy&o;yq+KwmtNqXkkE;lW%S}RJm~TgF3hMhJmM1*e{FX zzAZa!h!h8gz*sW)tjx&5IcYHCZ?H)C`A*RMDU}V5hfIAL%Agti;;#X zgnpW%J*;|{ke@51i2q$O-(X-PzE2|<)sjFr$4Sh}i2$8XzWKO?KPW*TNOKtQ3rVss z)=kuhH>txwk~dAV4keb1XaeIWIHO}a`UO#jlg4+K8|!IIRwyEiAI@#}lm_SFs{YM4 z2?PE<2lfS^XHBp>CRGy|t$d$R%QO3n|95006emMtaxH_s$O@GK)A7?$xnhTe5~^I} z*=W8nuN&ic`uxqvzaGdT>fU!2#$SmDCEcb;F{9+nd08?yBPv6b+#P*@gy~Y(AX!ZR zgJVvJ!U_MM!bd#x~W+}exFkHChqn)7EA4pQ27}6ua z1}u%zAv*>!E-#pm{t*~te+Dueefxz8m1<%>ug?|T;GP!aDXlKJ-Vk%qDxe6-{6MPm zU|dw7nu5^O^wIrGOf z;!pBx42qYDB<#*NJe-S8^reN3vvCi$4x)x$FlNUCHybUdGB!-#UEUxLo?uJjO#Usf z9_Mx(MbEeev>-5K{-P%8423?WkU^t62xrPt(zYA~Ctej3OvoOBaSWSG!+kq;wnLtH z+0_O(x?Y-XJuE)i(j2GeXG~Mc%nrWNQxbi-3XrkMRqxi7*S{8*JD4&eg*lgo8oB-TPkINvg9Gn0Nj$A6t;Y-rPB)(Y zB&*^e^)Z}J)ZpJ9s(Iyn3t)66T^@xuZ;jBq#yCeI^uWn)`ZHJ7pY|7yhjh8CZDWeA zP+!Z+F*%~va(BG%Pi%bM*IZmauK%*X)It9Gt9&B+IhK>qq*#g+wj@^qUJug-c9SEp z!0xN^AB!_Ss&V~}eNvt`L&UO6P0{%ulBULZYf3wqQg$$WHZ3Pbi-E@&E9iu+Ud04&WCwrTf5N;Q=wnP9iFv?I_02f8`?}p`CWffC`(xu z{jfd*Va9*0l~c3pn&C>BTDt;x5Sr7kM&e?0pNYDBQa;3ZALFZ`u=D4>L!{e#uw`zkfjh5<>J3Y zp;ebbEGLTBPWhZSb2~B<#B8rHPZF_xF!HOG3QD)h*a}&zeg&^)vN#W@e^QyH@Fe)7 z0D8eF`hGLbeSNM~o94cc_iSzO`ZfU2{DHNEKKYRuQdv2{TF|#l+BEhg`UUqpzaz8S zG16yCcbEymien@w>-Cm*EFFi*YNWY(Ij|&;3Fhm}46mB-J!z@3z*c^aiI;O#3A^$P zu@{|nLe<5x)P?!(y=}gWl*GmB_f$YYKzsmpmunBu#(XA*W@WLbMPblhVnbi0db0BP zx+#?gr*&dD1tZ6X>XC>zxzlNus;0;=Hv+S8mWq|-XS4U&ozP!nZEe>u!B;0TEze|U zcnd>yuLhDnO0W5S^y>UCiVW*JSkZ>Q-0r3g?y#yk*p@vKox0zU~OjUrC~ukCIvIg@!$r>7r76N{zFF=b6=v>>wH zLOS8F#Z8|pjSoE}#neqp5Gy)~T}=SOJxRIrJAT!Hi+;UM{*5s(zW!19SzStU!Otn- zrAec@oy3%70T$3)U-3c>6qg9B9V~gtcD#3{xx$%pC(z9Q(|cx`AtkdNOhZd)Gu@RJ zM!tszL8bXhWz;gOYkCGnAm`arZoD_X8A0=9pl4Dth%?OewIv|5 zI=PvidqH9`U(ytbD|r+J-dcb}WJIQsFZIt?0I8ajprlE>$qVVY(k7k1mxj3C+9=!^ zR|K!WMkpe;d!NbkU8Ut={_hC{1~SYXod2#Q)+x(kf(lOdx*S1cAW$Sp{~dO#D=a`v zQ3Ik|WT?SBO84hJaES+#8gD?WF((eC0B0bV@!}-sC>iUqw_=oMQem z_{|5!@QAdWboW-1FMr>rH`rGGY(zxjA=;1UnGoIx!9Ip%Qyzd1ZX7!`X+Tj$}OOgXh1(MxY;oi>TrB&X4N!R)huUUe0=V z=Su=ceOJzh=21EH`~UL8$7DK3NwE4c%a%BTl5fNhct*zch0U0$R}R~}ky~b3mKs4v zo5HTI@S=SxICuY^W-Cp^sX-8@#eUti~geU_6UzzhbgA zPB!mDljxeD%=Y<1I$SOR2tl63@76gkL2I&Bw4feP(E!CYA1qI1(Jq4++N3p=k z0m5Tkwb^yiI2bv!fH$S*2huB$BcH4o95|7w?g%IJlqpu`O_bVv%hn(Ksgp0;_4$rN(=12XP`Q8j9O6t)$!QkLZVZ z#9~IE;q9T9iT&6P2g05Oa&nS;5l^xsIB_yZf!_ex=ZdCJRo09O3-N1luv%HqvKm3- z=zPNC6}s5SQxQA*8$R{D)hS_}W3u>#Yigr8OtCLT3WU=y$#QX&;vfw}bP4gg@s|=n zhmMjO&A?)vU^B}d^-6VS^Slm9!B&z)Gk+~hI0-ZM_&B~jRvEtV#a~a*voGkXH zTp)U~9v@BCFLbj(nKt!5Q+|dXo+Ax8Eby^m>`l1t%2tVovV&7TlgXp#9isip{xeR^ zix@qU8;3@OhqlT{V}M+Z|pW3_Jk~w28Ua>tNgtRSdcklf)pP65R`yMU zU#P}ud6BJ^NLKKB{lq8`Wb`199vo`no6_lo`bIPeoSm2qO;Ywr7L0y-{hXIhL+YIq ztJTx!lZ@-hd02CE{q^T)^lP%MC)*y-hMU>1Vn4cBCSy<~-lS+KH}gWNbL2LM_M!vz zV)CvfO%B6JC!}XeH}mqAteJ*w#Qj10>smdc3-&oO3uI?U%WA&`Y1RTITe`&rL&=q% zk--@^pN?0&lWdB*W|Ou^VJuCT1Hbc(`Cc$Mi!?0pvFE09jneyOES>c{m3YI8PfgJz zV$}PrdkE#C-4%;VgcKh~b%TpT&*z?HdzuEOy=HZlZN+>qAYx55irs|J>wVFRScWbN zMbIG9C(|ZVC6L5NUe)_{J{Rh4mMEg;w$>{f0syg(U$$jHPfhl! zX4e(b76Eg%!43D~&FbS8S&x+U%K{SlUF08mKg!s1<`U4yaJ1U1Vc%N6u{Ilugvc}& z+cdahFA09uZQn$jW+EwupZ^o*0vP>h;Tws7FBam59kD3Q*P(_snn&n=4JDvwCSiO$`_O6;jKjFCR;j7zB*1{G;$;*eV=3cp8-jq*_MUAX5-M8F8oB zfTYCh_(Jmy+6GRdi_Io-qEqGo?a1_zf>iB~QkmN9AyaPi@=^9C>O#>gi}o)Ysc!c4 z9zWcji8$awXoyqaYbt!AVkeG@xb|bwVc=9up1%!O&L-obomhKshGQb7kYg# zgV$Mbia?=h3vD^eCwbgts{8ITHnEwv>Z4b>d5dVjjgjKeHi6;IntF$`Qbu{rMW(9a zsy|5QROi?=Sv;!I%twQMAI-wo>-Hn? zJefpKTo}z$DWfd#U?#3=>l@mUi58o;i1reV^u8v|R$LXz?GlFNX^0R75h~G1yqGke zbZ#HaHKTNRbDHV9=OGI_?CBdiu#>;)b@4)qR(C}O{;JnK{31q6<*GPWMtPU&DTLn1 z0=S)eT{yL#eI{X452Z5pbTek+7hSv~T#5G=FQsU8ZbX*ZGCZK6zXb=k_+x8cSE$lmy(8v&`A=vgHg6HFURpOl&40J^8~<)o`Gj>YvWVMsColof z9JL^|e77ZX1Xo%3Hdi?tMQDjgFGOqbX>P=CYorXi6)w8 pqKPJ&XrhTGnrNbl_S&m!{~wnW_*yHptz!TH002ovPDHLkV1i2zS!w_P literal 0 HcmV?d00001 diff --git a/pkgdown/favicon/favicon-96x96.png b/pkgdown/favicon/favicon-96x96.png new file mode 100644 index 0000000000000000000000000000000000000000..a094a9e6102b4f8cf155e9975175e812a22c091d GIT binary patch literal 5705 zcmV-P7Pje$P)}>ji!?}0-~m<_o{F<5>3=d6eq+X&bBxv(TJ!8Dk_7bAoEZ_QF9fFMsZ?D+`aC5 zRbaYJCq}9O!&&RBVril8oqf+a`<{F6xh^hU(j{HeC0)`bUD73wDcvY4_E(SlOI^|i z(syKxn|Cm~*j>yVe|7{jtP2PyNvKTrThHO_J3^YR5K!y`A}XqT~=#EQAze@}gxk`cv{hwD2i(sBS^)t8AxP0Iq~sU72g_d_92xoR_I~(I zEknZC|L-YfX9{U~Eitf&7@uO{Ml0~fj5WwUn~Q6eI>fCzgy&wH2LVm~Ucmt*px8!t znmN!bL_UCk*xv8bsf2nr_8FhyG2`86MZS0Z(ZRBIj;|`f`bF#9Ps9GXEO@90)d#xT`Z@+wPNiK5P+}q&Xl7 z7?k3HhghEB8^TD!!oq&p-tXKYB=BwJfB6N=Bityqii}h~Y_JfD6$qL92~v)o$34B7 zGwh>`{zx_Qsw=9({N;N%?`a8R6azsJd&fhp+|(y{W-k}u=b0a3V`G2OCsZMI7c=QX zO8%|g@UAqAfN>unacc^0YV7{+(_Y|LG{3)&(zZ$L7VO;4^|SkfEu)sb_c z{DUJb{3qgfNJ`mgAfV(umsT`J*5Vv}t| zIvW5!S)0*pG@-smhn-0$FyM^^HrmSAXe;}TNFq=7lgepA8eBSqyf`WL_dX%A86uk1 zxzZ%Y+8Bpef#KnCNKeheeS-<#a4+9ZhX1#)WaWS`l~>}!6??e+U>`7qmAO*PJrA++ zAH7E?o^^5Qp!tCmzWhhb3UQM#S;8RsH@x9_b`$vee0;X+7_L`qACJ$QoUeog=cjQ;XZT4YzKJWW*+!v8gPVm#Fr}Wx?Fu#b=Z$9P z0${H%Y4S@Ui`@#(U=mu%PAdsR=n)cwsq?m=Jhuc* z+${FV40Bgqg_D1qjHJE+*xNS{d;10;sgLdFK7rU3H~_ivtJ*J_8_lTK=&>s)6)*mE z5w}QWpWg^*w%LtlPCIPw&|Rw7Xdm^Yo-!&T4rf#s(7;j3HgI>N1(my#u(zMx_>b0u z(&4zHso@yQ?Xm*gsVsA9awp&uFSk}yV{!aGzN}%R+d@iS|6K5Uj+sS!NtBxi+JxV~ z6O)K~tr1PewwuK^8Lhbd;nLO-|2?{U;2>1)Tn5XRi(%bA3s=wXX*YJ&Xfz}3k)L`|y9ZGavxDvqE7} zt%4;j0kwzYxD~PX0Du5rc(E9s5`NAgpqQJE10Y2C89zl=f?2e^O<$tfXu-9N3?#qs zGLG~ffWy!A$NoOw1z=CVK#;tAaJ2V8PQU6q2ssmnpe9xV-STlTta%;! zoeavBzKy!G$?aB8dK3U&uS{}x2moHed=6+!0Gf|rbByxqW~yO*od-iJ7GDMj&l|rpcZA4vpD)gT(M9u1nxUVO3kB$O> z1Cy|qRI$+^IlySpvrJLaNMr|U2P_(&#*IxPUr&Eo&9(Dl?!@-;28%+ai8P0Dxw`b|3((QvhhTz1XeF z5?HUCLT%}3Xo|D&$w!NE>f{%=ZY)A={wZ85$i#iU{-Kq%jsbvg$lJnB4M3C8j0S@q zch#lP?OcY!Nj*_9Hw5{c=E9P%LR~=y?rUp0#M;7B1wfO@f(ES?R@H9k_soZSehAc2 ze$Y(ufOfhcw2ANGx~>4XtMbuga_sh%4hcXHiDJE@0B9nm2!jdQ-AkbTSOWd>QP9V} z0^_1rU|Bj8mJJhNRwdwup#=3+SJ2D>@bKiTgG|IaBLGdL)~+`|v+)B|F)zZjA_Uge z!LY6y3Cq$~aCPli)NYyp%gObymY;>SARD)|Cfw4QP_Hv`dRK4awy8Hdd5ep40g$o@ zjsn1Xd@qV7xT8AyPpIAeCaxz<#kDJrDIE@3pRYl2}oFdx=}V>okcAE=os>^NM8gDGV=lv0XA$4jv5XbBc>y@Vl5 z8V3LYg?PlDrmJw_VwLj&c)62#K!eVRa-|shxqWesjQ+$ixREf11HiB%1m^VZxM``z z4c#RiPCkjcD#O1_zW4(il_ds9=bnKN0U?|ZN3#+yICQb*sQ{qKWQFPQ7U<><#?|FC zuB{u5s~cX&wN=3|ZFmcH>KxQxwc?gl18c>3+||}R(h!82{^MxDL!l@Y!{?nv1D6Y& z2EcXym%}<60A}1b=u!LSN?2EqM(u{b;_8lfQM>$Q=vIuv*EPAgWvRy3<_g@@<=~#K z`g{Hz6S6L-(QE37mc;xLlZKl*J3vkVfRbN-mU_#za{*wqA2&6kKL0H0PHp2B+|6qy zq9lF_61RSV=v5~W9+!g8kDPd<2iO5fPAh}oLmoiSO6Sg)In4tc3xHys<7+`?eu3U- zz&*VVS8^-h8-5%;BUSK;JdRglQgN+P|H$7ZyENWjcAg7C_8c%}Wu|j;K<5X*(mH`M zT2Pc%1>cAh9JM6L^#%4c&S$ETf4Lf0E?04S@lquY9xuW8#px}yl!TvNQ&spXt<-_f z>0|&r#m)l2(xOFq)f@oCpd7o2P@#9!N%VP0pN%>J-$)hbC9RV(6{fAs#2vk{3xKu) zz^{ele^>1zzC|Ndh+35mi`wAus_D*R}Q#L8^c8~8(i zj$SkP*#Ynpn~E#BHK;DpL&K>S(^qH1_o155AXzH3W%h#HQv^T{v14dx^N#?)Uh5gE zJdJCWWFHXEmWYvy^QtjGb_zZ=_CtXBVDm+X*MXjzc|h}H05HrBK+AW?mKHPSZ@$O_ zU@Jomkfos{U*qs?>|Fqucn~U!H5eTIP$CXjflbIp!&3!-1D7P5f3gSg+F&wa+3rg= zR%EY+rs86bx}{Fk>5FmB+?LY(m;ew%7|XR7!t&p<=Yoj%Ox!nG9hQ)tx**dY02JnF z;2VAdzTqnPgr{Pd@)WLC8Xoao{*=zT0|i_zAgqXdzgOf*T*y}A8)tfeqX6)dDmFM9 zfUh+M?EI<_+Yc9E+u>pyR+Vrk?Z3|$bs7VblKJo3wWe5$<~BUZ(~bZr9kMyM`9F5P zvUO0gQ_3H;4c+$rmhU=wLB?SKIAD8v^S`~21$Xo&T-O-5)9UqF6K+)NaZ6|9M)!T2 zG3&Kv)KwcF$@LoyyeE*~C*DG~uaJfRn>FN2o4GSD$}2WI1As48B?$lYJeKdu!_plW z!K}-`#zT3SwCo%{+MbL2+-ih>ngPZ7ESS}LZa6eH_1Q>0R}R_g z^C-yGU`kvD?&=*6fFrl1Jak5E2b#>^-@))n0N9gUjLC5sSg<(O~^#TfqWz# zD~2o~1Cy3zAoWZo8jKdCo~ghGpIyYpgO{-KA32EKauNHEm1616T&&oWhv;=#kjza( zRD32z$DYR5HEmrTHKXuiAv{|SZaZ*emba8Yq(}avvD4$BE2(TbSkaa*m6Tk9sMQzo z(e_JFuFt~SeFfO~c_9>uIe2gRIcz>u2xeUt_9m0h46NQ?2-%uU4zwjZFJsPz%a|OO ziSU)@F>g~27VpZ#n;)M=^tx9^s68s zl;@Qrd}bm%gOx2U8ytH^Od35}NHKidcydIaX1Km@!{3X;Syc}18%RHeCtUzH^Rb-# zY_vC1;`e;=`#yPgL+bqe@m78$l4P5mrAC9%#FZZ!Ol0z9Z;?Zu%i7WeT<0j_khJ&FfXh-GgSA34@qx_GU)pA-qFkFm1tBROFR& ziLhPfEy*>Px|KA zyABfVGkPB46Td)RW&536Y;H?6lHD3+u1m_eY4Lol=NdTKLJrMVc#7rkbRWY0&c)e6 z(C$vjLPZptDda9yAbljr1IA$JTZ?h{@Oj)O{UmImrQMBb`f+Nfv?O#@UnvFi;SP9( z%(8XOvX6SE)`OBS@eh?bhVws;_=n1V--D7d!XVZ_Vxhems)tmG2}}a=G7Hc^3Su3k zNni617@vHS$=~{|hY>Jt9x--nk_{ql+2jYh2h9j@>1dr4{X=ElJ%ggx3Mj=bdq^T+ zc!$iy{7?2kS5(oV`^Ghy%v=N6d!<+jggLqpPEV&}cLx|3U%&PH3f+Z{o@`9K{3T*&dQ;rEhTL z|GIP*Aymvw68*N2R+f<-&Gz_78a<7SSb@_gZM&9@kJ*~OO_guFWU0{LqxdBFk07+N z_3i@FTwElM-sCTi^y{?Op!6O$=a1d#=vV=zs1*h&TauWEghk}M%_zw!a?0ZQ!$$v3 zsXIx9f#Vmpcqx})X{K33D^>0x%&<<=G50?Uy7@?=1BJ9~FX=7%aI?SOW9B0+;Sg#o zHE1?DzUv7$nKBr0?(`*$owmwGD_bsicp#)$wTGCUOfHsidD?_@UG$blhKhpZ*#e5; zE^QFm8ln!JxET8mrs1C6(B}1}*2HguI=2k+*lqBX@-tZb^(N%9A5U7gI4~s2F@>~_ zB!sql((!)uoBng&u?)~b> zS%}|V3X$FD{Dln}r#5#~+BKGWVW)#+sL;K*Nl(bJ_uipk`zu(gFH z?((0vKEj~`X(-PvL)84uEq6%TZ@m!E%ry^MzR)*B`SjCDM~gQV`;4n3dWtK>RPone z*>1!WE8#_!16wXPt=kZ-@ThUD7Ij!(xBqEt&DU vFi5`8d*pP--(JxrUD738(j{Hu()RLC#YEvvz0)%w00000NkvXXu0mjf4od%9 literal 0 HcmV?d00001 diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico new file mode 100644 index 0000000000000000000000000000000000000000..271eecc7fa0b7128338f1ad0a856d8211adde041 GIT binary patch literal 15086 zcmeHO2~<>9wk?19|8%eZYbD)js-PSoG5%K4M$;x)=EqnA2%5xp3eiq?)FiD@5o!RG z#G#0hvn>MCN%apbCn?F%n}(g2w&NePv_uO+%i9`cLPl!g37E$dcIxtKmdQ~J6xw+l{|7nq^j-EYDHG99{7b4Lb z`d~PHLrp|;sj%n&x`aucsmXG)Ah2w_&My-&nSIeB*v~nj<{j*vo zKCt+WAaToO(jR>2 zbfSM#DV(RP#)}P1$Je|sM`l7Y=}J2<><{>8M@e=mB2_b?l}n(Oi?32q&5^nOvak5? zSBhWM$|UiG``)t2!*P1ob~M)iQy}inI>qKl`l-`c_2>WQbc*Irv9H|48*Iz!rE9+I zzka8dOEzf6JGBLR48%990#RGh@<_NJjDv-r2IEbf*tQYDZw|e`-bxM!Dh3aI6c%(o z?*E~ZJAbShFK*Gw#n|XO4MiFGgj=Ytbe8$U*lqu>E^WY$6}|{iN6F;A-pVAi*#5$Y z4~;?^#I1)DpT*&*Ff`P*b}w_9zm0X@p`of7=4vXn-=Wdi3UkdB?pcLCk-Kj)-k^8a zxp%gh?cFz-e?(HuKCGNJigZeRPetoAAN*Q{%VsU@mxY;3S9p$nV;j=fzK@(8E0O(` z4mrD4puIeh5{mC8vGVyu7_ycH7 zH3USACZH_o6e^NV^X{AN zdu&f9`KR&0uTi)}TktpXrePf?Hb*%9sO!83Go5Do#ojeH{3xj3ChAiNeyv;@)l>Y{ z8RwC>U^r5j$U87H?6tWCNLb{Kq=h43$ja_`XXV>bZN=};SN?KoWKZ!|rJqCMyyuXt z9ovDix#=flgwI6+J{ieD8Z4_?fOG{LNCBJ~8|m ztKUTf?G27(ZSP%w;;$tAXV{Y#k3>PtCMuE0`(_PN0$=BzXVN@q7B~h%@oVHl^}ikY z6+a?2;|8|u%SOWLnTU_ncCxAK3d#`A=D^3pXn(#WXbk!q|B=*dn7HmTW^B8H_qH{| zcVrLqFJX3Ihx~c3|NQmm66x|Joe?8HF=P6c%kT&>;{6TP2w4$XnlWHzx36edV&wYuX_5aPuD;N_{i}!Y3#kf^w%!q11_v;GGN-hbQi<;hE!w!Q%`e^L+6ux6YoxQx06i=MDO%-*`l z_nB4xeDP})J+ptRYJbG~1C5xy&VW5}MJTLlMWb1mtzeI*{=$DY>pJp`*ARc90DHd8 zKwgCj$1b*@!XV7ve3%EJ_=VWdP3Csg8*k&B{xV*jk&UnR8?ZaM9P^^9kX6x$pqNG+ zOuW`B`os795+K0-H&orif{)Vi+Ne1Eal~niq4N6li+F9N8Sh3I@n%TPBkNFy{AJ<{ zKJ!FV$Zz8FPx8TU{U%_-i@y#~NSBij>3im5jaJV>adsJv zh43?o6T^Gh=SB=b|U_zhbN3Ad9KQ%~xp-mY%sN8Crg)w@9x24nx{%TZ^bHL=mY zzIKPv-g|TXEu12M@TZeUFnQn8C?rX$2~rk*?5%5n#?wtk{bp1DSTS`Z#Ugg2seybu zkFd5d8#^;T1#4!HC)`ZO#Rj!<;5$r*dkeU2Kg_4AQ4aiABbT(Wx$*f&6Oo&mDfmpq zbg(SnfNe`Y0E>SR_M0lXbY*|V#(bv^e}?8%1jVv$(|U_9moJ2&gx|TuMDe9V8~=eN zUariq`LkN#9HSx~wUtwU-K)KazCf|NIBvb2^c;?Ejewba`Sx_GnQXa~LkBru8q+~q z7jgnTT;+td*J2et;hV*j)ETK}Y_77gI)d+Z&RHjzliYLiIx6sz?j(G#pDas%kkT}D<_G#>uZk-t5Mbr{zYXl2iHrn5V_%^~l73 zraUUfX1`wkGN*B5qvYt``6Jm$(pzNT=~(VaUxU!TAswudN%jW6Iqc_ezue5_Nfc!k zVZ)-SY!5c7v~SjwcaAqOdslz-7(#r;uzgAIH(vTu zZ(txb9>DTiXwR!%KmTpAH*)RTP*%H&z{qZlf^~_Y?=^8H^;lNh_z1 zMsn;SiuXD?XLdgGR23Vs{gZiYOs=#186S84Hj%G~^ckWZNoT6|LmO99-c-;19NEd~ z2%GD{&V0o*E}q@Vf?_0eh7e!b8rWUl(}S~WlZn~2UCV}@rQ-JN#IngF$X*d2_LB`9 zWDf_^Te8otCX+4P^;wu~&I6Ii-5rL)Lt9Xua00n|!jZo(0{Jl;P;fB1OZ_lXzQEc! za;OxN5AD%sx<=!5r8uj&%RU&c+Po4NDBfu-u0ma5IrnWtWix8?OHp6p*tZp}nnn2v zP9JndpX}_*j_F(U>|&%p3iof~Xfyvu)<$3CYz=aN+tRML=$~8h7IL;M;pkPQ#Bp)R zN~*2%u&cT|`jiKDi4Xsbe&%PhVMt5Gxn_dhlhL8bKE9iy$MQCqJhC<{=u`TJn%hvW zX~J7kR}q_a1%;(`obSzCdyVAa0j85yId@feH~xARxI9JgJb$~7>vU5Bsuzy)<2o!_0L2xk&x}RNX|20>xp8-WL`o>zJ0%j zJssfYUl;V*`tNA{y?EgoW=&1w;u+(;^zaHbVosD1CKLa-FQ3+9S=gl> z?b=a|7e^fA{NbZV?ML`=GqOr>zh#%RiE;lKMUulnj_Kexol&AOs^CNCr{EppN zN4>EPWhFOx(PeqOCn(mibkg%bGrLvmB^}%qZQJLnDXvcw&UJxGY1^K)!KkYe8e?up z`suTj|N9!}Pt$t3jI-^Z?|lIIR!A0SmQ8lQ7q@#SFTZeUZY82M?-5-|i%Q`#k8ggc z155+79@4jIZKw>JqeOO6nq7S}8NNfz=PME9Ip`;%9TEK2kl#4yQ}8Pm=OCZv66(A4 zi{N>vDl&37SZ-m${=HZ+<%N3`%ZXz$6WqCg20`QpBY)k_ATPJO2iAok{39>sr>;~h zrIV?fe)E}Xl!IPn@d)C1iO?930CxNQQ_gL`Tr_R2fQei)Ay0t0WXL}uBVUWFNhEqw z{|JTJKgC=b7B>dDFqr$I^(k@-$-pl5d$OmgxKZh;pJM))G5^jrr$0h3I>*nT`C7Mj zjv|Hq7J+Yjc0OD)Tb|6;YIZI#n{MIw7n|--PV#1UhU=;yjn|;xQamgA*w&4ASeu9U z2t#Qj^G#pZDy6y|)TG&eoxh_C+h- z*81W0lmiiAGF9;Tui>8$`9kF6%HS06+Kny}>jy*xXkLRs?+pF1} zqnM-m>rl-NLs=v8({kvyB-6`O)VICwyL#p~(b?(Kw|~Dys~o7hKacHxdQV3_U>W&+ Y=~p9qilTN0OxY^Jpcdz literal 0 HcmV?d00001 diff --git a/pkgdown/favicon/favicon.svg b/pkgdown/favicon/favicon.svg new file mode 100644 index 0000000..fafa54a --- /dev/null +++ b/pkgdown/favicon/favicon.svg @@ -0,0 +1,3 @@ + \ No newline at end of file diff --git a/pkgdown/favicon/site.webmanifest b/pkgdown/favicon/site.webmanifest new file mode 100644 index 0000000..4ebda26 --- /dev/null +++ b/pkgdown/favicon/site.webmanifest @@ -0,0 +1,21 @@ +{ + "name": "", + "short_name": "", + "icons": [ + { + "src": "/web-app-manifest-192x192.png", + "sizes": "192x192", + "type": "image/png", + "purpose": "maskable" + }, + { + "src": "/web-app-manifest-512x512.png", + "sizes": "512x512", + "type": "image/png", + "purpose": "maskable" + } + ], + "theme_color": "#ffffff", + "background_color": "#ffffff", + "display": "standalone" +} \ No newline at end of file diff --git a/pkgdown/favicon/web-app-manifest-192x192.png b/pkgdown/favicon/web-app-manifest-192x192.png new file mode 100644 index 0000000000000000000000000000000000000000..fdaf515f9d21c61c132edc8f03f0abf6b4ee8d5f GIT binary patch literal 19674 zcma%DQ*fqDl>TDdwryJz+qP}nw#|t#vCWBXV`4km{9Cp6d(quh??qSlL7(U7jZ~16 zfP=<{1^@tXlD|Zie%8MK1|;~;th8wZ@v}fV{L*v=0ANu58$f`p983U!5FjZkq~eit z=?kHua?;Ymb+YOGlrU7mlvo730K_KVFgk?H)<7IlWu}mvoRbV0?9Dgh6^7-KvF6>q(>l?)yix?l z&~-Ba^Z%MYaFDTH%YQ2``CHEw4NHHx9v+1vH+wDZc*R3!uiJTyJ@p)!mw^0U$uLe!ub;Rzx>4vS^B2eAAJtlfC*~Hm3c=_(W*`CY~L(_M3BMja1 zD==3_q}!z^6%To$(c*K5r67l)A%~?nB~zMflXe%~@|sRM<6+OJ(WAcycEI(rLLV|I zZ8yw9eBzqIc^4$B{dQ^9mXQulRDjGIasU81BUN4L$h+ET&O;rZI?V;|H!5xRC-alg zbbnPnY!uYj9T160UoC0WTRO1`tHyblAwvh`a1lZ^p)te*im##(h53&sIAUGw(KUa9d||>FCgy#%Zey;EsP)6@@5h z%%A`(&V>`^Hb$q(=>p=;K@xTGycHqTj<#qCi{3oH#P7A$omdP#KQ&?!lJCV)bG6o| zZKBCgWX-fDjV}d4wS}eJilz`uHqFb(!0_?^Jk@^ld-w(KGZ-F!@N%RJ&@nA6>a$^;AG#xQ4c07PTsJ~}@ z7kRtbtl2u=Dv1y!C1C}1NoW9Lz0OF#cc(&-7#E>LD%IDtk&6f&7MzzgL(!B{oX)zBL@hqN8Yv7Hu4mm7SLB1gj6Ts<#sGn_P($iVJU0NU z$_*`4@A?AoA44AgE5bIo$Ez_Z^PPO~NCoKDXqdd+!Eer^p$h97aRw6=2c$%U^y>AN zRDDXt!s}H}Nc|2J%keW06V{?M)7x2t0zieS>;o5&U}|9q@P6T3OgK1+5`CF)w*`+^ zY$i-$NSj<5ZIY<0E)@_8ygE`O6RHK3;=U>Qg`Re#jla46S%lrez;`+ah@Kw@76-|P ze`lQ1Tg#)8&-DPM>@xLLvXqaXQANo1kAUD#<#d8MHjKBa7D&KZ3&UA|$a>M}N3T{m z-^8!R(36}9_aVAZAphDhjk$2k)>4=JB?K`u3&$ruu8$_4KfOTh@%lVuEalNUomXfb z5~KCrNLsB%n5gyPU8Qa0tPBdvBn;*wpb_^8k))7Q+)u)%m<9rPd>*Ga_~R{yKQ7nT zJ^dM{ypOM%{6fe>(D_W(=e(|zMenPLYnD#eXqHxe8`d!`iTgFHikmg(=`p+M$TFaP z&)zp_k0Q`3fRJ^kShZ~|Y~FI4P|6jF7Oz8U5}GbTNM0FKz+XCEGf|5#)x~^f?DO`j zhskoUU`$&UrfW-CI3lx&YjxTy%%y;No4}@6L)6b)70%8=5WR9G@+}Fow=bkaWGz@7 zRz(?8rfsPhtCl`EZeC?~j^x!csxiDF!lea9KzV;R$^6zWuXlA-oVU2lb0~o!`HPIr z%}6Cph5W>+g3?{W07x*t;hrddGp>mu$x(ffU1OM_(d^26(&}3qa8n{Jy8WCNCN>{= z4yk(s_rqEBUKEEg`F*6?4x25!wi#NE)>{>uYj)v(LY0eMa5r};pkTJ2@hc-$dhXA# zTT~_~;O3FlX)wHzNNeWCkm?elX+~)4o>aGSK72++GsU#6V`dj_;Mxdb`j#JXLI%$9 zZI}Zwqh4uO&}8l0xZh{EAHpkz&E>#!SjdFoa~;8{ZvDg1i)@uBjFsWFG1PUz8ef** zj{oxf{QUfn{{~b}AB zoeA{>qi94hNQVW#ahUz!I~M#~zFz@>93FAWh6x`Fmhr^uW>|fc(Zh#R=QK`qACZR} z3=DwL%87!EkMdN3Mk0T?SMx-0#c^`orTwr!Azc>_W52Z|!Bi8Q{t%J?)hz)R4pmIU z??}>?x~P=dtYW0^NrQZ^b|r3gC#y1-np-`#jJ9*riSwNd@UUQ1EWJt{R;`@JNpNC< zBcR)f3`|CM3gyreBvG}n<0!C0+9HD_{Pm`yx+X{bS=d=;v%d@FoQwT#c5{b2EZ=_I z`xdJhbGl2kaWYWxSI%f)qrn-6k|h~43YyMxTNmCv-vM-bE3D*Yl9G-vlqLy=Hiqsv%z8de?teHz`R9_) zMB7VF0si)2t?aMv4KfQ?m-Ncs{A2APYAUd}Dn-KBIj9j;P4#jo4=MoHeMc1)y3SJC z@nwukuS6>G$L=ZIVE7mJL`y z(1nNVAvYu$vvN67KlUdKCi@P<^1dJdLqEJ`VMvJXGT z={$7R5gSmksC7JJ*HtSbjlfR$W=eKNiwIaHh*5*2k0*1MZ%r!X=cx~WH|V!=vVJYvrUj}Esh*mD%5W$gW> zzua%{`Cotn!k6|LQ^q~JM11q4TET`xo(Eh$h-qRhP*{o5`b$u$Y-H+IQA0N@`kkdU zb*3PfX0|83!y|nY>!_X2)6}Q!yRB&>vCITTK6EX6uWp>#S%8*gN(QGl8?q5YLE|rZ zE}o&9`se$a6mW04wzM=;IIIXzO-GU$$dFPB;|Ex?{`# z<5k1!`2pqlQo+ctm@$L#E6lI@i|PASv`R^@G=6hMW7dHT3};O32`WzrHjm)AU`R)!y83@aMB!x_>Tue1s)zCnL}szup!L3uANnoA+#L z>>8=VVGu2D@*#nqCW*lvjfQd6o(a8rJKXw2`BrfBb$0nr8Qb8U#Nku^Os&B;Uz^4r z)8u~bb_fl|LW9AQ9;~M`knDBRL`yx;_;e#rQk#%yZE;aaF6WDa`*lDhx)vCNtk`m$ z{`X1`N@@@Nc2qG#bZTpRnrP>j*1C)l9dhUaff3ib_XMN$m6{HxFWz&rR-ChO`gFCs z`vpxSd>I_g_~x^hD3EPY;2mBpzPVgkpZ_%apZkRVNSTuQVm7SN#d`(ZsxX z&6@vYJoX7|IsZxhS_$q)uNPd%uhN{QwZeEe!=$wwk>`Eg)tV$uSDV?oEshte!V5LpA zQdEmf7AC71HN%cC>LvyM_aY%pG;97()js#W)c5%!y|F0}pc}k84}H!G&TO+QFESMe zVej!7eQ-%c{8f%rSIRqw3IK@^6%gz#+c#FJr8GuKojYXcO6qRkYwN75^(QcgJ@EmP2f#Z=m#UnA@j;_7K6E2`S>$#C48E0%~T-ay5{{31A!i_pp%9O=eMym}-H#7-$I` z#6`1xweb`32dsp#>lyypN|w&ll5{HxvNO(u#x!-cj{N8Jjx;e_YrJ&Dd-=Ab`A|BU z+ZnGC){;a?&&e|H{ZxgpQZZ2Ti|(vTc0P$xtT)oR!Q@kDvn?l*x;yUe^}G7Hr2($K zq4_wya=aSp+0{!&etIa$6@tlNK&O`ISG6z=`JX(gI~5_>YD#-DHGKEyv>r0}V{?p8 z_QCj=j~OAq`>qWSYPl}jMAhaL%5zX;%`IiW9@i`QVnJ;NGGG#R!bdCcO4y-%GF;!r zs5Q>FmT6iZHB%JEK5|tK##Jx)YR7q!#)NuOH)aw#E)aq+dr=$);c|~6GeI*fO{M7) zs8PwHTI=x&nyukN9(_EXPKF;+QwRfB@S_YuxZxIRof9k8Gk8ZexpkuuT zq0f!E1brQl{D0oM$aH~%x z6*i}17k{W5jk?dxnjR~8F>tVizq~9jZV^BMrr`+v(@P+!WY;aMV>~U0*}y>Xtz2<^ z*G=S$NK!zqzF8>%i>pBSKIUD#NzwN;>6T)mSV&n2r$Y|_M9;U?~*nL zqAqzF>NaS4M`SFrmF-%@iEsJ0Vh%%jy>Bo`I7PP|n4Jmgt-`{@b~_A)My)@^1=_vQ zNuh?VVBKVdj|D-d<0m zSNPox{$mQb_+02v{YoXaTT%No7>?@YV$I#&CU}Xfps=s*?c(4Ya+akkil;LJXR)zhJhTTba?E#1s=+y%j_{pQ(8#X|2f2pH{f z>NYli$25tG{ba&8H1A(^)~B=-54{{EwJtAbT{#^Hp^iMYYVi`|pnQx@7wwnN^% z=vE2*MK2Z+>b-XfFV5F-ygQ$V^YB0GJI(bkuGV0@y>-u6*muwe5XYiaFdK&*KMs ziX9w>p;O9rPO_G%GP2acI*ucO^jhG#L9AkErS8~P-FHE^;dP_k1|_c>*i5CwrxD#F zs_31;f*C+dv*Ctk!pq~WX#1?ZE;r2GtF!=n?>Y* zmCyuX?~hN`o0_xUu{hl*)LA2&uwkECK92F%6NK~n)>laoT%2t~c#jw7UR`ZxzqeC7 z`_zf`p0DBX=wZbu6EFy-${A~ZW>WyH@-hi`lTeqq(Zx6#8%!l&!@65h>C^6KY|N>7 zOI?8*?)0oBPlxFTj{<$W@oY*C0+{YrbVQlCwUc?y4kK;j?ZOY;om}pqL{{go6TC?X zn#Ec08?>}MeJs?6eQP-$BUvk7A1rYnvEJ^yg6_u2Jqi(RKpq z(uCCxF=DBe+xsu(>_DPPU-q8fw9y&JbZ--f-(6_iEyu zCJTeVio<&}O;+x$x}{57qY>HD<5_$+pO;ol4$GJRJfB+g1?bMxMQlc9lVe@Q>^`vu zjEp$%qLpIJ+^QB+cEH^7m)=UFUlg8Xrqcn*_%p-GDI%UP`gPSx@p%Oo+}Xt=pdOVk zbGB2rOTec&lw^GO_P#5`Xbr@Ul;9OvCocbKU&`di7*M%gMg|i#)qjm>`*OoGki+)<`X6R3avG)!sPoK_AUTk<~D)Nm}l^Z1t zPl$305B8p)OX`WrU=<^<5yzY^{Fp7(+VIV|*>40ndQ==;aV~xD%C@wf15}Xb_K*61 z1n_kJf`kXOu+)SQqjAUO1WTLO9w6m*FL?NU&Fr8~qa9RslNl5v*ZWfrwhN~1E<*=- z5%M&7;HBjJ%{+tn@i1TygY4nbeq_V0Yh$UFe#t2>YPb1C5E3=dpP0)4>6mSDnZ zrkMB|`oVj!-;W>2^dznz?1?Euj}owm*q0rJs0 z{7!qUiUr^ND>)i@MzC+t+QYfnO#tt99UZ*&X5i0Ji!Qi{jRSd+vIzETR{9Ty=I6VC z#I@h*ToVOyiE?4@8_9$#Rt4=`p>RI*fgKvFG@pUorv40()rGavB*?B9Z~z;N&}u2J zbrUlk$O<~Wkjf4b=XMQ2oI63l!PfhMN9)(iZ*75(*=~ZT=hJ9kzBh#}Y3e?7_wWs( zx4rjm-+FHa`wM?#LU^z4u)*y?2X+_UD0l{uwZBc249kVQ-^|doGjpMCKZx89Tw;u{w%CP_R$EuOz# z8YKL2&$bc5JD*4Qu0T%h96c2Dbvz_OWKtpSh)0FrUm<4gVFJIhGiU8`qc&@Z7f>gc9H3Z0#9SGt=vw%?tthh@)P#e>uYDQX=!Pf&^h8puMgCEG-k=|_G zL(rG9d`j(;(B40&u~!r5>9}jir&W5b*D~j?>^`>Nwo*I+B*43>yC?e(%4PYhZK$;^%lHj;K3cK!#qogQ>6pCc5Xq!*9@G znja8&Lk%6grHHu+*51@f#L))h(nvq+#|pp#;&YVchI+n(p-o=TQV^f&1KAA)0Dg<6 z=g5m+u=?Yk&f$bZutcD}?ot@N=z`DV5tiYY-v~TfK>n~8Vz2xP#IgDvF!X>G(ZtWE zfVz(IHe5GYuLOLc1dc6cZz5wIy_le$(CUWmv@9$1bda#L(y(LAxn3;bcd>*Z z;pJ2dulwo^TT=BU&-X^sumBk9;)bQ7Q5nB6GEAT=m@P7#@I&4Z1N&DKVnVM zTLn{ALyc;R6LNQgW9CmI^xsy%EbbWqamK2&Tv>x*t&6Z7u~g6|TLl92VJqf2fne=i zgs^j?tBPTBi{Hxm0YUfdM6)aaJA9xq6?G(Q6!>?ai?E3Jf|D3th;D8+K#e?bV%A;? zU(H93r9KNMRx&u5xl0^pQ8DVS1#7QGR*dmP-+ee!jz@xYa^Sv74^eJnMr>%VSY{t3 z`wqw2m4uc3z(<;pZmt>WG0H0rQvfSyU|`%EAzl1(vf(cUDLopwo|tp#G(yW&>t7zF z2>aj<{gGcF37n3|cGVidgPEM0^Ct6~ewJTYr}B2<)4)*BCB6>MaiC#M8;W`kKt~-o zlndp>I{9JRS@(?OwZX?M`WEOtVb#q|1`+GgJep^4Gt?F~By6l;08Rt4jHEqG&twQe z5ky{X8fYg6V@F1%a(5xaRl>tca1#9|Y$^IHp;CUh)>yC#MzkWv6K*-YZ}g5763Q1R zZl^;K#Xl^tuN-j)HXlTr%!ftuDe)UN{B~yxhFy&a?KHlHL=6L*LccQCG1iN{ZAHAZ z#~y#%+5kL4)c!o@FxQ8YK%D`hGv9gtNWMRK9CZum5tVsD>xbaYxM+^aNnerV#2+ zHZI%Tt1wf=g#&+uQ_-M{Nu&{Z4^tjie*@6eZ_Te9$Ur zMy*&e=?SeAo4TT!3tHGvI;{QVi$+!7GXDC=cTY1f zK+gcMN`P!AKomFKN7^I_S78*}_P3F8wE=nj+HL6ZW{+|e8`yU-z0Gr=J@nj z<|eYIa&FH54OAdPsO}>Vranvw*Fahk zy+_gU4}6v@lk$V(EBSa^F}dW%!Ax+Cp9uC^qrCuaN5*kb)-;;J&}cR=w!=9)r>UR|^nF3NrH7TnBSl zR{{`l*~cr*KH~HQ;3H}v#A)ZjAUZEz>8rf~em{Djt?`2qgBhk&cn&xFvSy_91GyOW z?Wezh`J6XowDCd+)0M(x_zaLr20zNep_G>Q!3I1kGhtI>_^%4I5){7}T>9pxG`!AC?vq{@LFL(e%#twXqjkSoP6%5sv&oyLJkhDl*1enmRS%Xd`!vm4A-JRuHjbXf(HJ0 z08nI0EQA07T)?5(>2041@O?Z_;+r0Vj(;85UHP9NyHJj)>>bfFc7e@xCOFg155*1v zP_m7W0__KA*8g(TXW@;P3kr>&d?^XKdsUj0lYA1<`W!2AgL$4!h>d%^!t6RhHlJc+ z%laNtN9PQJuftrTey%{-2s(rD6wHZfY7rY^Cg!^%68x9&T=m*RU*G_bo}Jbo52Ww* zUNr6xhyxs>_$EE2V5Ju+GkJGR_I1bZaf;d)3<2aq85HH09k$dn#KE!<*@XWGBw443 z!p$7w;gn7M!?SjwK_Fx)Pg$YMh70OtUVLM<2kO@gRIS{3+?I0Jtn-NB9~h|+Zv$Fx zuptL*i@5-cw^Mu%U_21{0&PLsw`qR(L~iKDNAtvll(-FU^d)j;t^s5mR)F9_TiVa- z!+CaK04NCO#EhNA-HNlm{v*^6K|l6cfEESJBS>-`SQJ`UWU|52)~p{jAFQ;=jSj!S z&&6#1G|)Wv9S)P!OZ-{`Pq}>yH05nB(qxZ6O^QDvz9wVx_cRdp)mnoxKRhrHVwQ>! z9S>xGj*1WnFMn3<@UhS1&AZ4B=+=S&Gdz#T5mLt&|AZcOH*UGZNvl!x!JF0i#{#Eu zZ^G|70A{ltdn*tvVRpoxI^`%~EnfcL*zsyWAIOP3*))30-$_LtP zv476iAG$|}#P>oFad#D#q-&Let43%W4co-O9+|m-LF_;7fZ5}PA*Nks9A|~3dszc0 z0JmrIsswTyA^4%&sWp=W%&!1#L0nNJ$yKjYa67d1ct`iyjDXKafCbM-H$NS&BrY7l zMAX}K-L(V^R`}|@mNKbbgkTxUMwA0HtqXdAItlDfaIHg;v4#NVDLRsJn;q*o7R6A5 z3tOFdgjkXb9juc?!N&$j#vAp;XWS_Uax<_yKV)xU8FHvv$=KLU~NHU?l+1)K1Ogn-~&bl?C3{tB?pO>n_az zF+cqWi6gxF;wtdxbTP&2 zYx&NRo4`1S!5>zyZ6PBzEZz&++~B^`JTJ3Gr4EbV&`p*Z?wHtZlHjU?78$%SrRZ zS0Ro=U&0W%Ii!msewP;Wv#dSJEl%v#mhMPx9Eu{Fdyf>`ypZ`BUjsc7p!c)$F?}BJ zVUr8bJv3D7x;`Hkr1WXrk?iO=ql-}r$Ae0IvR7Iu=&|;8@RZ|o91F)D{5M=W=J{yE z+!V0a4(C%2o~$cKwc^&mfQ8yXri{)<=n3fNzgu9`dq6k1(1z|!jgDjf2!-NbX*1y@EA@&@7NaSo$A(O6Gilz%h+G}C6;mZm(rYx{Q+7#0x zVX|tjkR20wkMl&=V|hnQ)S7-cs6rGIBQdklg@~oBqe$rt(&@t}wd_@7@=2LugB_m4 zAYOQJpV;;|tdZi!gbs|DAVr9}8s=MV#(i&fRz8&k_-Y{?!06Gumn7)!Q4XRXHiBvv|C5;T~2 zq=65R9Rnlw$w5xhmlcl^j^Wkhz$6au`(uPTu^cCOhGDGG;mI4-iy6Kzi$aBISMw}> z=4F5A#|*rlAzQ(Cd>|JIlZiT@<*^%tZ?Z8y=S?qiF80L_jDYVcfr>emiDiH`~8_0U*pY}qPKs)u9kAb=N2&J;zPeOw$p4BawdT@s zw?jqWpF96k)MBAvIV~2+k7ueW*`}OedB*1P7Kx`N0Y=CsX)9s*#@0@Am^3;6N?B$&CAT%DK+e}DR%rZG~!sszn9 z^HY+Ww85b$JpEP4V2>&KJ-2UKC)nx12;BoK>M2famwoRrT0Mw|B3<6An&G5i_e(_V z%X5=vtp2km{~dSPIO`um3i)VwR{iA|oJ%g2aiIdKLuWv##qkwEJO@UuXlPu*aa#km z35RpU9Q8%rF)-Ra;044!ge_d|bR0oOhvslAhc*TG9XKrZy1&g2_s1L;p1h^uD-;}d zA{cyaLX;f^_tWD>bk(pZ_^<$_+R)qKIQ>ZQ03ACFS{Uo*oPK}JKy;gKhH2}>H_IU7 z8c<(EU3^*5M)hevSYKPbe1WL)lww6JZf+KYAW3v_yP(UXi6lcnDCX!t#nP2RW-_P? zgsQ>~K8P@1t5bKd!Iv6=sr>j5E+;}4r0#^rHB?M`eDUcel)Jw-t7>RPGl6lK z4PF=xLh;U2aZ2MZz5{BmIeuvT9R%*CKWOW{{nx*1>tc={V51O|&}=?8zN3ZKG6W!n zB%hiO01dJGC0;Wp9_;{mz`^Q_QE?r@HK;Rm#}ii%;$T&brtKYKjf080QmQ)K*jC3- zB+K%A4}Bx39MY}0GPm}PxehT@ zy(OTF^Hs)rsbKw@G8pKoK!vfVz_t@&azKa@dM6w>B1+vv!EC(&y<=t-SOEDbSvN{r zw0_0xWen`0074lDc0~Q>;Q~o)rvM8+CP(BNV(F;{)ST#0^?Z@ zPUvpoxZ;fqP8YbC(pZMepnaTq0$`l^qAl~G{XzMpg1^g7O<^7YRyxl_AOl;=63`Z} zuQ=W3^wfPDqBch;JF9*mHl`03Qb@E zeCFkOgZ8e*v@~A9czcqJpzBm{UI&zT#15C5I&B%@5Zp@0x^(cvDf@vhN!-`tRrx@dE&9V(S^>`4JqI)d}!ZdURG+A z1mMx=H+wo_vkTM*(GS-sI8-3tM|a98KE)MCuy42j5$aQUGVL6%GIKIF8sDlfvO>6j zqOC*W4L}rp9o@Sej+{L@x4;Vm^s8~%0srqdAiGcim!h*N%ou$S@b)uq6{HR}x&X}- zC7KADQZX}eAn|D)Aa{T5mN9-1QKP_VAjj1&V{*DIuIe3o4Upj&>0%-*qGRY*N4Nx%h#2ht!wdt#Y zbwnGR?Sk;a;a|l7K`0v_#~&qQh5iX1hqy|;Ay~PRm*~+9RlJs409A`5l!Dzw7PQY? zVA}Af2sa7(z|Mx0&b&B;pFw!k0z90+N`h-(JxVzC0;eNn-)jf91hUWv$F2Y9eJIxc2ud>$g#`^ZH}UnAYi! zi|(Hr!{b#;XlC1JnP#j=3eSla1n6Umm-OucSO7qQ0cotQ7<&d6a1U@~od68Tm1j^5 zU7~N%uCj>X(8<>a9gy`7%QN$1_!$dvz>Py+yC5&Xj|O04`4{4_AnpQKM%Oj%2^Fz* zw1?_P*@3zL#taA5G3=&=b#b^il5rhJ;`Fah0s1&s9X7v=2k;&WE=JaYY%bGP!;n=P zz;WYd1h4yyPX$MRkIp_vTm*pz9$*07FDVt(x)TclQqFp?-UV z5I(H{^>M>Sw=sg(j+Ztji1krKI=~RxCNAe0bXu`o@8S63jE;E_|BWwQXt zyEp->IH?1-kNLY_?gbB_m@+yJclp45>~L`79IHK-N#{I% zV%WjS7*VwMqIBkP91Iv0i+cb@iw~diXg~nAF%-OLdBJ2%{_Zh>h`DQ$p=z$#P+_+} z@Ve$H3|QK4#NHP_Hx}ULfNOUTlU<3KDP`cgtM&Vw&J}vkgP2e zP6P?izBW&MVR66Sc97jfq4)<>y0Ti{$cAV+!;2yol~IYj{tU4bMn^?rHGg-kqtK2W zM)Wy$?8L6`RO`@;c5(Qd&4F}TV8FCqIHYz73VN?cR5Yu6Nd8d+gXxBu?)8`?)v)qlqlnfdB$ z>F@5f%Gy+}TO%mh0!{sit|h|O#x~n4Sq0`z`={ls48ykq~LSrC{hC# zmOh^3@MG00)nH>=_G-Z>^>4&bcA8WSHWm}mkeLLfifl&7vhRS?(Ye7dl0HU!SQ zwm?J>*hF7vgijYmF0yeMuP-3W3<@Bw_mj$nDQ*N2q^>DQ8aFek)>k%T(5h-e(*oJn z%me+NnLbd^Vdu+pd5xQVA>zl=H5WIY;~3{e&5zrZp)<2@3+ZFSFq~R2UP!d|P(_QK zdEOMHJ9~slaNv!lldD zIIP3gKk4N#TKr5IPJCA+yKO^6-YrDs<&pnFvp*5it4T;Gz!0?y-f!`{OdJoBLvkDk z)yc9+y+3Bw)XipH-Mmo2!bVIoc;QU<$quhk;EGTjzZ*PfVn+{4DH1)(0F963d%aJ* z6VTBPZ$|WCl|@K*V$9s{5{937=WX);fW59pcG@b3UqT}>2{Hr5X{HV8FEHUpN{znM zPxkN<19ll^`rP$+)%=`)m@GGlGXbh2Ngq%s7{7OqjMVmqTUN~*x_5uT4JV5W0Pg@<#CnW~>HxUg@6!t`AvjFdZ~^*$N~ojjpv|Yv3Px-y zPpVl>)yJR%pn(HSC2z9);fv})W%ScPMS9=`$V&_5`y4+IlYbs0^i(f&mKEKBi=~so zzs3zlC#qewF@sMeXPAW1qn$J}L;}T#s@3RZS|B~K(|v@Nu*fs0`ya!?zfv3@cF!YZ zPl$Bg!JcJaUk*E2Wg>XPo8OuHDCKsYoPgr;yCT1cMj74j#k$%LN%=LL;bGkLMA8E| zW%SU)XP!z8HV2d$4;y3sjAUXznd;$`hL&N|vEu)dez{5K@1%}_**I&!JQfI2=k-0x72ZYU6F+oD64L)aGk|Udn^n{V3{EV ziyjBcR%69vWRs<_m(gLQ(Wb(dwdf6s=8QxhXd%c|w;Mo$#5Fe8Ouh;~mtWb*A`I88GjxB|OsNf5Md&c?rAM=wJbZ>6II4pKQ-)y5$|AW-!`ok#2LM zLO7W*GrCGM@%eMfynHz$Y9&Rqs)M(D-4jFNh&6j?QGeD4hq}GE_b-*V`s<5&)y59O zLIr@?hIF;`;H7m=X12M2<;Zl)tdh7fYrUz%8EJ~B5!=%bkLXoS$71U6Lj;cPSBsKv zm_ynjZ*1CdvzM+C|@-S0vC;qw+G$Oa)#hV_u1+mHRVxoUMoLXQTRFEd~$01 zhjt^iQv<@QZ){Hna12SKWBjuwdiJyKV9TfaX_25?Jj966CL8u|wT1hb_J-4CYPK5A zCi3V)$05$Ut~|M0+^q@hI}575waO#VYVnMF*;V%!T5;bOC>>GguBnjzOhsiJ2UC+A z+f|!VxjxFu9MbuPnlO3moqEUdV`h?)l6pTnvCr|*pNQ(() zMd7-$GbG{|E}``ay5}@ogGOvv4uX!RN#7;0bZT4Pa$ix_*R~sZeNBMbr*?}*)Vq#O zRC}4?DGB+T=lFA%szS)>sWW6o6PT{}bSaf1GC|V2{WU%e9RQKBQL9iRZAlBaqw(^W zX+Am~@%Q2YQt81Bm%sb7if899VFd2z6!#ply+`fr*`k(JK_HBVA3^kqxiRH&y!T?q z$CkdCMaFTU8FvO34EEFIsX5vE;AL4DnQ1^eyZH9+UjOd(a@u6^dydJ^|B!h!$KxQ} z%gn25R7)R~QU9v0(uCA+0Rb725Zo;kmX2KCUuW(5)|pV&qcAumqu)=UtLYZjJEwyG z%18ez^yXFdeM}GaXio;+PLDWQIsUZF$a$;=s@{+SJQS(8ml_Fkvovjy(Fk)}|3x~a zKYQX^tZz``83ezb&>K#z-Tc)iWpJifJ{?y%M(cluqcS)4%G1ME!FTU zYE~c15DE_ZDi(7_Y2dtLzzc_Xv?PPpJRBHP28(HwB2--DVkwa`_>Goe5YeC#CuZex z13!rR%8kqA1%8Yhr)=y>RlQMd`)K1c=%M&$#4alI5!dwJbrY?WQ?$dw7?w<$y&%uE z1ElECR;p%7TerzkdVl6f;J=>}xayCMC2LEY{Cg@=ct)qw;w1N5eF=O?BjTV=A&#`B-&sO^$nHRGyBPZo3So1r6oVKQrc02*gk@^fe zh<`l{zxc%Q>jQ<~ubbHlG9v0oOC8~?+z!9+llxujdwpLFSzrH5pT|4QqZK(c&jI~+ zRY*|;H^%W<^bsk1IW^+%S!WwgHD6Ca87@dHLYv6`MUXI0erH2$i6-UyYbzi1a6{$f`e$%+`8 zU}5pEzO^Kx-57n-_JkpOSP^M)IQ2-_;!ky>l^)T0O)wp@%rZ3FGY)*v-cf3MD@2(E z*yPWdpH7F&*VSeUbbc1Kflw7kF`eQ3zO>}+GOU}U=CN^J86)}>IW zSO?QXKCh>T_nDEFc5?8`Z8`2ar}mm`i&^< zD@}^V)TKW+1oT2c#^^+w`+f%9JV__G(!o>?Z|t%Mb+8Pzoe>YKI<;2{)LhTz^2U7l zjEWI&9kUbv(T8bxVTiRgh9}~apw#a0obu^~V>wTODQ>$YRZL{f)D5T(q0!YvwXh`G zU`kFm+L+crEj=oXnuUFFIkVS)Tr2nW(=uGfNzB&^q2n>`@4|orDs35S+tMU1$I1l< zqZ8LWp;bzU!4iwMY((jY*7x{~~2><;y#Req+LUZrD^eP@!0U#)(uBEh~|b zdO!zetI;UTTaAScR{@i-R^jpOVe$U7`Bs3@g>*1p$DC<;oEb%@#M&2yJ=} zzS;Q`#`v#98!ytI%f(sTE~}s}4^ggiuf)p|#a&k>^rRaT6x7)_plypt2PLgJn)LLG z{Ll8D(w?m(>Lo%+n4Ypt>kBX>2d%QHB_-Fe%PU^HF zZ-+D^nQ)gaMs(B}OqQ-j2j4l*uHF*%re$GiDOT4xi=;)ZJ%Sgw`ONC}!WXj|OZ*NT z_;aUG5wEur%MQDUloifm^@z()Hp`&6P&C%XGT%sB2mV*^-@gfDpm=2`)h)1({4U;x7HrgFlVtW&54oIAern0 zR*n%#-PJc?FiLb75rMIRtFU`-0?c_Du3L*XmT+TR>{m?3OlR6$9m3Qkz$nhu;QKxC z7#X-4ZX-y4hUL1{ckGd$i5p2$nsgDVbrvhHw(?L&`;C{ok?Y*p_nMbql*m8z@CoiE zl+66*WpU_jCyBDoNvx_P%{JUkwz@?!w3Mju53veuJ!O~?@g-8O<=~--#0DBXX0?`K zx0cFs6Lp84)v#mTwMhFU>B=HqXpf9W+(^#Aw1}-} z(mX8Pupig2WZ}L}M^9*ZR_e5=8UHWoJ*^HmlGCyD^MmL=X+8zMi&$!-E{LDfI)Ow{ z+(tZme@D;2kwg8I|JB&{l9zv3BLCFQXQo>_PuVP&VT$ttk*unvgj6v}piHZl)IB0` z0ynLKq)nCZov{L2cN_urJnpv^&CI+JtVxJs@*Q-jT4N5S`lm1yr_ zt>W5Jo3!~zWSQJY+(eP$z6&Ee-PTJ!qqDEHEx+nF8}a*dk5R!LT6u&n77ml^tt5YhqNyd2p6=>~2 z(w1cU!qW}tWC0M+<`e>gS(^49K_B-Ut!(44P3XM*b6Q15N$49+jC^NHvBDr=l#iaO zY>LUK76qkZlPYM>(Q`2OlkbsoDHV4$+Fx`xp3gj^r^#wuSC$TyS{7H6(=m71PV^ZS z0cVk%_Tmz^hs*BRzNZUA8qi6A8^X3>0(N$k_`gBwE4&T80Mgnk#Hp2se6ovJ8tuf$ z?~xUsR+H^InJD3oQY)l%h}Y{=mtys%ACPnXCS7eCo(5xMpZ?)4k7Zf}H(Q8|V=>b4 zDL1d)#AjdrfY&E4LTf@!vlIcXagRVkS`bMkmn#gqh!mABjO<8z&)I%`M$dk^vF`~l z&s)UezjPWgyIosPX^4wRmgYQ6RZG~6To>B2+#)4qL;8NW0tXJCKn0onX5?HC`)tu4 z3IJ;n%Ro+^G~qF8Kt-VeyALG7=fh=aJKWkq_w?tl-`N;Nt&ox4Xz!s2>h7ax)q*c( z@zTj7xL0eDe4TJuxW1)CQA>w-Ju$MyYDg_f;OrTWfVo?6{?t|6(~vWO375!jdR_hS zEZc0M-)!)91U384EbBy!+l3mOO}dO35u4E3LyeXqE~pniF^aOjx0+GZ3dBlXTak2K zm*KN}@OPb;2GV(m^#9sQLVR2#p}Pf)f=sJ;nr&*$lUw=`2Kz0-;xz|w{bCv&_R8hq zpKQkY?R^OL>CFbiunY#=*Rr^NAr%W&?ZKe8BWX&LxN77WDk~X~OL1DVU1H^9fk?`G)Q+WAVdCA>V=F-M9bgC<(JnO`$YlzRxHGIe|4Is8^G8ysb>KP8t zsf)4otD`XGXzAe}x81P3KtLA!8XHZkM8aj;>5cFJSs4xWO?y9*$EBe=ebOXChpc8A0xq+3fMR@6C>`I;hCc6(20z@Xtl zf9G#IFMp_zCXkNavwFLTWoukS(mZETSS{rhJ;9-;V_S&JLb}m>=3v&G%{Uo%5#{+h zJ6@5scA!I9z6J?#mk}7T5uHYG=PGk!A-UbgUR}xG6NT3ZMXIc}BH7B$p32PQWGaF!{YbmgI109lh&1A;G4RbrnE%Nxq+ZITO)2C6 zY~t=*yO@f3D|XUR;`Yt`+@rjH{0kRvsOnr9xw(}{vAw;A!n51B8UM@QdR`h!ULt27 zwD%146Ef0s0+Eswo5;zAPmB+-8n2Sh(0p~m9BkS412V4XVZ)XmFlf?zxDfZo!b+v% zT`chgp=fZ;=;SrULszjhvE%UBqsf#E-p}WysmM!Ryk>V4ii1D?heVm>B$hvM2#Bga zbxKByI57&idWB=agpbfxLI`V?%54KbpQJRY8&ua)qIw`?>fHXigbZQzObE7a4&xP0x!)< z`g%|OTL;hC9 literal 0 HcmV?d00001 diff --git a/pkgdown/favicon/web-app-manifest-512x512.png b/pkgdown/favicon/web-app-manifest-512x512.png new file mode 100644 index 0000000000000000000000000000000000000000..97cfa752d274b7dcf21696e0e35426d692beceb5 GIT binary patch literal 114525 zcmdR#WmlU`w1xu&FYfM8io3fzg%;Q1R@~jCxVyW%I}|8T+=~S$PH_)#!h6>F5ofJr zB_EO}PiFS)x%a)ViBwgVK|vx!0ssIga2+ciOa(*QuVQ3}BE-9@6n^ zO^ap#F#6YC?%V3$K9+WX7&`F(-(xCv?B!XsXZ9A@G0_+(>~C zL_U^>-?iZ^w`nGf8brGYx9p(8(Q$KBU529W@ z%|1tJtMxs6Fjm#;be7cXG%?ldY-je?#@b z+tlqr%zt+K50yYID+_ zL+3$-ig8Dwf&OYQT7NcfYu;(z#Xg!_wc6nNi!a8B1B{Gw86_<`O{a@aR~RS^ zJagFo{V`i)d)s&m=tp^VjY!WA%?^R)S< z{8_IqfjJvj6taBdw@BM(z8hY&;d>AK-EjIL@r`}Bs)+q(_XVdIY71f$3ht#Z3EkO@ z)0`LzLmsv3YyX$GRbW7D*dZ1mA4HvqXt~(v^CQglwcL!jg@3AJ$C#XeB;t7WNLX}7C2JOFJHN;xleH8h&m1UW>g9#^REBWc1Rp+sT|Hnnb z66NWf!(1S_hH$CzUs@6c>!+Iwkt%?yI0irmlNbZanl>OschM5@+h1uE2GXTQpOjpt z*SRsA9_$gEO&mL>USZ*$ddbOL& zR0=2ofTVMNP@<>~!Cv{#sIFJ{U^10g=Et^S0MvG|{jV*mAhBPBAKy?i?Y4`}nHWfy z*#;?KCeBgKi5bK*b}Xn?3KMzVY~7}lgK}**4;i%FZbUA!{u>vlm9x9P5`i3lm1YI8 zjjNFI;>kf9ta;=!ef5#(xCZQQ^l_ZpIgVI<5-Q?Z_8t0f>n29S8e2@S(N?~<@k?y- zAHzlXR-{-f9l4>lr=fue0j-+=DNA57j*e^fN})*z7M%1290z!Wb>z_tTiwT=Slz`2 zT62t6Cp*#+CZ|)f^>AzN4X+ILJxcoc@nY{hUX7WUmv1KV>g2~jFfM=nRnu;Q4hU4mffVSY1E&1Em_FtDeH~oXpJ1aZ7iE4jsB9$68nDymp z38!xHNZ&VgKl?*Lf0nEh!ya3c+YRTa#6+i@{d7)0Tgggi>GGeK$_Sb_uB^H~{YIax zm)OAcB^}e6qjd0{P5L^yaAnd0P}?^9RN?%WFYbYKN*GyMw2ki3#bPvH_@{+oW6Gd#!*@aQdwC6W(3~D z=kZzs)xWW_%`ldVpWbBBwZY27KCT`|82uZ)pZX{t&k=8d^eCc;rFO&T(Wqn4xf(2h zZ!Be@``mo91EAVVH!r}d}#9=asQ-y#E^_+}@A&Yfvvg9h1{cEQrqmqgLoH_8#(nYd;+GNYyP z`@>)8Ytw$0kgz zBA(qENl##pIYPx<0zu~ZMR|s;+bf^pBnXGiiCcnV>mh&5#E3GFxs6Nc0`6h<@%%o8@G(KX4XuZ?sqxa=$_Ln$*u!T*FFG5yaa*S$iw}g z5T?yu!c(Pg$J`qA=ZSe_bdb-H8?bx7??o*i@>#UR;`A=Es}-dtWTkNWTTpq+hX+{@0ktQ zuT8iQ18wU&>X!XR6>%k;7dku=z)W~+Ob*@5Swc;NuYQPbNOe@Py!}AR!)+73-f5M8 zrO6D9ctu^N$Z3~Z>kg#jar{W5%KylRuLef{K+KKUY4KGwq$b21#?UFu2hKiX00KlweX**jgha|moSnENRMPxJ@}FaCU}-d=PX z{LI9VU0iXY%zZm6p_bEk@BaLZ>P66;jX7>ysR$k4EYk640~z@&ee@&^xMkEVXo*Le zf}LK??FziKL3pz2Kqi~Ep!<^z2UB|#;<}1p6E1@XKNY5h?_2O$OSa)O3cVqG)4qTb z^@9QQQN?!iF@5y3PZISRrZB+6!SR_;XR-KISV9gAIKe|J2}(~QOWZvkq$|V#7SAImf2<Dy zW4tWy{)Lx51v@mGi+H#%4L-574xRiE4zoh*gL6+7M5-vF70UxVq9+(Yhb3bou&0UQ zH4$~DN1{`_*}=aEz9b=@jbh$fAM)~%LyzFX^pQd|g?(Zyp;iNX2v%x%Motq|wK5$& zGPUWYQ0*iW>QO30Fdg~@BG>C)G*(j$z#5h<* zVQ%b-Ky}K^KG+5a(M=Y^>NiU&>IZKz082xAG~!1a-EE2EYg)t))sjT_PkS-J3$yA4 z`QK32pI5Rj#!vG4E%I!G#$!?(95ivjTKX__HZ}zvv63X5o;@>rb^)}MfbQplhE~#8 zjm5!%@t%5{q2-I!@mton#klQW?YaRwv$){f{fhWx9@1zHr)T$pztzY=hX;i|e#OMI zQ%o0lh=2yE=?En+X~AlXP%k06?+aN!X$Ej#FJ-GFqMG=e$AXG&uJpawH6maBo8R-0 zgTnVBSG((AYdQMn(A&^3bAhT#kb}8KGNSpHvjpRgJQdyPBFEt8zvSwpmtzA{k@<8y z=9JLN3Mp;ZOXu6;2U#^}2pZ7AtFQx0YKN&@s84^+gNUL?0}|y_hSn|chNAwS7>}0f zU+AacDSHrs+x)gbh6kZZn{bvl|H6}8p9?B#b6+3n?U|ZAY(T}!$Xn+%f#WCw#*cF> z#&`4Q0i2gsV?@sYYRF~VPaTaE>0xt1Z%ACgJ_7C^1kd_Kl)w+tBy#qFKtg5VT2Qfs zm-0IL2p^tw28nv-+JiBo)gadfhkk3`3$a`7l#zR`-@`$rvi)aK;SSo!<2 zB#?7?Q9_-B?;&NVZ`K>2?DYa2fB?i)a&>K%+3phJQtff&sebd}U^D>J3qCFU+0F$s z>KTH`Z(6os8wg75@|yfhF5W%?lGUJdShx4gQ8b?4a^;tX)Nz^Q(=rDD`;|4=&RfheuOG2kz_9)>Ww^I_A`+e8Sg?bG&e)MydzSA97-jmrg0X+-&b^A z%9RVwJ7OdgWXsMzO>b`J0^mrtSi<9I|52DZ!|VI$+h^1_a_dux55C#xDU@Pr8i>W4 zK4|M|{6wWwJ~#%xw^R?Nt7)noAe)swXBM#5SLB$M-Y4OXmt|LU07@l-WkAxV*X`~Y zsIEIN8HVuJ^U-MhCg92u#i9GV2ysPicvz0N@#vG?#bvl*ze1f4Ac@omR=SG}=A^u0 zMyToorJCunh^VlIR5wr=rkMq!c}x88S*s7Gut0yz1-UR4gNO@Koef2D5h}0c9~8F@ zO%6^TVsFkeDak5Ky3){Y9nO{tSiF!Zh5T2h?(N7}PxzkVbXLhI9;R}Z3%2N%o<=vw z#f8uD_cd#dcE(!bcSwy!)b!T+QYl?NFa7&e>k(KmIoc+I{fFnd#roqTCO z$ZvTIF{5o0W@kfXXm`3BnauYB_KW>0?ACcj7_F18<_Y+fuumjeBDeUFXaN$9{-rlS zNIXnHQ*$^V5ca??UIkEMD<>+7zCc-4ZlTc~AA|k~E!KPQDr-G$9$Y*m*+cms=#6!o zebN*1=x)^QKZa&HxaL)*!(AKx++Q#a>qm^(SW=IDQ;Nx&sb|Fb3w=^{0X;GmmKUSb zf!)PepGjZKy(lc@Bv{*6KYf)?WaKywaANq;p8^ZkhNekY1iYkodhu%L!*Bho4eQBr z8(jNJv>hYGunnTy1b}MG$lHwgZ<@Tx=QPBH5XYLK&q5Iny?ONk53kYbFprG@KL%5? zlLAP*?pT`deL+95o~^%%hUdvTclUl{D?s2F`a3Lp1ImhDX|$`LUf#2?@Q1YFnr- zk5tar)-?h~lCjYf81p#@KM;hPCXBYx(V|nyf+NwG12hfa(xUm& zY$^y#5-T!CO>PWaF*S;c!(ScTC`fG}lPZq(6lAV(u>BTmd6e|ioh1G1X6OUgcJsT6 zn}h2h+27Q;BKzU1XIZDG`Br-bt{?ki>{Bk~!JM9yNZ~2bgg&YSZ@Ax zKGw@`NevyabS;<7043@LcMOuW6C&Q!g+Vbq4`s4x?Y}B9?B`%%gqprd+opZ|%o>vp zE!VM2G0dnw4c%ClUxaX>0sxvL@nb=aGXn|Fz%UO$B@YJ;W@^k9uVkv_LCz_ zC(LTG$)_sUm6WG3_Jtzb#JBh-8w+=dhY!RIUN?9&@xE!nBRETRp|`piwt{*$Qt(Zy zS#G&iRNutJ?}fEP=@Bbp1qy!;HnS=l7;W#dxMthrg}IWTLL9`#_Hg|9j}))ppk{EP z!i3?J!`g4y+pRBh;(7L=95x@RCp~O2x*Hs5d>XD8*7oktYJF$4bYYZ^qkGkMMf`z) zU(oTrfmp|upoTRs-ew!JFLqCa!iEjF2D7!oeeAwmOlSPzjcB zAt8x#=chLAodDG*Xy`tc8}Io_lfN1y8}%RG$`6X+sOW4FLBt9}lO}l)jq9J+m|Rb9 zeH)RV4J;0*PNj1F8N~myLgwA?ldxF@*6g~!YgwtC>j{g{*I0^I|GZSgpYS&`-Seuc zDE>T@+6?DdQd1049O4t3;1eC?TO8U?o9l{=`qI4M4YG7);{5V2c#*6wJneub^zyzJ;0Zf#)F0nP&Y!|dkQls$BBqB3 zbS$}94$Q(3U@Cjaq(34B<{@09;H>8xD~JuH28J>5m6#Qq3+)Qpnj*W0Il?NKs3VzE zn??8ZoErriL#kvHVuQ_4FZll!@mL;Oqtq0$kVl18Iq{}HdR}%q%_e#pbFx(Fg|j#l zIDEkT0GEW}beUuBv(T>fY!mZeTDgcDd5L> zDAQ`S9CTG!z!^&ZE21PI`6E?mb=TL4@v`RX^>UL?`BL+G|M~tjz6w`lKFa%>D|?oCnbe41Iztljn1d zgK>n)mZ&?!8gp9a+tjR$l=v0iWS1oeM}tIv11^_qU^K6v>`QwWT(;Y@5?g7N{Yl7rG<$mu|R-9tS2Sl+!gm#B;`1?0^0~6zdvyKt1cd

    7H|9(4Zoi0GnKJRugnV{;{3@5WcDETATnA^i0|OK?RK?jQ+{ ziuf_p{Py_3ut+|3^q!4;6Yc9?8TmJ$)yS6*DaqtP1qDhBr~D$0aa)nHSf~vhba2Ez|EDHjl>Up7QhJIvA{+&?PZD*xceslTD zb5=zp9ZFa>n=r>q!iJv=9PiZ&ebu+lSpeN6g}ZOTZ@!ZC%@4Ski)Z1PcF)@r)2#!} zEWW^6x#@v?HZ<|+^-FX!1}F*LCR3wpQzP@Ai{FFEaiApYA5T;NXfs!F4_P0|(Fd+^ zUH|4Eag-dzIp@$JK9^Z}2=6pUD2hNE26SP|8_Kj>K_uKBIBb1sEYo13z9P(^!%UO5 zB-M0uRg!*uKbypy$&Y76r+v|q`RbT&lud|%^9X;At(J3--d-U6u6)*tBhMaJ9|z#l zs&A)Eh2n>(jpMKplVto+1X;dR5WXqTk0_PVK&tK5vyC3NH^!P{YjyN=YUa{EtoH4i z8O9;(;tvKx-|K&#O6hBN2hU^9Gsm{uZ+F zkIER^Sz{qh4|$ocM^CSLv~HZ^MP1OUqL1?ZDcUJwd~&jgm8ywZgc1X++k<5L&s$c( zn+Hmdx1MR^QBA|4gimw$Wt_(^H)4-iyB;JX4}K@Xea;jPcaGwH5vyCcOf9z#m8rIj z)SGbdAj=INhw>+Zm2Nk@?)#~Oi~gay0i{7je2-n~2-%wa4D4_8)de&JTgm`D7YhGP zZsCt`wgxwd0USJbPq4Xl2mK|S$m~u<2^hzN_y=p2QV2;0X|Bo{j+Nls(nRpZq-{*6CzqLER)ZGe||>7(N5E0 z$-1Rtaov~b8OP8tGOZ{`=*3OG53=zIbIvbMGLRaj$_a!}cF@>8_zSd*im6^F z?;hotT6i$nQ5aJ^pdg@Xy~K`509CZ{GLCOJ`dQdeeg*Gr{>{z|z_qAy{35ouFL&mx zk1qMWgqAKu7YGrvsM>8?$TaGC!4~^HXol5m02G1yS)87m(mzYvcv=(Zl7Q@Bn3rX= zt2YeQ+(UAJj&;u$peluG6+)o-Ih19s2vDYyFyGGt#iw7lGm& z8bx$7(>ir8o=HmS-57Q_wMCj<3eTD|EC$rU6Ffu`?Xd)J^lsbl4gB%f3I&aem27lb zAP`(uh#O~zuFpNR4Qd(ZBw!HUL_Y+l7F=)Ln7fxIG`>j#nis)~Lw(2$LpaS{Td)JT zJP;FSsAcG1*nkw;yXBP5XMxduxg`H^)l`>neWJ|USVyS55FhL71W1(b4JOHaeC>wb zz9EJ3XMw>02xH_+_RJB>`T|i08Zuv84#XDsbL#JsZtERpkvxp{ zp8eWms=GDha9;g*aVL=1zjXU&yZ>L0!@4ef%<*a09Mo1m>1(*9%$uP)0LTed37xM$ z6Ss;MQz@(FcOE*j#(zxP?)jpu^{`aN`dIMDDxZnCyrGJE$qg0s3#5eif!-!0k}tjw zep^vv@U>Lz?}dA1fhlw{JDTTjbgY6z4QtxrcHJA=$MOMc?htlxSwi)7#{;&U;uO&| zO1<|E_0fPrBtk!#-@AhshaCCCP+n~HuW6h2yY2Ef!h);5`^ZQsJ! zy+!W_#NV0dMHKcz#1)jOgJ0_(Cu%MR5~o2G2e?Ba&j$HB6JGPChdBbMg=*_Y#l8T{ zL&e^fp&TVg^l%x&2YHEON=kn5@@`U}+7O)*nE=IDu%*%7v605pr|cw%owjHsbWae9o-E^V(M|jo_M8G&u`BTSjBo{l{umA!9WHq!TbmfX`i%l;Ugj@?q zFG3_FPSZA|NB165zv=KQb56T~%3`*)_d<9JIO~OodK&)fip<=B$%q~Cvw?qaiEzob?ENAO)r4G9RATuEj z8SiN4{mBme|9mXJfdUnu=lL_7&R)K6YSWBtG~7zvLX@F>bPMBsgto4=Y)(@>a7&lL zxsJKE91)+@`(F`cPuhf5U`B_aM;^)%RRez4JvA8P;tg9Qi@i~}OH8H17g!F?v%WO& zfEJfU!dQe?fzPd{Vdr;CgNVnG=N$VL!AY*KLtAtJ=pL}Y{eADX9Dvi^sefLg7Yi!? z6qnpkfnEA2)ZSflX!CbUz1LrU54!<1kL?7_0*`g9cwGk(J>Q`X^ehAAn$TbOpCyzs zl7sWsAC9mQgccS*h-OU~(Lv`c0cHI-C`J}5E%ZiFqHpwB8NQ=|9?TNVUw>)YI7(^i zUe+6Ah`&`e4dZ_kQ<@BM@Oc+LeF1{3_KX*n^I=M|ou6cg=Y$sd=;uy-gwmaDXPte5 z!*GaNs%MHV9@I_Wy#FxeZeGFYZI=Tq&u8#H0>!lqu;G-C6`cDGTF$&c+Exoi2enYFJRIH4@Jy`c9-z@Qv$N{ElBb$e(9>+-}m@U zq4!Qgy?8@qP=-|#r^n3H7fP6=hbZIUsL1dVQZOLrJG1d{1Xc81cJ`bMfc1v)<>(zhP%wcW$v{?kL9-B5J zbxj9i+M%EbxDD)c>2CM9iv*A6dJ#cnqzVbX5>=__w<%r(1;@b6YQMar!#t;lHY|XJ zE$$bI-{?7yFT+ZzmTaux1f#I~um&(*LiUADvQ#?{^Vjwkn@lPi;Xes8RN*}Fh`5V7 z_z=-Yfi|2_`}~&Tb^UO$Cy1ApP9GhqMDHgUE3N%Zuq0&X--ke@ACZQlqYLsT!Gut6)T zo83BWxErMC{|&{fJo+e0=beLjELKAN`VrvA0+r7wNtp#_gH54&5*pl9Wjq>|a{-#; zx)@8c58R#VFd`Cy?X*Y{k4Smo{%DgCxiX)0IE=Srfe28xU3BEca+SAF%tC?rTQm|l zSD>17@wI)m;p5tV`U+EAU+?nmRmxJmX_OKd04+pwA%>swDasGAU3x1gXvX7c%Mw!I~mL(;C(4Ctz2H?o``dsw%G(jFx%W z{-cW1z6GT>p6K~I(&m$@@?i5h@6TI+QR@?kY0XvdJ+G|Q0#@+wd{s*a&oDT6KVrrE zJ-f7Dc|r1cns|hE;YmiyUoi`egx=sjEGSW0iR7z*y6A0a_Q*n>4&`HlqkzEOK2)}A zg+W{JZbC&j1Gm!T4;A-YrEwxMzc96v>}t9W%vxJ~#vqT8!+`*onE(ZI=s@o&15g6}po#GC3$XWlCDx_!snWyHq@ zmbJG}_RVKY_l1B5CRo7Z6Zag>FY2-7u1zxQ>7Nam{11MHTwm;Jiesbex?72975xcL zr!r=y{{@y~;{lW4M6nuhUR_}W_#@{k&GyWhj?lJ4B;ckx=vF5E@vU%3V-!-5z4ueu zUZi8=G^F96o?#%W*I8YaHGJt&$8`yhac;t?vm`=1TFQer2x}AN?=X|J^m-kK z99=VQg_MH*NwL`Ua>(Dj3T4AwO%)?-g&b$I#%wOI-@5BNL24j9l* zD+CiK_{iP;a`$Pa*&G?-04Xu~90ksqgS_`Yw=`uwm4`2N^oqUB7VZ8veC%yTdt27= z{G(-vCR2Hm|L;Vo{_@A~i#y%C{vqcrXsaD(2MIQ9PEJ_NMh5c1eK;7Q_33{k+q#r4 zr9v1MD@^&y$usmpNrcLRmAk{f(oHv>5mK3W-(5FIvW`g?g=&Tu7$joP1t5Hri6XP;C5DolwIT zC3{Qw1th=UrZ3-|0=vd?Rv;$RX*!c(I)j=#V1!8#f|2j8%vT(f`C$st8Prg=S@7HB z&$4~^6Nxv-;VX#}4Nofx=PRM>_BuaX^<~zQOKUwmY=0dSU~T#BYf}jXf%`fR^##D$ zkI3?C(*t6K5x#f5Yz^B;QoFkdNi(|eN20xv7>oXe7H1=6qL7yWP+YN3eW;4XV%&b0 z9gmdUO<_uvhJJXw0s@@lmpj<;LCyLTmsmw-)Re(D*O{;)On4S?6x#MO~=LUcnW1f2!- z0xgQz_or~nHWCSNB~-ap$4mp!f(8%YRUkH4J(dQOF52{OT_pDn5i;oxQuvcY?|k>y z9P|tw`4^bvV0{c&VGOx(*#T3v5N0AZLU|k&K;8g0Jy!))7?e#}iV&vDT5$>-1Iaww z4ipu`cci}|?v&M#_8w*8G<7Ie3CTyiyO?HY5ZHO2x=%Dw&cvC^aGRJ?ql%(0}bkv$%4c8;dt(;|+LIEfcQ5cPeoqqzn@esh@a z-pTEm8!2^FVIcm)RpKGt{PR%*|6twJG~~rgnz}7teL?ZBqKRhC!%ZIPUSJiY(`Quw zz*w(@eMa`Xlz1W3CzK4}V<<gRI+_|~3wB|clox4YbZcTb? zD)`TJ9=+e@{lHcpC~u@ZeBaAVFUgju`cE%>uU-ojZf^r-sZcAzh@uCa(}*z8_Y8}I zqKbHMk`g%o0tocOwAPL!1y`PNZjd;HVJ@s1EbragV`jQmKjh?M-4inIj1F*vGG?&- z^jtb^;}p{1ZYD8J;LKCpjkQl9$n~CJ81XA?F5eq5u56D7A3ewU|l)z~}F3@LCFx-9ewkjhMI@ zyT;F}@fBw4tRiUbtjl=gnCW6^XOZ;`BCJ~*JB&!UaCYWR5!&Jv10)=AieE8G(1%ll z!{~*A0T0?@hHpC3wo48>h$wV^MQjS*F6Ku`Mn5hTla&~i# zlv6BQeqAm{{h+`4iSQjJ-ur2&5!0#R(q+iIRJKzVgB?3@66u8-(n-7C@61wGvAS0h z^3C3zr0*h(Of^60gGJY4l@OF&j3zYxB&K9pnz-7gM}2fI(okpytMS^8i_;$pMvrq` z^%fj#*A-#XE!x#3XWRCMGN|2bZcArx>S5dmPo-dsnEB{nWe&`z$a8g>Dr48ofJ}t5 zN(lHPuswv<8&H;O2)+By7b@(Uqu*&>@-RaeY1ZodjN`CmC9sp#tP*gM0`R*7p?N8n z79=BBo+~(`(~&JZB`)_z8iqRT6v|eyGI2|F7TIK`C#IjsD>iq<^hkHUN)6w2yspYX z91*{Vq#BDy6CtnbdPF&2xQ^=`j-OW%*st0}QhH{r$Xz$l4zi;Wqc_p(#TI&HH?;0m zxsFxPqOW8?QC-56C99Zh1ds;76Ut?Oegm55qtNt_^Yz$3AEBH58q~AP&nffx6zG*_`mn5;M{YXtAa*aNT*rZ-0#JBQAU|>X2 z0G&t5AIQ+{DZs!*6XIDrZ@jUrb4QSmoukT0twH{`86g{UdtMJEn^n937sZ6HjBO{c z(BOC{$cG>EbT~8yBN+yxiU;^i zt9YRGJDx-Ff08x8`n{>c`?n^nv{UDyp%c!!Rb#Mony0_2jw#gJq6cX5i8S;^w^VeC zh*s2A2Qfrf&srpapXs8>aMS{`-8z^-VzN??&NccbCl`ky#vD|Hjx55%nBp#FJ{J6~ zN$;1?wZafK&p^-*$5nI)$-}p|#5Q=;VQUH6yXch|PcIgHygTGPdR48uXq}z(H#73A z%f*SaB+x8Mb;LS<)u35CCrYvIOE{+^Dw(1Lh)=TLj1j=EU;J{AIl^*yqe3g{OMbmj2Hr0c?QbB>ZMS>I?J(s4(hM4-VgXp7>&C^ZQiz{C;A2tP-hrfJ z)k6J0b+PQONH2I+2yHWT&RRbe7ma(cUe5XXFqNiEKSy_t>8F94XW>TdJBtX0^ANWb%NPS!S)%ar$Sa8yJUtg=? zMq#DlyTE&+e$={qW}%);d5NJ-U<;anAIWX)8-XE=kti8p>FVu^{xG%Nuc4i020b$kD!Dar3tT zYbVK6MxXY6O%G*Tr1dwJ*ceZw{Q>n)ed2A@T>T(p-Pzn)CEZ1E*-FEHhGGWU>|21M zUCY6B*x1`Qht9av-|`zu;UH{F5QJwknorXO4WadgjOJ;7xEi(~w?BoM;jkx`Ea?=J z$p$I~LW|zQ=2wM>azp`s{!+u4EUt(@t<0~gOmSV*VQ1=(s4+EForoB9jee*JOu577 zyS!GNdQ>a!u>AIJfe0Uk`mXv|q>oByptAI*3_-$$l9?LC?-y*YKkZsceu&uL%gfcP z{#xzYSx16e`ULtp8{_Qy*|E!8hEf-oJ*^*lA55th&dY zGbW$AU(%hXmU9wygCFlr;=Lw(X9U~@hf7k#%QH^1Re=H1`Qw`Zj?*zN5Y3$q8CKcz zdRjV>gLQPC^$}fNLNu%wICgm8G*)m2`M2Vlv4z$bbq*C}87AeYKK@(f*dSP9YTFZu zv}B4VADbTNH5%B;ZrXhAI@-SkX`&LjyXuvCn`&ip((p=U+q3>K#GJK%|2l z$tiSWX?x9nD!VeW$$R=Tmlx&A(jk{19LU-P++ZIM=sGfJ|8)yg%xyt8@bsmr)@dNU z`@V(<@BXi7>U&H})Z{s69~s^&_))!KpOC*-%@WgVesJb z7cTwnNj_b0_bWclB=q$~IcWNW%Mw}<@vHp#2b|HG zN^e>#Ou<46pgpU4H+?oi6Ln_SE~qy353!t;$@~)<^AUePGpuL8ccS4$2>g@7bB}Ri zu=MYdr-9F9LUet?Zo@%KMSo znVH5d_=xuebjFk{X{TVTg03avM!XuG0(j0{UyP~$F#eUecySv>Qs3u9)&oik_eAy_ zbGIIwUlr^l%!y9QIe|gmZNr5=8-<(ZWImigM~9l3OQoTFhD8-M84}|)@JEPU^p^>CH2*5sc|t5W!{bVQpWs z907{PMwAwA*gW``Cucf+C9=s#b?i2hL2M(o=eM~>y&l?L)u2QVN|lC@ z^MTE_h_0F^;`(5Z<5RpGO0lg0Eb{xiBM94uO6qOR20>Q|^yd|%n`D{pv|1V~d1k0c zVF5_tkdDEF0zm%bxn`;;SK?9N6O2RmD}cDBqAaHDtFGI?2utgruDw4Tn#e8lg}VrR zMw?Rb9^}&OQqWZNu?~ zb~fOqE*0--X2D;zNQNVygL#iE(W!DNj}-lxu0EiBvbM&=x4;50e}cB84M-ZW z#G&}4AG8@f-tRRp*{>ve`BzRo1P0Y^jH+AO$v3%|=7efKR%pIz2_2!St^|o(LVP2>8(p7?9OXYxuDuZ9TDvh6?>Wmi~ zTUhNkG1EC;VB58`pg7xGZHH*kDYLmG9PW^SZKbE7U65K2ox%yWJr7f0W_ z@89i+DECu4I5%-W_WIl9b<^EDyv8+p7X8~rh%}YbAAM5J`=bmfx z+hPAg(o7=4L!0}qjm7#ih|@Iihv6O45q11Y74JMM6tB1rY#JZ1G#1tT_d0VQ`xcQjq4g(0BX29Tie_rJvgFQozc- z$j7nrsmHFqo%@7OGbT61e}+S?C=f#j<%7zQ{rbFyGZ?YXZ?1SR>+yb?-v+;gVXZ$B z-3kjdK42EF?!dx(o(V(r{XgGOg2uU2lnaOob5qF zd)@j3vwe=in*>0xMExQJ6OlxY*l1Z9`SAJ6@?cxabH4et^21fq?Zti;!}h=`C+`+ES4{8S+RV{)o1 zmleTLc`63#A)lYX5gI}Zt}u}q1B4jnGnYLVESP?0O>)r=$pXmzDaQo;y&#G8MVgnT zYsvuE@%OEn=G`Py1D&}nP6GYT4+>nroGHd7xP~h^l-7`hD0b4DLD#24KGS$$OJotZ*x=-q{X1;tMHSO$4RoH}>5!JVOIs&#_sMJB~R(du?v#EFrvZ&|Wg zRI3aswU=Z7oF+74!JyQ?ZiMaYVlYG0; z6I8JKV=>T2@X?MA+}W^xLx7_<)YAE-&$Sv~j=wFbMD(hvh3sW=5z2JhG61WfGr0cc zLSpzfy>D_V{M5ONpu-vseH)7Dj|AEs8YygR=L8AGG^uPR;UyQ;GZg;@85$|>>KoB4 z<#Lf#L<;}pRrjQ!;SU~x9;Et9mq>#MyDRSZmJ-ch{z_#G$rCq*V$7(A&v=pGlx$DD zXcKn1Q~`FC!4vY|fg9z<7J~w~&r`M6Z>zAAteUuGZ8|h)X@xHV29f2XA*)VdwX&TT z5*LZWG4EgtWB8vIS~sd+8<%W1!&+ZG7~$R-APXD67A04MGEMEO>caMnS>`WRVF|#R zu+&9$=nHWG(RoD%a*F}A#Ko(7w4ArtPbodTe}9_5QwZ818X)!qdepN;BxFYHrxwAE zJy(Q+ok#7O%nz|q_&e#wpY*egf}bp~C9fMyArO5*kKX69i<52p zO%f)2kCi-t#L27kk&vxm$rd;A2pGhjBmP44ADAor;Un~KwG9&GyegDp!I)PWr=fx( z;C;mryj>(drpSQTy>R1UwIs!cd9A^j6MEh@KazjTk6hKyK0;lu&+Zx5V-Bt_Z7blc z-0~nb$qnFk{r z3=GT?j0uWf!k-)uL^xa%eVGPRq)De)_sP^}aX5v>VhV1C^`L`4Ms{4zH9}wWI3J}- z+DL^Pk!ta{(Q8=(;pEGEfGIGCBy8M+bMLeP4enA@#F1p?mL&w(>-SDXbr1S~*wqFe zZF&?sdch(^)ZaNu*!LY+!d=mpL#ZQ6i9sb`&@qH zEq6b548Ftb?LDtLE_oDvNM0*P<4jp0&%5UFyc_i9)oqV-PSCXz!rX-7$=f9e$XS3hVl?fNH@?w?ph-^s8rv^|?3WX&0QH!5^*CxxST!r6G|PR56KfT1QlBujW)-}je}aBAL1Bz0=FLXK2&MQgDoK@ou$P$Wr)UQ zyYo}XD2JhiU=v{1j_6!vR*GG>s?*KhfBYAG7ex;uom_vqvk=zYPu%#eSw9{#ReX;I zf|@*Z29X1Nj^1aaWcmU_Qa}Pwsak_Ckkp7{kECpERbba6m<7;*l&Shr*yGOQ_+n4M zXwm{>oY9L_HlBmpnkEckS4`8d^@R$}NlOy=)uZ+m*=qix7Ys-HXyVSqML67iVv7{fp4eZ{Pdo&V+wpgQF|>Tn&sm zf8Pf;Ltw#X$Ij1^a;-nEW9Kk9VhPz=2HMg87O8~t9SRdksQc7Xm$sNd@Z(!D>+(JR zf((7#e&K)kiIyx$UbD5DxTlJN9OX6(^bhI&xz`%3oe(fRXjou9Jm%>Ocp$_z zWW|0yNEg##XELR>3%I^fV2pS}4n1o{hGE1f@8q?8d=*R`&%d}t9mlZM1%-|or1*%B zj%`6VUYEhe-D;;Qb+kH^`CEu99|z|>m72Xt`!Fjs`7!r{-6T&;+IRA(#`bvHX0k2m zcZy@*8ZG8>C&y9;^w9s-yF|H5ohDQlD^DRrc~N@FboXH^sDA9!&AGulb-(2G5(#w+TdrWI>Q$p}w5;isc zL%E@w_3oZ?2K~7L53~!aH>ff}l^YUba;FRizg|~>S&r>c2HPN@{^Ed)Tq^hx2`}Rt z=8p8SSq85Mh|&K=L$}wO;NO-8q)2jnzZla>W!5cxJ3XAQf z?cPtonT}R|k8DLi(k!kXt>mud_SDyOPDFYUOp!(3!oWje-CkczM#CluYN1Drcr+3S z>qp7xDaHubYyu?fOzY!Uh~S5huGTM~lO9qS#cWzOLsFo7s)M&cnxnBIM|eHl%j0!O zjR=j!>QXlUIm)Kv0%?J)VQfPeG? zH{>uUFGHn%)*%L7Ds<^sPi~Y(xr?c{A`JP`u$lXqwvVDQOt#t1(XLWXv+9fEk^@Xq zJ4jL|*q>{G&YN3cY4B&pPY~&R*3TyvMO}y(It8CjAsN>a%=F&cIGyPn7FZZxJyg_& zb1u39CLyOJH7rY@H|gAZ#|u7rH3 zMBTDc%DAhpgB8)lA;9kATI1_XqG&KPm1_BA<>B_}h|gSccV)D=MsfFsluH6^v@t;^ zBA2z}`x^>z*CVrW$c--w3ZWB^xb5LR*VMe#(Rl9%LH65);u>jV#=H zsjH8hS>S;<6O^bp%$7tr9q}cQL<$lDRHIPY1@>#u6&|aYWHgnEUs{fRs|139yvhin)Rpr4MTEs{=sTO9DWLLrku8fdu z95$lxA>+$q3B0k6Tx2UVI{M}>f$k?X*zX+^(ah%LPhi$)p|W!Q(8QF( zIv%_$oRLAt$=@_IV170A^SG1KRS!87RaDLvsMkhz6d>s>HKOPHz^I*?UvjxX`UYUf z|PrstnCKSUCU5s@E;O-xkBGnoEb?-n?C(5Zu{H$k70D z_~0e$Pa4J%${Ff$1EK_?7Y(=Pd2Gv#@gm>kd^ySr?GxpfbGi8~5{L!~vE^5aa3l46R^~Ax>*^pC`rIo>;;dJn;j|aR7oxxl) z8Ais&FK-3Dn3(=WWIg3D4D!f)n)}Ga?YbxV=Th9!k&rLa=j*fVy#b5R>UE7_ndKfa z+hVx$hud%`JIF0!dgYTLdw(3t&fG$mFXR^_DdCgnz|+Ck=ZN4TI3S}Pwjf)E)DafO ze5_S11G5L-;4|^?%J|yY6#bA!d-91?U=6j#xNRZEY@K4%(=oC4>O?P z&B8v@qoo(<2q<4QStma-0o^q-QOc;Ws`wSqL0Jx;H^0y0sQ)oG@02^5OU2$Lsl(Ja zbf-#Ynlgi6z5GAqZ?FF{)ua;x`xn0tN^Wkz!uOu;QW$Q`XrxZ(F?2YOpr>X2jF^g- z&C4JBctS)Wxvk94+bx~wTxh+<9fx1y`{-cnewOgNr4RiD9~>RsmWVJ~k;#C@>B6w+ zk~q3kf@CP{%B`xUrN zhOd}kqV57iJ@F_+2^v0NgF(x{w4&2`04ZgUz!ZJ zrxj|(ehG{36^j|s9;y&T;!JvTZ*R}nxzxVm#MISjxEdYrLvTpbsD*fZ8<=nf#HKat zECRSrV;8RBNBeZaYdSZyQuR^}DBG8XitF9(Br5Wy6{)`}2}QK#%ab%}WESMHtJ3T> z9eC2IC0-+?6k!(Ln7Y5Qj~IrjToK!TK1vdEE1bMq63XXSLP^7@vy|6N9do^L$H7Qu zuWagz*88#Zyx{M7xvk+h&`Vo`rcazPkC1t?3f&xP=6RMR*2&gv5~1q%Ez^06toILm zC^}DctbWUm`YL%ZZoQ<7l5Xgsb#-uZ;y*r{o?E2Xe)lBX$ibubw~cbfv!VOAXBrLC zv1;w+Wi_=AVNUv!i|$_d(<6TAeM>${OHGxnq@-Ho{xyD|XyxWTghr(m@dP%7%ikGP zzH6+b){lL5QGxTI;K{L|(;|rdTbA(3`v6&k{MzQa6dhJZ7@59+U3P!$CiFrE6w|dl ztQ^_y@P7m=s{7vylH*UP2ESAY_G%ZU-jeX3(aq$^;{vvBhkd%Iy)Yywfc_lv%&amy zr8bk!PJ|>#&lz5eG9$|!e(f_2h3Av7KlY;#jDI862CPg$F^?L;!KoMG5kHI%j5Z5x zNea$l?t7&KteloQChRdpe~TqCyuxiGn}V*zz+WM53)t@&Zeh$`m;1w??{OGkW_f%% zo(fD+U&PS=c1ue)m6jn(vps{x?V-tndfPn`HhNG#d*G5~&3Y6ZMNJYHA)c*}*T?v| zmevb=p_T0A#M&c$;xJ3Grd<|`cv)#`i^7vS4d0Z53Q>GR9R5^|R<#_J)OApRhJ@P* zY)QRFdx=o(Nj@v3?*F<}RaAyQ&^%At^lT!CDm2d&Bhc`m`FQp(nbZ%&wE8cGyb2Yh zp*o`gS(wD^)u^OIkY9)0qdgS9eZHn&bP)-)+gaP@{!CU%T>%N?El#{&=Nh`D$6YGcw!dP67!qopa(kL;$9wC3g%9obZ%g$@G_Pnz5k*?QK5yFeoE= z1G5)zTS6)w=*btHu`wj^$;TQ==B7|A%Mqt{VL0>z z3tRU#+UFw9^qc^HRgXW8dUk@1W%C<*{WTO*eKV3s|0%+6*?{6<+9ZBMB9P4*`okF@ z<>PUGrWp=#(j$NUle_;cG2PDr#Xb1fd_Ttv&Y&I@7L(oeP#VSZNnP_dNujn{Nb9^L zJ9}G{Hm+aI(&{MCXJR^M1OC_~=)g&z;hMHCgHDltS+HO^)I+V+p6EDUICH|t*vi(R zuPqe6U#ux-a6Dld)gVD40nRG|U^_2#snCtCrGd_eB*bA66D#2MR4F6~xulP}tK>>V zygzi0$VTx(&*7e-7qns*;P_Dygt4L!)$cDOWAf4e-MFjoJnt1bw|&6kjJN+GVTCM~ z``@LGlWw6)k7?Aac=Ha|&gJQgGxCee))lK7DjD4)WGs;W zyBlDZCAf2b=i;{AsPZ!!^mo27+o0YY-S);0!Wj|%>QF#p!b@~y~h*v*C?~u-o54Jr?cUVVB~pYbH3Cg*dz#ZBZ7Jqn5=Z-x~-*KY}qHJ z7Cij=a1nxfNv@I9z~F)cigfQh_CVM5)Qql5g+T3LJ#TOIX_KS zT_t-}&4qJ(v3s`=fReti$(K~vV0GCS2`l7gLR=9&;Oj*z75Uq~)&BZqse53ZrKLte z?z=%dg3G~g{vY}CqW}Qj2xr^4FBG6)oHOz)B1!~Z<%C^ozrHDVzA7qrL6$U%Lu+E? zyspG%gRiCywj9ft=|!C?wBx*X(t(72-*SzfaC$zRy|fb6+8HJ@4bAacHH3}fs1jX4RjJBEE<2AcE`FCv!h3Ap zxuY&WtAE23<)Jh6^#t}=6@r)%wCWcAI7@?tLUA}~b0V(@zY#xtiekFeZ)us=6F=bB zK8+PampP4(aZWQ|H_thZ=fZtx;_d4cKydAXod0g^=fdLsw%@w-?9KWu_S#l@8_3`z)sWuQWAIZ~OIPBP~4vP&c?n~n%Dzh6dFc8YE$PV}yX5P6nh zMzxmxC^xl!2zd=z>=9dBED_#btN1W)%rqCXe)|;{e{z>wUsb%9gvMf!Ur^voEGEET z|Aj|!MNrP5rQjN|W&5tzmW+gcN~-E+tsT+quX5{nQmih8IpJy+@o41(+QKgL-dQhY(;FGIEq!sKfT4@kXb zCxB<6B@9rZl+13G+wEOlpVPv_?*LPV4;lRKN1r7-$QfAkepnN%O#Bp;NRV+{0_Vh zzN%mqiNR@lK$4#7-#Ox7Mxd~+fo5^1S#;qGr;wT4xli*;`ir&OE*VRIP0H{qiC9ab zR9L7V4IjY&n=CQ~Cpt*%fDd4KX|IH+ zWWSh)YW_U99l263I?IWx?yKOkc~CtkCP+?+6&@YYg;wS%%MH%;GDE25L)g-aD8}U< z4^70cSbDM%F_jjB23kiLjT7JnD%RsMleY2*GB#%@F3TtLLJBv!AY>kH|8}+~qItRF z_J4d@;2%4JWj(cE>8%+0xXf-p2_lpp_h=%-;qHj@zAU;Y9a3Ke5Q2 z|IXl^M85hT3&8Za63tX}t>?r?SuO=$Fw?~;7d3T%%e@-CR#%>Pg^TzBR&(e=CI&bY zG&Pjkq~wc#FJ4$>;g0>k6X0cq13`Q|9tF&3#p-1x%CFCp37@U+Ajl$V02m+(0w`U4 z`a@S7M|mtR_xoy*&$)S#vqCGaSlTENUkTdj0J~x#wOCteQzhht9iCo6UX6)aqDE7` zw^u&_KLMZX!2V?FLJ>V_A`^TndROFUb+ZsHpaJ*;)X3fL^J51U$-fH5S^C4)+If9n z1+|^y2UC-jj(D8^E8L5S}FoCFHcXu~Wsg;18N``4p=es=R&f465m(jBZd|Z0s{w zS9{a9IS=%EV zU+1vLQIS+y;)h%y%5dzUIPhAs^nFl<=E8J2J_mMj{~&{OH9R^E_NRvlJ-f28*k%o( zAR~RTuixFUzp(aZM=8%w5q?H_ZV~xoRVfCd6Z+z)3f83~K?N;+ z9`+U=Z+g+nc799l8}}Y^=G~7^GiUjH948m+Ze$yN2`JWgm)H}>`%J5jCuIB!-!TpC zhtRcf>!rA)8T$z+b|1a&8GOx-LkRfi=9a*|{T8os39BM+R0?3%Th<)gfH4)w|TjDq;#)tPlj5HHt0+ z*_iXXql{iuLR)=kU?%iIKfVzbxf#ac3wz#rr#)OBVtg2{o&Tc`T&!+b_q8mVRXquskmtJO#l)! z{#c`?QhB&}Bb>o(BFREYUYXtsXpR z=XMRbDm)usskeQTk(YEdhp9DcOKA8fE{Lw6RwG2m zO$Dm@aUPJ)Wl*xXN)%(<4T%j>wNqJM4SeBoM?SDL`SVAOp-!|}Gl9MyiRBvc>ge96 zV#*|xkqVj0EoN-3`IBCD%kE^>U0bswwllMSBEdHWR|{jT+Nh~ftw1jNqO90eJehdkP$ z>QWIjzhOb*wN{e~t#>%1NVvY--s0lE?A3`C>p@&hKUKg2_z<#jmj)5>-1409im+OH z^|~-}%J8+uZDDOgNY%@!!N)g&Lj{>XcCN82QQ;(HP}#G?QJz{Cl!;yk0N@AXn zjY0yu8tQr3t_*VWh=Om(cG_Azq0gOHLqjuk$7bi$0{8Iqun%@htC7+U>^1E;E68U+ z4SXCxU*8}J1h7h*y175agV2rxAxkM5yCjcikHxO}+bXsCr(hit4~vlKZXu%XvjoNn zJa^I7W5f}kZ1DX$kkJ5HX>QH#rb+^woIq|O0-j=?0U)wUOt`1vXrk*z^kW=TSe>k& zk}4DH&`(4g(1#rjUks|dd>YT9;03#=ulQdAF>gO``OK`3>w2H0q|}B30%WExcG>CY zS3b**(Rz>+7W_yzb+ADd^YvpESxcSpvmE%V^XA+Br!2S+0HU2m?1FY83sSs!9V1zS zUwHnoGTTCmrxW!pZqV_5xuz#x{~b~#8?WQu0hbW}RPy8LSB$E`#ugU9TK>bDd$4RU z&kG%--pr!2t>s2XyfqamcmsieiQ(pbV{Mqz3zXYDQGlHwgf~PX5{x92ZT09E>m*kw z0cb9Vkv`d*(amQOxCWnwmifs>MnG)ZpQG!W#NwNo%$?5AE{@_Qb$BT6@q#J6Q3>zy z;w>noDZB)b!eWLDb<=r?Jst@w|Eb3%jd5;K`CrC@tRGcAIDAijJ3AK-bUDGm zzIZ=iIG&F0*nBpHzn;)78Xc)l(vi+d;*oYluRLF>x}TBP?u7*^e(PZTcBj!_6ZgDF z3fcJige&NT45j8*?_@(iS+XVie&%nBpm3#5Uab7)NyW>C4@BqC+%;zsk~FgQkN_14 zO3G1hzpQ0SA!QF5n~+p4)+0FikRNzl2K5TzMtk4!;Wve&PuED`m7QgOdPs#PAnw-W z+BFt2P5y>wTTF~@sUH<15Fl)-mulj2d*_aBZV<~!L&m87mt<@86^a3N$UuN}aT0ze zkvaPFSwvXC3u)q@Sn`EviDE`@e6Z-cZZrOudN8z^bEqWGJwLqVG6fuVIw>X>o`N7_P<&Wit7hI^gz=3T$g&kHwtXx58 zPs(7aS?G^0*Q_G zSE+kpG7H1VNd6baug|*%`Xa$}7_T`vc(h{S6ta1}OJi^zQ9Ff(r)Fkb_qXWG$0u~r zXG7?QPE)&ozy(%*wtBHISeMxi?~j&nSN4VYgzT&x;B-2|!)|m|_s3-By1V3{PKXCr z$bWE$lO6-Iymp{znxx(`0K$B4a{GE^jrI@yz?}N-BlfDi;i@M=Pi^amk(BT_%<_7f z&IPaC6|uT%xmbc>jC=&v)Q!jG(KS`-@bKPb!ve2>0GdqHSIHa!#2IDg=$00VoKm7) zrsx%l$>a=)++lq_(vj6XU!$hxyqj{M564ZrCAzgqDl~#=m&p;`#yJib(SWe2X&B^S z@UOLgSPT|+sI84OWO!spOd^Tf3ZH$D!qxi}Ct4%1aQB%@Gwr+jGXy_b`ZF4HH=71O zsN+M$+8VeK>_P=Ry(pCCp}H0o;5il3XC4S*P*iKe=&9%rN@P_dcdNw>$Gakq+B9?< zm|^B5T1`pOG4O>*HvA>b{)&mec~XkDdULNUG)Ga@m}Y4ch^}$hWOGcbQl()i6kE;8 z*=X0`DHPaUFpr&%;p80cqIXqhmnSXF>F~B4n)VbQh>CS?f?e=mor$0zA!~f4q~2J_ z|LzHRwb#Eaf0<-1CVw4=jrsoh4u{Zw>R^l0>T2Jb@g0-HTP&fn^D+URtMn@%YD)x6 zYX>zhKmtPKjl!u^w)nu9W(`QZX)k(uLLlR$Ft_i6Sk0jrJ>3&Whh;tDQ4F2Igjr6h+6*asHa>^}0WsX>|4wYaJ7vC;WvjUT5!_?(X;*Mbn2wjwF7S^O4qj7(Y6VVAjz)9X{!gl_1-Jz@VZ<;~ZL4VY`|H6+A; zTYkFR>6kRNZ?JYR&UT-Mt3|BeCWfv4e$*4NmnY1b_M}aS&WIwCsHvj5%=}f(>pwmd z42Lcw6pMh5GXY=N=f~+E7t)m<7q5KC3G~L5oo3l^c4{<%>hKKWpXyX~k@KS7O<0C2 z_)hyxng|HI38mbBLkqTLB72$9EiB4layj+NQ{+{?zW0UFb~{Lef)N(jsq*&!in~2Q zT;HD!FC?+%5OScvJD*3lcnyd-p@>Y*M!LVI-n7p1c?$eq(Ll*}e}1-((^U{EHg@=` zE2L{{`x%Q?RSkl{009O?cg4J}M(8siKiT3M!Dvrrumi*QVn!-xRF@6$Qq5UWoD2{! zvhq=e4|Hpa?zwI2YbnUDsDI#9!2(23Xji2490>*4t$L0@judf@5Hsz7JbBe&n7VeyA*k_#-+n z2l=Zo2YKmmi=^#8Dd~|nqYLa~OT{pf(UCqy;2hX(B7uU>Eu3%zi}r))$dEui)1l#b zJXrS>u3Yq?CJOTg1Lnf0sBLV(h00NNpp34hK;VK50 z<|iQ)lR>baT7%E0V=&|KXXf{TGc8hrKf2eH zXNj2LsOa{cioPwocWOzRckAXdkCPR9;Naj^S&t!dEk>ld6h&nT^ig5iF(n{Tqw%}g z4tibdm3piDes3`TEc*lTW$ojHM-V(BO$M!%AiK31QQ*ka&pWU_vvWHQo#BxSo^1j1 z-~~bbR{2@~x1)g#xe!3QD=g@FiB=e=!uwB#3BvChUlGGeX8uI?pMVd-r>PBTHEl9t zx%~?DZ@&Zi0=0i#Y10*_w%V@Nx(wPS|IW<2FwwbMACJ7Ns=!ro-V#$&BxH`9lDO8{ zL*L^DU>yl7Q-V0%HnD(d6upn8cVPz%pjvqR>9h!OpW|O^%doKn!M~Q~L1h8hAyoX> zrj?Mk-ZvV-t}nTv!S>`VibL_6Y&w0ehK|Ko4GDph%ZKjBC!oH9+KSqgl1%iW1O%8< zF;Q4Z7dhAvL$OLDVLEU{7sxi5-yOCAt8CVPf~$z-1mk_}&KqwWT-#%2dniX>m%W;eTnw22Dilr@?NPT|qvyc6P!mA;aF(fMt&EFeT^?ZQTiEn#fseuE zKxs>3jN2*vIAc{cmCzUCclVLAX3QH8r}A+g!ssrnO!~Ym*^!)F=WnABi-K~rsf7>R z&ev3A$DQj?0n>9lSlvCb1IqKn8iP6{2U$yuY?E8E85T;RvzsKz+)thwkijf0gmP$y#W%AnE;Bn+=T9 zBeDCo-n*x2T$d-@)pt*5TvjP?QHri`sV@`iNkZS=o|U1qK?z(E005P}Si&)OU;Lnq zjfya1RCxd0j|g0D2cf^?TM=FcUw0p`6x#f_2(rZSjOC9I0>c1 zU&lP#M-qRO^2Dl)WN8S`ORLC!v+~lz)3lk|eJ`6B%i)8KdUi*1*fS)#UplzI%WdY4 zBC#>;Wfm$peDu07E9GDUY#k8Bwp2v-3-X9uUHjiR-;&-p7zLN#G50fVF4fgz?Pt?B zDj50-&eXP$RNf<(s+nv0Xc1c;-(F*MB@XMdYbzl^8{Lv4$?1C$n#fimP~NpxY7&u) zjsoE;-vn4a@Acaf6T*j+&^&Lq`{R+Yi-v;nFD9sSymcW-N!1L9<9Wq23%5TJlK0>! zY8vHdy8Floc-W|%{N);+oDbX;!G&Fy|K6N`i8#tu6!=%-iJXJ^qKHkPVm5l%PeUcN zgKvQ!@X-;mmjG;kKmzU-C~%@WQ>4qtIDOtH?EXA1u;3?2+^bx2J(b7V=aceLCl^ag zjUJ!YY7YM%^qqm$Phs`VlZN{QG?S2S1#EwX2)3_>V!63iBg_w0>;b@)rc6;7!>+7D z9@R$UmgQzIG|)GVvdV9o-;J4=a5XqQ7C|d7KNMHwubIMD>(wyQivxIqB{ZO^3G*$r z#tbUhb9vf`JJk+)JUSBoNq&FaL@v!olRkv96^^HFbF_Y5LAUb_&YEc%<)Tu-j7v9M zInN)r9kxIEUvn=aFxHyw6s%@XI zmTGv^lJj=|_ZnHE7cPvKc8bka;wv0&a3U+7lh)jlFhzR1g#^4B$8j}Tt3yE{pr~_! zT4Zmpq*llE##ZYgRfyM%`5~$*euYf@>E&+Am;FOJgOMb!CNYBb$MS-hc~}xcf4%=* ztEQb?T%RXcam^79uq=ykK0?d%*Q?arE!2(Og@xwz`-}gXL{aK7RtT4%4W~LL&P<3A z!YDv|I??@~CseE4PBRRky2T{w?Ka~Snu^7yg-Pn;G>%g3IGX3NtMIjQ&d*2L9W3#@ zHI}}C8N%5HLcE#9VHW@3;cZg{KykT?9@G0hJ91a>nO>u5*JMyLxRxpjvDp*t;a)i8yBmG81OaR$FI@v@OO(Je=}2yb zL~+l+-GW0w`)6nt`B*hMX}BMrkYTpPJO;jdHF1pJ67-lQn%khXsGuttCuOYc&`Xb` z3yHs;SlpotGX{NKY%ind=A^ zZ9_L;=g?ZrMWmnVqO!NdJ?|*>=^?-ZHr-orWC!B~1Yp#Sv$5$kjzG-;W1L+NVccvp zrECQhG(+^s;sgAyPx=5_SE1iq#47QODZ8G$pM)()RG>h7Nx^=AJXrMMt@QyxdMTvP z6%P|W-zD8ldx*Pw75A$|)a1_Qo#5Ebkbb#IzK9cTff;SXRUy!~Z)(``VqLKuWjeF=gSwqC_bQ~8?6jVd8AU0mzzGDma zq{*$!RXh0T>4(!_6KlR}o4lvB!y2sq3d{mX%gG9A8A^rmwO|2F@Dv6U%Uf0)|gxTB%{_&<|JSA1HZ;hJ%eShgXk_a+-#G5C@eTXf)NLze1pCV-iCd zzaSECObq>LAlEz|inyf!6lvt+1XfjsvlNE8-m1B;_`5xAnhhgp%=z3eu*fO)Py*LI zAjlN%`=)}3)_e4UII$hp1^!oWWOD~WwImaVA$WhgfjgD+eKsd~opVVTKwkjB<$(sg zzPzK!2W4qSt2>eBn1V;8Ob;?Z^=RmjgB?Uy3M0oFJgy(U+?r3NKKkT^^ZUksQdfVu z>)Q;1=@di&F5_1-K&qye@?JY(5Z%PKhjzIAEC&ikfw*7cH%|{^NL0!RC&=!Jdfayt zoSGVl8}Re-{~)J#&Xs;@#boc&5zKHPsN_X5 ziNrW0YAJE|%Z`zz+_0vb_FzAYB7?nxz~U4*{*eVclT|0vUA1YV@O{JX$xE1{sWYEb z8QtkMr4gjA6NN=38|MW_Ua01goPtjygdh9&ImcU{FEbpcBmsQ_AU;Q=&)(IRHWvac zBzW#ouc-rQp)5_(k*c28NRboUtcs{>kwh_W53sdR#VcaF8;fbP+8uU334oW*_#pOtW` z3TF)9Hcp~R>%&P83J||4b-_)0F{!76Uui`spiAAZkq+b0^wC_}k{9@}AEr2Q2#^w) z>v>2A0aeX45DQlFnmDP2kEZ04<8Xayb!5?vUiQR*XR%*1&WrF%0_kNTpt=Mv`U_%B z?FO{l4w-a6!D<+n5nogzn0mfjXnE+EdX@)0+_N%Gm=PAm_U?m45FF(eLi-gllsXYr zsSCiqf=C^OFNocd$mAsXeOp7@n-^*$)m|}A-!cOfwAy_@6CzpE+~RYR(HWuwl6+dR z`S4J*R!RHcw|65P!7wpdlK?PNsA?fW@wCk908Ywortlp&1K)oiy_8b6I!Ss!wyf}?j zm>N*tdW)_8d~Xx}13RoBBhm2Akm~e^(7QGDr&V+A;-ZOO@0aX^d>NUSV?n7-p z?;!E?v#1GE^bQ|{AOgS@GSO>WIeUJ_0fGX09h`@;fP(vX(1}h#+fH*lFhW>k@xw9# z-m`e3_7HGD_@I>|<#!iF(fb5KTLk$l?NV64_id3s#zeaBaB7ot(@0mc)pQn6)ngpI zd3hRpu@jjcQRyf1W*J)HCI61UXc5QjKt8pmTeLJi!{a#TfCP{rL1>dWcd!l4EVl5P zI>f!TfLEqd6ejU~8+SjpRNhapE&nIdiy@QSw4X z1CZ8l4BB0Z0$wz@g?BzxDMT`nCZwwP0H5yxkXn*h(W{=BSm0uJWNJ7IUG&G-mhZ*d z*;z%PZDBCk6E;y`>RG4`KtTj5Ap}3EpyVA*Kx8UH@kJwW9=Q+yo_zWVycfQ zikgeC14nZZ!C~C|hb~bZKYwxtJ4Lq@05xV-N2lefS8HFQUZn_n^ieCPD?- zpsrJ?lJZx8gJGg+!wuNG6{RGqaPbyD7)^nm2;V73S_~Yq0AH3;OjV}z!ZKylU^)m# zx5Gz0NO0is1XM#Ba?}m^z0)CpAN_?#|D+^0Z~;?r`h*md@!||rEJ2de1pQu*(M`Y;x6B#WGQweb8VVOdeFE0wJk`clSg-GoO2sj1C8={d1=6J)T%}15kP)!WFeZHp!UyhGR_#E2#B7t?yt7Lf znG{Y**xS(qWB*6hTQJnM1zmy%clY2HAQ0T$T`mxUySuwPT-+tN2X_zd5FjMDdywF+ zbKf`JJw5;6oL#c3R;^n5jb5Jz(R_7O!l#e?O5(au)(~NTI2W|3Ebjf4oy;OX=-|pg z7H5F+)tWt3cU1g`KXPirb)j$z@k~=)p$?_gXWFT`deN%kTv*e5a^MdVg7t-thFEYA zO&4qi1g9FCd#xuS37$5fL<0)8St&k3Uo6)cA^^9IeW{%FT|gO=a1ROL2+&7|2-MvI z1v)jNY0}}9E@)&TUclqH+nQE0YGgM&<-&NJ#{xMbz_xIQR-I(gCj$!%R=~_d8JR}H zKmgft$lDX>ysK2Ty`Pm;{wDaML>B)Y{hs(ST-4cxC^hR_K~Ez__G+Z+B?W2170ZtE zwz(ifdlcCAGLi0Q)|;YzwkCHPIse`@O{}2Mpj( zD~9b)`x}-k(Trf%<=`_izyv=dMOQbw2>^;%MpgQdn_c#q+*}7>HNBjzfdT}rgrSXC z1#JO~RiCeV>n^f_`kMc<#hY%>!emgwN}vcaSA*+r{4lEP4!&$_w}1?^q5^(- zKmn*ox>PbvI{H%!s>UZI+$^H@He;A+#b@;B+E+}=e^IcEz7spq+SpCDX8aVhVnOHt zs@Rq(l&E6v^zo;W~k3cuFEc6Lj*_dg7)Kth)jK zCos#d^D?Pm(&6^^MoblraIa4@!|Ipzf}QTL$AhXMyL{Nk6|uw`Qus@cz_EC{p(bAf zBEahC`PG#Z9>~0HNT2jdQq8|ivRgF{^n)!JCeN9n8rsZ}mA#gRcv`V&nqsUbtv4pQ z@=#h7Vh+iEB#o~ojm{GF_?+0x>FpFcgsw+x6&C_b9#9rEKm>v;{$8L_A)#%2<9}S; z0p_1o^55<;f%=9)16y0kduOo$3jFDr-0&UKRf;YT#H$>25P@O8sT}_PL%ubQ*H_Bn z-^grvl~)&E#DOi$Kao_0OZ-q*X$FbaBvHwqIVhE$$W+etBx_=$YX2?*toJ@KA}BTg z<%)$-9mu(#0ixiD)C$#47gUE(pQiJr&LYspUM$#^o&21pMu=oSlQ{jE`_)Hs{BwXz zhUwIKX^kv$>R+Oys3dkCWG3;f)Jlceug%7w~HlOm786<>LeI%Sa zmnpDQ4UEe05$$%z-;?3qUH)Oag5UR%Uti}bz^MAx0OmhKs6qvm0GWuQRV%p1(ox6Y zIkzLAgZVQE1H}xauJN4^?{KEr?Ob>bJDe)_B<4$bk8F#ZBsd&Kjfo`5D(yNAN_9W@NbZR{N0~>lP6xv@hYC_pJdT%KmBCmYeJuVNXQN?cfy&7Sr`D&mUah; z%H*(D(bz~zGGj%1GeM(}E2wh~h1NA!^~13E@*P00?yYwUZ4e*QH%(0J|*x6^vV6$=aA*MnCL6wmL-Nup|B^`QTy{ zr6S5p?G*EKP~Y)~NRn*+=P%=LW}2n@gTi6rwfVQAN@38oSEzrfX^I#vHqXyv{MEc$ z6bMkm5Ve6dsV2p={}&WGWcSZ`b_4yFa%+@xi&)M#A?zmss_1?2AejU2={klCe8=uz zBm8(Y3u<>Lo!cZKI-gjQG~%>j@I8n zH0T_#AghN?7=ALKItKm_lT7}x(Cir%_Y6()D5*3tcN1m)Rh>S=tWaDdHnI|1@Y9ck zQBRHn;X5I4dV(nT4Epk0I(_U-1eF6Vnc+-dRWj9|3i53(JgEPA{3oIZyVDtnBoI{4 z^7ubK^-Sxa8hbWimcM%ZrAIGZC-+EHw06YyJ9Zs}8{eA?=kD|Iiu+%m`8#F~kuVvZ zo))k1Dlz0J7>ZRM&plq0pdjU_5GJp3KcLUyG$e0}OE~K!O3c9OCYfBCa#v-lzfFlJ zR^K3zoB|Vn<2)dDzQHR}DZ-p^9%-xoynUePxrV;A(=$u3Y)qZl)raA&&?EMCH9ls@ zg%@sHUidfCntq)fZ;n)*VwnwYhg2QZ$pe%&TvN)e!#>Urf(~;=2OGP*w7lT9*Rye3Dn#Y0SbPD2AkGEAh- zV=H9Q9<8!xCqe4M% zF!rF3Dm~$fmyGjQQ{jpT9yk|=V)Y4c=-UhEVGtJge6R3y%!ZzsL{jRE=!;oy7`rI} zIB;*bwwKXC`83{F?2P_J7!xmxp@IpkSm)ECJiyp2?S@CFF_|8Kuk!=4O9ID*P~15nLnxXnLM#R5j;ail89@ha5k#H%7O2e?()6n)&~rEiT5@w-MG z<3S7c8$^T@@n}Z}j-Xak?vhKC0>w>K?+Fad^Q@S)VN++*Ml=V-Mk$ZIMf%lV_yk8i z@w6||A6(*EIF_OzzI`>*Z)uDQu%672!w*RUZ*#z`>{cW%4UtWn+L!NXUf)%BOTR=A zz|kg>D-DOH**ZI4q0-!cqzvRKxp$KGQL)V7EGG@9EM=Ty(o1qUt9&)U0cOX3+16lT zaw=l|$qFyz+bQW-@afz!Q{l;B^^~ei<50eJ>Epu?5X?M<_l8BNq{ruEe3odc6ydCT z7HjeWCKl@p4TeKp_)x&5XNfFCz#}{Q9^;QfEg?*>drxBBWrQ6b!4+2?sQNzm={eZz z;gzCdTrWr?lwyMwKUp7&ew`cPF=lkf03gnKc63K@_nBCuN$N3G1ay4#q* zaTez(fiy#UJWK{+F_rk?0&rHr7x=XZeEQm?+K>%%+Xw}cybZR?Ln$e|OAHqf?>)evpwuE%7FRmBbgfPI=lUCK@7=#7^Y*BU(NCLvI zJ0i&$wW^h>rE1%Fe6J8vwx9rtITBL)4=1+ixNl**=>AD|yCJwJz9m{K)WZ`{3}2^H zcNdAELevl9WqCYHln=?(5M>2?EGLe|wqXJjpdsXwxhc{_3+qUAW$rN&qfp;npW@h= z;7@Zf7>i!wP1$JkpP&JziAxc^;o-qFy$XWcP`_G^5^+XZ3(xSOUV#!p6xqjx#0z_h zZS6v)F=*@_JTpq}#PC&d?iu_>S%k6l_5!9#0(q*nM1e`NHfgtkdCGMs^Bm%{nP>Eg zKN4P9`3axCqqda%)F>R#^*^lRIWH#JDOMGFTMO@6c!!-D}J zsv1@?P`3Lv-Jg+k#@F(LCh8sKUQ$|iQ&b6OcPgXkb&w-lv;*JC&q*m!}*F7je^zQYw7ch zBZ`PfL7c^mSLL1(cgG-KiTzYoR@K!i-OT9_gDbs>huTu@F7f81c0X8!zHa^lKF%{ ztUpj(KDNnBH#>}F*~bVPljBZZi}x25(rXDLKPp60ITj)yhxit|rE?8!W))9uLMIyu zj1~D5GtHsFi4)*55k@5cQw5cg4qSKZ{i%@M>?Lu;g@yk6TLiL(^G@RT_0AFofaoGx zkT@~wLE4p-1+%wa#fXd!IQrQ5(Z@t@Uf}@@1iRb{B!48K8cfICFs;!Z*-Jt&N`Si4 ziYKnxlS|U+mh{nM`HkCbND#`L&)tBWt4XapW`P0}W_f;fODYD075&H)0?ggX0DTik zNAc5Re@|i+dOX_qEu&wo@e|>*BtF=|EbGyY;ok=P(Gr8x?C3RJ3iSFTY=}_6kfa#N zFGgY&UUUR8@OPZE_>-V6btY$)0t^=dbeZw8b5JV};anJfl<9zKvn@BWW`cB5Jq!47 zsd#A10avElmlMn_!J?U1Q9h=_^p6{(I03ul9*3%$n#;-v%K|w zxo3dE)}km3}j+ja816BW!niU`SSrO%y5 zGcQR@*!xS+F4|c_Zl>@o(clK)#yp7;9l>k2b4582AHJn| zC20b;kCW{^MnvdM5aj1O%iV2re*iHZiJJ?AP=DD@$W0#pTzq+YXJ5fFEl!dV)fJ;j z;rfDG;*H+V7TLpV^Do3ST{%_UurUoLUibGcOf%mOFW)+G^Cg!6u_%k0s6ocBK_tsg z0o8v2bf><%H=>4mnQv%kECfYfhkm#!I{l)dT3fgeQNV{sQ!);W7^fl40YMvsV^oL!gY zaivDZT+g6C#egrF7>V%~9STk_*!CP&z`EN>?X1@D${1vEe|q#vcyFb^TntODL(aB4 z57vh&%I`|hqSU#7{=P`fjSTL)?5FM28e;Y*UnE)yJx|U1r?bE>F8j0idSYJG9Fy{MLh(ULsl+&>Bp*Y_!r4(PYd>(7XMX=MW45b zL5uZ6m1H0NGU76Elttz-e9%iZGwxIAhk3IJDlY2=B)}*Fy5*ti*Ky4-@Za#jK>bwl zAKhE%WnT>vApO5aDZ!JFqQx5kRe z8~-a06mVlp`aOLR*F@5LG2})Md#^1)G|3fl;-rg0qyw9lxJODj z5I{ayD!k}oQDv$ZKhmR%8YF?FaY>?0_#FUcZ>nLWX4%85-U|`z@g(75!u92TS2fR- z1jF_B1@Ap%q?X(NJEX}=O_B*m1$kyyRSbUOTD`ERm0-eDfpT4#bT~#3#94O0m~Wz?xwv_To$U7>N+n5t&5NN=zv3a{#aLyu!)a(O0o2TZsk= z|C+$c^UW2w@8}M)CzH}6vsmq%{_tnax?v$OB4WwTu$9l2h0{NSIw?pi5h4rQTM^7J zQ9#`uRLE~4zUQPQ^I7}n@As?c)2C-sUOCi8u{a~#My7VG{YydPd@{5}m_(Aee1{ZC z#p6Vjl#-axxT+3vxr1oAy3mUCLb@|`XZA>}t(F#TOIY~#U;HaezkYJxyw5unI!991 z1qr_BqpG@V96FL3V(9)s$dvvO6R@O<8}}NfM>`oP!F!hylUQpvSS%3TcEj|hHoRO8 zvS=6YbA#)BM25Q7&hq82Z?w`5#5HS8QETe(%WIn*@Qxoo!OAi_OgcCS&^YLxrtTl?@&{rK-mOC@ z6_dkagVB!jS-1C_ey1pMVYFgS2j!4`QhlH zM*G2j`Qab95pjwALbrB@Lw`Wm33_I}Mt0P~*kF_3_s#+@esiC29bXw=4QmZa)a!-( zn&!;KkDf$w^Q8P7FfO8(8DanC4ps$V%62mooATRVBDs?TeTrlGw&x(tg)i7aJCOTIyC;ghnY z+}SAlK8b53e1{+W#OFrIUG4@kWMAsZqHm9rF2sbePXfl4JIS5zsA;?2QLw-HOI@{* zcKj(9S(Hxr>iJ5$x?7(s6o2jWN!XQ4SeH`RmomVXIl%QJnfj;NIhvAc7{u`tR(m43 z@oGm_MTb~xMSZ3u_lEed({Cb@Je9&v!$Pd*-@s1B)MrIre)1KYUg7Kt{7~~phg+_D z+pc@N1XoCi-moNmu%|>1HJTUcIsGXu2uD-mOy43+v=_wS02xJ`>ZWX?>_zn5mF-MV z7D@gl1jl3TiAHAEstf)$w9>VP<&N@Lg9V^qVo|b1Qv*c}76)0+IOOSChC01zu1as)T`;!U^amW3%GdG~ zvJw*vnTF`_w$t1mXh_XX*vyNrv}8rcD7R!sEd?X#&MD?P_O(3Y`#KvL2VT;nZjms~2~?0(Dnh^1ECccjKC^5Z$Nhi$wv>u@MpQ3vC%S_K zm7Pyoo1I-q@CCTv?>+ zn$g^gC70}X}gtF3i4Z92st z{rMc%(DRS-h!Hh zEw16`n|KX6ebyT4dWj=L_Cn-NcrmNJK`h53=YA)ZyK-MK0P=3CJwB08=kh^&D+O5Z z3^0KRTL4r8Rq(R}sg84z3YfYhzHAlCcTlCW5~*z5}oScbE}&5K&`H^0fIFx=ysh2Y}M7Eg(~#m`bb z`hy6w0zGbZW?gz$9Yo%rUNkW2b0@fFhBUhaShX~#k{KSbGW`r(1bxm{@FV*|3}p9g zrK;qngzDtKyW_P?WVU3rg7y5cO{W>IYV&BW=bUSE1i)uL$Yj23P|LC%>PgWq%OxSB zX#KJspb$g)A={sQHN8P@?g9(1DXg_;!Nv=RgqEB`-0upor6&dK)=nlcvD@eBycJ~2 zg@(yELa--={~lajA2!T-$h9G)iepHW&i8UdJDqnN6i?>c3h!j%LsdlF86;@WaQ@}L zjcHp|CaZ%I<$?~LNN?T|S$M7JqZUyof@`;K+Fi_`q9HAJ`-ciHyDxJxGnJQK7!*8{ zI930!mHEbZXC23;VjbmdA`!d$!B~41?`TXmtK@e$ai|;jFvF=W$c%4U^5OLNgQ(%hJXgd zgwH4$lyH|5%GH}n1I^vUBY#!u6(2E2*UH9XdIq@ah+N#Lr>Hl|d0(inMp{dqk_yEsh0(AbopaIbe9 zqUZ>=r}-jAQ{z=WQBq{6opFNBIMvS@RnJ=04_bGVln52-Twlf<(pjR7`*Y-&@;HLk zBe_97uQc&fq3!BzChH&MF8|cgXU~R(G~}DC5ypE3keW@NMV7SjGsP@j&AnRvS9gp?{k`U!R|Q887n)FvQkH9bx}Kg7wKE{N~L6>F?}OsGq#rh9h!tttTRi?0S2(7obk z)oX+<>iZd?KnF^+9CAp%J?7de0Lk@*N+8cc$jL;WS67bA%~jXU^|zKh1q+rAo)jXcg~kq2c4fo&eVh=A9Jizq@B#pKghc(Q|^(Ce)~bbx?u%2n=BTM>3tiJhL*)HkE@pK2`{$%_b5tv>VAVp-e}?*M5}F;2E7N z@NW$iPi`h8{2eplGfw#%mH06;lW#HG=aXn_7wT#p5%E}SaQB66N%$rOlT|3+fv%zg zg2`qZ>|!a-+NbHR!0UNPxYcdi)Kx+S6(a-P3np97AAm2^zURbfK&79Ui1Cv-bI=s2 z_KxrPgc7ZpL1JtUVT|dh7i7)HB!3xJ?r28j)%51KaFLUagiASBsg;zWU3tdVgiy$) zTR3||5PL@^dq%KJn}+)vj~{kG8)?<|psMfD$7dpDAeMp1J9Wyft+RQ;D`jf@;awKN z;Mc!?ZVJyS#J{s*zi$?73cz^2Sqnx~dBKtrKomVJ#z{WL#}_y*qDv-_51xH)Fe}L! zW#MbzcXuAd2@4`tCN^&j4*C+cm>yqsBRDX>o{8~Otk;2_wn?`z|Bi3L`)31-O}P6u zPbPuqNV^Grx;K&q*$fd@1r9#uh7Ow)Z25pgWg{FNGD z(1G1T(%RCf&eueieW8e6OOZU|mpW^gbjU`zG*lTN>V?wPqe-V-ub*-V_P)y?#BVNg z)20J2q7K#jBHzV)bH*FlKI2f!)PMH)yvUq4$bzzV)pZUd+F^(Bl`<;)!9L3?HY3p`-b7&|>Tydk zmRN#~=>+U-OpJQnE7n^tG@=n&f0h|e(wowl!+E=Ac+^w?B|2}|rV{ry56qglWx)gU zgaCvpTzV-`LuUnm=24!bVSxPzDq)&^*}h5ruCedAt0iS4U^-1;7cJ| zDyPO7iD)@)N!F@Yzvz7 zGlbc8VNNp*cDgbRD|D*ymVcIt@iB^uftWMx>QrHkJ6)I)MKlKZa_j#5M-~S7NhSa^ zXYqcG0R*99o}(EVa38;`$zQuy^+_` zyxSgE_>$YZniIU~k;_h*!2TU11dqsz_ONaNZ9pvCh8I~HwKf%Vy4DEp;26c~a-bYV zx2I;=MHQC84~U#=y+__j6C%WzmT7bU(PPRL6 ztI6ay=H75e;|4v<@PeCR&;G_d^gA5NjNex6XK1{V*;J0y1w%xHgqVK=kQkU%;RNXQ zp&9w%DuJyX88IS(YDLoKs~|U~7O1@XKP!I5AgUTRkvl4B@PsvD|Sbi|olarIybRz9HDOjU+{>|tzXs`YZ zMUNH?EuTVB2=r1T^iu2Eqv=^F3~J_tU9Wg%s?<_=UcR}n*mFddO zhdnAhkb`8u|6}P4$cg|g)89>FbxN+AnrR};4pp@%K$wZP#xagctHYrz0e>Qb)Y8e7yg{`9akDVicZZq za2d5g%IkWQx0Lz}4Z2-)Y{~e)4B5*8R0!UGJw!#s_N?}B_>1;{e3jT#OJPPsZAMG6 zPrJj=QNcgYt_!~(Z#R*e+q&Z>MQYH2TlYI?(R!#{mU|0N;S!nlxL9RwH{-^Ol$H=> zZcLF+Vy8#Rug!&f^-$%bgAXo(Nk)p-6U8EjI%ajLmt>QU0il!5r7U>2ZQGNN-W6pH zWWFCUDchkIPk(^pq&I5FhR15u9jnPeHzgeZIuW2aF3^y(8sqf{n+FNVSpug~hy8eZ z7tKnmx@!5!x4L87yYFgvK;QLG88Yt{DJ$|CWh9hD!bJXP_D>^QoUYZ6{6sQlZpFKcHSU zF)7Hd&z_~gBNruI2*$NbG3Z-YMCs|zq5zQ8F>S(aaBYjHiR5>N=BEb+SS_KiS6@@St6Dn zO-B92vrka1PUtaX3CX609JSHiZDTRMq=;E zH>-S5{cHpBE?X)geL~-ozD4Ny!D%M4<00}!r+R;|RE9naarKH}+2PVd`-r$wTO}8A zT&#pNdWa2@f0Eqy>w(q1bZ@N7vHaI4g-SY`a9J$F;rXPP&Z0N;G+&j)W{+&V9je`G zM|Mev0m^g@XV1uTX=67UtB`-yBZ4hKrBE9I1g_|tN^n^9hIApi24@UIH@jLae$qzoKB5~WUBKAhFu!9J8M0-!wY)3kTTncY9g=CN0l!N ziW7E=44$~4gIUUBSB5D?jc<>!q<^Ge&RK%aSS|WcDgRJKRi%@)Ja; zov{VGohKQha5VeX?<-*^gvQIH>&Z-ew^+DfS>D3=H2+Y`bGsm}0hySQo=f-ZMNIo{FjC@D?^bi2O{2Q0fo43~3PQ|J1j za}ES!!?SV(n={N~4jL&eJ~ow0aoA3Lu~5z)SR+!`=48n(MrbRZ>B8Qu1PeD-oJt9=OxoDrW#%+^U6tl!ud2L`3x&55fX#Gdo-Vtg`a zZ~6DWlxvz&=kGG{GR=sP8YX|<;Q#is>6^*9HY4b{!D&P1JWt6ifslgqpZ<=_rQMtu zj$$8N7Q9b0R7{kFgFbr`#K#CEaiDL1;*IN~AxcP&bCesk?2RAIORyWKqk9#+q(iUg zav()Hm{y|(nm#H~JKVY`lWmCIwKU0cm)g~bv5yy^lU;$mz3jEU6gB5bdtG2DOLIlr z-3XscirJ$1F{`>|}6e)#qT7(`B2vNg1l#K2&xzH+@(ux&eA$@){B}^D9 z+T_A`y|bE!6!IhDs2|OJKmU{iT82$n13d*MYlMd#Z96Mf(Fs zez9*`N`78c3vXOdGS3!0jnVk1?evIwcSO@3wu>?L+^yG8^DbgW0;L`=*y|D1#Rs`3 zgv8-ntc_;xM1+h;-FYDA+-2hRyY@#9R&3Dxc~V*V7S}8w+B9nZ0a7@jbY=s6gK9Ye zvyYQ&c(e`**ljdP#33+-a+Kn8#;Cf7s)WB2a-2VpfBTgcG7Q78!HYbYXJt2vPf1%N zqr4u+am_2P44uAaHkX3oa%@Br=`q}Bslb$hgJJr)GwMq=c+m^Z@zT88`_S1yBqk9r zL1-6up&4iC_YM~O^v;xWf5ta4ZB=2O+tRgGtv{&mn;#CJRTN-?KJ^OcfB3&bSbx5< zT0igs^?5t@Lc|XBrv6%U;IMzFLw+64+(ALvAsU;hQ!2 z-7B*C0)8*vQF*%>{cpzIV7D>v0;zgExlYvX4L`~FDg%E!lHiCB{D*mVMso zofuyCLub6)LGM>imlf5Ls!^=kydh^Uvga1qp(&Jhm%8o6{mUQYWBT9p?agpsHuZX6 zMJl-#Fmi8gE#EW(e+d7Z`~S}O$rA(U&+Vb2#n_6BWZw_fzLv)oJxE^`r=Wv*oDz+%smqr&5A${j97w@1=(358SdBDVfHPn=WP{@DT9lw)9--Y@HkI*;=?)0$dq zVw^U7q4T_hR8^0+-{m0X^P3|i*O%YJyKZ*8HYs25?y;3jg zz9&_4ze_nB9x|NX@(;tD6kt@z{JNMKi?NaFpJ>1(T@N{03mCdlk6JFry54a%BkRxZ zB(U_L+8Z6z)1~xJ<$_0S$I%3YF@5zO@VB>elUixT_9Dg>QvLtGR}|#4ueAWt zEI1=ir%8*0h~y(jdJyS(+zaPK6EjwOa?s(LaY>3m!Wu=Jtg-l96zqJ0E z1J~mTr*ryUOzuzww04Ps>-hj9MfxUdJo;YH{%lD9@0#T4jireE1-Wy!je+nHDdN_& z-f%6Fkt102lIx{(@#5&W69EmiWp1CYQxb86o`de~3kC0=)7OG)O)|IuwNgnaNa8*| z0sVfz`2Ql!oTnf^{DBes;f$x*n|1Bu(%OO8NY~ZN>$xZIAD50U3+hc``9IkFfvWHu zYq)Df(e3I9yUH7p*MIPbUK#5hvciq$3EkNI>7!mkUc?-WPA*A?bKg@2rUQ%WCk^S( z?hI2so-uCp-w9K%oD<%MmY!!apG88g`wUr8{UVYJ>r^?rnbVb$+Bp)iW=owWzmB2l zV(qt5y*zOWK3ZO$FsnOEZTspnh(yIlj(lJ=_Y(siR5fS;*aU&fm)Bn3b?)MNxb0W`CSezLC z3#k$$5KiE4tR6QY2=VeOgcnx_3vf-HCwAC#J6F*pG@cM#mXJs*FNM7RMP_?Oa{(QhiEblv+;&JedeKWLA|y@RbT( z;pkI$!*?{sej7kp<2-OuX@-N^O1k@DGq5wrqXcOr_7}^`=!k%b8}A?HBK9AQ-2XFC z?YHSok#kLw-nrM>Mi_$&3)fMTZE0()yeSmk>9c+xH?D;rY&Ow(<|n+>x+6yG?8v%$ zu&rnk^|gQFtf$*jm2E;C%!I(=n?+VuXkZD0QP%2@2T3igXm!DSJMPt3b*3?1Xu4rL zr-s8HF0-F<+_li`2Jy<@@$cBqcL)s$M)wlxC3!}8yYTM(eul`r)>bPy(@z8(`4Vy(yLd6q<;#8hL=;MRZS@R3GhE)0p{6?sGGu-V1w7N?; z4Mk9mgj3m*#MUk{Mxq@hF zLn*l+NvJRJx`cI$A78=GTeLAO{04KHa=e>)Ni?u#u|&{3(%HmS;EW zcz!{~4HLpvJo_xjz#nT4hGX*@ybE5${8i|l+P8iBmg`zZOV(4v z2nSP|@EBjU#scaCsecWhPa^z(0wl!Zn7dS%rV>dDXhRL%0tcD@GvR{_SxTul3f+cQ z38^**1usqQ)QL^RyiCg(tP@Zv0Ko)R_MUMH-7Sj# z2g-;5icvltQh!Phdt*Ca*D_Q^7;f&@X2$A65WguQ9#0|(E^>kidSgqzp2+<<#~SRO zkE9=?@6)z9aCEsanYXEYZ{g`PbgTCLb0k7TJ5_gj6Icz=hJh~lGokr$e4RagXGUSv zhbn%}Tw*M1IeXxHzH#Oo(H-AU%#3Ckz2D@JC6Fc7p<4+|&HMg_5{~rDubE}sBb;ZZ zil)aVu}{G7u!MT$XVmBFk5Nq`GTG~h&X5fR^-Y-x_8;o~wDj+PLHx z9pB+4bW6B|uoiFndy42=OJ9 zY){!fH~h2;u|F=?qT~5u9^(*ZYJn4$X%Xd`P4)AU#Cd@ZkwZi}`<2aQYE;(s1J$%` z7;7)Xz)l^Orl-^fC*oq>FRyq-u@w=b)x2@U!#1ju)bGKMsRH&GKwolP*8@{t5se=l zLAy1`1sDRqL-q_SdxW{Hv4Ed>6u*H2pS9FC)vgUg`<-HoH-)vd+_fbAwWPF90PT^= z%>6JCZ^|90)BA%I%Cj2pC5k+qe~7yebyy|~<{^)a&dLXG4a>0o-1;fUIByRHCXR2W z-RJfP$#eB0Jr zz;@QQ4ND_U+J)cR;6OhAW#wmyPeGa+Xa0_Qn&Cl(SH9DNF9-`*_#G(bbaJ$#;9MT$ zzrz87^v~*KCPt8sfqKflZu1UvaTLX`KalV^u~wHl>E? z2a=QK5ncdaFd%{unu{;!fu=1Fm-bc@K|KqX$NOyu{mAWRU&t2fJ`QpkNP*UIVZmlPY&2 z__)Q=-uGEzV7#@WMFnmy7e$>4m(;NRcL3n+sE%~o=nS|umkHE#ZrV~a$ z)JZevR)8^2GpC3U7NA9@8258zS2akCeErLObs&>0(1Y`ch4xE^OFVNP+WBpf7r%9+ zp#*K9u{BDeS6Xk4#5u2V@E!KK`Dv+`m}1H*Oz>VI2c=hB=LKypnOjz2g^I-?PVk)( z4?UF{xFs|S;Mg1f>|AFP>gX@?(x87a>OM-kh;mpK(C#6%CCo~8|Ldq-<);KMKf>g8 zM-&98|D6 zf9%|E1io#rzrY+C@&#^fpT&qdJ@5NIP+&sZioJ|+m$wa52v#zax6xQtUPz3m7o$*m`Wp(;I(IYD zTg44lu)VE0N~Dx95B(!p%drMdrTgpOLds-gbSn}mK0C&^YWV6^@ozy~!uyxz@tI-N zBZ;+xdJYO6M9a`qg20csYb)ko2wkl}t9uB`%rA^9iR8Cn zGqwt3FSTprKX(JY=)nCdqsZPC`JMr+2!wobyf||%uK^3N@DQ&&$FU%EKdXh_10oc2lL2H|Ciffw$m3l&09)`LYD-3LtCq=ma(}O^Fzl+jYN>ZsbYlwCD4~Lg7f65vPZ!w~#-P4_UonE8K1`xoL@`S7KTyw2n9B zTN(BlGPI`@ou_01G8Fh)vyvpWVpL!ItJq(HWU?ftx5@x7L?Gnp(Jpx6K>nWQ-k)I| z|9k@>2(171x{ClQujXx!qBS+3M6VMexWyNVaD-Nr|IGyetY)3%i`#TnNQyO}zK{bC z+U!{_>L7)e5cfB*dMBMg$7lZbBi7vx5A@LMVZWI;*gNHf*@4lQ>&-ksRV@${O+@ ze_!16&}-*X((MR#m_F;FlZNdyWXSk|Qcoo0a*dxv6Juw(cLJ@rwg~lNd$G6?clH*8 zkv0H-S7Nza3)W7CYy)wFP$;qeC8VCzpAa}X6VEa z6`0{BC!Gbhz5_vQIz&cX9Snkk%PhRei>hqMnn>nd?To%1=4~L0sZnPW#!hc6+;|%) zu^FAeoxR|m(aB7zjZyw$qWEz8q_1w`S_|l_19eVJHo?u+w9|MsPPK0z7FQfEYHi~@ z^@+P}b$7K_;qN{dHlgqH;(%k2fLBLN zP`6EW_lNW^`lylo3OL6-xN#2pOb$IDS?cX0(!C+f{4e=4BkGb~&5U=9{XNHIh55jk zG?%N*5I4h#O+@}cmNr@z&$NDdjGsCcQ}gZlb(bia&)#z7Ur8@utJ}&^fjoQRtHl3k z6=hJOw{SsQPUOSR^zkzWNe^_cDoBAS*yhWc&UqW5&bP2G(*9D@iJg15{z&@g1gy7y zP$%`C4Kr2|^?!9s=Jhc(-Nm&w;GMl~bE;OhbgnEWey+eA{)BM|)7 zxxKzdx_NMR?0TlLxurLUdiXLj#)gJjz9^BYLooU$0n5Ta*wWn+dKF=NlZ|jQUaXzx zex#$Y%ExU>`!~{IqX!~N?=Tq;>T2O5Z<=aft(qURkU<7i-6itInyHpDGo`0L;iE4> zfdaq0wa*9XTsYTgQiTS*nCW;aI-_6FT3|dRE$}}r^0YJZik)Y>VUJT&Sl)6PA7X*pH*G?bo|H0t?yU7B0;LJU> zk6z9zRDs}pnyROYJYPo39d5>rutBY_ie*lA0_>f=Vit9W?ZR6sf1h6A6zVJ+Fnke= zr8$O%|0OQCOBih8c`M1}*a~dvEJEE!OndEgZm+I|_ATT+wA~JL)ez+U^S?YJiE=yy z{8pd0;!cXBQA*(Auq+p4GQSc$m$Ws+)rGph_%0O@@96x>>uVK*^$6eD#EI}#Ff^mJ zG_ptNuId@?Xy+OTSy)O7mXN`xup}EjWa_6Q*i8dp;L~m^tw%VIda+xyZm(3b=`Huh zrG{PWwO1aRWM?TXD(ZDwZ0~RpXW*7<%gJ%1BwJ9?{(NxNe}3-Fv7q7lIh5vxv&bH6 zW=1srlS^ICY_NzR@iVqTmtxk|UfJGWYc)yN*ozic^uswgYHCmhR^II6Qqg1n3EstT zkv}+2`ZoW8RdkDxv)sS}%%>bNfz$r#z~!Gcb0!lUEW1msi0ez}dl(E|9$s4_dYda@X(`ctW|5)oU^J9ruk|=y}%83Xvy2RQ#l_cC@z0>K8;~)BHd6H zxpF*<4e|?u5klD7sfgCvYL1uXZ-jZcONFx_ z52Pln=D|H|3_yxJRPU&yBrYbw5-TSZBK&PRSRtYmt7tj)1MP>yn8il}0*&1&T=I;G zh8CqCgO)E%W-Pa)#`#^$p~TrAzO@R(fBR+2x|ZA<)2Ztq?45fye6vJoJaR=xZmscA zUYRc`)xJ;FLFU5}b2G|Xtu~nqQ#&N`1{)ft8E_2secS z;Hs>*1Um`)*Hr7;Iu(qD38x#Map4UiN=}>I>eGkSX}8`4uLX;o3BH&ozZs(J1$X1l zf~_@FIq0$A7wu>)UE-+ zV$pPk3sX`EK~rsGjqIPk5BH9zT%_g7;T`%<8cojp!Ru0&ju)}c?kd8hZB&)VVYa%~ zr|pbXjE+6oget9{#e1@XRf4doP01tfu=iA)6nr-qm$(Xuxg;ZI7|odDWhu6c)vU|- z1d}o4a`%gqt;@we1V_;BXz~#G94zt_Np|1eC0pC@f5=mj%`KWaO64Z^i_yZ}{Y#W9 zezB|&#@g2NZK3@4O4iU==<=xo>)xp*Y-_6)T&Hv<&(RBnLExXW!YF+i*=&gn6s?Mg zj8?n@Y_L}}e!`SB0UXTN`vhu)jk>_X-j7QcueKPH`_+&UVn0Cn5KGCVdlN&Pn&b;C;TR)Fzp%7&s_f%1j_SadMP!nk$8)o0jh6wdz z7wT}gGtt{C?G+_i=*1Ui!}?+fVUV@<}CrMtc=lNOCvDpB}M!^TKA<7xN7&^o^qQiO_T?2$R@x~S73l+7l0 zBjDN;^|Smt-r=_-#b0T|@8jkCMbKE3eqG?!ze~ zPM4pkp|cC4zmZ*n-#`*kiJ!Kx!%!|dNRr+l%Mw2;yqZTA8EiKlF6VoJLzm0n`8kUG zC04=eG;6$a?dwo2m(QNnS2OlnH^sEpUv%h#B5SE%JHRHJ5hizi{Q(FK2H*TWt22~xJa*G4BNKZb-?$Ykn{cuiQ$%(BZajd+mwIZdJW75`5H13dR=DUkJAR-U z3S=+Ro`=w*!5RN?m;=uJU^0(#_4M zZa*A9qB$|o+(ht^Qt|hT*jXhH@v>&xIlyAA-Cn{Rq%vBHqrKtaT^G2Xbl904vZ<2x zqBY+_+CP1EUAZ!E0{7_X#dFih21%PP=ofA)j2G;SoUZ+k}Qy>aegXD zpGT8kv}EiMFG)4f*e!fgjf*ZiOKM8p-G-(yg5lCiz5|8Iqwmv=le92p{HMM8t3w;1 zSK-$KV~e#F7S@fgqvxsr=#2lQ=G)8gj;5`KrjmRm_5XeYX_S@f?x1L}=y_+HxPS`0 zK%rfXdP1}NG3#*D(=QJV1_P}yWl;O&PYknPMA^-cAZR~=r_3p?QGWEY zn-e|a3_(ATebDW_(NAgZ%;WtL=N>U@lalTU>JdQ{Nu*D|@aiGg_iS2v<8yA%ETnt` zO=LWqT4F>MECEX5>zh(z*HBF-ounG0rvjF{OphTmd5*D_ShmukU%N0SyF zL77Dx&>&uF{|?O`CWFSZ5E{#CoS`Ibj>ygkC`Wu+Y-dh+gV9ubVV-+SooGhrW7 zMuB)cP#?gwv5xJ1kJf*)&e8E4xhuqt0-0fY8D`uP5+HsEW+FRzHvP7d(ihw~YWrYa z)%?a@r}vtCdjOeS_yLjqxEr*qo(iGrv}Z$+Mo_Kpws| zcDY}A-$WrgF-C76O)Q!aV46EZd@cI4?co~tj5W76gr^M2DzWWc7WBZI8=fec zio)lPUFsDoWPIoO)_qVpRbFwYa;$u3O`)!%`n6jn8bi2}1O+I=Dv+kZ(PVB#zDWG| zV|g$3OKj`!$2;Q6_57)F3z6_vUb@a6N9xBsgj6_6a*A6Uy8nD^|9mUc0gjSG(g}pl zn`3K{x6c1-+^+(*_VSJn@{ZIeYIw06XjWmo$B+2ZV+L;1u z|4b#^9*K|&gNerI!k^MJHiDKSL5rnyMrww`BR#Z?_MUuO1TMhCGg)`oGdgJ6LD*o7wi&aV--%|}q zI9VnbI~`+%U36B$od2)8WK#nGsvFS$Udh&rLTd)b|LDr2z^SLP?2rPqLRWX~TbEU< z!}LO==U|>asquxkm88qw|?VZva5Fo+tsENS0w4l)#l`exc|um zyBiWYk01?FF68M@S|KI>qmH~Y7;~D-J1c^~Ljn}_hV8EK z;;q)bKPvTCm`U;)`Fl%4{0lPn^&n_xhcIa8v@~dEU>GtugD~aRG|^rX&OO{_hQ#+t zsXxe{Ca+kn}JVN>QbZdWdIoQlQ0s{y}uMx7*h?o#}?-h z6L)>HI}e6IgdXG3u#fL0QnL6iBeKMjq$iToT&{ZF*ARr{WJtR_}0XMjhm38$XiK_@%MrvcI zfbI?58#F$xT@%Kf0MV?ZH6G?|LueWy(HWlaA<#s9Zdu`H=!)cM6z#i>;J4zIj541NaIc;!iFvw1DV;A@8EODSSfGE>m z&fTS#pW&0ikhbaOjDQ6#Yy>NV)0)kf8$om31$0|?_8cL^t*7^Ri|48yC6{-N{rtjW zG0eD!bFBWP7ZGITNW+j#STGK}>eTB(42T{=mAq1jJddHU^$TlX?VrIYHWCBjyQE9s zM}ZAepLCUC9AsVJOpj;xmTz_g=B{q~E+VsnI#7b$CosDCfl{!CVF5Z|-d^+2iY{56|BNNLR?xg~NDE*-z+v*mptu-|hWZTJTt6)q zmO)OAo<$N(k66A%EDqr4;y$-z@eeIZ<~%a&46Mkf9#bg?VA?)K9%r_dBmi$Hhu0`< z_R;n}EFCQRyZU!*T?=PdmFHl0Wke4na6=QUeN-|iwb~XTP~N(fUVARCxgZ&w z`8t=$>&W~%JTS{`fmvv-UGH$O)TPg#9Lpl>?z0Z3&Zo@iw~ zZ5~zV<5`Ry*n}9mGn?DCx~QX?#<<`h0KTx``Y`bPF|_?3;(qwY5wXIe9r54hH7$c!y4 z8Y+KEW_>2LbtB)i^+>i}7#4uIdo*7_N1~i-{&M|g7w^8$*P_*=g?Ps_x!L_Abftc? zv59ulBR7ff%OLS8xwe7I8nj;4YD0873-?k~@$gO(YZBVH6G_r~=&S4Cqet~i5^HAh zaTiSG>t^}>aV}qEw}vt&#>Ii*db_*@Q>o{5ooH{JHriO=tIr(atg{m9T_i=p-N+eQ zPD{d-Mn?!YYkcqU%3c{8x-Q5F0=0ay7PlCw}qE(IlB@axA#@&7db6Ah@enkWBXeuV|^9pr5lv7WrU9wq;F zcvo8UFrIenhrC-r$RXDeV)^@IX=t&Bvz4H)Br6Kno=Vvl*LG}mWKOJycn)i^j{!O! zHQZX$e$9SmNAH>KlO^6|*1h+iF9Xd@xWOK|m%mQJ{0tclPK0*Vb09w`_;=gN-5ie- z?A^WAvfIklfFK7#7^rBmx`aM8bl&pELq>0%cy-qE8)0*QM;qpWGWIvG#D0Gll0N~d zH5cTuH7q!$tMWS;%BH5bFuw5#ySdbnK4Pa>cM+6(vD0e3p_`XaZvF;yAPB&Pnwx|!QZ($!B zuY2;z1(*`LB@=mR)oDQSG*ehjbm7X8?k!nXR3@n*8VFx~FwIo|qYi!Np=8%)I5f2y z_J@qsg0m^%GV6Yij|}sgXU)Y*eqVQn9CD%uQjFJR)Fk-eKR@zeF+eZ=XIxt|^u1AM z8oBOx_aQ`nYrY;Hh`T|o{+7`j&-sF*OSNO9Ux3^iso=KmCUN!g3qIBn*xC_s?L=rh z`Xs?x!)vY9(8cjIj73Y$+Q8NDa=@dPaxt@RY4R~Gx$mTXYh{|;CqRYlXS=D&{v)1v}DEYp}(fs zAI~){F@pTN(E##s1j{e)DOE;j*%eN&CiG$uo|c$eM(%o_fg(1pza2e~thjep1E&f7 zZ^aag(5ngR7K(h?5zeFRkpMoc5vGP7I*Vg)X!}#a4MYHVc_j-m{s_XPcfCBT(P+rb zlHNQ1?3p)G+A^K6_zr54WDt!JV?lhj9N%Kx5?r`_eh2G7;33BXTR8+}w0RH!%Yry6 zwLDkse@C)P?rj>=Cs58Sh+uBZx>mLWEOLz>=2}h5JQgsSHmmk;}|a~ zIpGt06PrkTDItSea@S#xzV33a;HAlyMNe^q1?1tjjU`^Rz7A842z05LL5yM>sQ(4p zSodi??28lrA6(SYHNn_aMFuXvF&IIa%EP&ufR3uXpNRG+_>8~iXS=yrqrK#Ec00EZ zy@R}QE-)2~sw$*KiPFW_O_4jqgw+=O`lqfpqVg4ejFw%4I9|{w(PB%_YrHo|^LkeM zaWuuth^x4-1;$AWqvw&LONXYtjZhVKzD}cdkfryrm}dA$p-30cu6U8Xzzvzw-eju|n_p4HCH79XRzY3f*|DE;(Z^ zQbZFo>j0*q8mlGOC+YP1nh>^;9paYsjtYr7Q|ZHB^jW`brBz2g6y&6^o#$7>hZU|& zg?`=?Q-hPXE^QO5l;0bfjf>WsCtckSqC{HC(pP>D1%0G|)f%GfCzTP@5GwX#SW5*; zoo;`uCj7*{rtAEgDu0qc3sb#Ko=m5tHl!waIqky*2c(36zX&Lyb62h29?j0Pv(RoT zyX^UiZT`$JR^)t%lO%z>y0`0wXXzm>B4Cq<|Dh9kIFFCoF$nkI%(?&i3=g^*61>0X z_ASUD^q7*iK&+YA>;uo60KENyDN^)v^26?@0kWmI#uHETosJ6*?Fro69zWXyZw z_|Xj0!Z^q0t^x<>UxapO-pG@q6KOtNLiY)ZCdl8|7?Ow{OW!^+VwXSC(ZJ_dD)!2q zs9%~&lWZ7fM6X?TH0;%Iwc=4tYDq-uqZFHl$yZ;J{0P{T-ku z5`u;S1Y-aw@2%1AF_zJ47RHkMM)6 z?{$~zgF@I2g&hVtYqX9`*#3x*3Po1jQYIHagAg(Ddv4>0Iqj}=2`VlqKl0qocv~t6 zOE&*7y(<(Z6V;C1O~!|Q1)AJc#;%QpK!UW^mb?W%^rH?!8PD2ZJ2Ly;gS!q-?tR+M zGpZ#&k#54P*jMw#zc>y8YGEF7s5LJp7zd}5;+GM0amECZ+c!MkcD~#cD8&fkB)7;~ z?ude{2hi<7E9tmh4g8?F=I^`Ht!78#mIee4HurWggCHu^L%~Gga=W+}M3uyj;+c-N zl$460zbEmn>xu89SPLdTq>J!L^bl>BC^yBraB0qs<#ESzqy$?-{ z`vlV%PccWLg@i=jh&1HKaI9NAlM^kjhFV@lpD^zA&F_(ME?So1xZ7A+I_u9;8G7NU z$oTvehH(L62d3+ViaISq=+q~;oNtQc5fkx)sT$^&E-ft4mwbHK$2K2I1QG3KSm+R@ ze#Z?ieZSJV$u}sm(xp1GG{BeE{ym7DthUB1KAoiwI3B z8VZW$>anxB{S?iEU-%{f*(MP=<3kg(IVr9FNm@?*!88ac>AYe@&6d=Xz?T~^n zH92o`{RfR~?pRILL?U!KB)e{89BB6wbpy6`ors{(CI(K?fGWKGVg^y1i1@iA$aW~x z+ZO0^2P8=Cb-A-f=^SKgh2{Q=+wG6HlLbmzL=W-U#aiM+k940KcX9H;pFD#D@ZK(v z01qd?h5Zc;II6uWTNWVTSv8I{zxi3?NCvXpRh2(61~+(Og=tRp)V$b!{zV*f{F-VK zvj(H@M0d>guM8JOjgg>O_FaU=d&&53i6rj4IZqb+V`fx@`Jv1ZZkpmLvvse-tC`~) zZ@V!cI5|4g#c2N$YoZytg`FP@(b*{UGR!UI@-5{f$B_2ZoJFnXj_*kp40nekl@o6D zG`lf$#gnWORXD2O?8A5qar^?AdR`1OzqNb-O-=pTsx7yR??wS#Rl!L#QwC?Onjiu$ zpiui&@H>>JaOvINX&Yf-W)$b@kG(^?gVV{HHN9b^b<SWV_4R7g1fv}@{ck7L?-Nwlzr{(5qUa|P zho+m{XbH;fg;sMcWv;M2RWoQn&ht>6;M+V>~OtStIM8|C7hz3)nfv7{OUp@qVW5H!cZ)ESZxF(I^LHwC zm4Sa@c9kM&@j=z`!%6@2ZqesB7$w|bO6Vl`09Eatjcx#tIA092(+vc*!l`TbXQb1a z{h4$ii+vZYYAel!2tLnGBm*8>ND&ahJxVYZ`zG&!mLGft)a;lMuh=7bPdF%I0dQX- zPwbzAzF__?42tyeRnZ{=gb@VHs47W~!2#ng{CwTN0dNY0Y*nte_QZq#J|WosLWh4D zMhv6T0;a*8?D!#0>UG1ltoR7nM>-9hqkTuZCW_L;#x7;>K*MT}*pI`BmVQ^=+p^F0 z`Qi<4K`y-quM@SYgJ~WWzJ>Mcc3qKNz|VJT>=}i!Bcc5{AnQg99{gl16rQq?nEqbe zWTZs?@b7*NOI|xTvvVx2$_@2yObhsldz|A}T~a?LeRIq0{R}Uph42BVk2FpSG=b^N zVvU;yo};PH6q)K^1iP#GZ3J79-L#q>Ee zuaE>StGNI9r$)_;>!vpQ@ zB|(&X^6LIBKQuDG;ks)PA(jijP-tW0`aQz2XM)6f6`$H_+hwBZKNzL<5n2tC z4s&U+c+g<*2CRv&uL3X_s^W%k+`k-=7wMtTg`EGzBYI{5iO0hvJxC;~qQ41g`5n+2do72}*m02MqW7BTUm}+$36r-li)V{wCGsyp!{wRU50N{x!&b3M>_<2f7Y} z68$h;t!!BkrEzsr{A`l5Y<<6Nw^SzIs6LyUWHOi5bo1#$$z8vR(F0D!-$}>`2a;G- z2+tKj_U}+lBR4{@5X^R);fTP!#AZ`d-sZqnJA7P;U#1zO#=f^*cSUpjvs{k~TY#|G z_1&>tjwoShz1WXpj$$YaGj&rHnf)LR6chY!qg+Zqga@NLG*e;NqC51H}7v&pfdwIEMgO*1TFQBhc zsK6Rp_&baxWX-D9v4)EB+6eZG2a4Y#euNCxTqvtWf};8#!7f#N**q&q3p; z1#l9*FyCiGDjjHPFboIE=+%fgVgWE~xUHBmJh;gzIF}B-E<(EDQDaX$Hg9|8h?F2a zQmW|cJjUWwP!~L}Bw`o;`PVcr%=8oS_ByCNpbLsf`q`m5UmPA#Y4VMgEIiWV*3v3| z&xbm6!AI*gqk}i$kFmcUpvJRHO>`)Rv3*loP)P)5xp0%DjTyma#+36Jxn^H;emYk) z{Drwg*H`TYt;fn#v9$tIV?>&FT3k%y3MvDNd>vh_CUx2F&KDVHQQC-mt^KPA#cIl4YgE zv~3rXy`^wT(GADGt(pfjanr0Bx5m#kF??V}3)Wi-OahH3ZIqnISxp*98id zVVzki*aEV4qsnz7_NV4l;HlbXAbZzjD=OID!5pSZj*oSy>D zaS2NLO#@M_5PI-XSc&hJa5d*p91 z;;oRu4b?&IY~V?tV6lYh_Q!1Bl-bqs4j${1Afnh%x>PxiNNl)#ohJ^+=E86KHQ)Tb z7y@{^*ZIau9K;KSXYT;-FNU543gt4X7Q;NTaapknNt6Dtuam?~M%-jyQS-xXdvTM} z(ZG&>xoX%*kxs6yO^ro}cupb;t@@#LTS-cfwpzUVMXA9A7U!FuI*7_~^B#^9M$!aAi9zjF{Y zer>fOV67yc%|`?(*ukX05ly8NVoM5){!dIg1IB7#IYu@X{cq;iB|kw@NP>J%sOkI= z|B42@ix7b1hzc~oPYVfWX~N#Vv0~5?{4n`b3fd!P!f4wT&;5Ee4f zmzdFK5Vho7>= z6Co^~#M-A?2DL)pbl`fZi+jr%VANAgI+YX0dEcS3MoPVt`Nd3lr}?*xSq0q5k8r2C zY}543#W2ku75L?r@0{41^o;R)mtOpmzBwj~izk{FZ=cjfT|aD8Kjq5Co9-!6uGre1 zxWJ3X#1BziMYljtQvQ4Je1cA_QU0LW$P1m)iW@fMUpd}^TL=a;bX)f4}wP4nyL@PlPNmf zpDhcQ%?3QwPPs!jy?`x84CtK&^k3*1R#Kg@f0e!CluA`k5D=QX+S@~|q^n_EpP1W$ z?vXp{um%%IzyZB_XnEOSmBmui&A&89iuByk7VwUaeh*VkfWc%08F2n--3M@S1CXYn z6pJ`e@Je2_C==2*I}w9FffDdN?+Ql`4ipbxUKT9|b2UOZT}_F(dz?Z2K8WIvX2T<9 zuzA0t!_xyCADrbZ7Pi~dUUNo{X}QY8lx-B^ zxURai*aa{);u>*bjU9uqw9&yn`}G`E0mMURkcj=~DO1Hq3=eui1Kxvz8NFcHY>IeK zT9PvY?iFe76*_J`OM}|z7Bk#w6P{ut&Z3P9IdWL=hk2+)k?>~5WKy0rP_w?EXy5rB7a zx0anS2GL-rjGj+%At91x!~j~>uYN@Pl-gZy(Xkk51MJh5Pe9KGDLq4qFmlmG(#Rg- zf9Vb$Y$^~+S04(@K^1?}H&O-CsXCze@W#a@EnM{}C1WDmGm~@ftno3ew<{izY z#Y7YG7qZI9Ai5lA@VadADzjy!mU#*OtmB$)La=ipCDq*d@g^_C!e3V(OxL+E{x}w! zlwKH$;Y~*My7=>8H7&pvRFVKb`&?LBok*`MoMmhHDBCYqOYVV^zeH1)UsHA|GvA=k zG8d>W<+n{k)^r(>i!Nt@QI*!O;IAL%S?F6>33uwg4Fd&Lg6Naia0Y)4x3ZRd#D_EV z0Vpqr2LmMY&=%#uX?!PE$f&5XF=oiiBp8hI_l>Z9!vbzG{_HGgx_)b+0c9ud71f9j zSoS6m5IlKhMUm3Q$k&{qVgO#b{7?$-C-i)AfC}!az+-cG$P+PP3_npocHBKf zb+g%Q1l)KAVO&?-X&R(dr@3&p!_TJ}n@x8fOS-ub8~&!a2*(pr)u#ARkB4p(p-be` z$i8i1Uh+xYxou%l;>rH}-Y$rt7J|(tZ%iYOXHxmJcADxVo&!sMn8%<7mbPeOMYU{^ z|L`zJu0EpueWHt&Wx=N(GP$flqfd)b2=9>Ti~*TyJ=nP$H~Qm}kMpCJWf`%{JDXJd zg%TqYq4cO85orAHQq-!a`gu}86G1q@i?8CrJwVl~1SDyO4;ovWZGC|OGu@&Ue*`8d zVZgy$W>@zg$a%@eWCOdvg0bWiRU$zMK&4+Hn3V26gla7ST+W>RPk9JN0kPGQfL!E2 zdLZx^EIncs37QS-gj|3xU5=WciBK2bHJ@pcXE&zpvwl)@VyMTk_mXEf?CK(A&)d4S z3q>Z{VRWWTUJmRb^DHaBic;|Iv&zC5IM?~ZMbOC;q3P?fu8wx{a8D{$h6wu2aUsWf zAmtDxfy754z)yzNPHDOF**LUBuK062LOBZhX9A{j>Nmkwyhb->yOIz5gCFJ<8XgG? zB*tWlzl9@Eqh_$_mho8h8GVguJN7rA2WnI^x||SzWpwBRN7Zj&D=|yoi3$`25P*pI zxd<*;7fp8`mYGJH3pUK8Vt<~hphN!4eiCN-fH2JT`px}Az|bQBKq>kkR+q73Yqn0- zkeX#BUElwFI0>SH<|By;w1R8#>z}1{jrN*@Eh(glB43j-V zUz;0{W~tJ5J*dG^MS(H*W`aZrrN;#jBB_yi4#?(pKdM?o-?Boy$zz(OiW_R}L&@pG zp3154+IN@{WBx?%P^pgGO?fQ(O*^9WGz5>8GRydkrQ@k_n<~D{6Qj5;SV-5)IKToy zZ-cEYKmi#r$bu-IDC5VzlW7YFoVf!|*6?d;XnEktI}BXvTDLqn7=VJ|?lckFIza35;0uhXU!l`1rIq4(J$;g6rSo?Dy9YvhNG~=*x4qSWzVy2d~ z5XHaI@}CsM9n6G_c5p6J8L-7<7jB&h@};(Ed@} z)rO^Pg{wD$CZE<$42;C9S!n{d&C?lrSgGpKtwLNJCT@5XS+}T~KrY);RfM<`aD-15 zdw4joyBmdf`j49O>mY#vZW)YtFB^h*8mfu&9k8Vdtcw^!FVi+6^fH;i0_{ib7ifEqsW(bg-KJt z?7CA^c=Qal$F>f!Bbgd@rKeRq{hh9e!N za_=%--gCf-5_qugJyRc{1=hu!gQl$GoI(Gqr+|9UL4Q`EqpwHHM{OI#CTL*bU_+3V z7xr89(jz1KzRX(>7rv*(;bCUnR(hnkU#d2ZUqSeHsuxw7-s@(@8D@S%MV^QLZ*?@u zGXT!CAMTrW7s4E2zsZ|F6RTome}^x3#h*{&_u7=yPG{UXD>X2ij_c9ueu<`YZ}P00 zJ{UKAuVLjUliPDVhnE`_@*R!BD9(XCplbH$0aC@u?Ra`?PSa(9j_w2DAC51`ie7oW z!L(u$gaH)c<(x^VxN63ki3Gub`0*b$FsYF!z=y|D6~k*`Nql*h3FA+Y92Y4?Gb8r7 zpWw>a9KMnlmWHs$`<4MfT5JQTDEbLXOjep=`Te_yBn5(VNkEr6pypRr7vShzU>u6S zyFp+dt_xC5p(|%8Yr{_Kr5w`Fu)ZqUPpV#qNB){phr4;y^{yAwnMYi1)OlGgIQC8X zk~80FbXd^r80$PoZP!Iz-##AK{c`lX$-2M(MD@i34-dZK8@kPG#*UpXF9}MDnin(5 zWLj#?U?3vB9bw5$HdS6U*xwGnq}W(|O$;%eJk=!X5o_V+8+?C7P;bNeX3c3gQ=_O)E{q zw8wahED{>HEwXKKx)qfY1I2~-XEqIHOXbMa}*TZ!* zK=)ZZSZpIIGw*#=VFy!iK)y;X~J}ADgbpg)7eDq2A%8>v#(qT zq_Jj8mm{1I(2i+3mICYTF$?P8KSLDe+7(7n5{YDF$nEdnCY%;C2o;^bWXN%FF1LK| z(IpgFP{W0Uk|=$lKqAbo5If8`Y&O5uC*D}N~SBPgW z?|g`@g=Qq__QNLwrrye5TEM~fgfP5)$F5%c z(oSX&#U81wq8!5ye0df|;{cF+{}m%rdOPhvb`+fpKs{yuxV+)0lIFYSvh8CF;&UDK zJ&=)q4{vCS{+RB@Kd_%lL4#+}gR9H^UcyCNrF+|AS2?gy;bu_I)c-GG@{P17iW zMHY5o%x-`I-*k8TOC00_3TB`uNv9OemAFmZPoAowg%hJlitVc->`z|pwMZz7HQ{1R zFO0V+iG8r!t}SBR$Pe(PyW3ESh0v3%eldS|v_6{Y_d7FDL~?@O_iU+nxEVr(bY6aRfJ)!w- zvQnJ>NAmN@`t%l&z6QHUp{B>-LPS_Vv$L-espuD&V+AM5!g!RwR8EKN992bnvxZ5S zz?a0--rVIf@{5IaT4A(%UvHZK@L(%dnx6GExMUy7e+`7x4)dx9(}ww0M)tOmhp`q^O7L~V&7u_Q&NNg zs$f{?&%1QedX_m&w;7yzUrxO5$hDT8Db3vqmC3l7wYb%AX^v%?-q{p}3G0G8SHO>H zI1a)o;kDy9(;1mt(>s(u-wFRg1$L(AJW7AUfDr;Dd5%a)!n+Cyr&$a_pBd+F)Q)hU za77Ks6W8VHlJoS!e-?Gp0&Aw6$pP@&8O(PMHi|5~(9%+A^XnfLIngY#y0xHq0!-kt^9{iLPlAWy_a01!hWzpy zj;4VUEsPe!J>k*NwEYd5STwjS{FFU6%FolREH-Y@Z_YeASo!KP@pA9W0j!U)f@fEA zG}Z5K8=959nj0?brJG%RmHH`YsR|ZvF*|$Cvvfa@DdGtyJ}eHHAI`9reAldtdlo_j z{(LG%(`Ng?x=&zXaa_AAO(D9P6bE&09FbDQi<-_LnPC;I0CPowLV)VU<6oA}1R6xn zBkYR7VhwZ7FHU3xXA{zrvI4BWTvfGan0cqr!v~$jOBpD_4?OmU-E(;`k(S`_>e}Fc z#rQyF!gEle!%S`2=2c{+YZeRP8H`}aCXZ2*^#4fAOWqY$tEdU6;!m8PK8LB*8Gj+2 zfl=U?Hdkjo&zD9GM0<*qEu^fUP!`8(97OK~KXiTUx!=u5$}*Zk09L%Z>_uc3?<4IJ z=8ZP26da9<-(PPWj;-5i^DGxGaz~@AK6Iz)Mqf-Fm>(Zl2=lR^Br183LZ+doU|TX_;8sTE+HT+pb^Q}rPQ}_;hv!=v-$`7LT|9KB)=*JU^}HJmQ(tq@bilTHDQldjs+gTPV?3QqLE@Dw=mK#gR3r z_t&34&E15+$Ye$emHrJg(g(7Za()+$Ca#NDgjg8+#;Bqfy8*hdCd0Lg-?{`q)j<@o z!#|{pAtgjj3xyFc$T0KmK`2+77|`i zwOjbd01?WG!BhOF7AD>^$A4?-)r&Wq;4UGqggCR?aP)wdI1IZT&5HeLU9iA{|EZe< zzu@)GaJVih&nTK z89@JzuxKe%g`&l@fD?nF%ulWz*BHrlIitsxm+eZBsN4oFz`E0!AKVD2%w2|f!U4YI zj;YhGxIo!(b??#lQ5|0n%tPF9Q?9J}^lny`99Z$@DS8aR|MBL3e=Vrz>%_(oYgzxB z7h`hheJdPPl8X-?#7$*}Ns6u=H=D_@ylV%E8y>AFcJ`OjNqj{6Obavs2+%biUW;_* z<1-F)C7%n29OR0(#ES?2R3JEKDrjjEu)J@deyl-q-ve4YMx^9lYm+a zg(DrAiRA2{T?*-)4LhTPD|5Q96 zw3uOxrGr~@=zkyY{fXc26RBC(Zb9XR^L(lQRhOaZar*6DwTsW{v`@Q5bJaXDu-34$ z%{?M7|6bc2AOdon5dm^Ssg(A&Tq-buBm!XSdW4@oLQ#DACPQ@Fv{p?PQY$O;AkLxjqbS)%R;Zo7^h`!$-5LQk_C6hn*e+xNfd%=ovYysQ zGqOicQu{9D!4mWI3~q21tVIH)w>F}qZH#@Pe{V%%!vBZsMzCRL_X z$NJqw-nm2h2EsEdJNkLqk?s9^n>q&9VT1oWI zWO;ezgZ&z7UZ=H&-mef|py0x~3j&94>gsJO0VArPA1A_iqh??O_3vC;s5aXQ%G$KO z-VFRlHA6@sWPB$Ozc0T#f&+}R`Ep@_Zux&a0LKk!^O}My9B_3iu%bc9!G_X*nA3j} zJGGm;pX_ZdBd7c&Ai(c?1@ce9nK4vvzd`tpdKwg5ZRzb?{26ci?+E7FLngNn)t9^oqJW%Z`F!-0cpLOQNcEloT0zc>E~SjdM3jzcz&NsdzVq%O*-3Zz>p z-ivI}KbSYDK48ogsc`Vjsx6e}F73{jF@}xdu~RW|<8+P&aB#=0uRpl0CqEz;F1A+S z>--92^;L@LhfUpafzY{ef8KO1or&Ls1N7kF?K!;D5iZ!~OjeT>N7y-fozkWyH_+-T zvOn;^><9oLmjCjHoeOmQF*13*@uO{^EB86JF(we{+K2;TbF z>9{#p4PA!#A_ZU-NvX;UhlH5V2=S97ewx`@7WjV{`^vB?+os)nExLOVQZBk%y1To( z1nCfIS#-B3CEX=0NG%!#DM>|ALP1(Ua^KIp_qX@+{@edq$8p_UbIqJ{&N(w?8mq74 z9~53QFsLI24~B%6Ct;!fdxiJkzt$p9WY!ZvWb;qG`#+B(1Oqtq5qU3WIvw^neA55a zjq6Iwo(PiTV@8^S0@}o;@eJNjC-jTAY)VS6DMzp=jTOXOcq>LUgqdmp zox2A^4twM8edaHZP1jF1{_h>W^xg#4!On^H%ipRr_i~%ZGG1_W4eg;S#dwnr7MxLg zwVe5P-yMd@(qRG1^I0<`P+)&V1t_|B0xCR^XSx4%P#TDH-_^w(%Hx;sJuU@4s8MuV z!V4?A-{JVFNEsa6niAWa;9keL9{-pS!8Of}OI@tA{~JzC-KP_AYk{&a?vlBtpQ^Z&PM`?_(Y;k)ZgLw?FdVr@cRCM2a)Ekse?8-5y>p z<-R+{ak*P1{Pl}GmZf6<_$#^URe(Iz>(F2ldH31jRlKlqj0Zo^SL0IVg zapnAF6mQ$6f8VBDr}A8T5CCnQQ(YgB`yly;xnKsKz2C3f}^^NAxFx#+Zr2jMOyCKd^9L>meu@aQ5#FybDA8m+{?80C7+KE_()u zbFj3vo4-411v?aw#1<5rz1Cb47~*m#Pw4sVYj$okHCkfa2^nK-LpMtN{cJ zj1VWEN=)j+^Aqz!1UR#vFM2As)D@|wPlGxL3qmAho#(%v)M*b{V=kLEAme{8IY>N{ zX?pCE{U8*wfz~pz9Fea|#w?cGu|tHcrCp_L7=5=hrHg&f_9?Ddam0Kp0hrV?%k6XB}J{ z>?U21{Nvn5Pz9dL)@A+5>uoYf824}>K$KjMW8>xH8HzTA*q`4ryd^#mM)W6*!#-VC`Z_rR)12n> z^@t0{m-RRiF2K;`J<5N%-9Nhk;I~rxy6gOFz-vGSm|jE!NQ@cne)m)7r*gzLX&_7< z%W=MMP1o7cz1i(%YT89JVP_ue7-dl|mS%$UuiZffwhnq`Kv&Ri!Ao{BQPuU4fTc0C7Edqo;(12h2RZ#j7 zGDw`#!@6@whZvf8>h@zU%PCIZcO2~t=%N~W~v$Bz$$h)CcxU2U! z22x2p$;tgQ)Cm-w9Yz+|dy5jZUkDw)v~st-9s6M-A!!-8+{Lpw8l^@`o;$<2>Q^w1VPc= z#f-O~LMrp7MmbW3D~xS_&HazM46^>^!z{A@A6Y^2=vwxvwRVcBMB{_&S;d-g$cupo z+_$0I1-8B(D*|rZ2A@x6Ep9Ix|JKAzj!Mcu-C8Xcm~r|cCn4m`wBRNkU81hoXhh+q z{<8z~`OVPAhw*<{48nuH(J{pJ%*|Qb_uY%LBlWf1b~iRQ7-i! z8;L@7F|#8U<@JScj^4yi$7Wttz?_V7{G$cSkOJM$NGObsFmc!8pW(4a^1ofhzA zU!xTRgDW9&@*85^7ZAka*LKw3{9r8T|(TZ2(I2qO& z(7XE;N)I>_*L7@@@!v_F3NEL6={FV4*hMtWAy_RbcMc|y$7o^_PmwLsmf$kMCU}*eo379Aq*M9vHp(j zznr-`a5YbEOaL@q2Y(GF|J}i~bkgEHEYt#R(o>MDp|w8jiqcK=yV^ZBS%|7KHfaS5 zuY^NX&i z915s@pl4VQVpc|kx9(gcUJD< zV9(<44%a_-3TpO277kzMdomFsC6SG3Mb*lOWxd*ec|i@5dqo`L$4g@WW@M|_3-7w= zQl2T19kY>t_?R0&&}3o&*D+~T(g?GKfUr3Hsj0+K3|HdDO9v_T1jW~cOFrhnx>h&@ z#6tfsEMlVqI^-c(?-_}N9U;OFGlsCL-uq@<1=|8z3 zP)J$u9u0V(o`wy$cmnfFRZemE+8T+&je&euA!~|z863qtP3u&KsH_G#MM^AU`^01Q z5h(v{FUC-rt}d7B0&`0M$z>{=NiRE_mmbmtRVT0*sA9qj2+G9|l`d7Z_`_<$6uwcD zu4@cTH%aJd;+FZI+63Uz=21s$FEZIb{0wn$Fe;wZ;EFH|gMKY>{!KJ}*mGtDfw2D9 z7m@;?guvwQ+wsgoE8k3*m8x71eNpQW!gCS^4^bCW;*3*%u)({Isrnf9OYZO&@zo>n zSf`kKbX3WU(y4 zcmj5k2$?=837+K*Xosb0=mw)s^Zohbf_a_?K@elhw+4hHpz}>_DCQ{3xtXfQD zj0zDZooN$#{Jsfi#~gtC2Q|_Hu!#?zLv@TEXa^W15;D()p)&iymklj%BuyWFr^aui zuwpl;61&aA92^ZFZ|cBCxD!Xew5&)%4Qkigfprf8Q1_!N|3p&j_d+n39mw;{$yJfOBy< z+8eo}&lyoliIg!J?9|DeNRU?xaE!+fl`l0Zr32TR-rT2AbT_lo3bdDRcscMTk-@1H zKAe$z%NJV!eg<5KzvL|!wRF(wirbQO0e&TXm`nOzxpyu{NaKr8W6g}uN?&$%EKRW}vwA4aj z7omerED!E`2dDwXv)pMgd>yp-gB3sI|F9r3Nx<_u zVlP=B`uj3%H-e*t^7SW|+ak81+a5}aPCnyj$m8=IoQD+5VceMOM2If+|9ZFCz`9_ zyV_4c`|}iKmdDU;DhJ-(Cq+h}IbXE)j|7efh?74u0=%SG+jVtf+xu<3CrppSdASPm zi6Unb?He~`(DjdLU27nWn-nho9{bNz0S+vKqfrC9(sKDrpyj%Fv+G(T^fO zHeKyL$CENGO!Az9t=qkZXfgc05jUjp7NwZA>Ch2c8on#GUKc?y z{K_Fwp{`#4xE=gQkWSYFN7!lK$BXY=4ey9OnnoQggvJ|RnRy*Qr;T7B=5>So!7RGe zxVhKm2A%rsD(ycFp4@-%=Zl@3p+QY$11d?kaQwofsezwM?Af){9n6c(aZyyT7w(1~ zh~Z3NEEDYbEV!MSqF;lqZ}}78gIK!wff$fUT?T>splw=OnqEwDEYHSg#}hXq1A%Yz zRF~ZDzCFYnL0ur3g&rzj0w%iHbakp8D1h)0D`4WK&i@{Y$YromOe`u=;(5&6OKnXv zF(S@Ea-tJJdd-(;^Wn^Y-xvziqQ=<+grrnc?a~o)4156|xKb8*QCy?gX;~coPkq*N z6?Tyc<{3%mCE`xSlBiWZC?9Ul2L9YgMS@p#^&KR>`i^g(0n?L0N6cJG33&LCaaXVS z-9+-Eh2JnW^S*r7DALYz$T$2G3hYh3nIEYAbBqey$(7FVFk;_D@T?Ect1kI*zJVay z#L>k8ug%vW*uBB?-Nq1zbM4TTq@gp-(=#7l! zf!H9ghNtw2*Y5^*y*Snn3sxYY?w;Iz6t5QLMQPI29C&^?B7}l5rnTkL_mqHDoPzf& zIVZBk-t|N%*DuwQ_8(D45*U4f$w$+YC3sfT8i4c=1)_y2uU19TNjRYj&y12BtW&N4@LIGi#*e?n=<$RQc z+|bi|`pm(OO2v5y7}i2Pu1*C&QC7(9V}L^B<;mH@Ixu}lB0dd~d9fZdkJY6c&fSLl zDAi(MsXTsc{x@6qStUpNG}MW*Et|(1zfj$zGoni*B&jB# z9+>c#hj1dD=vRmLbzXPBe31}Dsx%g$cmL$M5y=ty7>`mf24IHijtf*_(~Fi;qW46y)mqoGFO^T(O<#U-K7SBQkPHiR2K6M#gKP3z z$3V_zlm#-@mE`zOwR%UkX$o`GZ?u+R0MU+Np;y@zHX60+w!7(tNQ2ebl54{ ztt2NpL7J>i9IR($bpQ2@M5{F2?>PYx7(qzIU}+Zf8R>d8 zt#v{n!9vS3xvMo0$ zKOx~MGG5=uS&9^m=ncom*a#c<4QQoI>A;xyjL+Ev7yWbcU=jZ4?Y`pL%|SkDl37Mv zTAadxSZ;JlzRO%5ss%Y0=sSn|eh2?BLVlMve)-KQ<4<&u)k{qK{4szBjdBXAMW$1xaR;pwrcH^bNRWVUM`?GB_Ylio_h?5BQ) z9EfKnA5Fs6y&Tx|W^3sUD0DrWJKTbfyy}BF2%nfoK|t_@ySGL56Pfsn({N*p^RZqtV3Mka+3n z1nfXBrT=yFES*#^f!~D-?lun}@`2bz1JwhYdf$Afmpi@2@A7481m$ONs`x%R^P10a zns{3>?pwDxo@ma5=arBMD?%Y4z}xOVdIDf>1B7wF@p%*zkA#HF{q0Tcl-9N?;w5iC z%CTJe^>l4YVA-RRq(>zY%&PrlX1H9$RG*;@*@_lTX^a)Mzn>3lyvv-iN!RgApSCGJ z;wzQa@iMLHH>~OOzbkkGtgC(9mjZOw)c2$Fwo%5MGaM~Q94+`r2tU%KE~@`7+&}k= zh^vMEq1Ty~!|B`miGl=FTD#~$-~qL@`tA)-T+a-Kg#}GK93J{563``wZ;?N&RkCn~ zZfxk{{L@T0gfHl4Byi+Xv{n7an8!l+W08`9{Evd@E|Pc}#kJa1!*AYiT@Jqq{?fe# zfNq{iTHx4W>qhU_U;EwHZ}Tpg;-9o%tvwHitU)_&cK<_>p#Tg!$Cxty+J`c|I&J$U z{%7raFC$m{7v8gd?9vCOtFiPJuYZqTyG}+6TlgKSPhYGYQzN>9to~_~l|n(-wsaDJ zzdr6m1%)_&*?_BP5n$!}**}$?FbcrRx^exU$amHN$o9>=2s?b%BK+ek3Dpzp`RTtM zPGfE>;?J3{lPuyYnHz?3e^=@}uf|-!M)6>4z$w1`uH~;y-5~wE|HLA|!auz}Mx;P7 z$}#hOQ~&RS8*t@>yU^lKmnN5o4=IlRmUk&e`Xvpp9qyEE0-luL?Wi8XEcdbVZRGu) zH&UxK)9>Dq{evXgfTV{_#edLL)14tm0E7Qhr?kX>YIWckldIwK+QfaHwe&T`>(a-8 zbe@k_G|f>%PX4sGf<0mXPsj#-8wQv$e3vEw_2Va%P$YdX+VoxK*LUNWb=;jacVl*o zTvPWSuJ78P-26NbdI}7M0CR;~p)8?^LG$B2V6&p=ji3z z&FVH!t}fTb;|f1(^XqbIG~+KN4Hq+^q*%^$kmHxq2mY*cBC3)ef7%Mx)UCgdNFDYi z=LXB}f&&51^OY~x z8=o6CV0u$CQAD6smvP0wVMWj3wvJWfeH|l*hw1N*@+C_gGOk;At|O6VLIg8Ei!Ru= zG{x~`rTOd9<-N4x$b&v(Md9+4;nILIPFTx)%+ov?;iajHHI^+WQ=guZgnc74E+a}V zBOMDKuW0(`k@R%v_doYXT5Sqj20>_M%zv>MYIiIhT4*yHnXRtTTQ+yunHHv zraag+fS=isu_x3#Hm0;?uT@ec>glEa`K%mNNg)nPXjPZd%XV{gjNmde>Q%yBgBuRv zE>70Vc1&y?ilc*W-ZWL!?E@xoxbQbrOBb>dl5wIe9jLpSXadCgIaP@ukz>XBuK67g1>HXAsK;NP zbwu&?O7Qz__Ri|@CuvG7uO8k{c4lzpz5c-@FL!9_%0q0<{h{~rU~PH3@5p3qnnA$B zl*-%GQ`X%OB|+UKy`WZJ>m?1lpi;J9od&Py_q8T4ug}DL^NX{JTYz4=k2a^%Z|w6s zW%p#Kep0SvH9&Ur%*Sh*I0tiMeiqyS6ET!7b`FOaLVucbjpo+eZ$k>yzP z+vr1#MmB3Xc5WhOi22yF#vL#G1-g&@BMgB{fz6nslg9LqJJEBAeau*L?~E)wcuVSZ za2)N}E(*Ajx$>PR!K|rNe`#y+cWwWqOSnmyB09i=G;EPxpqBU~o{CyRA0dR{+j#2* zfv05IY{%QV#j%fU;E=@`@9U&h#un%17r1w5?LY`sZJ^vg7(JUe?2^&i%9R`(=HTq@ z*xyP7<0N#VqJz(xY_w@%M^mGpN)?yLEzuowVUFd0IxL)!TrHjMsOygxw^^3Ag3h1S z%ahPVy?RrtXkdY5MEAMBhGE&nj}d1-<%i9e8HMGhy`lBMJh;LQ+I90KSJ|UIOILrQwmO1Nf9zg%}lg4;$7>KQBg;<_Cn5) zYy07)K(olQ=QJ+kc!Ck~Ul^%D4sbUe1@O4L0C<@hJ8COmfg3{aydLlmY*SK1A|CB1 zh1k0&DQR&T(M|NP7^+gx!BW%vy(wr)hO*O8ldz1owi+EY;x&}VQbMRxYL#9zL0~<2 z6=Ect8RJdYI!}5n3Q*q_1>my4s8emh-@%9zH;VbP35inYM^6d!%#tH#n7}IfBVQvX zdlMZA2|0uHDfNNIK=!0O^3-SP)oBf%hhN)o$7w&4DIZbMCl%&$OQ*(q6ISafr}`2_ zOVPE_&6B(0oyM>dlvr^PZKZgjueB|=J0KW+BDh>&seIPsRXmYT458GjTZ`xuJ zQOiuyVD8S!T{GCOA5G}4*1z85W1LZUUyUW7YbSQ!j&*hF_J?fJ|29a;QDL~0=$123{cQepPHk{+~~l`^=|J_ zfc;x4??t;|Kk%g_YwDE$By1Hzp_??eOIt(3Jx%SOE<#Ph)wK^OqAKtay3!+)GJBPP zc7yG$SFY&ShUOW%OBC2hx=T{4V{MqIj)%U| zXkuI6RMff@w?+Pms9lJ}no~7Grg$hg1GSq&b;!n)IA$z!gImAfk~nb+#$+>-f*V3p zD=S})CA{ZV{37KTWSw45qUa4db;U(=iycTBCgpJG&v;%0b{~>N%0kpa=yl~-^#|l> zQ;SbUG?G+eo~v`eD4Z#xx5kLnO7+xy;;^$|^YNZKK)H$+c|^T>B8_wOm(Qe^g+x@; zuVZOig#m4CE>AbZIu@l;osS8Qb#yhd{-^VYXVu7TD4L4K{LIM^DUjcW-9d_^gQLlW zzs*A*t1oN@D`zwk(|y4J{Udy~y_U`9er(5F{MmX@iXM7O&qRY`Ox2P6WYM&vu}Ek8 zC%thR(OrU&5L0Lcr{>@<`C(R8-lB?uq|7F&C^z-dX&a{Nn;{zoXLzqg4*v3j8|T+I zv5Gf7O{ZS8lQryVS>}VxJGHZKCT zk+EpiIFYpEvQ|CkaaV8&cT7nMI`s#gaAf`RIjN)qajgFk)-kT;NL0CL_J=3rEyCOO zBOf$0tSTZL^oiT^$D+mRGhmzF8S4Wso{V<6*Zm1fe|T{l7Tg#L4%2S&ho@1YU0*Yk zZqL~~e3YB8D2OqBI%}$!9S!odlTc_hTmprbZg^MGMw_Mj9uaI^JrBdTfnmy z(CZ1ke#`U(v@RT?JQKXoaw32CvV8;!LK+UFJ<;=^=6(N?A2??q0tlX6WWoW7@NP|1 zWHM3lWgI=OTRiaUiyY63v#WS^pOufB{$2gkt9LM&Kru9*9`nEbNR8oSlrzT!Qgo%-z-T`I*>6P_5!#2je}kPDu11bK}_C0Of{}+Izk$A3uIj1gEGM#B^>ZFv;RV)GR<($f-5*t(VX14LhHd1YYl> zv&Mrs^t`?XXte?P=RgH;87n{ z7f{8f$ManP3zgbz?aGEW_mdJD2^vvOY1nt6#JoW-`6K)tHdHLoKGnE&q!}d^xi3>l zN@MZ-t(gvfA+dTK-(NOHdLX5rvI0eM`;$EV`cczE9s0|Cfs=3vEJ-KEqFoIk^l^Q{ zZb<^CEV8Ov-f8`^v%BNDBlXDw0MPoK=MEGB2}~F#r+YfjFR`O=7|ItuREi&+5qB*! z^d|kNNSuCnL|!~q%}pyH{rjUvVA~n8DQwGPU!WO1C94ycmX4hsm`+ARm=mA?#xDFF z*grT?d56YE8TTaNOZY%#@yA+(W^HB9`VWJ_Nhklw(snY+4PgDUtDkUmD&aD%FB5HX z;%SIIFT>+{s#$kaiWXk1BUO^);RFrpq-rI**R)uacuS;);odl3oUejRcts7J;Cz;` zKAI>gL$Bao!RQhZh5;Nh@usdVjcjU>*@83)fTE(TG z>GRrnaE2^wZ`!ot*R+Z`tDTEb=;JR>QYTsEN0Enc+x!R-D$C<<+<(r-@B6FiM1fMu zDj#1dJx=ysErd2b#Sla7#IHL=iK*t3#$vrbOXLwUtE zzZ3$e6ELpa`V9zang{Uc*)A7D%Sb7_Ey^PU^qG|=^|#3An1Vhh4UV_i@iB8^rQhHX zzO7R9D@PMW3*wYCL8OwiY-#F3gC^qS-%*|fSl7gas55Jgypl0qKqi1<%Hvp6gt&st z_*cx(KrVj0gd!6k%y&uniUd5vJOBdW$p&CLg^Ym0UTmN=LXHjx7+MzK@8IL_;P*ME z5EbJuW0px+Wr*Y*3r?p2YHYqxc~z!=pHoqXxt6i#<-<7%CfRr4KwlU@AA0)~r&q{? z6&P!Gv^^M5z84|$%b?tz;h*O$j)<)yG^K0m)w5D*ohqDe?}A2at-Cf-hWU-nfqyI(ke`s z1gAWTe?>TE_joxYx~1B0$+wu;cfrxdq>Ad@U-pyD1CeeC7W{&Km$)ZS?M8p7W(L!R!Gxv%SD8jO4juP6DyzL)6U^D-)M1AGw%g`$%I186qZg)#E zO^fn}8c+!Epq=^e*ni%DD;$nTPJMmO%g?k*K5RdmL0Tta64xCew#SYqLS!CORBuX% z&a^o!da}+ze5~7n{l%zi4J7oOK-L*PJ2ub6|9Pzu zW+B*t3dn+SPJGLNoO}?RFwIP% ztQBaqF~)zPKn9o0G&mE6bG6WlYa83tkN|b!NxfL1F?g<4^c0ulM3D`g{=j|wZqme^iWzI(N{bf)dGV^U(YdY+Tf#)gI|bI%^T>5 z4m;o)*d6CT`MQD{bY0lQNp_?CM%LPWQ0R?riSLK^8s|%VKvBa@y3A-FVEoK&>%|W=K?GI4tsXK^F>oX*r6jAr>6NW7C|Z&`Qv@p3rlv##&a6^SLWBThRlJjAZ*M zFb1v`m@${;)#Mze?_0`Pdv;!LQ*?@GD$l<|wx4F7=Wbbhmr)dQt4AwWQPHu!q9Cq{ z80}`nB~TyAZba2EFNiqqLBm|tMd;doq~O#9rIIeV=0zjlHc_zw0i#OW@p$Mf*uuBr zSNY6rK1KK9Xh7_N9|u6#=>{h(e^=Fpf|NafR4=2=6IAoC46L&sOMWf~3UmPq2Mk1m zGz6el@<>U6vWa1r?}4is37Dg7hGR%rr)m{4+i5T3tU|iNnNoC4Q-A9NV4sFJfM|tO zv;Z<%+n(3VHb@Jmn7FMC?&MMWCgP)U0}4qVO2{K0FOd(}Xwgc73&I0MZR^k7(B#@1 zH=KxrUK*DSH4+Mq@Mw$-F+FQ_MTUjK?mpy8FkHNyr}r{PSK`qr?z6@nGWYf7?u30k z4O;Q!*8y1BpUM0Pm+0mJTT~rS)-jkj6SH!%``*QgeY*GEqEE}DeJ}tG1{crlQG*#K zK-lxZeCy1t77kkx%G`TJ_MY?ew6Q5sp+%x2M&ij#326t%D+)dy$f|k5&8G&X-V8etI9#!PenP2hOAhBS#e z#W)?{@rKGhabjTarH(Bbuc9D;AfyB~k4+WCo=~$X20i66yuVp>CKKIp z!jqbrOA}0P9Zh^13F#CW`+cpT-2(;`T_Tj3MoxAE&4K~wL^`^gEpenFA4JgPqBCH2 zT9$d?)%z{$wE1!UdSn$1D#KqH&{!wll@bwUpl^bB3?De~ReLbH==npN+)8CzH~pBQ zjUrtAqV$24G6+BG-VWGf&X#J5y&=ErfFqp<0joeLD3JW(j}9osr2J4Kj+^n1BBcu< zP9l4hQp(v!ocvV`8}O&&H~CSFVpK3~f7eRaA^rA_5wICN^}Md04r?GrK^c1{g&*oP zx>1in4WTYbPz=US&jwdLB;&2+<=M{Vc(XS|C;>6()zhBbME9yC_}U*t={ABBh??GG zx~9H@b9dr14L_xh3@K7B!K7g_-({*FKcHdqD4`A`H6vriRzkSSn@2 z7?jtGJ}KlLVNstw{zT0bl|ZVIFrl<`4|Pl79=S#7%x-#uGDxNxu%*sa!Kpg>t2BBk zpak`s_8Z$@ryAWNlC&h`PBvdQ^gxnoJ$G2m32tCa(YTd_zC~WC!vzM$O`$9i!YZX6%}C=ibV|RuovprDVDzm z3&#@05B?2uYwxXMXw8URr zZQy2iPdUzo(DQXN@?SE?pflT~6%w}?J+;3}=g&8MR{bJW%L)%0+eO#dQ6X|6skA98 z&F%B>UL#}oPZEsb*A_#}KXptiM#*Z)Iu)jOEJUBa`>62H$+ym7aOL35KJbEk-Pw(d z^xGMqNyP|#JoaI~YMT4hU^F9FjbKp7I~K!x1?9DA%{(ICFKKfcxSM8QI+`IIWHKtJ`f?sj$ycWedu6*1G!(Zuk{l23lzypE#OQJewp zu_khe$<(CzJ?SnnhmM(5^4^@9TN3-=k1^_QDM>6kt}&VQ6bS`d_Wm7xvg~GwM?9LT zqh-UCOCcSoKPlU;`t9W1+lYSQ(tyNdB(F;RB~ugOr>*s_Cnz^lhVWAxJ|!NNDCH{b ztv6-JFjxGALhiv^6h#UtY07su>?dFIQM1_Wl_vQZDO< zS!MGbDW(@y)^#h*X5nXAbl|lSprTS+%yPnqqkmi=h&H(6G~i^;M>a<(#6wiz!!+_) zU$&W#ME8V@^^0JUuBXyltyKF@dSmaMY@Ca*Bkzdmt=^}`MyMon z$87ScNK%H4Wm|>l7{r4nfcOv9Do zFBB4Pq>|~`049)VN=_afPtU1UY$>J{jcyYmtsPFv3fz;9oYQcixACPNxO`)yZ$QS( zGc}SZu*vsW0*~VYwrL?JbQkz5iONmXFv8UJ3!e%pioYqR6qYfAn=&_A=60+auLLJn zgpCk0r>64WDwNvT(EiJ!;}t7E3d-&Lp11(S^DmK#n!;Fv26Y05hbn6L|7Zb53vjlx zJ2=sf^pjEH8x~QolEiLp9RA>%y(KcPJ=>SCcT?D|JPebzRF4LLZ$X-^tPKU% z%S#p$mW|{*DX&T&p#i&3kQWy^z*Paux#XA6_9JD7wEChz09Z;74li1xfC3r$$|#6Z z5`^EqM-qhuHlX*MhJ8@IH1fFfxq#7;NbFvR+aCL`X#=N{--e72VecK;&4WK|1MB_- zz(vlnum%AJB9+0nk-vs`Upq_w1KXoQF0~TTohBS&K2LvI@ZL+hS5V!_y!WVB+nojk zRFZ{54X*4|@nJ{Y!@UAz9cfjH&-H{h_1jq489&^kQ+Mk?P8K9^anuJBeGRS{`4h!H z87iwaZ9A|jmuMv(Ut9FrDs?Q9 z2?UE&R&R+CQ^_mfZpsiNTE+-zLxb(csk(sNPsgT($-_5^jc0D6utN?cImaxoph5Iv z2+#Du81i@L(hD{DQg|)?8>9duf zP@Ny8iGMR8xn8Z8oM}om2Np17KXEIlB1|s#)<~I!Geb26#BhATI)3%DCaWPXoSdL% z3OyB6yQN>6+{T|JU7DvJ4*u9X=!XJFEGUR`m^SNmIA|5$G)3+bJt987^P?5XBY_6J z2G)DD2cq7kU==LF0NMrgF|h}&r0hw+1|owlOhEY|m<_3sGSrIXGHLqlnx8tQ^ioT7 z!VG1ew(nW)UzsXk^m^OIw2 zxjK8Vrm*7u$ZM`P`)-p%Oaj+$^a_Iz^Z!b>c1HF)8(|*&Y~)=Xm3i^~XgRUtMG zDp1(bCnY;Q(dXrO9WHKiw!O4By$uLw`6m?7#E}XL*dnxp^2E>jH}cy=kJk(^3;jR? zc?Ktaq~CO>@c1IsGAViVl>YmxgyIAWF%}zsQNtt7p%@V7`Pbk|<@xflOQ4|)H(kll zCN_TW6rnYaCuz!h{&hWysXAbo1$}^!jJaMz{_0-tK+HJ&_)amq^U0$@`MCglEx}%k z*D=Y;f=e&Dsk=(p`H}(TK|qa%$O~_F=7urk#GkS~-mLb+9**SEn`RMq>+Ul*v`J=S zt_ZU_DGQA*j;jPl4XgCXwo#!mjv9Hn3jF?HY+f-58qe$6$GB=rV}~Ks@jR9Gk)@gJ zyuO<3Xp~U>`$wlBT$UeBjEk@hcKS01`9t7R&p(q=MP=SNTA^HD-+2o=;Tn}%63bow z>za>K?fGT*OU%(Pu13R0I=S_-AsSRh9#Zjar0mxj`hNNt&zakKzKqp3v){WF=I*K<$#Gh%0dnsl9 zTi-~|+0U`5S!9KPo?q+27pDDl8p)+P9l}Rk>mUe50}S4Q8yl$}oxJVEimw*JT**jI zg)z?*OMfwTWMD5w&k0m2d-?<{XZmPZXN4C(W)Fw~iKGOKX@`L%xz$?ek~D|Fd!K71}Ov8}S}hY*0!sxjji zn25F_G=}}vu^ua*J=)JU9&la<_M9t~S58u&kh$$bZkjUvx&xE z9+Sk_C6-#alMP(L!TZXt30vLY$!@Azjykm-`N4iTyOj}(_EaPQjoC)S1kTK@Ik?Ng z&-;|1>RZXD^&Un%o~h)1@!5cY&-xpgap1)lBzSLp zG{ESOd=5h$frmKJ+L7#goyrMa6tEATXXOM0YDrw*jM^7j#1p89TYJHyWL?a*WJqss zg`e7ddxpnWoI4ftZoo0B~f&Zv9fzQ>QSpqswL06D~ zr%P4U;-agkml`$4e&s$^R3ER<@zLL%*>2vQ2OIy>BwyW8UGy!lNT*kM%>L4SWtgz%TfNjMgblGZ=X*KngPTj3&|8XPy8ECG zk=YCGtsOmQ`<~5X?f;1PuXJJi+UCN$R`i#&ho}9O#k6;$=+Tl-(2mFQhD0^#BRIBV zr5G3k&bH_^Fij$-vtpZ$oT1ILYQ-Eg8+l?RS!zt3itrCUwKS-W^wSrzfrOX^QlB48 z0VE&ZaS9Faa$5K?Ln%!C@`vq0f}n;;T2v8NXPkDmyk93-%rCGUEo}3*AFg4U6Qhe0 zx20ajCzf%kbO;48_{ErC_B<$D1=g zM@972H!SVhGQ|<(x_3C*LkDDRCSe_fpUSAjw(dXltGQ~&?adjspppN1@&h(Evo{#= zT{OE@5Uo_skWgjoB-|vvpIAsLt%m*;IL4riYW&h+{pv4q&73mn&Cb!-aM^G?1raGh zI47-Dze^IX`pDAp^CUd&NaHH(e-wzrP4IlJ*~e<8$-i|SuU;ttJ45RSWr|dWFtEwcG1xX}vjN$nT$hJ1 zwGqyviNRi9si>jfs-Zvxp|7B`h~5e8tU)knBh^tZ&VuN3hE(Y}^@9VFomXyHlw0{pXmw9#_G}G;#|bugW|=b!H2mbcs#u7+Cg$?_lHj$cA_1!tiJQ7L zvYl3z-4l&P2_)__x%N`tO|<%RQR(V zg&x^V-P@z=`k%e}@qvHyn>IRPG(4QbQi5qu)FR=%6#nouTjFt62nwu00)e8unO0zi z>Rt_7`}MiQ<0%?voD~pAF{U|{fKK!Wnb@j*vq2QT7M^*l59VOd_fx*S!W$LUM2mP& zoYl`o3U#7;DutGOS}}EJwplqq5UnhirYU$?kY*LzL(bmxOM!2pfEC%4EjLt+Q>?)` zwA=x86EFB*G+kv>oK3UbUEJMWf&_Pm#UX+O0t9z=cNQl&A;DdOyF+jf4#C}>#a-^c z-#PaOfA=uY^i0=OS67D@K3&%AfVpTft+Ab|;Xh&$s_H%645B*H)S&kxXcw5PZ~iF- ziFB~b_65?i3aLPbULLf(IH``~@C~7c=P}&>Yjy zvW{kADG7i7IZAqem^znM=43n{&V8sl=fMZH`dS6YJ)1d{yAUKB%2!;)o%csQu35&J zo1_0P?C1ZmV12wJG9n}2)WOhyG9LtOoshfm^RPIHY6tH=MPVzh9e4Y( zN~lMC4gXm4t`zjdegKm>gl`#(MQhVlk`9*xdFpq)Va8EL#}}Zq9zg<4xx$EavS`av zfxLohOee+J1;5|u^2S3?W#NSbGRLmNzA$r_%lkQ4ER|bA+07EL>ROSpCKqe}nHo zG~(#1(Vg$f8y#@z1}aGx9x!3&=Yual0ypG|a^Ltgb0vlcY-V>#LqkvG^8vDAOF_c5LLA^~wzm~i!|mzEMb&ZDWHQr1+}CH8U)r2@grGZf z>@;H9M}d}WDAhIAY}6J)Hun)9BnWFwgpqV_GWbRP3I@$nkx_i+>afC^`XuBzLtCA2 zF27_cx(tJVg+cf+Ope%wEVqP{uDu$_+@ig+n=GlO68U$FTOI!^wL}~0A&GW@*(?oT z8<1J3?FQlYGzIf1iFJ&c=@bW6=@B+=*R z-9k(iGcxHdIx)BIWt)z)uG>hOl`?_|jx3?lpQ&{$b$Wi6)LS3ZT$ zEWP8~E%&ZYw21eEMoVd|6xg4|5gAZh{t ze*siA$p92kH)tifMu+ zyrPtFK8E4eh?-2WQ1=Ot>)v9?4m$7523d09)^O<@#AkfGfmK0Mtn3E+wec$Bv%C`# zn#KrMICai5r{o%r#~RF2ToD&sZ!Akoq+RUb(yVV>jSC9@0$dtU7%E8QG7%6nLn9GV z-Q;vj8TshsbnUBiO4j5o7SikGQp#?sHD+h39HvPwK4+3>q7w>NCbugu1ieRsuf}1J z&-(T0o@c7WFNTld$oH6K6jlS5G%ySLW+CO0nJVnZy_WnBdxcZ`Tsjyb*_xH}Yie#4 zZ?B43;5QpdwF(m0f2QSXu4T>IY|7cIZ2|U{<7=ek=oySsyU>Q9^33fU4lX(i3l8PY z&KOC`O}|q!>GJSKt4u?_*LLbR?H0f=fAsr2Yo1aTQyqU-#@Aiikk`_PlYH~}zI!1e z{o0}TZ~Gc=-FOB>CVw0zwQTb!=d0-;tCk59-Q6@B^KK%NT-erp zL2lMs2BbH}VqRL8(#+?e2#gY0Ig!BRco+ad)YqlolBcp$Y}K-72A8c2x?KFzK6&)Y zQCCxo3-v6BwX#ner*(*h|2TbTP z@{b%oaIKucgB=>VJ0o25tY+-&$13UjBa;Z>%*d5%;}jN~3%%e3VXQpyx%YMt!~n-v zt#tdq+k(~i=DmxFRo%ThG346Y^cIT0VS17xhDT`Jt=g>}OQ0a#OY#db4!sjG4g(FN zv->0EgV0^MOwDMR&n@(ZE|XgEdY?k=U}(S-N5C%mP#1-JGa6l}#er+PBlLMW;z{Nv zS|K})?cdoKn~HdMeC^eS6vugE)3=7SL#WH3J51q{>^R|#b5}mr486~ch)4Z})cA#N z9m-x3T&>qfvHWhOhHvK1b;7!^6YF8sA#qdl^H{TOJxqp3s1uvKl^B8khej!A;tcHdwOW{9|^RxDZ(Z5m4^7^ z0pU<89jU>SPTp+Wx{Z#po>Ir9A)m&{rI@zg3@dzk1<=jP81y6V4f%As{ZHWU&w4k_ z7FN|ng*ZqudE!J=w1T~2@)EOCP3zf9Q28b*)wdm6Qx1C0N4sE>ut;yyqU6o{5?59& zKiq6Y+a5!x$*PBn) zs`M4-&wy*&7$-vjbV(! zZ|WJs)}@B`i_5>XwFQS)oQ@X0)0s%0ma7>nv-eryJSEJz@NP4ZV4Hbd#>U1c!CDdO z6jy;dSW?rH$)~*qC#QMW$7$Lbv`+DNqkSjituZwe=(aMw;=G}0+v3In61P5l+n8J~ zJpKi8d+>t(jBS&srw#VrIT}Ik)x7*$WWgjYLJbQprT7Mw3c;M5K*{BZxd4(2vn$BLSSrO)YgmKtj5-5jrY~3>Et804y^Twrt^lC^o;*vhyvd=x8Y4 z4df5bM(Fy0>OdZb|E|A!9_Ks$;pB$5mlD#A=-p3L3^*xv*JuizwK?pAe+B`l<#yMq zT9M&cE2TQ6GZAJ6J=M)A)ft}*Ma+HXgDib;&ZgX?gCO19IV!qJR%at=s*#M<8 z^r^U#u|NVmBwfctlz%zj&)(~(6~`o%-L4On@7nk&K$lw zsy-Y}%K9;^m|2m+FrE$Q7JGtD=Ea+Pcs5Ze)yDMF(Kr|cSUc-Dnr)tRKN8&z1X zoJMw#23K?J@;l7>d_@K-Xb`P3In4i@UWFh=DEJBaHtxA)!1lIgSmM2=@9x4^R;qNC?PkMbdrjz+_D;XIB zG)mjes@|Ee2Q152>x|aKE#KL1-6Q;<@`}E%WuYr|!;8Sx6$9~mkRAzC)EVBgywRoH z-tGTsf7`WsVzYm-W_hlH2YE-wyPlmgZ+Z|tP8|NdcYu!GDZA}{Jkq_NhKg|4rn7?< z^@swaArLWIus!+K{mbTiLzG19qU|sf3JIH7viQO;Z8ZX9!kk}RH$F}#D2JgkpRa{H z+)Modj?88E9L`ux?x=Tbn00+^M`%*aC33ALZPaT zQq6b*Vxx0b^oMp6t_^wZCa}`BEtY#3a@4G%R(B z7VwlX@bQj1$8C7+qWd?Q_R~aWCYh%Em70x(_6(Q%zB2WkeZ?J#PKNi0@c@<_9;+~2 zCtrE&o`=3dg1dNCd{)^BX@DQ%C(|EuEJVsg1v`H!3Rn@wtbWWB0c!pVuxW~=zW426H<->S=s(Ea2QxAdTn(diAO9ap!8H@|rzgj1uR>x~cignc!Y8JZTC zn2;K?au)E6)A7cod7E0W_c#zBb2Lh)?-ZA@yscflUB?|7zYo-ZhMTOafrHT1zvcwn zoF=&A_cZLZ=_n1j7u`&Dt6_%QK+!FcFxeg!_#rcE88);T0rKwm1SJM7=Ji`X!5HgD z!zzRl3o#+gcW_fV0X@#v4z^pZ4Cju~m_ucaOyz^G}|`5~u9(>_@Ee8SZ!r ze|3qiOymPkH00&n!yy1=>h?Eqa|r@~l9k++i^c{EADi2j9x{aPffK=HxFQ<;>Wol; zc4xFs^KLp3bxK7)$^oYClcV`>)F9@PD({?iMQKp%$~%GiXQD#T60kcn+Y-yw=sCK| zZ>6hP-tVpP7M^cd-ZfU#Q2B9{^5QDs_ReeN$+u@e+cM76LHXHBcl<5eI=e89!CefG z5J0{?_3d!|*c^?Gw1T-x@`JOuJ5^+$=capfY6m>r0770_{HPAj46;@Fq2Db?d{F$c zpvU$Wn;|S6?7MD6Kd=0yjRIk7nIZ*Z!yeta7IQIjNPoV*JS$CqdPqaM8ej^}o*%py z<-iU}RFi0WMITvSelkFe#duqW7&*_2Q~r1r3#rXr6@ACkhWu_s7^R<44`EA`l5VQ) zyin82_rZ=*0$WsE$G1l*#XDu8PZ|HOI2+;x61zzf5mjS`(=O$xb^#{KrUg! zPXBKrf}@Qy50w%x$KB-F-Hq@O!2{?1^9i^5v%f%KJ%`h)7{bi!cFTTO=<{1Ni>N5< zzC~Ok##uS;$HDa%P?qRq2X#`|M>G8zB+}7cC6G7|3t8E1L0aAB3cT|IE&64}uUN(* zL2iS?C^<#oo6k{RA~zX+=FK}ItYtS7Cz_?#xSHUz_nGG9Rg;c2$aoH9$-Ae8ucjHe zV_FF-30G{}Q+ecBi=l`eptoRLWVay33I7rYf?rkUUoW7iiqHhVY^?dZ`-aNi;OTma zQ;%1dE_)ppbWRtgenFzaM&+q$z+}jA{Z(N};lOs%VssQA#x($sB2)6Nwxsqm@ud~9 zJ~@LFQ6Puzz5fAq{FYa4UcZ9QO}=(*HZnl!(2pp0$6r489`?6mkCc0_Bro@GbUUha z^&V*8VeU)YismPN%+u5KhSs~+x}^M^F|$AC5CrhP5t_Wrk_VC)(%4SxVg@p z{7Q_y5{h$rHkw>2f{}2f`!H=zY0&cl8Lj_K6fhYJY;1&J661cD^eP5%#HNPdiAQyL zX5V0QEXCa{Pi(F%y6#w57Ap+gVGyqHiaiJJz)CGA4rDzR{WqNwqHpeU!gx&YMxc zep#WFWRwI);ZVcA_qJD_WB<^kpCvV-FL786j|PqBu;htExr}`)B4I_K5~-<6r3^xa zU*T<)WkB%^lf??(##!K?@T-BHgJ-qhHBvhX3|OUFk)8;ZhlyTt%6&HY4r@WmOK1G< zikL%3SBrI;@MT{)qoX$>&%oyCMwxrRJ$a!$R%&>5KXmIirj+XARS-l>G_W(kgTvr1 zIqcz%5c&5DlH!Xqdz?<3!P?rJlzPr%%GaCydYs=jT08*jlR+nCu|2Vt$IxSlah8lHyx;#svzgfTQKwXKA zXc%-lD8{uaB|kuAnJk}~`LE!ZEpE7VI^M53 z@9cPzg}r$W*p4o?kg2NHvRt0qkbON`FW_pud=s(;6&x;z4=E^TC;^o2a4-{UBnafa z&hQCCI197z4$DRlV+9xYH3<&#YhNgge+3>l$( zm;i)vT>k_d#+z-*F-&zr* z#SMbi=z=ys^gN(DJo z?{eiHY?U~^cQto;tzdBHX53$&wzdms=LCpO(<pl{0rSqYt(B zoq8CL_SCb0MLSX8`hq=Z%0}$|$N0Yo7n%SVn2vHq8_jwNctr6PX+PRr?j+iNvhoOg z+ZzAWWu@6soHnSCrdR9^7?xFp*1-j3WVTAvOacMUj4q^NC-A8CyYWHbGVmm3EIB%=7@uA>cIoWGZBC`EAU%0_R;n6 zg9;ez(I=5;bZvH6YOwCR@Q6v}QyaGrjGSMz$rUIO1#+YJ<`DhJ!=`4Ejn4j@YPDX# z$7ZR_eAjL@reL4{(Q>}C`R)pK?CJy5yV)Zm0=ai z&|k>Bx_sJ>CF96;P6X45XpTD}X^l5yD665W1{Hl>aYQ-uoCv}Ro0ieU6sJMr<&j6q zO^vFMxql^SbS?7<32P@zKmGS)qi&H;fq?L(o@EjOKO zY@CL*&k|2DSEo-~oCd$cIlHRR=$3W|k_%f~M=C0P9|$PvI_FY}E6Ei~wj;``aJFT`;R$SvN6@wLsgLOr-U0cX|Y^x)a$ zaU;1QrDkRAAkD$ByeK5auS-SQjWyZ(&&x;o@evl(x+#XuoRSAank$Dx3LQ`;bW6vZ z^RMm~DebxG;S-u1-jAKj6CeLcbJ{HhIEuZjc#|G;$jBVT1Yo~F7R9`gU&62PBN*H_ zKkj>&n<5EwP16g=<-rcfn5dk0qWm;m^t1ml1dV^^22$>rPBItEnFP>=}e z-tYKCO!*b#S4E?Mc)U==@$6&{YI_$NI0*lyu>Rct+NC=Sp^Da6p>|of+v)ZnLSEr_ z1D^UosMrbn?Ed~QeXYk?@4`(Snk?TB!7Cb{*rK}sbEUISC526=3NFmcQhFZ~H{3Js z=Y*{9kB=v#vmx#!H2ePWNcN{H1x=KezsQ?!JCw@ZsElZNA~1H&ComlyF#o zBRx-8`4w+P1-l$q?_U!#S6}i)F8WCYK611a165_-XSj6bRk z`?-91E!ftcctK+FAw6R}$P^LQRALo%wC1)AoqCJc*@%E)Jxw|H{KU5U#WB4f>s|_7 z7nPvS$usHw=lnZ`Y~V}SM-f*_ktc@?v;6O z)%_oNgR&3ce?r9JuUDNq}B$X~ne;n*MhzZEKXII<@I9rakSR_FJibyJT zZ~!YJdMltd6(={ggFkK<)_%E6*K?*;(+zrucxG6+I>yo8n`SMGfzP-Y)ad|<{Rc;Y zXEob-Q-aNIbQ|J|*m;W222Sl-=Rfk&pB}?kHjP_JQ_&->h{U|Yri?_J{|?p5*PIc> zjeKCwJ?%d?Q&O;uDuqR28fRpaaH965M6A@}tqAoo0@{MCAklfC14Hr9KB8S$C!*}L zEq3iGn8CaTR$!baM_dcX9mNAd9KNy3d;gV3y*LX0%Iv$&1gUQSUW@C~cNrpi;e#iT z@gN9=Xdrz$KFZ~N?Qx|q3C-#gJw=y0g6Q9ik&F|XJYx4v>MRQQ1>`{TN=j~+WHleJ zNiLuP-zB)o1yCe|wFK^lm~Bz`KQcy5F=JIR(;F zB_Oz3Y~E%yN3MIcfJknggAU ziCqFE>4s-v`lBa{exc$)nqs~_w~lvSuPuRn7cL)Q>k2OShXJHV5Usb6q&HA1}7TqPukHXwQR7^7QCfU0_T+ib|1c4P9K&;@7wKbNPg6@ zApluv3J%GFvN~KgPEy+umD5xXhxVK1uO0at!`ENEo~}N~-TGGv^!}d7XRRVvL|I($ z;6y~zr0g+0WI%rq1y#kShbvK@Q10|t^gb163{RErFXmXtL`#1~cH66z z)K@?G*ylTc(E8hvkg-yges3Stjp|6Eq0I5@XgsK8O7Gr(76uT^G&`>4DKRz^tNp3n zcKUKfmf(lKXMOrhy9A;LHEv!&;MM{d8Y~;%S^~&$s8y&#(^Z1(rQaP$$N}$^dpTuW zaW>21w(m>Sf9`0`Jb;?WTLJEw5FNrfEo7LtCmU@3LYJBcZpKS0EX^Onx@IqO$JeJ& zKY2enq_A;n&gTnO;ST2ET2)LE{cs}|rNM^@8)Yn%-QhWguj*c&%fZTw)A%*W3o6Lq92VNN}#Er%ILR2F@z3>jsu~hV~A1WTb+RfG$5Z( z1BUphd|yK2ZJ|!IO_W)6>u1a#>+;doIXdcmz%673#%`MMf50?4s9%8#cIQBNXs=0BPH z&KQFIzVV@QM>+1^sUen@-ix97}KSBCy$n^u6Xh}qT#ou=(;Xbj*1IyX0eGyejQwf>N zw*%n9QCOEFF!`9R+05oQTv#zRvK3Y>uNsphq`McgVdapL;WWSTtrdy#YvNTkPP<(m z=(=xR<`k0vz_Y!KC#ZCC!1s{5zG- zUU zW7iYX=&Fp=yaZTdnvLu8RCSQ_R7t-4`zGj1OSyR*YaD6J6Q&de?wsPjzNEzzfy5sA zt!0^;=10W=AW4nl;jS%uo$G6e3)*=@|rJ5{QGyX0|^|KtI=i343yd!j6H*G*|!E zJJ@>L6nG6!78V11{B}m|Ief+_|1Hl9w!s2MpE2-FUo%i}_!mcs^EMK%n=_G~%XUvc@B?*CXz~rOX z+yx#}r@4K>L~(8{Pop5EDs~!OW~`x0H1vz z<=0=YZ?bnyZx!!TeToVN!0M*`vaT)@Ej%UalF@pqAAVRhjee36$csQw$5*Xk(Ne*Y zm6TM)R*hf#NNvZE`%UEo6AkoDXn!p|Rk6E~r7~;c>W?y0AQD5OPse@+^vQ44D1AfB zR(6`1hjx=hP7_da0AD!=f{=Q;5>>JN9V-*^q7wl)lN!1p=DK97o>!F(^v=Fhqt<#w zk0H=+^<+EIH2|)wLvtU13E@O|01I!R(Txv2z&kCw<5=R02LMwY8f*qgv)j@$3<*Y+^VA$$t0zW3( zLcY~Wgek&CSog|{BeqDNh1hGxf_xfL|44^kS$?cR|Fb6h?}#*^o@gen0KY=%N;FsV zN09e4>pht#jUxmP)HcdgJsR{Y*)|VaNq^GLjL}v%4&7E7XKKD6cRn4ad_W&K6pCUp zoo1V4YwF8b9CY)S(|59utZNp;X`@u?%0kePTr(&9SM{06Gujo2SP!tL0T)JF)4g+5 z-`1jFh{T6@1cI3Rm^gETr`w0vyRqCYnCW+8g3f~fc6*`WfZ}?05HHP2;I<~1BmLCCqOBn zvLS$7546C0d{RS+b0Wv)y(O?>PP?tZrqS6gCsb>JTi6Cl8Ap8}I>gMc@$<_?@eYJgOfq4ULkUVImvWcQ2fKXBLKgqh8e~ zy%RasSD5#$!tnCn(Y&DIq~IR-u2ch4tru^D;JINxH^)C&5th;bOIk2lb3=0Dw!a!l z*eV%|;c&P?R~<(OmKmNwNOxArIh5=yNa;mR+E|}Cg>Ye+Ma(HHc?#VK&o#A16H{s(Hq!u&5be=iW zQ2netx-)3_yng^@FiLoajFQhke8<$x!tiPDGy0g(NJw8LVA3!b{SO*}H!m{{e^^bE z|5YA38zVGr!zfxDIu(wJAQM>-{6NjD8H$GZQwnP25$JJ}f4*_Ocs{2?)g5VOV|2Ht zR~_KNMqXMGY%*2x@p^E_$o%A4X98bv2Fq0Agzw&r@U`*muA!{X@Vi*cggiKpQ!we&bt-yyU?dPTpp>Q1H0X~;^ylVn}tt95skF^7dOrpi10So9rW zjLPp{^;0G?5&ef6IV$h@P{3sL&-Y|MG?o$8Gx}I3UKAI^X!|$i4!zEzvk*F56g2Uc zVf+3@AspXL{2SI-NXOhclyv0k_Hq1{pf5^)nEmezYu+<3d{)oNc;h%$aAC;k2LIc2 z#Sjwz&TQtJgg$IOD&-QhBzY3VW5{qUi6-9x+gn!*@iDF$Nz{Zg9EmC&4%*R1&L2-B z-DbUs%!NERD`}!fOxoMv$gR8l=X?;I)EET$9=D!wZ|QP@WmDmcapSYGkmW7dB98}@ zmoi$Y%g5y}UqFYB>L98e^hm%xVssL*w_A&vUXvg+o_uLdmx%j)mJl81-qUUTJA#xk zG{FLrz-pa0oNtC5F8^cG*z`hT*u#Jz zobLNjCRWilo7^WT2|`E6we7?%3MTZ1U$r%gXm*i->-<{=or+n{QL^X{GS(m{Jr1x2 zw81-@1mOIFT!ZdJ&li1*J!0t2G+6>wxW9ATbdaiR(>UTc7`E zU&n!sBzOELmPBkp5=MBkPZ8eH?%%5G|1q>$Fl_vAB3YzE^cW}cJ`5cg~?Af=jIAcxpHO}Pu9zhmY_+}~Y>98#+P420~yFtAd6kH&dD1X1t3 z4;(;2%E{M4-8=cBFv<}cg&2c)vA4Ww{uZp_{}y$=^%2^A`OYTCSq;HgjUWus7`}X6 z84n>Yu@WF`7motrX-}yUz5;a}TrtWmI+RMOw0kkKzTKmF8twTK2dqaq20wDV*2Q@)E2`-Zcj2dW zvVLrLFo>aTT0O% zF|y%1E|h!dl*fXb*1utvNvxxP)hXQon^BOXo(6|iuMsZj^LNED^CzXSZFSy{OC0&# zC9XFutt-~@#{LW0EQ_=*UR4L$Bv*xd?D>J>MpMwToOp63&V6#0bGYK;kCCD*@162G z1!DTMUC$K^AJ%~4Q$_IVj1S%~s`H(FGHP5#3NXK(fzp+ZUXBK!@C%NYjM*O1;zcFf^$ z!2s5AF!T&{~GV$9hZ#OpT}>R08ao@I8U(~O}nskfmSKC@uVf65wq3;6 zqzsOtg)3dnl+2Dz^CHnyqFsS8E&UO?!Zhh4Nz4+AKBgg)hVSHz{F08L0y0 zj6!G7uf?yj*>i)2oUcd+5U$t!cLL`EAML*jaT&D0a+lM9$PSK1I8>Y#UXay+*C?PJ z1tIooXx)-VwR;RUyw03$U5DfHYQZXGN;VNL=A6cvFNaDsP4))^G2}WZfj5;kJeq>t zkNnK@oX^wiR{s3qhnq^B6;TYnI3+6V!e_dqE(957yMJ2x4WJI9!GA}Z0x;~^A4P%4 zJ&OMesv53C^taKUD`z1QC1RK`gwWt>Rs8!uI5^}2;)RZZnr!& zH0itJa92%ymH{Ha1>k)f|Iv2EV|4ZS)yGfA8MaY$6H@Ma!+=J}1Tz}DIP*@H;NVK`}U_x*({HR`JYoP4T+ zihSP8>^kkET$=2zP}b=FK=-OB=83>|mnzR~HmAw2>zC26 z;j?u?;N)QDKuU?iZ?NEdO-Kx#IcS3j8(^2Fv5X5qas}pO!p8%(O=UPxMoJg8f$1F! z0O*7PYMj^$VKH7-SO?u%;Kxc*IA$T!=GaflQ$zLR3dEYn;Ory@iEWqfhL+;MoFc$0 zLmCQgaY1Z)-Ot_(YABx(R7wBZ*U;^!Xyyhhim7nqlj|^B3nydIfv%l473^EA7ge9z zZeb}5kr7(BH7A}fUhZBj9vP+|P?_MsacK2zaPwe>d6C~I^;+Y389Js!0EFjtbavc= zahOkm_}@;J%Zq&!PS?Hw%cMgK{(LzQHe^MfUq_htqzsyF(+?TU@=BIVv)8YqxIHZo zLwpaYe}*I$xB{_V20z4UH^kYkRn!_+b#u@ImMC`e*Dn%}A-$V^DxGzt{8ft}=-3-P zrOy!tQ~MQj^YiJv^#5xCmUu{N?K1#+h|#&s{u)RRYY#XSA{Dx?kKf7JDyk$fk_8HNtYEYbdH613&!wx;Q0#OwKwij|2Q z!h&d8DTwe?)AqumsypCVY*J1x)TvXMFo0HL*a~ctl3^OUsbEKOQdJ!KcdX6mVY-3y zDW>1??qBjI;hQw|nmT6YBYgLsdb-+kwD{```}Jc&=jP&ft|R`q*WVN(pJCY0y{~(F ze{-X0e-qq}GHf%tz%voMdiPEw%Hi_}^WUQ%RSUvcOfQ3}{+wLI(FTCL^Y4nBbycL< zNo38O%mJqBAuBn9N9t6YvR(-!Bk5xbuW92%;6Cbuc}o7B+?fol^KAt1we;UeGlijB zX*pm`N#U!sso2GsgepNqcrG2cMGw#H98X%)Lh!Uvg#N=5(hj|u-H{0-ssojpi?~YMWtXIuh&nxrtk6!Bz z(V{I30F|CT!oUGE{PMES8-MJ+lRbD~LHGvC{o~Nrsyd+p6#l8ZND9TW;V!JG9CBW| zH&vb(IE;*~;aSK9^)!+17_TKUf(a640~%i384@+;g^=fE zKSK3=@2_gN8;ym|x-{Y6aS1aJ6=bC!abw$GmW3l@(6y}y`o0k9u<^iam2N;~WI}Y* zqwZwO)*UL7K-51r=E34&$HkVbopreURZE~KiF=T_r~uV7URG#e|DALbi@c<9rTL@? z5t3yXqE&v3ZjG$aOANU3HmF4#4Z=WKVv0DVh=~yATzt)fhpN%H+2yRHo>eF0M>p*B zhTx~W??I++?0?!YKaL16KQrO>ZFa2rI?ukC|7qB3jlD#vDxUU(^p6@3sk{vz zX7Q1xX@=sjgfyNJgWY(dnEV%}?-wR;0gDpfa_Use|>z(p&9x!>`rs z_)hPBbpx*HB9}co?R#WVq%B+@OV#dP}K)A5Kd)HQ_;F7+B>n}Bp!>m3Vw&m8oWyPsSXqbr1;f+j3|H%FQLcFH3(ETJNoYR3s)~SNCUtL^rAX4;k6Gc6cT3f? zkC6}*$a*>;0^?_-Jzvb3AXkvz(8Tu^WtPtn%F2rH(y_M9s0se=6M>{Iu^IjFA5O}W z**MyfR2R+kJMafSX$%&PLz5AoFKjaRh@M{ZA+j7VKHptWc+;xin8J73MKA3dBQHhV zi=GvvVvk}bFs_xxf3-30vhW)}o4q`vBW@!l=IkRC?6V{n2>WTmo`#rcx1*a0^^t=g zD8gUX(;PPhok(5kb-?SZGaUiAqEg;zH-H~|IXMb4B~vh|PiTV7M<0dKdZaX0bZmK- zNVU)r#JF(D{zRiuvAT_iWQmYCqN-rM^io6UxVE4=URZtujiAyX1|Ck18zyl@&=TB= z)^m(vNP&-`!)T5DNWNaH$}=h8BBk}8KF{Vl=wNz# zoUp{Tjy1KZoq(@|rjb^zWmQX^8vP)ym?$dyCP1!X92K=|Vs=~nu)CJ!K{R$w4#w@60!LYd-RX<v~-WXrFD|I=gpvt>J_-=97DRJTzU9o{H!DrJ@r36$0op zuTt|OIWY;twFx5j)C|DcBJ%nAjCbuYe7yZ5jmOX`r}2)f=lO+z(QD9z;pyKo6$4c` z1I<|}X(sf+17@&m=yEJZY-wW{R_0-7)NH^3pQTrQRg~mu$Pn?0iEq~2M3vsVgv3Hl zKV^z?)b6#+*=qNGLQjwG4=JL4?C5NM=;Q+H7*-EvuD79zlNLtxn}I?xJ_Z~n1BegB za%``X(-X>-%Sz{hjz5XukUUS;$4%U7zN-ITto!QWoOLAlRtk2WARCzgGD$@FcGebA z!f;@mWDy1-VP<;j>4%RvtI6+#SLXXfR`OZ%o|q|p#J8$Fd@>H6mSlJahKDv4L`$X! zuor=T+1L@L*@=k=wf7$Qa9tuG!wD2{@@xLarOk*@wGZl0lLQKu*agFA<{gUf#Uf(y z@;8ii_4%IfkDM9BSlz>|+7&(82_m}N&6+ybF*SXk0MA+Q;Om=7uEz!e^G^pTKOYIY zo4)d?bovRDYj*(m#-H$ii*jMDG)Z8=t*Yhj^X*O+u3J`%#HhAQz#=G%Sn;l(_!}AU zzx6M~IxDOWM!m+EPrYT$=89Xp!T*CV66Iu8K9XdB{P20L4BZVdj*@__y-HPI-(SPX z=pmc^Oox2E#bc`QLg<}s=^vRH3#%g$MjWw-I`+i{P#M4RPMHsO#X#yeFzoBIFlKW7pXj zfn)V=#Mlt)4NpCc4CMK)VMh$!Fq;khmtri+$XkSZocDdsApg}~Pwh}}!||SjSnZvb zXO;fW;LdylP;IGFLdNf%=|$C2GhByO2W3{kt~65{lz{lakC?sLS(JYNSCHcQ6f2t2 z1k{12ze-jl8>g6n1%Buz6+MF~A+B#x+53^qtAJ8~?na05|C;;Cho-*A{}H1`cjxHt zZg3z{f=Gv;bVxU2h@)FdLP|iTL%JoUK@dp==|)ELy}UoaKjOD1d$0$)=kDyBSDwr5 zBWGmvo?-YiB{C4!ChFnys&etR=PsqBtZeIELsl?o{Q(>z2<_HAp6}fSc`|(!@93Hx z&E6NN{@Y|hS$d5YTVz*B(fY$QN%lL-p$%CI-Oz=8<-6485VQ{g=+J6rCVp)kuH-^= zrMLb_^zDGqChsHT!Pb2@YT+H>Cg&Yqq0?EE&CjW4)vmn~7quMtE6M5Ifu6;>FHECB z%%y03oJzhCz{I%2R4R_U4sH2U1?gQ|5DGRif&7|tjd;mafuI`7T*kHvFDS}`?-ihw zQJ+V)pFmnu%^d^8Pk90q8~r~0i@*eBt=q?)z0*B5mbOuzQhvW$(a18sDKU8+v$WPK z+g-4no<`@vAsu27Em;cdEbJsz9t(T`j5Oi&vMH?tI=5{WQ+P4g#Zqsv$R?|)TzjI% zzYkLUu0hF?r6+nByNVf5)fttxVoivQvRAV*87F6i&h&vuz(9LIl3&1ssD7|Sik$jk=cz`Svy zyvu){TrnSIRdw!OSr5`5Qx zbqS2ODgpq=Q8-&E`@%2JeM(9;7SrGTrS?@N6`*zRWfwHAw#P*l<1vm{9c#$H;)v}u z8uh!WaoeVpp9qxwpl@`gA5Fk8g~Vsy#9F-xWkXvE<}~M*2Zd{n_p*(5V7PZ)bAP#i z!8_x&M1XW0vBsg@jZ$P@pr&SE`;OV=t_z|*xHD#RP;FxDs325z*cCADe8KkpJqlOu zYDNxc@gKVRelDJgmFtPm+?1wT&jp^>_4U75p&Dtc)S_zaCwT^BL-pIlxFltZlERH z{xK4%3Sw(%G4mOnd2ANmWa<5 zL|rc<+>vV7`<cCp= zoKnTnj)2r{;kC5XN_FA?0zg|UbNE;h$L-c}_wy7~cejOzHC&pX?DtQGj`5?Y*ncLJ zAS*ON=UBOR`At0K1qYGR&|EPan%`>R-)hfdVXk?iO1|cSG&WqWV92Bg%gJUG4)Y78 zd?~Ksq@S`l8TgC@w=oA1DZ&6wcC6}kcISJ$!BmCV(Ux8PZ1HSD&lv|4Vz2Q#QnSZ; zOY8-J60PDvQX#)>?T!iiLiOQi@6WS z6VhSOdEtO6nz6ergjD#mb^FVMZY3AQSn-U z&#V^9*L5BZ8+ZU&ff1c(Fsor{h5&k*Vi%W0;Kg?fw0hBA<-^|-3zui<3i9biQnIw0;V)Uc2VC?j0Tl5CR2*Y;c~f0;cNhWYFEwIgfFtCmEl4 zHGN+2UkmCWRIEqQ8BP?S$U?3YBi^{A{DuV{J`Vx{U8#q_e4u&Riq-n<0LGP6m8OvpTOZE_ z5YhJK$wu_gDdNw)va^VG2tT5}H-()^41#xzEtZwM*vHn+bahR6>DyoOXt;?HXA4#( zVz-{rQ}R4MV)q@)rl;3yt)V%;=kM$Rl9L zX_Tg0#?BB|&J{nZ4E8cDT?-O}<;7Tte{MMQ=goS=7)AwuDfm-Fgxo3UV8!1x+K12m z<%^6a>cErqXM&GlB_PhsDg2cSQ?JH)mA9fIW^`ZFSM;}B+v*lM@a78`u@yc$t)5Ue ziAt+E%}6*#Tz>$+bE)}5a!U5i24%lavE-qwIM*q#D`--`82V#;+*&B~y*Kk6d<^69 zeRAIB<0qaP@}xP-;SzfWdx*2BXGwpvzybV%gFf^rodDA{EnL;50tvVOu%mjU6?w78 zTuhbL{c>&@7vnJ_x;tPIblG~X#Y;1Ff71P-H2c=o!^4lAp6w3a(lYpa+ESL84Ahwk zidvU&c=6=@SShD`O5Z?W$_mrlq5|UJ_EtO|NjD@#{+GzPl?!Ud%sUQ^KlvXcN(2Pk z7(`AZh!3F=rFK!h3uVh&-SQ+wE8AfBWcDY5RuNL6cLww+bOGzPKjIdBUaecYe*5PB z>)UT+N)B6F`B>pyR=_tZ`*Z$;LrTYeTapgom;b7p$f$nrcl_=oU~^L=%TdSuP;LGA zJ$U<@l(Ok83AYbJjpyQ<+5UV^P@H2#KZfZp^#t%w=S7!I2e#}Ymct*K%o&Op<70tL z3YY#AZ@%s$RK@M|al6X{*=Qwv{qcd3p5ZEad$MKyHO4OOX;{!vG%q56FVs;b9Q=e} ztNzn#_L1Z>X~WA44OJNY^GYe7#jjiOI$fD`dksdKiJ9da-b}!SC;C>l9xK#rocq;L@ktXH~c5^zOJZe#X{(Pwx7DO2r_wiDiVk`!UlL z37S&u@@PuB3htEW?SyL=*I@fUx26VfnMH+-m;MJOsI^}8{NBa}Gl1hhmNHkZ#Hhcv zclDppJ=C;kM5M=dc65auI+uba)Z3`DK@KxZw<|y1u(Z`-NmTwMgiuw$?O(NH|2fRZ z{R(CbZ!_aiL7^3~$a8{xZ*M1ZmR8y>oJ;m^ez~1G`}B~LfQl=shTf!Mk)?F3)!3Il z<1={$Qy1j;u(qM;-#6;m#Kp^BDs@`eQJDZXb!Pf?EJ_`>BF{h?SRSUi^|_yOy34QbQWmc&f-6E@&pRSdqC|w0mEzaJoTb#WYv6(4_hq2f>Kk#S+&fCc z6U!9ac?`#~g0Gfol5GQuUT+t+3&%YH(-Nx)92seU8hOw;0G!oKT3ZrkqV8BdS`b$o zb7DZrCny5xsGv_lP4tNs=Rsqoa#Jg@!Rmj%ILm&G5|v$m5VM0ET3G_%&iXyjxuqEP zYH5nC8F#3;?=5E2uq4F|nH3zCmyLb+{TlNJpA}KVd*0Rek6rhKO#C&(i87;i6z9G> z*34c(m6%}Ws36H(N7QwN=nblVt81R@G*DvZ&FcFlalQ6(bfb_KlI6f_1Am8pIlY5m zMyzHgxaC~B>gKX?l%GSXQs0uU#if`PtBC)njkL!J>-rN<@b*Jgw9cjr42z?bK7=Lk z-5@-BSh-+)2+~HJlSiT{%MI4!-mS)@8bgesFHOfLv|0hdc5n~B@j{du|IxKKvkG&7 z#$~=NkeO@(T4Md^fAr)Y2HITQ(mV zs(Kh6Mo5iYF1^0{_~3A8&QL3EX5pleDohnrPaMU{J%vl`LWu?~j(PLUG5py=kQx;T z#%D5&_L;e&8q$%4J8zbqvnil4?q{WxaFu#Y+`BZM@GvF*1aS*0^3r77OV4tfh~#us z4*fhpm-T&TtafN8n*R4l!?c^F;Vta0DuBhm2gryy-urlQ1f7vocFfbQDe%Vj)4LAltxri_W#L%(EJnD+_^A<`&pNU!V6h&YG?LAu{TT6%<6Y zGG-H~jxZwIejS9zR?!0{RcJQm5DQ@ORg|Z$tVk@}Gza3bhgc<5^LzpPlnqRh!Zzk- zW=Ut|1l(2qwl80>o-b$bok>rfF4E*)QM?9NOT)P^HGaRYGM$)O3s`1zgj=)O(!Oxo z!lm~B#y?os$EVSH!S@eG@Ip7q0Aw4g1f`sx-@m^gE*Q*bsp-LkNadx?O zI|^;oNUrAkWpw{&$W~m%(Iot`0^!^-!vonKb87lrXaAbZ1Ua}CLrb|}yM#)rOQA~} zRz#&LEDm^)1>ELDFz21Mu1cBtYA0Dh%ivzT-lFq}4daQDOjpfNC@#^(s_T%w=e9aM zKS0H=8PIc}D@l_eH+tpLeKTuNY@fG6xF)$*va=5YL3aHb zYnnl$u#Qo$g3ZKPKv>m|H^2y-u494NbW!Yrgtd6)-b*TuSl!oEPx$C9=W) zh!fL7UKP8D*gDpLFZ1f7@{*6|{d`gknxQ~4fwlS8#ZWK;0Hd4Iv3p-!$x3zqm8A-Q`y@79a-=IDjM%=qOeiaW2X^rWqk(8O z4`vzhTUeAiKl27F9=X0KQoXgG(?|UH@h;xv!QOi^=3m66FgHJ#-z>E?-KDJ6PdoLRmOT&IUi(F&|%w@&Nc0`g3> zM}!DL|I$64oTwKGUtk#6#k>Km^2>KR+8Z`hX4B#&;X6Jljpk}j)R%TFZGT5w&>nQN z#c;oU$8>i8M17Lc0cUp7BFte#VE*hIhkyQ)-5?vZxE2(9)1xdb6G`1S-#bc(^DACT zB(2FW6vIvycJ~9%FqMAY8cgR+eqJdY>AeVqwWw|dg)jcgUr!EBQ$10zO!7O?xSZ$v zB$&;xBc)a8ohxtEAy@Q)kEQ6t4ZX<5$&=1qU?Yl9=2qM#0{*3mQq`^JugwfR0e$%I zMP*HNhb(`gdnJvQa{x5to6WsGBRD&bnc9_;8kfMSmHi2CMG^BSpNY)7A1*Qw&>;>& zz7=2OIxd{IvX!jzSSRuqXD5E0frc5E{?T%htWTdAzb07b{`?m+!<%61J0g1P3M3MG&?lM?_Zak|W zO1VwVe2J#1WA!|!u{2-%?C~q)p^fPIsHE-73L5Z^Ke^Ok0Z7<4_jfc5P798A4xi^k zt4LMieSr?mC*udzlT<@x;rP^3!+coG;_guKPZlO};NU;`Z;^~)kiTQMm`0(sgr6jg zx-uxlC-lsSI8`2f1!c);#5}2+Zox_zxWF)tfv0aHY6iAD4PD&rY$We0_%Y#mVM;l- zV%P2UHMT|NT{SxaL2} z%f7)CLUuYLps}yGpt5Z65U2o_f?IE9S#c3FxKzDCP>{^G&A^~v^o;ogBcfk4EXLTv zN;Gj8C0OoQSSP$5kCx%4P(L?0baxlJ**NpSQ6Q-f1c?QP!$CSZM)?gR2c8relPo>Y%3wDxb8j<$hC{e3leRqF} z8&HrMI_+2vSzPDF7jGW~HbwQho*qRXe(!tvnh#v^++QzNpw;Zkh8$VRCwR!4{DA@` zbr}7{r=l%IC(_$^=yrS&MMKn9DMr1HD1CpX?1!wOK}}%S1~xI$Ts-gH=XlbRX}w2X zVolB`fN)+yWW9}aw%*-w1xf}K^j|6?-?j+Rv&DwVn~1Rug^Sq;IVFqxPK&9asE8<> zxIuB!I9HjLJZf>Nc%I``w@eyOP9$ep=FRkR-#>SK!_E{+I6i6)`nsYBaXZ(I2(wZ| z8#|Q5b0OSs5WBhzQ#tHNUt%7%E>u^`nNs`yf!>H#+gQ4XGrK7<9Cgi zu>Kjo=E!UNm*>x>DyfCen7rp6_QbgReK)k)R5rgRXrZ|LxL>5a8O@9SsrH<*HX04xaE>MBqX29vquvrqk@wP%E{Pn}n=qXxIOt=ZV z0I<7r6tWrS6}tY%ULE+&sO+Z^7^y*Od21Q?#BKeLbBX%8#2eIfT3eCN^*_UI`A$4E zk0(?h(~0EQ156+NZsJ=&Ql!fm;%0u`+2eD)T6I*D!tIiu5|yfUIl3+}`c;D6xQ*%8 z8?FLyL$d)dLQ*7?9?#nwb5#!JXaEz|&_sP}b(`tlI&N7#U%R=}|1Mog~hZL$$b_~3_}vgnAl5JOC2vminYq% zIyNXsnxF<)5P7oN?3aI#Hq{{R`@o zpU~Fhlvpb(S5GAO@>Awg2B7no4wH~f)DC_@kEMQ7yvOX#!xhPkH_-jAms8ogXZq-( z?y##clDFW60ma^m_ILR8nPD5Tbfx?S?@!2-ebQWgcMA5rz5tUNC#-r}|%_I~i-9j%g)jNq~(lRpg)%zP>z2bFr zM9gKqkyAg`$aaC9m{E3j4#y$HDGSb=wT!B}c`)ht2UlhugK}Oa$JBpx6mBSfzT_ZV z^hh~8F6ABbxAHD<2qH<*juoHxJt0c&M&^5{EjQn_1HqnYC)xRa*&8 zRpL5Mj)Ek!DRF(-QP@Y;o+3h86&oo-3rJAo;ai5?#@>`~K*;iE>{=zZWjM=S`D)vS z&fp&1n~Oz|w;GRkU+9*G6`3N#(3b|gM-VtAn)XTB36!O^r^_yGU} z56w8c_3p)*{C1p$P@^T)ftOhG&y`std+W{MM(=A{0MA#=kNhT+nRVZ*T<}9)J!(HP zLfl91YZ0vxpBZ-D$_36r@X@m-%@9l=GVr$Y7N+c^%xzrvY+<^p;hg4?;t6d-!|6Q> zI`hdj{Zl$=D3Btp&!=jq8zn@wUAUk^G^N>lr%%lj1lr|uMeu^%uG9FG2`!Y#jce;$5|)k7*`6H zEJo^RijSQizY;j9x{z11(8z3Juho9;?`g=xwwdXpvhMdf-EIIHQtv;6Ub{&dn_vtK zRkQ3=OJ41%l041XH)A*xh zAa-yidI-O-+_d>{t-Ph+KwnIe7LL0e8+zKb+_-R6s2Z}+`A4#i@|7o#Dk4`yQ8DWW zawCvY%gi5nh!NX+n>M;lo0VfGSEdy@$u5t@-DvsgiYny4l^h?d1fv;4;uQq?=XaXg zUb7fuYgGd5K=^p@G>1Sd-z4d&?V~$YIXp2>sd=@8e{8Y_y}^_WDn*;P6Op>$6iKB} zdVah(1B^f!IJpz)lh>a-^jDIP4ttJ0Dp1N!|f|U%yYi>T9G5wLP9Ay;^vD9;=|Qzcqy0p3Y)P zz;aPxqWAf`v5Aw9e}1iW`%Bz_<#5e_N=AUxXs$bF>#tsi1!fXGv}yp^&b7st|Ax#& z>}eg+?=dOz6=%%1Z@%jxgKtZ|@@rVwKe{8dj{g6KbL{ER(u(*ux1llemUGj^EjK1&lzs7*C;30`{~sMK^7YPq$^t7ONRLmMy?Y zXH^eA4pHVtQyuy^aiSegT-QE`b8J`|sBHR4R9~z|Qwt@bp`q%xD~6-XseeZc&P?66 ziEV`HFQ-|qKjL~!f~J6d|6ZmrU3hr%{(hbh?A#+q&)tWTII_dD>KaB zvp8RBUunnj*)B%d;!FaB8%P{$mLe&?rf7AJZ!G z4bUv%r^dZ+x$@;|awTmVkV7+I3}IN#z7}?|Y@pczgeH;}YiIc@F;V#WIt=@?-on&u zZFz8W`U8vn!qgKTjZua9>1L_B5AXgoR3=*4J7 zP6j)(_*U&WnWE~Io+87(Fcsbs1JAfao}cb=a=ir!C3jL?(n$e5OR5_>SK|;_MqY!I zoZ+KldTv>10NDYBN|zymoA{CoK(xX7vpEsIj_o}pSX;7IsAce`(0N~FND6ZDU4(7h zAa$!sXl*s)b<>#!J&!yMGNRO>l?e}#mCk`BMlxX;r59VM(zUWj6h#)LuNPTQPf=Uh zicxv2fMa|39xT{)gT`lBPuf`Z6ECO{FdCkTd)Hc?{$^?@`$`E4YVas%2^lTPrB$N= zZ~s$apeKl2vwp@8SQ2lwKR5RDpq}>_2nxKZZME;QMn!n2ulWxSCbNXA?Z3KoQ0$~c z*x~hc(HD9F)Q_=Z)Bz|)SI^jA!o;}6F6c?t&&qlzayJGOxd{NE)+Iz*hUOO`I#k^bNG6vsaXg2Qk@ z-d??$0(1p)ARz{LD{Dbccx3>-g}rHj!%S`W#Fd)@Et&F$@nR1Ds5KcdO&VKp`yr}dEeHq zW;@4fN_ui_q%OMFj&j5C6<@piqp4S-DLbPG&nPPN0YHe2fpv4#CLO!t!YP$ig3~|~ zYVbw}CjQ=Yg7aUx2y!vuaZ@1IzvazIY|C%PaABkE*RI8t~WSTn6^s>0AL=?R3azhGtHaB$N-M=4Wl= zO3COQ79B&~WXFhgV{^0hB2Jt~f@xQi0jDo$xA7+wtgvF4!^KBnV9=%9`y%obFIe}t z2siA3(NycGFqy^I_gX?;KU9qGj!oy=3(yG<2)k>N(wQ|ro+TIl3G5A8-Cb(XtFgi6 zyN%+zfmq*!h^|q-(@x4q&%-lkUmyKX>eNwn?sz|;R?C}5Ql1wCVw!EGU;#vLMzKDg3G;B&Ni><(NT z=BVMq%Tn=ck5U!M0KtMdWpdfx=`IY5R$IygF|gw&XM{4Vsh><(g#1Z%Hbv+0EtN74 zpaFNE#a<=sl)+FUz(y2t>|A`qmm-xBw{iNE{$Rb2e!S$k(7xK@49kVk@hy#3Yyi}C zGwFl?IfErbj-&n(BPvB=C?Ojh5C71(fYlIy{#H{@bj?xyE>7K$MOqRESe^)a{*ir{ z5T|)OlK+PD)%S4JU;c1yE0^$3qwn+@O7MPE%;TRfTjC|k9diH)PXa(V?*a?~T#KuO zx9d3|<9|wQExU8N+;P*mqf1OdIl7@MO&t@Vx@4kI%pn}j7#z?B7jmQOdtuv9OvvFc z^+Pt?7tx%!8E0Cr$*ppLSOU}%!un-i9!O>aOD`w$G*+}CobLs9^T7z|w-lB$Q>CNP zH6W*eOv{!k4uz?>J{epYv}ul}3Q>Y+Rr~^Xx?{S1)?)!nDI+kE__?R##8q_IUwMdn zEDS6W&n@q%mxJyh{$Xo8nU^~+nr`n*fVc^<`D<5chR15AS5FY3Gb;y2x$}`L#xvzg zA4)Mu4482bqscI|IXuCL*+*ngX`dKhruTZ5n4E>$P=p8$*p4#{HLc5te9W*DASb`L zV+tS`KbuPiuAVxMiJ<=?(c+(2H?*|MIi+{EK6=^4Xs`ACK*yXEwCaHCQ^Bd){iKw> z!q6lcXj_pLR8NME>talXmW%heVBp!G0_&|159gnMR@-lBlH9^*-3a9HE&(pX7}2lt zNSS6nM|riOzWo*13JL;ZYac%nPU1y(y%8S8B#vkS9p$f9d#1sjHqcxenbusF_#<}{ z`dsGtA6gzMf_@yRn?4{!d;S1q0j)|KSs57_)^hRqvJKz<^&DmmbcL@4gJUn?BU^e# z&ZgdHnHL))QUDoL+lK1uU{p^n@=y3~Luw`;&li>?U0{C6^v8s*COw(H9HdZIaicN! z*f8D__NPB#b^fiM()jHjRtaLZMMmetGf^@zXi~a-7-J?_ z#{n;sQmpVC1JE>v&LeUcPa&RO{qR>hVj?)}OkALKYP7C`DGtI*-D3^uZnkYWO^}~y zwS9s1nSvYDQn(sy2(D)C?TE#gmju)-U{qm^yZ^hcoVu2cjA7735(m;`a+e1n!I2Q6D?m|N8IYHnUTidbWk|>*NpYB{53G z4x=-U&`CkVhHN&X8mnpFw#|o2ms({uB%r%y=lQlV!D4TWJ6i!cw(l=NALI4cCnut{ zkU}JC>;6&guKRlOy_uz6j}a7TXOHjVmf1b6E!t|Fad}P{t#=T!^ux~lZd1|vyXp0R zbL|=vsAvz595VrV#0&fv()G{h3_4u1WPw@%~YR z!u7l(f**|FK#vu1=)FHpT9{P@6!JzNTT1w7QoZ=WlK>w5| z8{FK(dXfGUd>Cg}pr$#X4wm;qmc9aNf0!W3Un37U1q*yP!2(p`A=)h?r@oql?~<2T zmR@;X9n?lmjpUSl0b;W$s>3XdBLlWzkV#sDW-tjFvB@3*%Y-R){nl=x$qn1>HNE4$ z=)!e2C#93RA{BS3R5;(w@LU_SyC`G|X4H+cLqAXFutCk15B{tA&iCAO96>kELW8@< zJN9q|kLZ&6S}k`l!nT1jce4I!k8kOCuXHh|l)h!3O@O5MO!U);=4Lba1xCHUjVq@v zWuRtN6zIZI)aJ7j&5`X5!yQNME|BFWPn;p6X9)kYw+4P0%RX|QZsD<#k+#vojX`j0 zznN3u>uOBoylwk1=08C|@IMM}Hzi`cs#Pu3EF7eM|2y(?2{Fj`^N8)J2w>i&=lw6Goi+D9n_Q+vHhk+2*&^ba#}W0sPy(?)e_ z-G9<7hpXviDrvK@enjiL#p|_|f8X*MuK%~l*fRIJPvODxwE78u!Uu?SnD?X0$r_Un@g- z73;?ICwiaDp43K>(#W>;@My3=QaU%17YC!C8su;RU#+u82&(E}JhV1prRMHVpX!?IV~Q@a$tT4{7@PBI zUyQ@#PFzH7R-SV}C6jWmbpaUTx}N0uMs=8x?CD&V+6F@^m*Svo2xE!~@!^qW&MIF5 zXZWM+$p^dUVSP{rPKW8K6Wmq&elm`*S(>8%Hphum8B~F=XB52f_0+fnxZ>*_0wr(G zs%K^e3Z`3$jekm8Ls{w5is+x7XD8Q=AwmRyR=az*^)7MBkLSMDw|Wi>dCDY;df?0v zud%k2d{>t|wZ50@JpXF9Cr};BnE32W!A^O~jI#KPDCBXb>adNDUbKF7G~snY`z;Al zap+bOa>7l>4TPBK*OLstv2A;$C|i4JknQVS{=l3>?*Giwu}eo2=BNdZ_y9%`XN6V_ zlu$5ka1Lqdi}mvmX&+lPdzYCk%Wl*UQ`&Gw|&p~07|IisE5Z{{f_&h z^S6#lIHl~;*7e*H22L1!`9^E4x5-3Pe3LKHIrJTcqSw`wq=#58g#-tKMiKRqRO{-L zQ2Cc6@@y6J&oWof&g(auNk#F3H;Kc$egESn);Gf}W5K^C4xg^>zFYHHN{6P)Q739C z)LW11Flw%N0I7SG(5KhZ%0Gb+f;rv!lJYAOZ_md|cklLvYql(bNdkbT0cP2Ax90Fp zi=@rRdnt#_(4}qK%q=dX{lZ;k-t#dDwv|@7l$Et)x#_qxO(T7QM(N;yhp0li&d}87 zj4LYN^#{s;-+#}uv0=Y suppressWarnings() - expect_true(all(nchar(names(result$data)) <= 60)) + # we have to account for the '.factor' so the limit is 67 + expect_true(all(nchar(names(result$data)) <= 67)) }) diff --git a/tests/testthat/test-rd_insert_na.R b/tests/testthat/test-rd_insert_na.R index c15ba8e..7690008 100644 --- a/tests/testthat/test-rd_insert_na.R +++ b/tests/testthat/test-rd_insert_na.R @@ -39,7 +39,7 @@ test_that("rd_insert_na inserts NA when filter condition is met (using event_for expected <- df[[v2]] expected[which(df[[v1]] < threshold_value)] <- NA - expect_equal(result[[v2]], expected) + expect_equal(result$data[[v2]], expected) }) test_that("rd_insert_na errors if data or dic missing", { @@ -103,7 +103,7 @@ test_that("rd_insert_na leaves data unchanged when filter matches no rows (with event_form = covican$event_form ) - expect_equal(result, df) # nothing should change + expect_equal(result$data, df) # nothing should change }) test_that("rd_insert_na errors if longitudinal but event_form missing", { From d0e61f675f7b1da3750b0b4f9897e863e3e6a911 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 13 Nov 2025 19:04:50 +0100 Subject: [PATCH 5/9] Final review version --- .Rbuildignore | 2 + .gitignore | 2 + R/rd_checkbox.R | 7 +- R/rd_dates.R | 11 +- R/rd_delete_vars.R | 7 +- R/rd_dictionary.R | 7 +- R/rd_factor.R | 33 +- R/rd_insert_na.R | 12 +- R/rd_query.R | 6 +- R/rd_recalculate.R | 23 +- R/rd_split.R | 112 +++++-- R/rd_transform.R | 15 +- man/rd_dates.Rd | 2 - man/rd_factor.Rd | 6 +- man/rd_insert_na.Rd | 4 +- man/rd_recalculate.Rd | 6 +- man/rd_transform.Rd | 9 +- tests/testthat/test-rd_recalculate.R | 4 +- tests/testthat/test-rd_split.R | 12 +- tests/testthat/test-rd_transform.R | 4 +- vignettes/REDCapDM.Rmd | 461 +++++++++------------------ 21 files changed, 344 insertions(+), 401 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index eed7b8e..60d60ae 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,5 @@ ^pkgdown$ ^\.github$ ^vignettes/articles$ +^doc$ +^Meta$ diff --git a/.gitignore b/.gitignore index 6ebd4e6..74167b2 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,5 @@ docs .httr-oauth .DS_Store .quarto +/doc/ +/Meta/ diff --git a/R/rd_checkbox.R b/R/rd_checkbox.R index 361bbe0..e37630d 100644 --- a/R/rd_checkbox.R +++ b/R/rd_checkbox.R @@ -132,8 +132,13 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU } if (is.null(results)) { - results <- c(results, stringr::str_glue("1. {transf_message} (rd_checkbox)\n")) + results <- c(results, stringr::str_glue("{transf_message} (rd_checkbox)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_dates.R b/R/rd_dates.R index a0be83c..4521fce 100644 --- a/R/rd_dates.R +++ b/R/rd_dates.R @@ -4,8 +4,6 @@ #' `r lifecycle::badge('experimental')` #' #' This function processes and transforms date and datetime fields in a REDCap dataset. -#' It ensures proper handling of data, dictionary (metadata), and event-form mapping, -#' and applies labels to the dataset for better usability. #' #' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. #' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. @@ -40,7 +38,7 @@ rd_dates <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) # Handle potential overwriting when both `project` and other arguments are provided if (!is.null(project)) { env_vars <- check_proj(project, data, dic, event_form) - # browser() + list2env(env_vars, envir = environment()) } @@ -103,8 +101,13 @@ rd_dates <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL) # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Transforming date and datetime fields. (rd_dates)\n")) + results <- c(results, stringr::str_glue("Transforming date and datetime fields. (rd_dates)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_delete_vars.R b/R/rd_delete_vars.R index be59a53..1d8056a 100644 --- a/R/rd_delete_vars.R +++ b/R/rd_delete_vars.R @@ -139,8 +139,13 @@ rd_delete_vars <- function(project = NULL, data = NULL, dic = NULL, event_form = # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Removing selected variables (rd_delete_vars)\n")) + results <- c(results, stringr::str_glue("Removing selected variables (rd_delete_vars)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_dictionary.R b/R/rd_dictionary.R index 68081ec..bbf402d 100644 --- a/R/rd_dictionary.R +++ b/R/rd_dictionary.R @@ -185,8 +185,13 @@ rd_dictionary <- function(project = NULL, data = NULL, dic = NULL, event_form = # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Converting every branching logic in the dictionary into R logic. (rd_dictionary)\n")) + results <- c(results, stringr::str_glue("Converting every branching logic in the dictionary into R logic. (rd_dictionary)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_factor.R b/R/rd_factor.R index c5de5f5..0374b29 100644 --- a/R/rd_factor.R +++ b/R/rd_factor.R @@ -3,9 +3,7 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function converts variables in a REDCap dataset that have associated `.factor` columns into actual factor variables, while also updating branching logic in the associated dictionary. -#' -#' It also allows for the exclusion of specific variables from being converted into factors. +#' This function converts variables in a REDCap dataset that have associated `.factor` columns into actual factor variables. It also allows for the exclusion of specific variables from being converted into factors. #' #' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. #' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. @@ -15,7 +13,7 @@ #' #' @return A list containing: #' \item{data}{The transformed dataset with factor variables applied.} -#' \item{dictionary}{The dictionary with updated branching logic for the transformed variables.} +#' \item{dictionary}{The dictionary used.} #' \item{event_form}{The event-form mapping used (if provided).} #' \item{results}{A string summarizing the changes made during the transformation.} #' @@ -71,13 +69,15 @@ rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL # Identify the columns ending with '.factor' (these are the potential factor variables) factors <- data |> - dplyr::select(dplyr::ends_with(".factor")) |> + dplyr::select(dplyr::matches("\\.factor$")) |> names() |> stringr::str_remove("\\.factor$") + factors <- setdiff(factors, stringr::str_remove(keep, "\\.factor$")) + # If there are no factor variables, stop the function if (length(factors) == 0) { - warning("There are no variables in the data which can be converted to factors.") + warning("There are no variables in the data which can be converted to factors.", call. = FALSE) } else { if (!is.null(exclude)) { bad_vars <- exclude[grepl("\\.factor$", exclude)] @@ -98,13 +98,15 @@ rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL if (length(factors) == 0) { stop("All variables in the data which can be converted to factors are specified in the `exclude` argument. Please, review the `exclude` argument.", call. = FALSE) } - } - # Perform the transformation of factor columns into actual factor variables - data <- data |> - # Assign the values from the factor columns to the original columns and remove the '.factor' versions - dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get(stringr::str_glue("{dplyr::cur_column()}.factor")))) |> - dplyr::select(-stringr::str_glue("{factors}.factor")) + # Perform the transformation of factor columns into actual factor variables + data <- data |> + # Assign the values from the factor columns to the original columns and remove the '.factor' versions + dplyr::mutate(dplyr::across(tidyselect::all_of(factors), ~ get( + stringr::str_glue("{dplyr::cur_column()}.factor") + ))) |> + dplyr::select(-stringr::str_glue("{factors}.factor")) + } # If there were any variables that were excluded from conversion, reattach them to the data if (length(keep_factors) > 0) { @@ -132,8 +134,13 @@ rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Replacing original variables for their factor version. (rd_factor)\n")) + results <- c(results, stringr::str_glue("Replacing original variables for their factor version. (rd_factor)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_insert_na.R b/R/rd_insert_na.R index f604000..0cb3b72 100644 --- a/R/rd_insert_na.R +++ b/R/rd_insert_na.R @@ -5,7 +5,7 @@ #' #' This function allows you to manually insert a missing value into certain variables (`vars`) if the specified filter/s (`filter`) are satisfied. #' It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. -#' Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +#' #' #' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. #' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. @@ -14,6 +14,9 @@ #' @param vars A character vector with the names of the variables to be transformed. #' @param filter A character vector of logical expressions to evaluate. If the evaluation is `TRUE`, the corresponding variable in `vars` is set to `NA`. #' +#' @note +#' Each variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +#' #' @return The modified data frame with the specified variables updated. #' #' @examples @@ -129,8 +132,13 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = N # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Inserting missing values into certain variables. (rd_insert_na)\n")) + results <- c(results, stringr::str_glue("Inserting missing values into certain variables. (rd_insert_na)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_query.R b/R/rd_query.R index 43cbdbc..acc5df2 100644 --- a/R/rd_query.R +++ b/R/rd_query.R @@ -474,8 +474,9 @@ rd_query <- function(project = NULL, variables = NA, expression = NA, negate = F # Adding each identified query to the queries data frame queries <- rbind(queries, excel) } else { + # Handle cases with zero queries - excel <- data.frame( + excel <- tibble::tibble( DAG = if (any(c("redcap_data_access_group", "redcap_data_access_group.factor") %in% names(data)) & nrow(data) > 0) { if ("redcap_data_access_group.factor" %in% names(data)) { if (all(is.na(event))) { @@ -542,7 +543,8 @@ rd_query <- function(project = NULL, variables = NA, expression = NA, negate = F } }, stringsAsFactors = FALSE - ) + ) |> + as.data.frame() # Adding each variable with zero queries to the data frame excel_zero <- rbind(excel_zero, excel) diff --git a/R/rd_recalculate.R b/R/rd_recalculate.R index c0ab0a2..b587005 100644 --- a/R/rd_recalculate.R +++ b/R/rd_recalculate.R @@ -11,7 +11,7 @@ #' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. #' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. #' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param exclude_recalc (Optional) A character vector of field names to exclude from recalculation. +#' @param exclude (Optional) A character vector of field names to exclude from recalculation. #' #' @return A list containing the following elements: #' \item{data}{The updated dataset with recalculated fields (if applicable).} @@ -43,19 +43,19 @@ #' #' # Example usage with a project object, excluding variables from the recalculation #' results <- covican |> -#' rd_recalculate(exclude_recalc = c("age", "screening_fail_crit")) +#' rd_recalculate(exclude = c("age", "screening_fail_crit")) #' #' @export #' @importFrom rlang := #' @importFrom stats na.omit -rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude_recalc = NULL) { +rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, exclude = NULL) { results <- NULL # Handle potential overwriting when both `project` and other arguments are provided if (!is.null(project)) { env_vars <- check_proj(project, data, dic, event_form) - # browser() + list2env(env_vars, envir = environment()) } @@ -113,7 +113,7 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = # Process calculated fields: evaluate, transcribe logic, and compare results calc <- tibble::tibble(dic) |> - dplyr::filter(.data$field_type == "calc", !.data$field_name %in% exclude_recalc) |> + dplyr::filter(.data$field_type == "calc", !.data$field_name %in% exclude) |> dplyr::mutate( calc = purrr::map(.data$field_name, function(x) { val <- data[, x] @@ -180,7 +180,9 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = field_label = stringr::str_glue("{field_label} (Recalculate)") ) - dic <- rbind(dic, add_row) + pos <- which(dic$field_name == calc_change$field_name[i]) + + dic <- dic |> tibble::add_row(!!!as.list(add_row), .after = pos) } } @@ -188,10 +190,15 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = data <- data |> labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) - # Update results with the this transformation + # Update results with this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Recalculating calculated fields and saving them as '[field_name]_recalc'. (rd_recalculate)\n")) + results <- c(results, stringr::str_glue("Recalculating calculated fields and saving them as '[field_name]_recalc'. (rd_recalculate)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_split.R b/R/rd_split.R index 1327bbf..9df855b 100644 --- a/R/rd_split.R +++ b/R/rd_split.R @@ -94,11 +94,6 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, dplyr::filter(.data$field_name %in% vars_more & .data$field_type == "checkbox") |> dplyr::pull(.data$field_name) - if (length(check_vars) > 0) { - # actions <- c(actions, "There are variables in the dictionary that are not present in the dataset.\nSince some of these variables are checkboxes, please use the `rd_checkbox` function\nwith `checkbox_names = TRUE` to resolve this issue before proceeding.") - actions <- c(actions, "Missing checkbox vars from dictionary. Please, run: rd_checkbox(..., checkbox_names = TRUE)") - } - other_check_vars <- setdiff(vars_more, check_vars) if (length(other_check_vars) > 0) { @@ -130,12 +125,6 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, fact_vars <- grep(".factor$", vars_less, value = TRUE) - # Special handling for factor versions of variables - if (length(fact_vars) > 0) { - # actions <- c(actions, "Some variables in the dataset are factor versions of other variables and are not present in the dictionary.\nUse the `rd_factor` function to resolve this issue before proceeding.") - actions <- c(actions, "Detected both versions of variables (numerical and factor) - run: rd_factor(...)") - } - # Checkbox vars already identified in the previous step (vars_more) less_check <- grep("___", vars_less, value = TRUE) @@ -157,7 +146,7 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, "" ) body <- unlist(lapply(seq_along(actions), function(i) paste0(i, ". ", actions[i]))) - footer <- c("", "Suggested order: list(dataset, dic, ...) |> rd_checkbox(...) |> rd_delete_vars(...) |> rd_factor(...) -> rd_split(...)") + footer <- c("", "Suggested order: list(data, dic, ...) |> rd_delete_vars(delete_pattern = ...) |> rd_split(...)") stop(paste(c(header, body, footer), collapse = "\n"), call. = FALSE) } @@ -174,7 +163,24 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, ndata <- tibble::tibble("form" = form) |> dplyr::mutate( events = purrr::map(.data$form, ~ event_form$unique_event_name[event_form$form == .x]), - vars = purrr::map(.data$form, ~ dic$field_name[dic$form_name == .x]) + vars = purrr::map(.data$form, ~{ + posible_vars <- dic$field_name[dic$form_name == .x] + posible_vars <- c(posible_vars, paste0(posible_vars, ".factor")) + + check_df <- tibble::tibble(check_data = names(data)[grep("___", names(data))]) |> + dplyr::mutate(check_dic = gsub("___.*$", "", check_data)) |> + dplyr::distinct_all() |> + dplyr::filter(check_dic %in% posible_vars) + + if (nrow(check_df) > 0) { + vars_dic <- c(unique(check_df$check_dic), paste0(unique(check_df$check_dic), ".factor")) + posible_vars <- setdiff(posible_vars, vars_dic) + posible_vars <- c(posible_vars, check_df$check_data) + } + + intersect(names(data), posible_vars) + } + ) ) |> dplyr::mutate(df = purrr::map2( .data$events, @@ -188,7 +194,23 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, } else { ndata <- tibble::tibble("form" = form) |> dplyr::mutate( - vars = purrr::map(.data$form, ~ dic$field_name[dic$form_name == .x]), + vars = purrr::map(.data$form, ~ { + posible_vars <- dic$field_name[dic$form_name == .x] + posible_vars <- c(posible_vars, paste0(posible_vars, ".factor")) + + check_df <- tibble::tibble(check_data = names(data)[grep("___", names(data))]) |> + dplyr::mutate(check_dic = gsub("___.*$", "", check_data)) |> + dplyr::distinct_all() |> + dplyr::filter(check_dic %in% posible_vars) + + if (nrow(check_df) > 0) { + vars_dic <- c(unique(check_df$check_dic), paste0(unique(check_df$check_dic), ".factor")) + posible_vars <- setdiff(posible_vars, vars_dic) + posible_vars <- c(posible_vars, check_df$check_data) + } + + intersect(names(data), posible_vars) + }), vars = purrr::map(.data$vars, ~ unique(c(basic_redcap_vars, .x))) ) |> dplyr::mutate(df = purrr::map(.data$vars, ~ data |> @@ -218,6 +240,14 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, } if (wide) { + ndata <- ndata |> + dplyr::mutate(df = purrr::map(.data$df, ~{ + order_cols <- intersect(names(data), names(.x)) + + .x |> + dplyr::select(dplyr::any_of(c(basic_redcap_vars, order_cols))) + })) + ndata <- ndata |> dplyr::mutate( max_repeated_instance = purrr::map_dbl( @@ -257,18 +287,35 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, dplyr::relocate(.data$max_repeated_instance, .before = .data$vars) } } else if (by == "event") { + # Handle splitting by event - var_event <- event_form |> - dplyr::select("form_name" = "form", "redcap_event_name" = "unique_event_name") |> - dplyr::right_join( - dic |> - dplyr::select("form_name", "field_name", "field_type", "branching_logic_show_field_only_if"), - by = "form_name", - relationship = "many-to-many" + var_event <- tibble::tibble("form_name" = event_form$form) |> + dplyr::mutate( + redcap_event_name = purrr::map(.data$form_name, ~ event_form$unique_event_name[event_form$form == .x]), + vars = purrr::map(.data$form_name, ~{ + posible_vars <- dic$field_name[dic$form_name == .x] + posible_vars <- c(posible_vars, paste0(posible_vars, ".factor")) + + check_df <- tibble::tibble(check_data = names(data)[grep("___", names(data))]) |> + dplyr::mutate(check_dic = gsub("___.*$", "", check_data)) |> + dplyr::distinct_all() |> + dplyr::filter(check_dic %in% posible_vars) + + if (nrow(check_df) > 0) { + vars_dic <- c(unique(check_df$check_dic), paste0(unique(check_df$check_dic), ".factor")) + posible_vars <- setdiff(posible_vars, vars_dic) + posible_vars <- c(posible_vars, check_df$check_data) + } + + intersect(names(data), posible_vars) + } + ) ) |> + tidyr::unnest(.data$redcap_event_name) |> + tidyr::unnest(.data$vars) |> + dplyr::distinct(.data$redcap_event_name, field_name = .data$vars) |> dplyr::filter(.data$field_name != "record_id") |> - tibble::as_tibble() |> - dplyr::select("redcap_event_name", "field_name") + tibble::as_tibble() var_event_add <- data.frame(redcap_event_name = NA, field_name = basic_redcap_vars) var_event <- rbind(var_event_add, var_event) @@ -291,10 +338,22 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, dplyr::select(dplyr::all_of(c(basic_redcap_vars, .y))) ) ) + } else { stop("Invalid `by` argument. Please specify either 'form' or 'event'.") } + # Order columns + if (!wide) { + ndata <- ndata |> + dplyr::mutate(df = purrr::map(.data$df, ~{ + order_cols <- intersect(names(data), names(.x)) + + .x |> + dplyr::select(dplyr::any_of(c(basic_redcap_vars, order_cols))) + })) + } + # Handle the `which` argument if provided if (!is.null(which)) { if (length(which) > 1) { @@ -329,8 +388,13 @@ rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, # Update results with the this transformation if (is.null(results)) { - results <- c(results, stringr::str_glue("1. Final arrangment of the data by {by}. (rd_split)\n")) + results <- c(results, stringr::str_glue("Final arrangment of the data by {by}. (rd_split)\n")) } else { + + if(grepl("^[A-Z]", results[1])) { + results[1] <- paste("1.", results[1]) + } + last_val_res <- results |> stringr::str_extract("^(\n)?\\d+\\.") |> na.omit() |> diff --git a/R/rd_transform.R b/R/rd_transform.R index 569f8a0..d6c8918 100644 --- a/R/rd_transform.R +++ b/R/rd_transform.R @@ -2,7 +2,8 @@ #' #' @description #' `r lifecycle::badge('stable')` -#' This function transforms the raw REDCap data read by the `redcap_data` function. It returns the transformed data and dictionary, along with a summary of the results of each step. +#' +#' This function transforms the raw REDCap data read by the `redcap_data` function. It runs in one-step pipeline all the functions dedicated to processing the data. It returns the transformed data and dictionary, along with a summary of the results of each step. #' #' @param project Output of the `redcap_data` function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project. #' @param data Data frame containing the data read from REDCap. If the list is specified, this argument is not necessary. @@ -11,9 +12,9 @@ #' @param checkbox_labels Character vector with the names for the two options of every checkbox variable. Default is `c('No', 'Yes')`. #' @param checkbox_na Logical indicating if checkboxes values with branching logic should be set to missing only when the branching logic is missing (`FALSE`), or also when the branching logic isn't satisfied (`TRUE`). The default is `FALSE`. #' @param exclude_recalc Character vector with the names of variables that should not be recalculated. Useful for projects with time-consuming recalculations of certain calculated fields. -#' @param exclude_to_factor Character vector with the names of variables that should not be transformed to factors. +#' @param exclude_factor Character vector with the names of variables that should not be transformed to factors. #' @param delete_vars Character vector specifying the variables to exclude. -#' @param delete_pattern Character vector specifying the regex pattern for variables to be excluded. By default, variables ending with `_complete` and `_timestamp` will be removed. +#' @param delete_pattern Character vector specifying the regex pattern for variables to be excluded. #' @param final_format Character string indicating the final format of the data. Options are `raw`, `by_event` or `by_form`. `raw` (default) returns the transformed data in its original structure, `by_event` returns it as a nested data frame by event, and `by_form` returns it as a nested data frame by form. #' @param which_event Character string indicating a specific event to return if the final format is `by_event`. #' @param which_form Character string indicating a specific form to return if the final format is `by_form`. @@ -32,7 +33,7 @@ #' @export #' -rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, exclude_to_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL) { +rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, exclude_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL) { results <- NULL ind <- 1 @@ -163,7 +164,7 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N if (longitudinal & is.null(event_form)) { results <- c(results, "\nNo recalculation is possible as the project has more than one event and the event-form correspondence has not been specified\n") } else { - recalc <- rd_recalculate(data = data, dic = dic, event_form = event_form, exclude_recalc = exclude_recalc) + recalc <- rd_recalculate(data = data, dic = dic, event_form = event_form, exclude = exclude_recalc) data <- recalc$data dic <- recalc$dictionary @@ -213,7 +214,7 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N results <- c(results, stringr::str_glue("\n\n{ind}. Replacing original variables for their factor version")) ind <- ind + 1 - data_dic <- rd_factor(data = data, dic = dic, exclude = exclude_to_factor) + data_dic <- rd_factor(data = data, dic = dic, exclude = exclude_factor) data <- data_dic$data dic <- data_dic$dictionary @@ -238,7 +239,7 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N dic <- dic_trans$dictionary - results <- c(results, dic_trans$results[-2]) + results <- c(results, dic_trans$results[-1]) } diff --git a/man/rd_dates.Rd b/man/rd_dates.Rd index 1fabe8c..90fa921 100644 --- a/man/rd_dates.Rd +++ b/man/rd_dates.Rd @@ -25,8 +25,6 @@ A list containing the following elements: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This function processes and transforms date and datetime fields in a REDCap dataset. -It ensures proper handling of data, dictionary (metadata), and event-form mapping, -and applies labels to the dataset for better usability. } \details{ The function performs the following tasks: diff --git a/man/rd_factor.Rd b/man/rd_factor.Rd index bca8fd2..e8dc051 100644 --- a/man/rd_factor.Rd +++ b/man/rd_factor.Rd @@ -26,16 +26,14 @@ rd_factor( \value{ A list containing: \item{data}{The transformed dataset with factor variables applied.} -\item{dictionary}{The dictionary with updated branching logic for the transformed variables.} +\item{dictionary}{The dictionary used.} \item{event_form}{The event-form mapping used (if provided).} \item{results}{A string summarizing the changes made during the transformation.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function converts variables in a REDCap dataset that have associated \code{.factor} columns into actual factor variables, while also updating branching logic in the associated dictionary. - -It also allows for the exclusion of specific variables from being converted into factors. +This function converts variables in a REDCap dataset that have associated \code{.factor} columns into actual factor variables. It also allows for the exclusion of specific variables from being converted into factors. } \details{ This function searches for columns in the data that have a \code{.factor} suffix (indicating that they can be converted into factors) and converts them into factors based on their labels. diff --git a/man/rd_insert_na.Rd b/man/rd_insert_na.Rd index 4228fab..db3b41a 100644 --- a/man/rd_insert_na.Rd +++ b/man/rd_insert_na.Rd @@ -34,7 +34,9 @@ The modified data frame with the specified variables updated. This function allows you to manually insert a missing value into certain variables (\code{vars}) if the specified filter/s (\code{filter}) are satisfied. It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. -Note that the variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. +} +\note{ +Each variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. } \examples{ diff --git a/man/rd_recalculate.Rd b/man/rd_recalculate.Rd index 23074ab..084b888 100644 --- a/man/rd_recalculate.Rd +++ b/man/rd_recalculate.Rd @@ -9,7 +9,7 @@ rd_recalculate( data = NULL, dic = NULL, event_form = NULL, - exclude_recalc = NULL + exclude = NULL ) } \arguments{ @@ -21,7 +21,7 @@ rd_recalculate( \item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} -\item{exclude_recalc}{(Optional) A character vector of field names to exclude from recalculation.} +\item{exclude}{(Optional) A character vector of field names to exclude from recalculation.} } \value{ A list containing the following elements: @@ -64,6 +64,6 @@ results <- rd_recalculate( # Example usage with a project object, excluding variables from the recalculation results <- covican |> - rd_recalculate(exclude_recalc = c("age", "screening_fail_crit")) + rd_recalculate(exclude = c("age", "screening_fail_crit")) } diff --git a/man/rd_transform.Rd b/man/rd_transform.Rd index fd11c6b..9cb7766 100644 --- a/man/rd_transform.Rd +++ b/man/rd_transform.Rd @@ -12,7 +12,7 @@ rd_transform( checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, - exclude_to_factor = NULL, + exclude_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", @@ -36,11 +36,11 @@ rd_transform( \item{exclude_recalc}{Character vector with the names of variables that should not be recalculated. Useful for projects with time-consuming recalculations of certain calculated fields.} -\item{exclude_to_factor}{Character vector with the names of variables that should not be transformed to factors.} +\item{exclude_factor}{Character vector with the names of variables that should not be transformed to factors.} \item{delete_vars}{Character vector specifying the variables to exclude.} -\item{delete_pattern}{Character vector specifying the regex pattern for variables to be excluded. By default, variables ending with \verb{_complete} and \verb{_timestamp} will be removed.} +\item{delete_pattern}{Character vector specifying the regex pattern for variables to be excluded.} \item{final_format}{Character string indicating the final format of the data. Options are \code{raw}, \code{by_event} or \code{by_form}. \code{raw} (default) returns the transformed data in its original structure, \code{by_event} returns it as a nested data frame by event, and \code{by_form} returns it as a nested data frame by form.} @@ -55,7 +55,8 @@ A list with the transformed dataset, dictionary, event_form, and the results of } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function transforms the raw REDCap data read by the \code{redcap_data} function. It returns the transformed data and dictionary, along with a summary of the results of each step. + +This function transforms the raw REDCap data read by the \code{redcap_data} function. It runs in one-step pipeline all the functions dedicated to processing the data. It returns the transformed data and dictionary, along with a summary of the results of each step. } \examples{ # Basic transformation diff --git a/tests/testthat/test-rd_recalculate.R b/tests/testthat/test-rd_recalculate.R index 9228f2b..8f77e6e 100644 --- a/tests/testthat/test-rd_recalculate.R +++ b/tests/testthat/test-rd_recalculate.R @@ -33,8 +33,8 @@ test_that("recalculate returns updated data and dictionary", { expect_true("glue" %in% class(res$results)) }) -test_that("recalculate respects exclude_recalc argument", { - res <- rd_recalculate(data = cov_data, dic = cov_dic_test, event_form = cov_event_form, exclude_recalc = calc_fields[1]) +test_that("recalculate respects exclude argument", { + res <- rd_recalculate(data = cov_data, dic = cov_dic_test, event_form = cov_event_form, exclude = calc_fields[1]) # First calc field _recalc should NOT exist expect_false(any(grepl(paste0(calc_fields[1], "_recalc"), names(res$data)))) diff --git a/tests/testthat/test-rd_split.R b/tests/testthat/test-rd_split.R index 0034ad8..60396ac 100644 --- a/tests/testthat/test-rd_split.R +++ b/tests/testthat/test-rd_split.R @@ -7,10 +7,8 @@ test_that("rd_split errors with missing dictionary vars that are checkbox type", form_name = c("form1", "form1") ) - expect_error( - rd_split(data = data, dic = dic), - regexp = "rd_checkbox", - fixed = FALSE + expect_no_error( + rd_split(data = data, dic = dic) ) }) @@ -40,10 +38,8 @@ test_that("rd_split errors when .factor versions of variables are present but no data <- tibble(record_id = 1, var1.factor = "A") dic <- tibble(field_name = "record_id", field_type = "text", form_name = "meta") - expect_error( - rd_split(data = data, dic = dic), - regexp = "rd_factor", - ignore.case = TRUE + expect_no_error( + rd_split(data = data, dic = dic) ) }) diff --git a/tests/testthat/test-rd_transform.R b/tests/testthat/test-rd_transform.R index c44c6ef..42bf78b 100644 --- a/tests/testthat/test-rd_transform.R +++ b/tests/testthat/test-rd_transform.R @@ -105,12 +105,12 @@ test_that("deleting variables by pattern works", { expect_false(any(grepl("_complete$", names(res$data)))) }) -test_that("exclude_to_factor prevents conversion", { +test_that("exclude_factor prevents conversion", { var_to_exclude <- covican$dictionary$field_name[1] res <- rd_transform( data = covican$data, dic = covican$dictionary, - exclude_to_factor = var_to_exclude + exclude_factor = var_to_exclude ) |> suppressMessages() |> suppressWarnings() diff --git a/vignettes/REDCapDM.Rmd b/vignettes/REDCapDM.Rmd index 7e414e7..d420a05 100644 --- a/vignettes/REDCapDM.Rmd +++ b/vignettes/REDCapDM.Rmd @@ -38,8 +38,12 @@ The REDCapDM package provides a comprehensive toolkit for managing data exported All main functions are listed below (and described in detail in the examples): +## Import data + - `redcap_data()`: Read REDCap data into R. +## Process data + - `rd_dates()`: Standardize date and datetime fields. - `rd_delete_vars()`: Remove specified variables (by name or pattern). @@ -58,8 +62,12 @@ All main functions are listed below (and described in detail in the examples): - `rd_dictionary()`: Update dictionary (translation of REDCap logic into R syntax) to reflect transformed data and logic. +Or we can use all these functions at once: + - `rd_transform()`: One-step pipeline to clean and preprocess the raw REDCap data. +## Queries + - `rd_query()`: Apply expressions to identify data queries/issues. - `rd_event()`: Report missing/incomplete events per record (longitudinal). @@ -124,26 +132,26 @@ kable(vars) |>
    -# **Examples** +# **Usage** -The package structure can be divided into three main components: reading raw data, processing data and identifying queries. Typically, after collecting data in REDCap, we will have to follow this three components in order to have a final validated dataset for analysis. We will provide a complete user guide on how to perform each one of these steps using the package's functions. For the processing of the data and query identification, we will use the built-in dataset as an example. +The package structure can be divided into three main components: reading raw data, processing data and identifying queries. Typically, after collecting data in REDCap, we will have to follow this three components in order to have a final validated dataset for analysis. We will provide a complete basic user guide on how to perform each one of these steps using the package's functions. For the processing of the data and query identification, we will use the `covican` built-in dataset as an example. ## **Read data** ### **redcap_data** -The `redcap_data()` function allows users to easily import data from a REDCap project into R for analysis. +The `redcap_data()` function allows users to easily import data from a REDCap project into R. -To read exported data from REDCap, use the arguments `data_path` and `dic_path` to, respectively, describe the path of the R file and the REDCap project's dictionary: +In order to read exported data from REDCap, we first need to download the data and dictionary from the REDCap project in R format. We can then use the arguments `data_path` and `dic_path` to designate the local path where we have stored the R file and the dictionary from the REDCap project: ```{r message=FALSE, warning=FALSE, comment=NA, eval=FALSE} dataset <- redcap_data(data_path = "C:/Users/username/example.r", dic_path = "C:/Users/username/example_dictionary.csv") ``` -> Note: The R and CSV files exported from REDCap must be located in the same directory. +> Note: The R and data CSV file exported from REDCap must be located in the same directory. -If the REDCap project is longitudinal (contains more than one event) then a third element should be specified with the correspondence of each event with each form of the project. This csv file can be downloaded in the REDCap of the project following these steps: _Project Setup_ < _Designate Instruments for My Events_ < _Download instrument-event mappings (CSV)_. +If the REDCap project is longitudinal (contains more than one event) then a third element should be specified with the correspondence of each event with each form of the project. This csv file can be downloaded in the REDCap of the project following these steps: _Project Setup_ < _Designate Instruments for My Events_ < _Download instrument-event mappings (CSV)_. Then, it has to be specified using the argument `event_path`: ```{r message=FALSE, warning=FALSE, comment=NA, eval=FALSE} dataset <- redcap_data(data_path = "C:/Users/username/example.r", @@ -164,52 +172,41 @@ In this case, there is no need to specify the event-form file since the function > **Warning**: Please keep in mind that the API token gives you special access to the REDCap project and that it should not be shared with other people. -This function returns a list with 3 elements (imported data, dictionary and event-form mapping) which can then be used for further analysis or visualization. +The `redcap_data()` function returns a list with three elements: imported data, dictionary and event-form mapping(if included). ## **Process** -As previously stated, we will use the built-in dataset `REDCapDM::covican` as an example. - -For all the following functions, the only necessary elements that must be provided are the dataset to be transformed and the corresponding dictionary. If the project is longitudinal, as in the case of `REDCapDM::covican`, also the event-form dataset should be specified. These elements can be specified directly using the output of the `redcap_data()` function or separately in different arguments. - -### **rd_dates** - -This function is designed to process and standardize `date` and `datetime` fields in a REDCap dataset. In REDCap projects, date and datetime fields can sometimes be stored as character strings, which can make analyses difficult. It detects which fields should be dates/datetimes from the REDCap dictionary and converts them to `Date` and `POSIXct`, respectively. +Given any data imported from REDCap with `redcap_data()`, this would be the pipeline of an entire processing workflow: -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -# Option A: list object -covican_dates <- covican |> rd_dates() - -# Option B: provide components separately -covican_dates <- rd_dates(data = covican$data, - dic = covican$dictionary, - event_form = covican$event_form) +```{r message=FALSE, warning=FALSE, eval = FALSE, comment="#>", collapse = TRUE} +data |> + rd_delete_vars(delete_pattern = c("_complete", "_timestamp") |> + rd_dates() |> + rd_recalculate() |> + rd_checkbox() |> + rd_factor() |> + rd_dictionary() |> + rd_split(by = "event") # use "form" if not longitudinal ``` -Quick verification example: +All functions are optional and should only be used at the user's discretion when necessary. The order of some functions can also be exchanged. For example, for `covican` there are no variables to delete and dates are already processed, so the pipeline would be simplified: ```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -# Simulate a character date since covican already has the dates in the correct format -covican_dates <- covican -covican_dates$data <- covican_dates$data |> - dplyr::mutate(d_birth = as.character(d_birth)) -# Check class before conversion +covican_transformed <- covican |> + rd_recalculate() |> + rd_checkbox() |> + rd_factor() |> + rd_dictionary() |> + rd_split(by = "event") -class(covican_dates$data$d_birth) - -# Check class after conversion -covican_dates <- covican_dates |> rd_dates() -class(covican_dates$data$d_birth) +covican_transformed$results ``` -After this transformation, all `date` and `datetime` variables are standardized and ready for analysis in R. - -
    +All the functions that can be used in each step of a processing workflow are detailed below: ### **rd_delete_vars** -This function removes unwanted variables from both a REDCap dataset and its dictionary, keeping the data and metadata consistent. -This is especially useful for eliminating automatically generated fields such as form completion flags (`*_complete`) or timestamps (`*_timestamp`). +This function removes unwanted variables from both a REDCap dataset and its dictionary. This is especially useful for eliminating automatically generated fields such as form completion flags (`*_complete`) or timestamps (`*_timestamp`). You can delete variables either by specifying their exact names or by using regular expression patterns: @@ -231,10 +228,42 @@ When variables are deleted:
    + +### **rd_dates** + +This function is designed to process and standardize `date` and `datetime` fields in a REDCap dataset. In REDCap projects, date and datetime fields can sometimes be stored as character strings, which can make analyses difficult. It detects which fields should be dates/datetimes from the REDCap dictionary and converts them to `Date` and `POSIXct`, respectively. + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +covican_dates <- covican |> + rd_dates() +``` + +Quick verification example: + +```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} +# Simulate a character date since covican already has the dates in the correct format +covican_dates <- covican +covican_dates$data <- covican_dates$data |> + dplyr::mutate(d_birth = as.character(d_birth)) +# Check class before conversion + +class(covican_dates$data$d_birth) + +# Check class after conversion +covican_dates <- covican_dates |> + rd_dates() +class(covican_dates$data$d_birth) +``` + +After this transformation, all `date` and `datetime` variables are standardized and ready for analysis in R. + +
    + ### **rd_recalculate** This function identifies calculated fields in a REDCap project, translates their logic into R, recalculates them, and compares the recalculated values with the originals. -It produces both field-level and project-level reports, helping users detect discrepancies between REDCap’s stored calculations and the values recomputed in R. + +It produces a report, helping users detect discrepancies between REDCap’s stored calculations and the values recomputed in R. ```{r} covican_recalc <- covican |> @@ -246,19 +275,16 @@ covican_recalc$results The `results` object contains: -- Summary report – total number of calculated fields, how many were successfully transcribed into R logic, and how many recalculated values differ from the originals. +- Summary report: total number of calculated fields, how many were successfully transcribed into R logic, and how many recalculated values differ from the originals. -- Field-level report – lists each calculated field, whether its logic was transcribed, and whether the recalculated value matches the original. - -Example: excluding specific variables - -You can exclude certain fields from recalculation (e.g., complex multi-event calculations) to reduce computation time and avoid unnecessary warnings. +- Field-level report: lists each calculated field, whether its logic was transcribed, and whether the recalculated value matches the original. +IN addition, you can exclude certain fields from recalculation (e.g., complex multi-event calculations) to reduce computation time and avoid unnecessary warnings. ```{r} # Exclude specific variables from recalculation covican_recalc <- covican |> - rd_recalculate(exclude_recalc = c("screening_fail_crit", "resp_rate")) + rd_recalculate(exclude = c("screening_fail_crit", "resp_rate")) covican_recalc$results ``` @@ -271,40 +297,9 @@ When recalculation succeeds:
    -### **rd_factor** - -This function converts categorical variables in a REDCap dataset into R factors. -It detects `.factor` columns (created by REDCap for multiple-choice fields) and merges them into the original variables, while preserving labels and updating the dictionary’s branching logic. - -```{r} -factored <- covican |> - rd_factor() - -# Checking class of the variable -str(factored$data$available_analytics) -``` - -You can prevent certain variables from being converted to factors using the `exclude` argument. -This is useful if you need to keep some variables as raw numeric or text data. - -```{r} -factored <- covican |> - rd_factor(exclude = c("available_analytics", "urine_culture")) - -# Checking class of the variable -str(covican$data$available_analytics) -``` - -> Note: the function automatically excludes these system variables from conversion: `redcap_event_name`, `redcap_repeat_instrument`, `redcap_data_access_group`. These variables are retained as-is to avoid interfering with longitudinal event mappings or user access groups. - -After conversion, original variables are replaced with proper R factor columns and their `.factor` counterparts are dropped. - -
    - ### **rd_checkbox** -This function processes REDCap checkbox fields, converting them from "Checked"/"Unchecked" categories into binary-coded variables (0/1) with user-specified labels. -It can also rename variables to match checkbox option labels and updates dictionary branching logic accordingly. +This function processes REDCap checkbox fields, converting them from "Checked"/"Unchecked" categories into binary-coded variables (0/1) and its corresponding factor variable with user-specified labels. It also renames variables to match checkbox option labels and updates dictionary branching logic and calculations accordingly to the new names. ```{r} # Default transformation: "No"/"Yes" labels, renamed variables @@ -314,11 +309,17 @@ cb <- covican |> str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) ``` +If a branching logic exists for a checkbox field, the function attempts to translate it into R, by default. When `checkbox_na = TRUE`, values outside the branching logic are set to NA. A summary of problematic fields (e.g., missing branching logic or logic not transcribable) is included in the results element: + +```{r} +cb$results +``` + You can specify alternative labels: ```{r} cb <- covican |> - rd_checkbox(, checkbox_labels = c("Absent", "Present")) + rd_checkbox(checkbox_labels = c("Absent", "Present")) str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) ``` @@ -332,112 +333,41 @@ cb <- covican |> str(cb$data$underlying_disease_hemato___1) ``` -> Note: If a branching logic exists for a checkbox field, the function attempts to translate it into R, by default. When `checkbox_na = TRUE`, values outside the branching logic are set to NA. - - -A summary of problematic fields (e.g., missing branching logic or logic not transcribable) is included in the results element: - -```{r} -cb$results -``` -
    -### **rd_split** - -After preparing your dataset with, you may want to work with only one form or one event at a time. The `rd_split()` function separates your dataset accordingly. -- **By form** - -For non-longitudinal projects (or longitudinal projects with an `event_form` mapping), you can split the dataset into smaller datasets based on forms. If repeated entries exist, you can reshape the data into wide format: - -> Note: For proper use of this function, ensure that `rd_factor()` and `rd_checkbox()` have been applied to your dataset. If not, the function will emit an error and prompt you to run both functions first. - -```{r} -forms_data <- covican |> - rd_factor() |> - rd_checkbox() |> - rd_split(by = "form") - -forms_data$data -``` - -- **By event** +### **rd_factor** -For longitudinal projects, you can split by event instead. The function uses the `event_form` mapping to assign variables correctly to each event: +This function converts categorical variables in a REDCap dataset into R factors. It replaces categorical columns with the corresponding `.factor` column (created by REDCap for multiple-choice fields). ```{r} -events_data <- covican |> - rd_factor() |> - rd_checkbox() |> - rd_split(by = "event") +factored <- covican |> + rd_factor() -events_data$data +# Checking class of the variable +str(factored$data$available_analytics) ``` -If you want to extract only one form or event, use the `which` argument: +You can prevent certain variables from being converted to factors using the `exclude` argument. +This is useful if you need to keep some variables as raw numeric or text data. ```{r} -# Example by form -baseline_data <- covican |> - rd_factor() |> - rd_checkbox() |> - rd_split(by = "form", which = "demographics") - -# Checking the names of the variables collected in that form -vars_demo <- covican$dictionary |> - dplyr::filter(form_name == "demographics") |> - dplyr::pull(field_name) - -all(vars_demo %in% names(baseline_data$data)) -``` - -
    - -### **rd_insert_na** - -This function sets some values of a variable to missing if a certain logic is fulfilled. It can be used as a complementary function for `rd_transform()`, for example, to change the values of those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can perform a raw transformation of our data, as in section 4.2.1.1, and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: - -```{r message=FALSE, warning=FALSE, comment=NA} -#Raw transformation of the data: -dataset <- rd_transform(covican) - -data <- dataset$data - -#Before inserting missings -table(data$type_underlying_disease_haematological_cancer) - -#Run the function -data2 <- rd_insert_na(dataset, - event_form = covican$event_form, - vars = "type_underlying_disease_haematological_cancer", - filter = "age < 65") +factored <- covican |> + rd_factor(exclude = c("available_analytics", "urine_culture")) -#After inserting missings -table(data2$type_underlying_disease_haematological_cancer) +# Checking class of the variable +str(covican$data$available_analytics) ``` -Recall that both the variable to be transformed (_age_) and the variable included in the filter (_type_underlying_disease_haematological_cancer_) are in the same event. In the contrary, if the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted. - -
    - -### **rd_rlogic** - -This function transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic. This function is used in the `rd_transform()` to recalculate the calculated fields and convert the branching logics, but it may also be useful to use it in other circunstances. Let's see how it transforms the logic of one of the calculated fields in the built-in dataset: - -```{r message=FALSE, warning=FALSE, comment=NA} -logic_trans <- rd_rlogic(covican, - logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", - var = "screening_fail_crit") +> Note: the function automatically excludes these system variables from conversion: `redcap_event_name`, `redcap_repeat_instrument`, `redcap_data_access_group`. These variables are retained as-is to avoid interfering with longitudinal event mappings or user access groups. -str(logic_trans) -``` +After conversion, original variables are replaced with proper R factor columns and their `.factor` counterparts are dropped.
    ### **rd_dictionary** -When working with REDCap exports, the data dictionary contains field metadata, branching logic, and calculation rules written in REDCap logic. After cleaning your dataset with functions like `rd_factor()` and `rd_checkbox()`, the original dictionary may no longer match the transformed data. The rd_dictionary() function refreshes branching logic and calculations, translating them from REDCap logic into R logic, and ensures the dictionary remains consistent with the cleaned dataset. +When working with REDCap exports, the data dictionary contains field metadata, branching logic, and calculation rules written in REDCap logic. The `rd_dictionary()` function refreshes branching logic and calculations, translating them from REDCap logic into R logic, and ensures the dictionary remains consistent with the cleaned dataset. ```{r} # Update dictionary after cleaning @@ -445,9 +375,6 @@ dict_result <- covican |> rd_factor() |> rd_checkbox() |> rd_dictionary() - -# Review any branching logic issues -dict_result$results ``` When we transform the dictionary: @@ -460,198 +387,108 @@ When we transform the dictionary:
    -### **rd_transform** - -The main function involved in the processing of the data is `rd_transform()`. This function is used to process the REDCap data read into R using the `redcap_data()`, as described above. Using the arguments of the function we can perform all the different type of transformations described until now. Its a one-step transformation function! - -#### *Data transformation* - -```{r message=FALSE, warning=FALSE, comment=NA} -#Option A: list object -covican_transformed <- rd_transform(covican) - -#Option B: separately with different arguments -covican_transformed <- rd_transform(data = covican$data, - dic = covican$dictionary, - event_form = covican$event_form) - -#Print the results of the transformation -covican_transformed$results -``` - -This function will return a list with the transformed dataset, dictionary, event_form and the output of the results of the transformation. - -As we can see, there are several steps in the transformation: - -

      -
    1. Elimination of variables: we can specify any variable in the dataset which we want to remove using the argument `delete_vars`, as explained later.
      2. - -
    2. Elimination of variables containing some pattern: by default, the pattern that the function looks for is '_complete' and '_timestamp'. We can specify any other pattern using the argument `delete_pattern`, as explained later.
      3. - -In this case, we do not have any variable with the pattern '_complete' and '_timestamp' since the built-in dataset only contains a sample of the variables of the project. All REDCap projects, when downloaded, contain one variable with the pattern '_complete' for each form indicating if the form has been marked as incomplete/unverified/completed. Also, if the project contains some survey then variables ending with '_timestamp' are also generated automatically. In general, we do not need this information so these variables are removed by default. - -
    3. Recalculation of REDCap calculated fields: it finds all the calculated fields and recalculates them using the REDCap logic specified in the calculation field translated into R. The recalculated variable is saved as the original name adding '_recalc' at the end. It can happen that the logic found contains some specific smart-variables or other complex structures which the function is not able to transcribe. With the summary found in `results` we can see how many calculated fields have been found, if they have been transcribed and, if that is the case, if the recalculated variable is equal to the original one.
      4. - -> Note: If the REDCap project is longitudinal and the event-form is not specified, this step will not be executed. - -In the example, we can see how there are two REDCap calculated fields, both have been transcribed successfully and the recalculation of the age does not match the original calculated variable from REDCap. - -
    4. Checkbox transformation: by default, it changes the names of the checkboxes to the name of its corresponding option and the name of their labels to 'No/Yes'. If we want to specify another pair of label names we can specify them using the `checkbox_labels` argument as we will see. Furthermore, if the checkbox contains a branching logic, when this logic evaluated returns a missing value (some of the variables specified in it are missing) the values of the checkbox will be set to missing.
      5. - -> Note: If the REDCap project is longitudinal and the event-form is not specified, the evaluations of the branching logic will not be done. - -For example, let's explain the transformation that undergo the variables corresponding to the checkbox field of the type of underlying disease. The variables were named originally as _type_underlying_disease___0_ and _type_underlying_disease___1_ although the name of the options are 'Haematological cancer' and 'Solid tumour'. Thus, in the transformed dataset, the names are converted to _type_underlying_disease_haematological_cancer_ and _type_underlying_disease_solid_tumour_. Then, since this checkbox variable does not have a branching logic, the variable is advised to be reviewed by the user in the `results`, as seen above. When reviewed we could use an additional function `rd_insert_na()` to insert the necessary missing values into this variable, as we will explain later. If a branching logic was found for this variable, `rd_transform` will insert automatically the missing values when the logic is not satisfied and no further transformation will be needed. - - -
    5. Replacement of the original variable by its factor version: REDCap creates two versions of the variables in the dataset for multiple-choice fields: a numerical one with the number that corresponds to each category and a factor one containing the labels of each category. In this step, we will replace the original variables with their factor versions, except for _redcap_event_name_ and _redcap_data_access_group_, for which we will keep both versions. We can specify other variables that we do not want to transform to factor using the argument `exclude_to_factor` which we will see later.
      6. - -
    6. Transformation of the branching logic: by default, every branching logic contained in the dictionary is presented in REDCap logic. In this step, we will convert each branching logic into R logic in order to apply this information when needed. For example, we will use it to properly identify missing values in variables with a branching logic, as we will see later in the vignette.
      7. - +### **rd_split** -
    +After preparing your dataset, you may want to work with only one form or one event at a time. The `rd_split()` function separates your dataset accordingly. -#### *Data transformation and classification by event* +- **By form** -Additionally, we can change the final structure of the transformed dataset. For example, we can split it by each event. This can be done by specifying in the `final_format` argument that we want our data to be split by event. +For non-longitudinal projects (or longitudinal projects with an `event_form` mapping), you can split the dataset into smaller datasets based on forms. -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - final_format = "by_event") +```{r} +forms_data <- covican |> + rd_split(by = "form") -#To print the results -dataset$results +forms_data$data ``` -Now, a final step in the transformation has been added, which consists in splitting the data according to the events in the study. So, now the transformed dataset found in the output of the function is a tibble object with as many data frames as events there are in the REDCap project: +If repeated entries exist, you can reshape the data into wide format: -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -dataset$data +```{r} +forms_data <- covican |> + rd_split(by = "form", wide = TRUE) ``` -The column `df` of the nested dataframe is a list containing the data corresponding to each event. Also the variables of the forms that are found in each event are reported in the column `vars`. - -> Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. +> Note: For longitudinal projects, the column events shows the number of events in each form. -#### *Data transformation and classification by form* - -Another option is to split the data by the forms found in the REDCap project. We will use also the `final_format` argument to specify that we want to split data by form: - -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - final_format = "by_form") +- **By event** -#To print the results -dataset$results -``` +For longitudinal projects, you can also split the data by event. The function uses the `event_form` mapping to assign variables correctly to each event: -As before, a final step in the transformation has been added, which is to split the data according to the forms in the study. Thus, the transformed dataset will now be a tibble object with as many data frames as forms there are in the REDCap project: +```{r} +events_data <- covican |> + rd_split(by = "event") -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -dataset$data +events_data$data ``` -> Note: If the REDCap project is longitudinal and the event-form is not specified, this transformation is not posible. - -#### *Additional arguments* - -There are other arguments which can be used to customize some of the transformation steps that the function performs by default: - -
    +If you want to extract only one form or event, use the `which` argument: -checkbox_labels: specifies the name of the categories for the checkbox variables. Default is 'No/Yes', but we can change it to 'N/Y': +```{r} +# Example by form +baseline_data <- covican |> + rd_split(by = "form", which = "demographics") -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - checkbox_labels = c("N", "Y")) +head(baseline_data$data) ```
    -checkbox_na: logical argument involved in the transformation of checkbox variables. For checkbox variables that have a branching logic specified, when the logic is missing the values of the checkbox will be always converted to missing. Additionally, if this argument is true then also when the branching logic isn't satisfied their values will be converted to missing. +### **rd_insert_na** + +This is a bonus function that can be used to set some values of a variable to missing if a certain logic is fulfilled. It can be used, for example, to insert missings on those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can transform the checkboxes with the `rd_checkbox()` function and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: ```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - checkbox_na = TRUE) -``` +cb <- covican |> + rd_checkbox() -
    +#Before inserting missings +table(cb$data$type_underlying_disease_haematological_cancer) -exclude_recalc: specifies the name of the variables that we do not want to be recalculated. For example, if we do not want to recalculate the variable _age_: +#Run with this function +cb2 <- covican |> + rd_checkbox() |> + rd_insert_na(vars = "type_underlying_disease_haematological_cancer", + filter = "age < 65") -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - exclude_recalc = "age") +#After inserting missings +table(cb2$data$type_underlying_disease_haematological_cancer) ``` -This argument is useful to reduce the time of execution of the function. For calculated fields with complex logic involving variables in different events the recalculation operation may be time consuming, so we can prevent the function to recalculate them with this argument. +> Recall that both the variable to be transformed (_age_) and the variable included in the filter (_type_underlying_disease_haematological_cancer_) are in the same event. In the contrary, if the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted.
    -exclude_to_factor: specifies the name of the variables that we do not want to transform into a factor. For example, if we want the variable _dm_ to keep its original numeric version: +### **rd_rlogic** -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - exclude_to_factor = "dm") -``` +This is also a bonus function that transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic in R. -
    +> This function only returns the transformed logic, so it has to be used outside the transform workflow. -delete_vars: every variable specified in this argument will be removed from the dataset. For example, we can change the argument to remove the date of birth variable from the dataset: +Let's see how it transforms the logic of one of the calculated fields in the built-in dataset: ```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - delete_vars = "d_birth") -``` - -
    - -delete_pattern: every variable containing the strings specified in this argument will be removed from the dataset. By default, the value of `delete_pattern` is '\_complete'. For example, we can change the argument to remove the inclusion and exclusion criteria variables from the dataset (variables that contain 'inc\_' and 'exc\_' in their names): +logic_trans <- covican |> + rd_rlogic(logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", + var = "screening_fail_crit") -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - delete_pattern = c("inc_", "exc_")) +str(logic_trans) ```
    -which_event: in the transformation by event explained earlier, we can specify whether we want to keep only one out of all the events in the dataset. For example, if we only want to keep the baseline visit: - -```{r message=FALSE, warning=FALSE, comment=NA} -dataset <- rd_transform(covican, - final_format = "by_event", - which_event = "baseline_visit_arm_1") -``` - -
    +### **rd_transform** -which_form: in the transformation by form explained earlier, we can specify whether we want to keep only one of the forms. For example, if we only want to keep the demographic form: +Alternatively, you can do all these steps at once using the `rd_transform()` function: ```{r message=FALSE, warning=FALSE, comment=NA} +covican_transformed <- rd_transform(covican) -dataset <- rd_transform(covican, - final_format = "by_form", - which_form = "demographics") - -data <- dataset$data - -names(data) -``` - -
    - -wide: in the transformation by form, we can specify that we want each of the split datasets to be in a wide format. This is useful if the form appears in more than one event (or in a repeated event). Then, we will only have one row per patient and all the variables of the form will be in columns repeated by each event in the order that the events appear in REDCap. For example, if we want to keep only the laboratory findings in a wide format we can do: - -```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} -dataset <- rd_transform(covican, - final_format = "by_form", - which_form = "laboratory_findings", - wide = TRUE) - -head(dataset$data) +#Print the results of the transformation +covican_transformed$results ``` -
    - +Using the arguments of the function we can perform all the different type of transformations described until now. ## **Queries** From 8b5466d371da5f1663bd2ff099c0e3f4abf78a52 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 13 Nov 2025 19:09:44 +0100 Subject: [PATCH 6/9] Removing @export --- R/utils-suplement.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/utils-suplement.R b/R/utils-suplement.R index ecfe5b6..6cef016 100644 --- a/R/utils-suplement.R +++ b/R/utils-suplement.R @@ -49,7 +49,6 @@ fill_data <- function(which_event, which_var, data) { #' @param event_form An optional event-form object that may be overridden if provided in the `project`. #' #' -#' @export check_proj <- function(project, data = NULL, dic = NULL, event_form = NULL) { # Ensure 'project' is a list if (!is.list(project)) { @@ -105,7 +104,6 @@ check_proj <- function(project, data = NULL, dic = NULL, event_form = NULL) { #' round(3.14159, 2) #' round(c(-2.718, 3.14159), 1) #' -#' @export round <- function(x, digits) { posneg <- sign(x) z <- abs(x) * 10^digits From 2c3af35c3161c017f3d424bdb33e336cdb631c73 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 13 Nov 2025 19:19:28 +0100 Subject: [PATCH 7/9] Updating information --- NAMESPACE | 2 -- R/REDCapDM-package.R | 20 ++++++++++---------- man/REDCapDM-package.Rd | 20 ++++++++++---------- 3 files changed, 20 insertions(+), 22 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index cef52cc..ddafc85 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(check_proj) export(check_queries) export(rd_checkbox) export(rd_dates) @@ -16,7 +15,6 @@ export(rd_rlogic) export(rd_split) export(rd_transform) export(redcap_data) -export(round) import(cli) importFrom(lifecycle,deprecated) importFrom(rlang,":=") diff --git a/R/REDCapDM-package.R b/R/REDCapDM-package.R index 930d38c..e43e8eb 100644 --- a/R/REDCapDM-package.R +++ b/R/REDCapDM-package.R @@ -19,17 +19,17 @@ #' #' Core Functions: #' -#' - `redcap_data`: Reads data exported from REDCap or retrieved through the REDCap API. -#' - `rd_transform`: Processes raw REDCap datasets into a structured and analyzable format. -#' - `transform_dates`: Transform dates and datetimes variables. -#' - `recalculate`: Recalculates REDCap calculated fields, compares them to originals, and reports discrepancies. -#' - `to_factor`: Converts variables to factors and updates the dictionary's branching logic. -#' - `rd_delete_vars`: Deletes specified or pattern-matched variables from the data and dictionary. -#' - `transform_checkbox`: Transforms the names of REDCap checkbox variables and updates the branching logic in the dictionary. -#' - `transform_dic`: Evaluates and transforms branching logic in the REDCap dictionary into R logic. +#' - `redcap_data`: Reads data exported from REDCap or retrieved through the REDCap API into R. +#' - `rd_transform`: One-step pipeline to clean and preprocess the raw REDCap data. +#' - `rd_dates`: Standardize date and datetime fields. +#' - `rd_delete_vars`: Remove specified variables (by name or pattern). +#' - `rd_recalculate`: Recompute calculated fields and compare with REDCap values. +#' - `rd_factor`: Replace numeric multiple-choice columns with their factor version. +#' - `rd_checkbox`: Expand checkbox responses with custom labels and rename 'var___1' columns (REDCap style) to 'var_option'. #' - `rd_split`: Splits a REDCap dataset by form or event. -#' - `rd_rlogic`: Converts REDCap branching and conditional logic into R-compatible expressions. -#' - `rd_insert_na`: Inserts missing values into specified variables based on filters. +#' - `rd_insert_na`: Manually set specified variables to missing based on a logical filter. +#' - `rd_rlogic`: Translate REDCap branching or calculation logic into R syntax. +#' - `rd_dictionary`: Update dictionary (translation of REDCap logic into R syntax) to reflect transformed data and logic. #' - `rd_query`: Identifies discrepancies (queries) in the dataset for validation. #' - `rd_event`: Detects missing events in longitudinal datasets. #' - `check_queries`: Compares historical and current query reports to track changes and additions. diff --git a/man/REDCapDM-package.Rd b/man/REDCapDM-package.Rd index e6de934..8fa7462 100644 --- a/man/REDCapDM-package.Rd +++ b/man/REDCapDM-package.Rd @@ -20,19 +20,19 @@ Key Features: Core Functions: \itemize{ -\item \code{redcap_data}: Reads data exported from REDCap or retrieved through the REDCap API. -\item \code{rd_transform}: Processes raw REDCap datasets into a structured and analyzable format. +\item \code{redcap_data}: Reads data exported from REDCap or retrieved through the REDCap API into R. +\item \code{rd_transform}: One-step pipeline to clean and preprocess the raw REDCap data. \itemize{ -\item \code{transform_dates}: Transform dates and datetimes variables. -\item \code{recalculate}: Recalculates REDCap calculated fields, compares them to originals, and reports discrepancies. -\item \code{to_factor}: Converts variables to factors and updates the dictionary's branching logic. -\item \code{rd_delete_vars}: Deletes specified or pattern-matched variables from the data and dictionary. -\item \code{transform_checkbox}: Transforms the names of REDCap checkbox variables and updates the branching logic in the dictionary. -\item \code{transform_dic}: Evaluates and transforms branching logic in the REDCap dictionary into R logic. +\item \code{rd_dates}: Standardize date and datetime fields. +\item \code{rd_delete_vars}: Remove specified variables (by name or pattern). +\item \code{rd_recalculate}: Recompute calculated fields and compare with REDCap values. +\item \code{rd_factor}: Replace numeric multiple-choice columns with their factor version. +\item \code{rd_checkbox}: Expand checkbox responses with custom labels and rename 'var___1' columns (REDCap style) to 'var_option'. \item \code{rd_split}: Splits a REDCap dataset by form or event. +\item \code{rd_insert_na}: Manually set specified variables to missing based on a logical filter. +\item \code{rd_rlogic}: Translate REDCap branching or calculation logic into R syntax. +\item \code{rd_dictionary}: Update dictionary (translation of REDCap logic into R syntax) to reflect transformed data and logic. } -\item \code{rd_rlogic}: Converts REDCap branching and conditional logic into R-compatible expressions. -\item \code{rd_insert_na}: Inserts missing values into specified variables based on filters. \item \code{rd_query}: Identifies discrepancies (queries) in the dataset for validation. \item \code{rd_event}: Detects missing events in longitudinal datasets. \item \code{check_queries}: Compares historical and current query reports to track changes and additions. From fd7c5059a940aa53c3a3080bd80e1fde1beefdcc Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Thu, 13 Nov 2025 19:23:03 +0100 Subject: [PATCH 8/9] lifecycle --- R/suplementary_package.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/suplementary_package.R b/R/suplementary_package.R index 06cd03b..3ba036d 100644 --- a/R/suplementary_package.R +++ b/R/suplementary_package.R @@ -15,7 +15,7 @@ inform_startup <- function(msg, ...) { rlang::inform(msg, ..., class = "packageStartupMessage") } -core <- c("REDCapR", "openxlsx", "labelled", "dplyr", "janitor", "purrr", "rlang", "stringr", "forcats", "tibble", "tidyr", "tidyselect", "utils", "stringi", "cli") +core <- c("REDCapR", "openxlsx", "labelled", "dplyr", "janitor", "purrr", "rlang", "stringr", "forcats", "tibble", "tidyr", "tidyselect", "utils", "stringi", "cli", "lifecycle") core_unloaded <- function() { search <- paste0("package:", core) From e8c92302b5e1a97a9a3f82980d1655fda70927b4 Mon Sep 17 00:00:00 2001 From: jcarmezim Date: Wed, 26 Nov 2025 10:43:41 +0100 Subject: [PATCH 9/9] Final version! --- NAMESPACE | 2 + R/check_queries.R | 100 +++++++++--- R/rd_checkbox.R | 101 ++++++------ R/rd_dates.R | 34 ++-- R/rd_delete_vars.R | 64 ++++---- R/rd_dictionary.R | 55 ++++--- R/rd_event.R | 69 +++++--- R/rd_export.R | 20 +-- R/rd_factor.R | 63 ++++--- R/rd_insert_na.R | 227 ++++++++++++++++++-------- R/rd_query.R | 113 +++++++++---- R/rd_recalculate.R | 66 ++++---- R/rd_rlogic.R | 85 ++++++---- R/rd_split.R | 47 +++--- R/rd_transform.R | 78 +++++---- R/redcap_data.R | 69 ++++---- R/utils-suplement.R | 36 ++-- man/check_queries.Rd | 101 +++++++++--- man/rd_checkbox.Rd | 69 ++++---- man/rd_dates.Rd | 34 ++-- man/rd_delete_vars.Rd | 49 +++--- man/rd_dictionary.Rd | 39 +++-- man/rd_event.Rd | 70 ++++---- man/rd_export.Rd | 20 +-- man/rd_factor.Rd | 36 ++-- man/rd_insert_na.Rd | 51 +++--- man/rd_query.Rd | 85 ++++++---- man/rd_recalculate.Rd | 58 ++++--- man/rd_rlogic.Rd | 44 ++--- man/rd_split.Rd | 48 +++--- man/rd_transform.Rd | 57 ++++--- man/redcap_data.Rd | 61 ++++--- tests/testthat/test-rd_insert_na.R | 119 +++++++++++--- tests/testthat/test-rd_query.R | 164 +++++++++++++++++-- tests/testthat/test-rd_rlogic.R | 136 ++++++++++++++- tests/testthat/test-utils_transform.R | 78 +++++++++ vignettes/REDCapDM.Rmd | 87 ++++++---- 37 files changed, 1734 insertions(+), 901 deletions(-) create mode 100644 tests/testthat/test-utils_transform.R diff --git a/NAMESPACE b/NAMESPACE index ddafc85..ba00b00 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,5 +19,7 @@ import(cli) importFrom(lifecycle,deprecated) importFrom(rlang,":=") importFrom(rlang,.data) +importFrom(rlang,eval_tidy) +importFrom(rlang,parse_expr) importFrom(stats,na.omit) importFrom(stats,setNames) diff --git a/R/check_queries.R b/R/check_queries.R index 14aa8fd..376bcf4 100644 --- a/R/check_queries.R +++ b/R/check_queries.R @@ -3,35 +3,91 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function compares an old query report with a new one to identify the status of each query. -#' Queries are categorized as `new`, `solved`, `pending`, or `miscorrected`. -#' The function generates a detailed comparison dataframe and a summary report. +#' @description +#' Compare an older query report (`old`) with a newer one (`new`) and classify each +#' query into one of four statuses: +#' \itemize{ +#' \item \strong{Pending} — the same query is present in both reports (no change detected), +#' \item \strong{Solved} — the query was present in the old report but is absent from the new report, +#' \item \strong{New} — the query appears in the new report but was not present in the old report, +#' \item \strong{Miscorrected} — a special case where a query in the new report is marked as \code{New} +#' but shares the same \code{Identifier} and \code{Description} as an existing record (suggesting a +#' re-issued or modified query for the same identifier). +#' } +#' +#' The function returns a detailed comparison table of queries with a \code{Modification} factor (one of the four statuses) and an HTML summary table showing counts per status. +#' +#' @param old Data frame containing the previous (older) query report. Must include +#' \code{Identifier}, \code{Description} and \code{Query} columns (character or factor). +#' @param new Data frame containing the newer query report. Must include +#' \code{Identifier}, \code{Description} and \code{Query} columns (character or factor). +#' If \code{new} contains a \code{Code} column, it will be removed at the start of processing. +#' @param report_title Optional single string used as the caption for the HTML summary table. +#' Defaults to \code{"Comparison report"} when not supplied or when \code{NA}. +#' @param return_viewer Logical; if \code{TRUE} (default) an HTML table (knitr/kable + kableExtra) +#' summarizing the counts per state is produced and returned in the \code{results} element of the +#' returned list. If \code{FALSE}, no HTML viewer is produced (useful for non-interactive runs). +#' +#' @return A list with two elements: +#' \describe{ +#' \item{\code{queries}}{A data frame containing all queries present in either \code{old} or \code{new}. +#' A factor column \code{Modification} indicates the state for each row (levels: \code{Pending}, +#' \code{Solved}, \code{Miscorrected}, \code{New}). The function also reassigns \code{Code} +#' values so codes are consistent per \code{Identifier}.} +#' \item{\code{results}}{If \code{return_viewer = TRUE}, an HTML \code{knitr::kable} (styled with +#' \code{kableExtra}) summarising totals per state. If \code{return_viewer = FALSE}, this is \code{NULL}.} +#' } #' -#' @param old Dataframe containing the previous version of the query report. -#' @param new Dataframe containing the new version of the query report.\cr -#' This is compared against the `old` report to determine query statuses. -#' @param report_title (Optional) A character string specifying the title for the generated report.\cr -#' If not provided, the default title will be "Comparison report". -#' @param return_viewer logical, whether to return the HTML viewer (default TRUE) +#' @details +#' Requirements: +#' \itemize{ +#' \item Both \code{old} and \code{new} must be data frames. +#' \item Both data frames must contain at least the following character columns: +#' \code{Identifier}, \code{Description}, and \code{Query}. +#' \item A \code{Code} column is optional; if present it will be preserved and considered +#' for sorting and output. If \code{Code} exists in \code{new}, it is removed at the +#' beginning of the routine to avoid conflicts with re-assigned codes. +#' } #' -#' @return A list containing: -#' \item{queries}{A dataframe with all individual queries from both reports and a status column (`new`, `solved`, `pending`, or `miscorrected`).} -#' \item{results}{A styled HTML summary table showing the total number of queries in each status category.} +#' The function merges the two reports, constructs composite keys used for comparison, classifies each row into a modification state, detects and re-labels \code{Miscorrected} cases, reassigns a \code{Code} per \code{Identifier} to keep codes consistent, and returns a detailed dataset plus an optional HTML summary viewer. +#' +#' @section Notes and edge cases: +#' \itemize{ +#' \item \strong{Column types:} If \code{Identifier}, \code{Description} or \code{Query} are +#' factors, they will be used in the comparison — it is recommended to convert them to +#' character prior to calling \code{check_queries()} to avoid factor-level mismatches. +#' \item \strong{Sorting:} When \code{Identifier} values contain a dash (e.g. \code{"100-20"}), +#' the function attempts to split into numeric \code{center} and \code{id} parts for +#' logical ordering. Otherwise \code{Identifier} is coerced to numeric for ordering. +#' \item \strong{Miscorrected detection:} A \code{Miscorrected} label is assigned when more +#' than one row shares the same \code{Identifier + Description} composite and a row is +#' otherwise classified as \code{New} — this signals a likely re-issued or modified query +#' for an existing identifier. +#' } #' #' @examples -#' # Example of a query -#' data_old <- rd_query(covican, -#' variables = "copd", -#' expression = "is.na(x)", -#' event = "baseline_visit_arm_1" +#' # Minimal reproducible example +#' old <- data.frame( +#' Identifier = c("100-1", "100-2", "200-1"), +#' Description = c("age check", "weight check", "lab miss"), +#' Query = c("is.na(age)", "is.na(weight)", "missing lab result"), +#' Code = c("100-1-1", "100-2-1", "200-1-1"), +#' stringsAsFactors = FALSE #' ) -#' data_new <- rbind(data_old$queries[1:5, ], c("100-20", rep("abc", 8))) #' -#' # Compare the two query reports -#' check <- check_queries( -#' old = data_old$queries, -#' new = data_new +#' new <- data.frame( +#' Identifier = c("100-1", "200-1", "300-1"), +#' Description = c("age check", "lab miss", "new query"), +#' Query = c("is.na(age)", "missing lab result (clarify)", "is.na(x)"), +#' stringsAsFactors = FALSE #' ) +#' +#' res <- check_queries(old = old, new = new, report_title = "My Query Comparison") +#' # detailed table +#' head(res$queries) +#' # HTML summary (if in an RMarkdown or interactive viewer) +#' res$results +#' #' @export check_queries <- function(old, new, report_title = NULL, return_viewer = TRUE) { diff --git a/R/rd_checkbox.R b/R/rd_checkbox.R index e37630d..3c8a32a 100644 --- a/R/rd_checkbox.R +++ b/R/rd_checkbox.R @@ -3,52 +3,59 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function is used to convert checkbox variables in a REDCap dataset from their default categories (e.g., "Checked" and "Unchecked") to numeric values (0 and 1), and optionally, relabel and rename them according to user-defined options. It also evaluates branching logic for checkbox fields and adjusts the data and dictionary accordingly. +#' This function is used to process checkbox variables in a REDCap dataset. By default, it changes their default categories ("Unchecked" and "Checked") to new ones ("No" and "Yes). Optionally, the function can also evaluate the branching logic for checkbox fields and adjust the data and dictionary accordingly. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param checkbox_labels A character vector of length 2 specifying the labels to be used for the checkbox options. Defaults to `c("No", "Yes")`. -#' @param checkbox_na Logical indicating whether to assign `NA` to checkbox fields when the branching logic condition is not satisfied. Defaults to `FALSE`. -#' @param checkbox_names Logical indicating whether to rename the checkbox variables in the dataset and dictionary according to their label options. Defaults to `TRUE`. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param checkbox_labels Character vector of length 2 for labels of unchecked/checked values. Default: `c("No", "Yes")`. +#' @param checkbox_names Logical. If `TRUE` (default), checkbox columns are renamed using choice labels. +#' @param na_logic Controls how missing values are set based on branching logic. Must be one of `"none"` (do nothing), `"missing"` (set to `NA` only when the logic evaluation is `NA`), or `"eval"` (set to `NA` when the logic evaluates to `FALSE`). Defaults to `"none"`. #' -#' @return A list containing the following elements: -#' \item{data}{The transformed dataset with checkbox variables updated.} -#' \item{dictionary}{The updated dictionary reflecting any changes made to the checkbox fields, including renamed variables.} -#' \item{event_form}{The event-form mapping (if provided).} -#' \item{results}{A summary of the transformation process, including any issues with branching logic or fields that need review.} +#' @return A list with: +#' \describe{ +#' \item{data}{Transformed dataset with checkbox fields as factors and optionally renamed.} +#' \item{dictionary}{Updated dictionary with checkbox fields expanded and optionally renamed.} +#' \item{event_form}{The `event_form` passed in (if applicable).} +#' \item{results}{Summary of transformations and any fields needing review.} +#' } #' #' @details -#' This function is primarily used to process checkbox fields in a REDCap project. It performs the following: -#' - Converts checkbox variables in the dataset from text labels ("Checked" and "Unchecked") to numeric values (0 and 1), and then applies the specified labels. -#' - Optionally renames the checkbox variables based on their labels (e.g., transforming variable names like `varname___1` to `varname_Yes`). -#' - Optionally modifies the branching logic in the REDCap dictionary to reflect renamed checkbox options. +#' * Checkbox columns are expected in REDCap wide format (`field___code`). +#' * Branching logic evaluation requires `event_form` for longitudinal projects. +#' * Names are cleaned and truncated to 60 characters; uniqueness is enforced. +#' * Fields that cannot be evaluated are listed in `results`. #' -#' @note -#' - If `event_form` is not provided for a longitudinal project, the function may not be able to evaluate branching logic correctly. #' #' @examples -#' # Example with a project object containing data and dictionary -#' results <- rd_checkbox(project = covican) +#' # Basic usage with a project object +#' res <- rd_checkbox(covican) #' -#' # Example with custom labels for the checkboxes -#' results <- rd_checkbox( -#' data = covican$data, -#' dic = covican$dictionary, -#' checkbox_labels = c("No", "Yes") -#' ) +#' # With custom labels +#' res <- rd_checkbox(data = covican$data, +#' dic = covican$dictionary, +#' checkbox_labels = c("Not present", "Present")) #' -#' # Example without renaming checkbox fields -#' results <- rd_checkbox(covican, checkbox_names = FALSE) +#' # Keep original checkbox names +#' res <- rd_checkbox(covican, checkbox_names = FALSE) +#' +#' # Longitudinal project with NA logic +#' res <- rd_checkbox(data = covican$data, +#' dic = covican$dictionary, +#' event_form = covican$event_form,, +#' na_logic = "eval") #' #' @export #' @importFrom stats setNames na.omit -rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, checkbox_names = TRUE) { +rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_names = TRUE, na_logic = "none") { results <- NULL rlogic_eval <- NULL + # validate na_logic against allowed choices + na_logic <- match.arg(na_logic, choices = c("none", "missing", "eval")) + # Handle potential overwriting when both `project` and other arguments are provided if (!is.null(project)) { env_vars <- check_proj(project, data, dic, event_form) @@ -115,21 +122,17 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU } # Update results with the this transformation - transf_message <- if (!repeat_instrument) { - reason <- if (checkbox_na) - "when the logic isn't satisfied or it's missing" - else - "when the logic is missing" - - stringr::str_glue( - "Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. ", - "For checkboxes that have a branching logic, {reason} their values will be set to missing." - ) - } else { - stringr::str_glue( - "Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options." - ) - } + reason <- if (na_logic == "eval") + "when the logic isn't satisfied or it's missing" + else if (na_logic == "missing") + "when the logic is missing" + else + "" + + base <- "Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options." + + transf_message <- if (repeat_instrument || reason == "") base + else paste0(base, " For checkboxes that have a branching logic, ", reason, " their values will be set to missing.") if (is.null(results)) { results <- c(results, stringr::str_glue("{transf_message} (rd_checkbox)\n")) @@ -159,8 +162,6 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU warning("The project contains repeated instruments, and this function cannot accurately evaluate the branching logic of checkboxes in such cases.", call. = FALSE) } - # warning(stringr::str_glue("There are {sum(dic$field_type == 'checkbox' & dic$branching_logic_show_field_only_if != '')} checkboxes with branching logic, please specify `checkbox_na` to determine the behaviour of this function for these cases.\n For more information `?rd_checkbox`."), call. = FALSE) - caption <- "Checkbox variables advisable to be reviewed" review <- NULL @@ -193,11 +194,11 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU } # Set missing values where logic is not satisfied - if (checkbox_na) { + if (na_logic == "eval") { for (j in seq_along(vars_data)) { data[, vars_data[j]] <- ifelse(rlogic_eval, as.character(data[, vars_data[j]]), NA) } - } else { + } else if (na_logic == "missing") { # Set missing values only where logic evaluation is missing for (j in seq_along(vars_data)) { data[, vars_data[j]] <- ifelse(!is.na(rlogic_eval), as.character(data[, vars_data[j]]), NA) @@ -310,6 +311,8 @@ rd_checkbox <- function(project = NULL, data = NULL, dic = NULL, event_form = NU "The transformed checkbox name '{out0}' already exists in the dataset. It has been renamed to '{out[j]}' to avoid conflicts." ) ) + + correspondence[,"out"] <- ifelse(correspondence[,"out"] == out0, out[j], correspondence[,"out"]) } # Update the variable names in the data and dictionary diff --git a/R/rd_dates.R b/R/rd_dates.R index 4521fce..bbb3921 100644 --- a/R/rd_dates.R +++ b/R/rd_dates.R @@ -3,31 +3,31 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function processes and transforms date and datetime fields in a REDCap dataset. +#' Converts date and datetime fields in a REDCap dataset to appropriate R classes. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. #' -#' @return A list containing the following elements: -#' \item{data}{The transformed dataset with date and datetime variables correctly formatted.} -#' \item{dictionary}{The original data dictionary passed to the function.} -#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} +#' @return A list with the following elements: +#' \describe{ +#' \item{data}{The transformed dataset with date and datetime fields formatted as `Date` and `POSIXct`.} +#' \item{dictionary}{The original REDCap dictionary passed to the function.} +#' \item{event_form}{The original event-form mapping (if applicable).} +#' \item{results}{A summary of the transformations performed.} +#' } #' #' @details #' The function performs the following tasks: -#' - Extracts date and datetime fields from the data dictionary using validation types -#' (`date_*` and `datetime_*`). -#' - Converts these fields in the dataset to `Date` and `POSIXct` objects, respectively. +#' * Detects date and datetime fields from the REDCap dictionary (`date_*` and `datetime_*` validation types). +#' * Converts date fields to `Date` class. +#' * Converts datetime fields to `POSIXct` class, treating empty strings as `NA`. #' #' #' @examples -#' -#' # Example usage: -#' result <- rd_dates(data = covican$data, dic = covican$dictionary) -#' -#' result <- covican |> rd_dates() +#' result <- rd_dates(covican) +#' transformed_data <- result$data #' #' @export #' @importFrom stats na.omit diff --git a/R/rd_delete_vars.R b/R/rd_delete_vars.R index 1d8056a..8c51beb 100644 --- a/R/rd_delete_vars.R +++ b/R/rd_delete_vars.R @@ -1,44 +1,40 @@ -#' Delete Variables from REDCap Data and Dictionary +#' Delete Variables from REDCap Dataset and Dictionary #' #' @description #' `r lifecycle::badge('experimental')` #' -#' This function removes variables from a REDCap dataset and its associated dictionary based on -#' specific variable names or patterns. It ensures consistency between the data and dictionary -#' while preserving labels. +#' Deletes selected variables from a REDCap dataset and its dictionary, keeping them consistent and preserving variable labels. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, -#' typically the output of the `redcap_data` function. If provided, -#' it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, -#' including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. -#' Optional; defaults to `NULL` if not applicable. -#' @param vars A character vector specifying variable names to delete from the dataset and dictionary. -#' These variables will be removed from both the `data` and `dic`. -#' @param pattern A character vector of regular expression patterns. Variables matching these patterns -#' will be removed from the `data` and `dic`. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param vars Optional. A character vector of variable names to remove from both the dataset and dictionary. +#' @param pattern Optional. A character vector of regular expression patterns. Variables matching these patterns will be removed from the dataset and dictionary. #' -#' @return A list containing the following elements: -#' \item{data}{The updated dataset with specified variables removed.} -#' \item{dictionary}{The updated data dictionary with corresponding variables removed.} -#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} #' #' @details -#' The function performs the following operations: -#' - Removes variables specified in the `vars` argument from both the dataset and dictionary. -#' - Removes variables matching patterns provided in the `pattern` argument. +#' - Ensure that at least one of `vars` or `pattern` is specified. +#' - Removes specified variables and their factor versions (e.g., `variable.factor`) from the dataset. +#' - Removes matching variables from the dictionary. +#' - Warns about factor versions of variables matching patterns, recommending use of `rd_factor()` if necessary. #' -#' @examples -#' # Example usage: +#' @return A list containing: +#' \describe{ +#' \item{data}{The updated dataset with specified variables removed.} +#' \item{dictionary}{The updated REDCap dictionary.} +#' \item{event_form}{The original event-form mapping (if applicable).} +#' \item{results}{A summary message describing the variable removal operation.} +#' } #' -#' # Deleting specific variables -#' result <- rd_delete_vars(covican, +#' @examples +#' # Delete specific variables by name +#' result <- rd_delete_vars( +#' project = covican, #' vars = c("potassium", "leuk_lymph") #' ) #' -#' # Deleting variables based on patterns +#' # Delete variables matching patterns #' result <- rd_delete_vars( #' data = covican$data, #' dic = covican$dictionary, @@ -46,7 +42,6 @@ #' ) #' #' @export -#' @importFrom stats na.omit rd_delete_vars <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars = NULL, pattern = NULL) { results <- NULL @@ -114,10 +109,17 @@ rd_delete_vars <- function(project = NULL, data = NULL, dic = NULL, event_form = names() if (length(pattern_factor) > 0) { - pattern_factor <- paste0(pattern_factor, ".factor") + pattern_factor <- ifelse( + endsWith(pattern_factor, ".factor"), + pattern_factor, + paste0(pattern_factor, ".factor") + ) + + vars_eliminated <- data |> + dplyr::select(!dplyr::matches(comb_pattern)) # Warn if factor versions of the variables matching the patterns are present in the dataset - if (any(pattern_factor %in% names(data) & grepl("\\$", pattern))) { + if (any(pattern_factor %in% names(vars_eliminated)) & any(grepl("\\$", pattern))) { warning("The dataset contains factor versions of variables matching the specified patterns. To properly remove them, use the `rd_factor` function first.", call. = FALSE) } } diff --git a/R/rd_dictionary.R b/R/rd_dictionary.R index bbf402d..c234303 100644 --- a/R/rd_dictionary.R +++ b/R/rd_dictionary.R @@ -3,26 +3,33 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function updates the data dictionary by evaluating and transforming the branching logic expressions for each field in the dictionary. -#' It checks if any branching logic is present and attempts to convert it using the specified data, dictionary, and event-form mapping. -#' If there are any issues with the conversion, those fields are listed in the results. +#' Updates a REDCap data dictionary by converting branching logic and calculation expressions into valid R expressions. This ensures that conditional display rules and calculated fields in the dictionary can be programmatically evaluated with the dataset. Any variables that cannot be converted are reported in the results. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. #' -#' @return A list containing the following elements: -#' \item{data}{The original dataset, passed to the function.} -#' \item{dictionary}{The updated data dictionary, with modified branching logic.} -#' \item{event_form}{The original event-form mapping, passed to the function (if applicable).} -#' \item{results}{A string summarizing the results of the transformation process, including any variables with unconverted branching logic.} +#' @return A list with the following elements: +#' \describe{ +#' \item{data}{The original dataset passed to the function.} +#' \item{dictionary}{The updated data dictionary with modified branching logic and calculations.} +#' \item{event_form}{The original event-form mapping (if applicable).} +#' \item{results}{A summary of the transformations, including any variables with unconverted branching logic.} +#' } #' -#' @examples -#' -#' result <- covican |> rd_dictionary() +#' @details +#' The function performs the following tasks: +#' * Evaluates and transforms branching logic expressions into valid R expressions using `rd_rlogic`. +#' * Evaluates and converts calculation expressions for fields of type `calc`. +#' * Generates a results summary table listing any variables that could not be converted. #' +#' @examples +#' \dontrun{ +#' result <- rd_dictionary(covican) #' print(result$results) +#' updated_dic <- result$dictionary +#' } #' #' @export #' @importFrom stats setNames na.omit @@ -100,12 +107,15 @@ rd_dictionary <- function(project = NULL, data = NULL, dic = NULL, event_form = } logics <- NULL - # Generamos el objeto + # Generate the object that will contain the warnings warnings_env <- new.env(parent = emptyenv()) warnings_env$count <- 0 warnings_env$msgs <- character() warnings_env$id <- numeric() + # Starting time + start_time <- Sys.time() + # Identify rows in the dictionary with branching logic that needs evaluation pos_branch <- which(!dic$branching_logic_show_field_only_if %in% "") @@ -141,14 +151,15 @@ rd_dictionary <- function(project = NULL, data = NULL, dic = NULL, event_form = } } - # Identify rows in the dictionary with calculations that need evaluation - pos_calc <- which(dic$field_type == "calc") - - message("\u23F3 Almost done!") + # Warning with almost done + elapsed <- as.numeric(Sys.time() - start_time, units = "secs") - # message("\u23F3 Just a few more steps left!") + if (elapsed > 10) { + message("\u23F3 Almost done!") + } - # browser() + # Identify rows in the dictionary with calculations that need evaluation + pos_calc <- which(dic$field_type == "calc") # Loop through each row with calculations for (i in pos_calc) { diff --git a/R/rd_event.R b/R/rd_event.R index 673d5a6..bf99944 100644 --- a/R/rd_event.R +++ b/R/rd_event.R @@ -3,40 +3,55 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function identifies records in a REDCap longitudinal project that are missing specific events. -#' REDCap does not export events with no data by default, which can create challenges in verifying completeness. -#' This function provides insights into missing events, allowing you to identify which records do not contain information about a particular event. +#' Helps identify records in a REDCap longitudinal project that are missing one or more specified events. Because REDCap typically omits empty events from exports, an event that contains no data for a record will not appear. This function finds those absent events and returns a per-record query table and a summarized HTML report. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param event A character vector specifying the name(s) of the REDCap event(s) to analyze for missing records. -#' @param filter An optional filter to apply to the dataset. This can be used to identify missing events in a subset of the data. -#' @param query_name A description of the query. Defaults to "The event (event_name) is missing" for each event if not provided. -#' @param addTo A data frame of previous query results to which new queries can be appended. If not provided, the function creates a new data frame. -#' @param report_title An optional title for the report. -#' @param report_zeros Logical; if `TRUE`, includes a report of variables without missing data. -#' @param link A list containing project information used to generate links for each missing event. Requires `domain`, `redcap_version`, and `proj_id` keys. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param event Character vector with one or more REDCap event names to check for missing records. +#' @param filter Optional. A single character string containing a filter expression to subset the dataset before checking for missing events. Example: \code{"age >= 18"}. +#' @param query_name Optional character vector describing each query. Defaults to a standard format: `The event (event_name) is missing`. +#' @param addTo Optional data frame from a previous query report to which the new results can be appended. +#' @param report_title Optional string specifying the title of the final report. Defaults to `"Report of queries"`. +#' @param report_zeros Logical, include variables with zero queries in the report. Default is `FALSE`. +#' @param link Optional list containing project information (`domain`, `redcap_version`, `proj_id`, `event_id`) to generate clickable links for each query. #' -#' @return A list with two elements: -#' \item{queries}{A data frame listing records with missing events, including metadata for each record.} -#' \item{results}{A summary table (HTML) showing the count of missing events for each analyzed event.} #' +#' @return A named list with two elements: +#' \describe{ +#' \item{\code{queries}}{A data frame listing records missing the specified events. +#' Columns: \code{Identifier}, \code{DAG}, \code{Event}, \code{Instrument}, +#' \code{Field}, \code{Repetition}, \code{Description}, \code{Query}, \code{Code}, +#' and optionally \code{Link}. If no queries are found this will be an empty +#' data frame with the expected columns.} +#' \item{\code{results}}{An HTML table (knitr::kable styled with kableExtra) summarising +#' the number of missing records per event. Returned as \code{knitr::kable} (HTML).} +#' } #' -#' @details -#' The function is designed to work with REDCap longitudinal projects, which may not include empty events in their exports. -#' By specifying the events of interest, users can quickly identify missing records for a specific event. -#' Filters can be applied to focus the analysis on specific subsets of the data. -#' -#' If project information (`link`) is provided, the output will include clickable URLs for each missing record. #' #' @examples -#' # Example usage with a REDCap dataset: -#' example <- covican |> rd_event(event = "follow_up_visit_da_arm_1") +#' # Minimal reproducible example +#' data0 <- data.frame( +#' record_id = c("100-1", "100-2", "200-1"), +#' redcap_event_name = c("baseline_arm_1", "baseline_arm_1", "follow_up_arm_1"), +#' redcap_event_name.factor = factor(c("Baseline", "Baseline", "Follow-up")), +#' stringsAsFactors = FALSE +#' ) +#' +#' # Suppose we want to check that every record has the follow-up event +#' res <- rd_event( +#' data = data0, +#' dic = data.frame(), # placeholder dictionary +#' event = "follow_up_arm_1", +#' report_zeros = TRUE +#' ) +#' +#' # Records missing the event: +#' res$queries #' -#' example$queries -#' example$results +#' # HTML summary (in RMarkdown or Viewer) +#' res$results #' #' @export #' @importFrom rlang .data diff --git a/R/rd_export.R b/R/rd_export.R index 4a24d38..15bc41a 100644 --- a/R/rd_export.R +++ b/R/rd_export.R @@ -3,23 +3,19 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function exports a query dataset, typically generated using `rd_query` or `rd_event`, into an `.xlsx` file. -#' It supports adding hyperlinks to specified columns and optional password protection for the worksheet. +#' Export a query dataset (e.g., from `rd_query` or `rd_event`) to an `.xlsx` file. The function can optionally convert a column of URLs into Excel hyperlinks and apply password protection to the worksheet. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param queries A data frame containing the identified queries. If `...` is provided, this argument is ignored. -#' @param column A string specifying the column in the dataset that contains hyperlinks. If not specified, -#' hyperlinks will not be added unless a column named `Link` is detected. -#' @param sheet_name A string specifying the name of the sheet in the resulting `.xlsx` file. Defaults to `"Sheet1"`. -#' @param path A string specifying the file path to save the `.xlsx` file. If `NULL`, the file is saved in the -#' current working directory with the name `example.xlsx`. -#' @param password An optional string to password-protect the worksheet, preventing unauthorized edits. +#' @param project A list containing the dataframe of queries and results (expected `rd_query` or `rd_event` output). Overrides `queries`. +#' @param queries A data frame of identified queries. +#' @param column Name of the column containing URLs to convert into hyperlinks. If `NULL`, hyperlinks are added only if a `Link` column exists. +#' @param sheet_name Name of the Excel sheet in the resulting `.xlsx` file. Default: `"Sheet1"`. +#' @param path File path for saving the `.xlsx` file. If `NULL`, the file is saved as `"example.xlsx"` in the working directory. +#' @param password Optional password to protect the worksheet from edits. #' -#' @return An `.xlsx` file saved to the specified path, containing the query data and hyperlinks if specified. +#' @return An `.xlsx` file written to the specified path. #' #' @examples #' \dontrun{ -#' # Export queries to an Excel file #' rd_export( #' queries = my_queries, #' column = "Link", diff --git a/R/rd_factor.R b/R/rd_factor.R index 0374b29..51fabb3 100644 --- a/R/rd_factor.R +++ b/R/rd_factor.R @@ -3,31 +3,31 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function converts variables in a REDCap dataset that have associated `.factor` columns into actual factor variables. It also allows for the exclusion of specific variables from being converted into factors. +#' Converts variables in a REDCap dataset with associated `.factor` columns into actual factor variables, while allowing the exclusion of specific variables. Ensures consistency with the dataset and preserves variable labels. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param exclude A character vector of variable names to exclude from being converted into factors. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param exclude Optional character vector of variable names (use original names **without** the `.factor` suffix) to exclude from conversion. #' -#' @return A list containing: -#' \item{data}{The transformed dataset with factor variables applied.} -#' \item{dictionary}{The dictionary used.} -#' \item{event_form}{The event-form mapping used (if provided).} -#' \item{results}{A string summarizing the changes made during the transformation.} +#' @return A list with the following elements: +#' \describe{ +#' \item{data}{The transformed dataset with `.factor` columns applied as factors.} +#' \item{dictionary}{The dictionary used (unchanged).} +#' \item{event_form}{The event-form mapping used (if applicable).} +#' \item{results}{A brief text summary of the transformation.} +#' } #' #' @details -#' This function searches for columns in the data that have a `.factor` suffix (indicating that they can be converted into factors) and converts them into factors based on their labels. -#' The `exclude` argument allows you to specify which variables should not be converted. -#' The function also modifies the branching logic in the dictionary to reflect the changes made in the data. -#' -#' Variables with the names `redcap_event_name.factor` and `redcap_data_access_group.factor` are excluded from the conversion process to avoid altering event and access group information. +#' The function looks for columns ending in `.factor` and replaces the original variable values with those `.factor` values (converted to factors). It preserves variable labels. The `exclude` argument must contain base variable names (no `.factor` suffix); if any `.factor` names are passed to `exclude` the function will throw an informative error. The columns `redcap_event_name`, `redcap_repeat_instrument` and `redcap_data_access_group` (and their `.factor` counterparts) are handled specially to avoid altering event or access-group data. #' #' @examples -#' result <- REDCapDM::rd_factor(covican, exclude = c("available_analytics", "urine_culture")) -#' +#' \dontrun{ +#' result <- rd_factor(covican) +#' result <- rd_factor(covican, exclude = c("available_analytics", "urine_culture")) #' transformed_data <- result$data +#' } #' #' @export #' @importFrom stats na.omit @@ -67,13 +67,26 @@ rd_factor <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL data <- data |> dplyr::select(-dplyr::any_of(keep)) - # Identify the columns ending with '.factor' (these are the potential factor variables) - factors <- data |> - dplyr::select(dplyr::matches("\\.factor$")) |> - names() |> - stringr::str_remove("\\.factor$") - - factors <- setdiff(factors, stringr::str_remove(keep, "\\.factor$")) + # Identify factor columns and remove orphans + factor_cols <- grep("\\.factor$", names(data), value = TRUE) + factors <- sub("\\.factor$", "", factor_cols) + factors <- setdiff(factors, sub("\\.factor$", "", keep)) + + # Detect orphan .factor columns (base column missing) + orphan <- factor_cols[!factors %in% names(data)] + + if (length(orphan) > 0) { + warning( + stringr::str_glue( + "Removed {length(orphan)} '.factor' column(s) whose original variables no longer exist. This usually happens if the original variables were deleted earlier using `rd_delete_vars` and the '.factor' version was kept." + ), + call. = FALSE + ) + # Remove orphan columns + data <- data[, setdiff(names(data), orphan)] + # Update factors vector after removal + factors <- setdiff(factors, sub("\\.factor$", "", orphan)) + } # If there are no factor variables, stop the function if (length(factors) == 0) { diff --git a/R/rd_insert_na.R b/R/rd_insert_na.R index 0cb3b72..43a4faa 100644 --- a/R/rd_insert_na.R +++ b/R/rd_insert_na.R @@ -3,37 +3,43 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function allows you to manually insert a missing value into certain variables (`vars`) if the specified filter/s (`filter`) are satisfied. -#' It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. +#' Sets selected variables to `NA` when a filter condition is satisfied. Useful for managing checkboxes or other fields without explicit gatekeeper questions. #' +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param vars Character vector of variable names to set to `NA`. +#' @param filter A single logical expression (as string). Rows where the filter evaluates to `TRUE` will have the corresponding `vars` set to `NA`. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param vars A character vector with the names of the variables to be transformed. -#' @param filter A character vector of logical expressions to evaluate. If the evaluation is `TRUE`, the corresponding variable in `vars` is set to `NA`. +#' @details +#' * Each variable is only updated in rows/events where both the variable and filter are present. +#' * For longitudinal projects, `event_form` must be provided for proper event-level filtering. +#' * Only one filter expression is allowed. +#' * Variables and filter columns must exist in both `data` and `dictionary`. #' -#' @note -#' Each variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. -#' -#' @return The modified data frame with the specified variables updated. +#' @return A list with: +#' \describe{ +#' \item{data}{The dataset with `NA` inserted where the filter applies.} +#' \item{dictionary}{The unchanged dictionary.} +#' \item{event_form}{The `event_form` passed in (if applicable).} +#' \item{results}{Summary message of the changes applied.} +#' } #' #' @examples -#' -#' # Example usage: -#' table(is.na(covican$data$potassium)) -#' -#' data <- covican |> -#' rd_insert_na( -#' vars = "potassium", -#' filter = "age < 65" -#' ) -#' +#' # Set 'potassium' to NA where age < 65 +#' \dontrun{ +#' data <- rd_insert_na( +#' data = covican$data, +#' dic = covican$dictionary, +#' vars = "potassium", +#' filter = "age < 65" +#' ) #' table(data$potassium) +#' } #' #' @export -#' @importFrom rlang .data +#' @importFrom rlang .data parse_expr eval_tidy rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, vars, filter) { @@ -59,41 +65,111 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = N stop("The dataset contains multiple events, but the `event_form` mapping was not provided. Please specify it.") } - # Validate matching lengths of `vars` and `filter` - if (length(filter) != length(vars)) { - stop("The number of variables (`vars`) does not match the number of filters (`filter`). Ensure both have equal length.") + # Validate there is exactly one filter and allow multiple vars + if (length(filter) != 1) { + stop("Please provide exactly one filter.") } else { - # Loop through variables and filters to apply transformations - for (i in seq_along(filter)) { - # For every filter & variable get the variables specified in the filter and their events (if there is more than one event) - if (longitudinal) { - # Parse variables within the filter expression - vars_filter <- trimws(unlist(stringr::str_split(filter[i], "[&|]"))) - vars_filter <- gsub("!?is.na\\(", "", vars_filter) - vars_filter <- unlist(stringr::str_extract_all(vars_filter, "^\\w+")) - - # Extract corresponding events for filter variables - event_filter <- tibble::tibble(vars_filter = vars_filter) |> - dplyr::mutate( - form = purrr::map_chr(.data$vars_filter, ~ dic |> - dplyr::filter(.data$field_name %in% .x) |> - dplyr::pull(.data$form_name)), - event = purrr::map(.data$form, ~ event_form |> - dplyr::filter(.data$form %in% .x) |> - dplyr::pull(.data$unique_event_name)) - ) - - # Identify common events for filter variables - events <- Reduce(intersect, event_filter$event) - - # Stop if there are no common events - if (length(events) == 0) { - stop("The variables in the filter belong to different events.") + # Parse variables within the single filter expression once + vars_filter <- trimws(unlist(stringr::str_split(filter[1], "[&|]"))) + vars_filter <- gsub("!?is.na\\(", "", vars_filter) + vars_filter <- gsub("\\[|\\]", "", vars_filter) + vars_filter <- gsub("data\\$", "", vars_filter) + vars_filter <- unlist(stringr::str_extract_all(vars_filter, "^\\w+")) + vars_filter <- unique(vars_filter) + + # check filter vars exist in the dataset + missing_in_data <- vars_filter[!vars_filter %in% names(data)] + if (length(missing_in_data) > 0) { + stop( + sprintf( + "Filter variable(s) not found in data: %s", + paste(shQuote(missing_in_data), collapse = ", ") + ), + call. = FALSE + ) + } + + # check filter vars exist in the dictionary + missing_in_dic <- vars_filter[!vars_filter %in% dic$field_name] + if (length(missing_in_dic) > 0) { + stop( + sprintf( + "Filter variable(s) not found in dictionary: %s", + paste(shQuote(missing_in_dic), collapse = ", ") + ), + call. = FALSE + ) + } + + # Extract corresponding events for filter variables + event_filter <- tibble::tibble(vars_filter = vars_filter) |> + dplyr::mutate( + form = purrr::map_chr(.data$vars_filter, ~ dic |> + dplyr::filter(.data$field_name %in% .x) |> + dplyr::pull(.data$form_name)), + event = purrr::map(.data$form, ~ event_form |> + dplyr::filter(.data$form %in% .x) |> + dplyr::pull(.data$unique_event_name)) + ) + + # Identify common events for filter variables + events <- Reduce(intersect, event_filter$event) + + # Stop if there are no common events among filter variables + if (length(events) == 0) { + stop("The variables in the filter belong to different events.") + } + + # Evaluate the filter expression once to get logical mask for rows + filter_expr <- tryCatch({ + rlang::parse_expr(filter[1]) + }, error = function(e) { + stop(sprintf("Unable to parse filter expression '%s'.", filter[1]), call. = FALSE) + }) + + rows_mask <- tryCatch({ + # Evaluate in the context of `data`; result should be logical vector of length nrow(data) + rlang::eval_tidy(filter_expr, data = data) + }, error = function(e) { + stop(sprintf("Error evaluating filter '%s'.", filter[1]), call. = FALSE) + }) + + if (!is.logical(rows_mask) || length(rows_mask) != nrow(data)) { + stop(sprintf("Filter '%s' did not return a logical vector with length equal to nrow(data).", filter[1])) + } + + # Validate that provided vars exist in data and in dictionary + missing_vars_in_data <- vars[!vars %in% names(data)] + if (length(missing_vars_in_data) > 0) { + stop(sprintf("Variable(s) not found in data: %s", paste(shQuote(missing_vars_in_data), collapse = ", ")), call. = FALSE) + } + missing_vars_in_dic <- vars[!vars %in% dic$field_name] + if (length(missing_vars_in_dic) > 0) { + stop(sprintf("Variable(s) not found in dictionary: %s", paste(shQuote(missing_vars_in_dic), collapse = ", ")), call. = FALSE) + } + + # Try to detect an event column in `data` (common names or values matching event_form) + event_col <- NULL + candidate_names <- c("redcap_event_name", "unique_event_name", "event_name", "event") + event_col <- intersect(names(data), candidate_names)[1] + if (is.null(event_col)) { + for (col in names(data)) { + col_values <- unique(data[[col]]) + if (any(col_values %in% event_form$unique_event_name, na.rm = TRUE)) { + event_col <- col + break } + } + } + # Loop through the variables to transform + for (j in seq_along(vars)) { + var_j <- vars[j] + + if (longitudinal) { # Identify events for the variable to be transformed form_var <- dic |> - dplyr::filter(.data$field_name == vars[i]) |> + dplyr::filter(.data$field_name == var_j) |> dplyr::pull(.data$form_name) event_var <- event_form |> @@ -103,39 +179,54 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = N # Ensure the variable's events overlap with filter events match_events <- intersect(events, event_var) - # Error: filter variables are in different events from the variable to be transformed + # Error: no overlapping events between the variable and the filter if (length(match_events) == 0) { - stop("The variable `{vars[i]}` and the filter do not overlap in any events.") + stop(stringr::str_glue("The variable `{var_j}` and the filter do not overlap in any events."), call. = FALSE) } else { - # Warn: one of the events of the variable is not present in the filter + # Warn: variable present in more events than the filter if (!all(event_var %in% match_events)) { warning(stringr::str_glue( - "The variable `{vars[i]}` is present in more events than the filter. ", + "The variable `{var_j}` is present in more events than the filter. ", "Only rows in common events ({paste(match_events, collapse = ', ')}) will be transformed." )) } } + } else { + # not longitudinal: no per-event checks required + match_events <- NULL } - # Apply transformation: set specified variable to NA if filter is true - id <- data |> - dplyr::mutate(id = dplyr::row_number()) |> - dplyr::filter(eval(parse(text = filter[i]))) |> - dplyr::pull(id) + # Compute candidate row ids where the filter is TRUE + ids <- which(rows_mask) + + # If longitudinal and an event column is found, restrict ids to the overlapping events for this var + if (longitudinal && !is.null(event_col)) { + ids <- ids[which(data[[event_col]][ids] %in% match_events)] + } else if (longitudinal && is.null(event_col)) { + # No event column found in data — warn that event-level restriction cannot be applied + warning("No event column detected in `data`. The filter will be applied across all rows (event-level restriction skipped).") + } - data[id, vars[i]] <- NA + # Apply the transformation (set selected rows for var_j to NA) + if (length(ids) > 0) { + data[ids, var_j] <- NA + } else { + # No rows to change for this variable (possible due to event restriction) + # We do not stop here; just inform via a message (could be silent depending on preference) + message(sprintf("No rows matched for variable '%s' after applying filter and event overlap.", var_j)) + } } # Reapply variable labels to the data after transformation data <- data |> labelled::set_variable_labels(.labels = labels |> as.list(), .strict = FALSE) - # Update results with the this transformation + # Update results with this transformation + inserted_msg <- stringr::str_glue("Inserting missing values into variable(s): {paste(vars, collapse = ', ')}. (rd_insert_na)\n") if (is.null(results)) { - results <- c(results, stringr::str_glue("Inserting missing values into certain variables. (rd_insert_na)\n")) + results <- c(results, inserted_msg) } else { - - if(grepl("^[A-Z]", results[1])) { + if (grepl("^[A-Z]", results[1])) { results[1] <- paste("1.", results[1]) } @@ -146,7 +237,7 @@ rd_insert_na <- function(project = NULL, data = NULL, dic = NULL, event_form = N stringr::str_remove("\\.") |> as.numeric() - results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. Inserting missing values into certain variables. (rd_insert_na)\n")) + results <- c(results, stringr::str_glue("\n\n{last_val_res + 1}. {inserted_msg}\n")) } # Return the updated data, dictionary, event_form, and results (if present) diff --git a/R/rd_query.R b/R/rd_query.R index acc5df2..121e435 100644 --- a/R/rd_query.R +++ b/R/rd_query.R @@ -3,56 +3,74 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function allows you to identify queries based on a specific expression or filter. It is useful for detecting missing values or values that fall outside predefined lower or upper limits of a variable. -#' The function can also apply branching logic to variables, enabling targeted query identification in REDCap datasets. +#' Detects and summarizes queries in a REDCap dataset based on specified expressions, filters, or a defined branching logic. Useful for identifying missing values, out-of-range values, or values that do not meet predefined criteria. +#' +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param variables Character vector of variable names to check for queries. +#' @param expression Character vector of R expressions to evaluate for each variable. +#' @param negate Logical, if `TRUE`, identifies values that **do not** meet the condition. Default is `FALSE`. +#' @param variables_names Optional character vector of descriptions for each variable. Defaults to the variables labels in the dictionary. +#' @param query_name Optional character vector describing each query. Defaults to a standard format: `The value is [value] and it should not be [expression]`. +#' @param event Required for longitudinal projects to avoid overestimation. REDCap event(s) to analyze. +#' @param instrument Optional REDCap instrument(s) for each variable. Defaults to the instrument reported in the dictionary. +#' @param filter Optional string of filters to apply to the dataset, such as the branching logic of a variable. +#' @param addTo Optional data frame from a previous query report to which the new results can be appended. +#' @param report_title Optional string specifying the title of the final report. Defaults to `"Report of queries"`. +#' @param report_zeros Logical, include variables with zero queries in the report. Default is `FALSE`. +#' @param by_dag Logical, split results by Data Access Group (DAG). Default is `FALSE`. +#' @param link Optional list containing project information (`domain`, `redcap_version`, `proj_id`, `event_id`) to generate clickable links for each query. +#' +#' @details +#' The function performs the following steps: +#' * Applies user-specified expressions to the selected variables to detect queries. +#' * Optionally negates the expressions to find values that **do not** satisfy the condition. +#' * Handles REDCap branching logic, converting it into R-compatible expressions for evaluation. +#' * Applies additional user-specified filters before identifying queries. +#' * Generates structured query results with metadata including: +#' - Identifier (record_id) +#' - DAG (if present) +#' - Event and Instrument +#' - Field, Repetition, Description, Query statement +#' - Optional link to REDCap entry +#' * Optionally combines results with previous query outputs using `addTo`. +#' * Produces a summarized report, optionally including variables with zero queries. +#' * Provides warnings for variables with branching logic that could not be automatically evaluated. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param variables A character vector containing the names of the variables to be checked for queries. -#' @param expression A character vector of expressions to apply to the selected variables. -#' @param negate A logical value indicating whether the defined expression should be negated. The default is `FALSE`, meaning the expression will be applied as is. If `TRUE`, the function will identify values that do **not** meet the condition defined in `expression`. -#' @param variables_names A character vector containing the descriptions of each selected variable. By default, the function will pull these descriptions from the REDCap dictionary associated with the variables. You can specify custom descriptions if desired. -#' @param query_name A character string describing the query. By default, it uses the format `The value is [value] and it should not be [expression]`. You can specify a custom query description for each variable if needed. -#' @param instrument The REDCap instrument(s) that the variables belong to. This can be the same for all variables or you can define different instruments for each variable. By default, the function will retrieve the corresponding instrument from the REDCap dictionary. -#' @param event The name of the REDCap event to analyze. If your REDCap project includes multiple events, you should specify the event to which the variables belong. This is required if your dataset contains multiple events. -#' @param filter A character string specifying a filter to be applied to the dataset. This is useful for applying additional conditions, such as using branching logic or filtering based on a specific characteristic of the data (e.g., `filter = "available_analytics=='1'"`). -#' @param addTo A data frame corresponding to a previous query data frame, to which the new query data frame will be appended. If not provided, the function will create a new data frame for each call. Use this argument to combine multiple queries into one report. -#' @param report_title A character string specifying the title of the final report generated by the function. -#' @param report_zeros A logical value indicating whether queries with zero counts should be included in the report. Default is `FALSE`. Set it to `TRUE` to include variables with zero queries. -#' @param by_dag A logical value indicating whether the results should be grouped by Data Access Groups (DAGs). Default is `FALSE`. Set to `TRUE` to split the results by DAG if applicable. -#' @param link A list containing project information to create a web link for each query. This can be used to include clickable links to the REDCap project or other resources directly in the report. If not specified, no links will be included. #' #' @return A list containing: -#' - A data frame of 9 columns (10 columns if `link` is specified), providing detailed information on each identified query. -#' - A table showing the total number of queries per variable. +#' \describe{ +#' \item{queries}{A data frame or a list of data frames (if `by_dag = TRUE`) with detailed query information for each record.} +#' \item{results}{A formatted report (HTML table) summarizing total queries per variable, event, and DAG if applicable.} +#' } #' #' @examples -#' # Example 1: Identifying missing values for multiple variables -#' example <- rd_query(covican, +#' \dontrun{ +#' # Identify missing values for multiple variables +#' result <- rd_query(covican, #' variables = c("copd", "age"), #' expression = c("is.na(x)", "x %in% NA"), #' event = "baseline_visit_arm_1" #' ) -#' example +#' result$results #' -#' # Example 2: Identifying values greater than 20 for the 'age' variable -#' example <- rd_query(covican, +#' # Identify values exceeding a threshold +#' result <- rd_query(covican, #' variables = "age", -#' expression = "x>20", +#' expression = "x > 20", #' event = "baseline_visit_arm_1" #' ) -#' example #' -#' # Example 3: Identifying missing values for 'potassium' with a filter -#' example <- rd_query(covican, +#' # Apply a filter to select subset of data +#' result <- rd_query(covican, #' variables = "potassium", #' expression = "is.na(x)", #' event = "baseline_visit_arm_1", -#' filter = "available_analytics=='1'" +#' filter = "available_analytics == '1'" #' ) -#' example +#' } #' #' @export #' @importFrom rlang .data @@ -212,10 +230,33 @@ rd_query <- function(project = NULL, variables = NA, expression = NA, negate = F } } - # Warning: expressions are less than variables - if (length(variables) > length(expression)) { - expression <- rep(expression[1], length(variables)) - warning("Fewer expressions than variables. Repeating the same expression for all variables.", call. = FALSE) + # Ensure expressions and variables match in length + if (length(variables) != length(expression)) { + if (length(variables) > length(expression)) { + warning( + paste0( + "Number of variables (", length(variables), + ") is greater than the number of expressions (", length(expression), "). ", + "The first expression will be applied to all variables." + ), + call. = FALSE + ) + + # Repeat the first expression for remaining variables + expression <- rep(expression[1], length(variables)) + } else { + warning( + paste0( + "Number of expressions (", length(expression), + ") is greater than the number of variables (", length(variables), "). ", + "The first variable will be used for all expressions." + ), + call. = FALSE + ) + + # Repeat the first variable for remaining expressions + variables <- rep(variables[1], length(expression)) + } } # Apply filter logic if specified diff --git a/R/rd_recalculate.R b/R/rd_recalculate.R index b587005..9d08bde 100644 --- a/R/rd_recalculate.R +++ b/R/rd_recalculate.R @@ -3,47 +3,46 @@ #' @description #' `r lifecycle::badge('experimental')` #' -#' This function processes REDCap project data, recalculates fields defined as calculated fields in the dictionary, -#' and compares the recalculated values with the original ones. It also generates a report of discrepancies and -#' updates the dataset and dictionary with new calculated fields (if applicable). +#' Recalculates fields marked as calculated in the REDCap dictionary, compares them with the original values, and reports discrepancies. If any differences are found, new recalculated fields are added to the dataset and dictionary with `_recalc` appended to the names. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param exclude (Optional) A character vector of field names to exclude from recalculation. -#' -#' @return A list containing the following elements: -#' \item{data}{The updated dataset with recalculated fields (if applicable).} -#' \item{dictionary}{The updated dictionary with recalculated field entries (if applicable).} -#' \item{event_form}{The original event-form mapping passed to the function (if applicable).} -#' \item{results}{A string summarizing the results of the recalculation process.} +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param exclude Optional. Character vector of field names to exclude from recalculation. #' #' @details -#' The function: -#' - Identifies calculated fields from the dictionary and evaluates the specified formulas. -#' - Compares recalculated values with the original values. -#' - Adds recalculated fields to the dataset, appending `_recalc` to the original variable names. -#' - Updates the dictionary to reflect the new variables. -#' - Summarizes the number of calculated fields, discrepancies, and untranslated fields in a report. -#' +#' * Fields of type `calc` in the dictionary are recalculated. +#' * Recalculated values are compared with the original values. +#' * If differences exist, new fields `[field_name]_recalc` are added to the dataset and dictionary. +#' * Works for single-event projects; for longitudinal projects, `event_form` must be provided. +#' * Fields with incomplete branching logic or smart variables may fail to recalculate. #' -#' @note -#' - Recalculation is only possible for single-event projects unless `event_form` is specified for longitudinal projects. -#' - If branching logic is incomplete, poorly defined or contains smart-variables, recalculation may fail for some fields. +#' @return A list with: +#' \describe{ +#' \item{data}{The dataset with new `_recalc` fields for any differing calculated fields.} +#' \item{dictionary}{Updated dictionary including the new `_recalc` fields.} +#' \item{event_form}{The `event_form` passed in (if applicable).} +#' \item{results}{Summary report of the recalculation process, including tables of discrepancies.} +#' } #' #' @examples -#' -#' # Example usage with individual arguments +#' # Recalculate all calculated fields +#' \dontrun{ #' results <- rd_recalculate( #' data = covican$data, #' dic = covican$dictionary, #' event_form = covican$event_form #' ) +#' } #' -#' # Example usage with a project object, excluding variables from the recalculation -#' results <- covican |> -#' rd_recalculate(exclude = c("age", "screening_fail_crit")) +#' # Recalculate but exclude some variables +#' \dontrun{ +#' results <- rd_recalculate( +#' project = covican, +#' exclude = c("age", "screening_fail_crit") +#' ) +#' } #' #' @export #' @importFrom rlang := @@ -77,7 +76,7 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = # Identify if the project is longitudinal or includes repeated instruments longitudinal <- "redcap_event_name" %in% names(data) - repeat_instrument <- any("redcap_repeat_instrument" %in% names(data) & !is.na(data$redcap_repeat_instrument)) + repeat_instrument <- "redcap_repeat_instrument" %in% names(data) && any(!is.na(data$redcap_repeat_instrument)) # Check if there are datetime variables stored as characters in the dataset vars_date <- dic |> @@ -164,7 +163,7 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = # Add recalculated fields to the dataset and dictionary calc_change <- calc |> - dplyr::filter(!is.na(.data$trans)) + dplyr::filter(!is.na(.data$trans) & !.data$is_equal) if (nrow(calc_change) > 0) { for (i in seq_len(nrow(calc_change))) { @@ -237,7 +236,10 @@ rd_recalculate <- function(project = NULL, data = NULL, dic = NULL, event_form = results <- stringr::str_glue("{results}") } else { # Stop if recalculation is not possible due to missing event-form mapping in longitudinal projects - stop("\nRecalculation cannot proceed because the project has more than one event, but the event-form correspondence has not been provided. Please specify the event-form mapping for accurate recalculation.\n", call. = FALSE) + stop( + "\nRecalculation cannot proceed because the project has more than one event, but the event-form correspondence has not been provided. Please specify the event-form mapping for accurate recalculation.\n", + call. = FALSE + ) } # Return updated datasets and results diff --git a/R/rd_rlogic.R b/R/rd_rlogic.R index dd68f8a..0e2e84f 100644 --- a/R/rd_rlogic.R +++ b/R/rd_rlogic.R @@ -3,38 +3,39 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function converts REDCap logic into R-compatible logic. The function processes common REDCap operators (such as `and`, `or`, `=`, `<`, `>`, etc.) and formats them into their R equivalents. It also handles event-specific logic in longitudinal REDCap projects. -#' Please note that this function may not be able to accurately transform REDCap logic involving smart variables or certain field types that require specialized handling. +#' Converts a REDCap logic expression into R-compatible logic. Processes one logic expression (`logic`) for one target variable (`var`) at a time. Supports common REDCap operators (`and`, `or`, `=`, `<`, `>`, etc.) and handles event-specific logic in longitudinal projects. Logic involving smart variables or repeated instruments may require manual review. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param logic SA string representing the logic in REDCap format (e.g., `"if([exc_1]='1' or [inc_1]='0', 1, 0)"`). -#' @param var A string containing the name of the variable that holds the logic. This is typically the outcome variable to which the logic applies. -#' -#' @return A list containing: -#' - `rlogic`: The translated REDCap logic in R format. -#' - `eval`: The evaluation result of the R logic applied to the provided dataset. If applicable, the result is filtered by event-specific logic. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param logic A single REDCap logic string (e.g., `"if([exc_1]='1' or [inc_1]='0', 1, 0)"`). +#' @param var A single string specifying the target variable the logic applies to. #' #' @details -#' The function performs several transformations to convert the REDCap logic into R logic: -#' - It translates REDCap-specific operators (e.g., `=` to `==`, `and` to `&`, `or` to `|`). -#' - It removes or replaces certain REDCap-specific syntax that does not directly translate to R (e.g., removing `true` values). -#' - It handles event-specific variables and ensures that logic is correctly adjusted when the data has multiple events. -#' - It also allows for handling of missing values by transforming empty strings (`''`) to `NA` in R. +#' * Translates REDCap operators and functions into R equivalents: +#' - `=` → `==`, `<>` → `!=`, `and` → `&`, `or` → `|`. +#' - Converts functions like `if()`, `rounddown()`, `datediff()`, `sum()` to R equivalents. +#' * Handles date transformations and empty strings (`''`) → `NA`. +#' * Adjusts logic for longitudinal data using `event_form` if provided. +#' * Evaluates the translated R logic against the dataset and returns the results. +#' * Logic with repeated instruments, smart variables, or multiple events per variable may require manual inspection. #' -#' Please be aware that REDCap logic that references smart variables or involves complex field relationships might require manual intervention for an accurate translation. +#' @return A list with: +#' \describe{ +#' \item{rlogic}{The translated R-compatible logic as a string.} +#' \item{eval}{The evaluation of the translated logic on the provided dataset, filtered by event if applicable.} +#' } #' #' @examples -#' # Example: Translating a REDCap logic expression into R logic for the variable `screening_fail_crit` +#' # Translate a single REDCap logic expression for one variable #' covican |> #' rd_rlogic( -#' logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", +#' logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0', 1, 0)", #' var = "screening_fail_crit" #' ) -#' @export #' +#' @export rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, logic, var) { @@ -53,11 +54,24 @@ rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL # Check if the project is longitudinal (more than one event present in the data) longitudinal <- ifelse("redcap_event_name" %in% names(data), TRUE, FALSE) + # Check for repeated instruments + repeat_instrument <- "redcap_repeat_instrument" %in% names(data) && any(!is.na(data$redcap_repeat_instrument)) + # Error: data is longitudinal, but event_form isn't provided if (is.null(event_form) & longitudinal) { stop("There is more than one event in the data, but the event-form correspondence hasn't been specified.") } + # If user accidentally passes multiple logic expressions or multiple vars + if (length(logic) > 1) { + warning("`logic` contains more than one expression; rd_rlogic processes only one logic at a time. Using the first element.", call. = FALSE) + logic <- logic[[1]] + } + if (length(var) > 1) { + warning("`var` contains more than one variable name; rd_rlogic processes only one variable at a time. Using the first element.", call. = FALSE) + var <- var[[1]] + } + rlogic <- logic # Initialize REDCap logic to be converted # Process checkboxes and other specific cases in REDCap logic @@ -79,20 +93,26 @@ rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL # Get the variables evaluated in the REDCap logic rlogic_var <- unlist(stringr::str_extract_all(rlogic, "\\[[\\w,\\-]+\\]")) + rlogic_var <- gsub("^\\[|\\]$", "", rlogic_var) # Check if the variables are present in the data or events if (longitudinal) { - check_lgl <- purrr::map_lgl(rlogic_var, function(x) { - out <- gsub("^\\[", "", x) - out <- gsub("\\]$", "", out) - out %in% names(data) | out %in% data$redcap_event_name - }) + check_lgl <- rlogic_var %in% names(data) | rlogic_var %in% data$redcap_event_name } else { - check_lgl <- purrr::map_lgl(rlogic_var, function(x) { - out <- gsub("^\\[", "", x) - out <- gsub("\\]$", "", out) - out %in% names(data) - }) + check_lgl <- rlogic_var %in% names(data) + } + + # Error: one of the variables is in a repeated instrument + if (repeat_instrument) { + rep_forms <- unique(na.omit(data$redcap_repeat_instrument)) + bad <- dic$field_name %in% rlogic_var & dic$form_name %in% rep_forms + if (any(bad)) { + vars <- paste0(dic$field_name[bad], " (form:", dic$form_name[bad], ")", collapse = ", ") + stop(sprintf( + "This function cannot translate logic involving variables that belong to repeated instruments. Review the following variables manually: %s", + vars + ), call. = FALSE) + } } # Error: any variable in logic is not found in the data @@ -145,6 +165,7 @@ rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL rlogic <- gsub("rounddown(.*)\\)", "floor\\1)", rlogic) rlogic <- gsub("datediff\\s?", "lubridate::time_length(lubridate::interval", rlogic) rlogic <- gsub("sum\\((.*?)\\)", "rowSums(cbind(\\1))", rlogic) + rlogic <- gsub("year\\((.*?)\\)", "lubridate::year(\\1)", rlogic) # Handle date formats in logic if (grepl("'dmy'", rlogic)) { @@ -267,7 +288,7 @@ rd_rlogic <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL # Check for date fields in the logic that are still in character class date_class <- dic |> - dplyr::filter(.data$field_name %in% gsub("\\[|\\]", "", rlogic_var)) |> + dplyr::filter(.data$field_name %in% rlogic_var) |> dplyr::filter(grepl("^date_|^datetime_", .data$text_validation_type_or_show_slider_number)) |> dplyr::pull(.data$field_name) diff --git a/R/rd_split.R b/R/rd_split.R index 9df855b..9314ed9 100644 --- a/R/rd_split.R +++ b/R/rd_split.R @@ -1,44 +1,47 @@ -#' Split a dataset by form or event based on the data dictionary +#' Split a REDCap dataset by form or event #' #' @description #' `r lifecycle::badge('experimental')` #' -#' This function splits the provided dataset into separate datasets by form or event, using the data dictionary to define the variables for each form or event. -#' It handles both longitudinal and non-longitudinal projects. +#' Splits a REDCap dataset into separate datasets by **form** or **event** using the data dictionary. Supports both longitudinal and non-longitudinal projects and can return wide or long formats for repeated measures. #' -#' @param project A list containing the REDCap data, dictionary, and event mapping, typically the output of the `redcap_data` function. If provided, it overrides individual `data`, `dic`, and `event_form` arguments. -#' @param data A `data.frame` or `tibble` representing the REDCap dataset containing the checkbox variables. -#' @param dic A `data.frame` representing the REDCap dictionary with metadata, including field names, field types, and branching logic. -#' @param event_form A `data.frame` or `list` mapping event names to forms for longitudinal projects. Optional; defaults to `NULL` if not applicable. -#' @param which A character string specifying which form or event to return (optional). If not provided, all forms or events will be included. -#' @param by A character string specifying the split criteria: "form" (default) or "event". -#' @param wide A logical value indicating whether to return the data in wide format when splitting by form. Defaults to `FALSE`. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param which Optional. A single form or event to extract. If not provided, all forms or events are returned. +#' @param by Character. Criteria to split the dataset: `"form"` (default) or `"event"`. +#' @param wide Logical. If `TRUE` (for form-based splits), repeated instances are returned in wide format. Defaults to `FALSE`. #' -#' @return A list or a data frame, depending on the `which` and `wide` arguments: -#' - If `which` is specified, returns the dataset for that particular form or event. -#' - If `wide` is `TRUE` (for form-based splitting), returns the data in wide format (repeated measures are expanded into columns). -#' - If neither is specified, returns a list of data frames for each form or event. +#' @details +#' * Handles checkbox variables and REDCap default variables (`_complete`, `_timestamp`) appropriately. +#' * For form-based splits in longitudinal projects, uses `event_form` to map variables to events. +#' * Wide format expands repeated instances into multiple columns per record. +#' * Filtering by `which` allows extracting a single form or event. +#' * Projects with repeated instruments are handled by filtering on the `redcap_repeat_instrument` variable. #' -#' @examples +#' @return Depending on `which` and `wide`: +#' \describe{ +#' \item{data}{A `data.frame` or a list of `data.frames` representing the split datasets.} +#' \item{dictionary}{The original REDCap dictionary.} +#' \item{event_form}{The original event-form mapping (if applicable).} +#' \item{results}{A summary message of the splitting operation.} +#' } #' -#' # To separate data by form: +#' @examples +#' # Split by form and return wide format #' result <- covican |> -#' rd_factor() |> -#' rd_checkbox() |> #' rd_split(by = "form", wide = TRUE) #' #' print(result) #' -#' # To separate data by event: +#' # Split by event (long format) #' result <- covican |> -#' rd_factor() |> -#' rd_checkbox() |> #' rd_split(by = "event") #' #' print(result) #' #' @export -#' @importFrom stats na.omit rd_split <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, which = NULL, by = "form", wide = FALSE) { diff --git a/R/rd_transform.R b/R/rd_transform.R index d6c8918..5c356be 100644 --- a/R/rd_transform.R +++ b/R/rd_transform.R @@ -3,41 +3,55 @@ #' @description #' `r lifecycle::badge('stable')` #' -#' This function transforms the raw REDCap data read by the `redcap_data` function. It runs in one-step pipeline all the functions dedicated to processing the data. It returns the transformed data and dictionary, along with a summary of the results of each step. +#' Transforms the raw REDCap data read by the `redcap_data` function. The function runs in one-step pipeline all functions dedicated to processing the data and returns the transformed data and dictionary, along with a summary of each step done. #' -#' @param project Output of the `redcap_data` function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project. -#' @param data Data frame containing the data read from REDCap. If the list is specified, this argument is not necessary. -#' @param dic Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not necessary. -#' @param event_form Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not necessary. -#' @param checkbox_labels Character vector with the names for the two options of every checkbox variable. Default is `c('No', 'Yes')`. -#' @param checkbox_na Logical indicating if checkboxes values with branching logic should be set to missing only when the branching logic is missing (`FALSE`), or also when the branching logic isn't satisfied (`TRUE`). The default is `FALSE`. -#' @param exclude_recalc Character vector with the names of variables that should not be recalculated. Useful for projects with time-consuming recalculations of certain calculated fields. -#' @param exclude_factor Character vector with the names of variables that should not be transformed to factors. -#' @param delete_vars Character vector specifying the variables to exclude. -#' @param delete_pattern Character vector specifying the regex pattern for variables to be excluded. +#' @param project A list containing the REDCap data, dictionary, and event mapping (expected `redcap_data()` output). Overrides `data`, `dic`, and `event_form`. +#' @param data A `data.frame` or `tibble` with the REDCap dataset. +#' @param dic A `data.frame` with the REDCap dictionary. +#' @param event_form Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects. +#' @param checkbox_labels Character vector of length 2 for labels of unchecked/checked values. Default: `c("No", "Yes")`. +#' @param na_logic Controls how missing values are set based on the branching logic of a checkbox. Must be one of `"none"` (do nothing), `"missing"` (set to `NA` only when the logic evaluation is `NA`), or `"eval"` (set to `NA` when the logic evaluates to `FALSE`). Defaults to `"none"`. +#' @param exclude_recalc Optional. Character vector of field names to exclude from recalculation. +#' @param exclude_factor Optional character vector of variable names (use original names **without** the `.factor` suffix) to exclude from conversion. +#' @param delete_vars Optional. A character vector of variable names to remove from both the dataset and dictionary. +#' @param delete_pattern Optional. A character vector of regular expression patterns. Variables matching these patterns will be removed from the dataset and dictionary. #' @param final_format Character string indicating the final format of the data. Options are `raw`, `by_event` or `by_form`. `raw` (default) returns the transformed data in its original structure, `by_event` returns it as a nested data frame by event, and `by_form` returns it as a nested data frame by form. -#' @param which_event Character string indicating a specific event to return if the final format is `by_event`. -#' @param which_form Character string indicating a specific form to return if the final format is `by_form`. -#' @param wide Logical indicating if the data split by form (if selected) should be in a wide format (`TRUE`) or a long format (`FALSE`). -#' @return A list with the transformed dataset, dictionary, event_form, and the results of each transformation step. +#' @param which_event Character. If `final_format = "by_event"`, return only this event. +#' @param which_form Character. If `final_format = "by_form"`, return only this form. +#' @param wide Logical. If `TRUE` (for form-based splits), repeated instances are returned in wide format. Defaults to `FALSE`. +#' +#' @return A list with elements: +#' \describe{ +#' \item{data}{Transformed data (data.frame or nested list when split).} +#' \item{dictionary}{Updated dictionary data.frame.} +#' \item{event_form}{Event–form mapping (if applicable).} +#' \item{results}{Character summary of transformation steps performed.} +#' } #' #' @examples -#' # Basic transformation -#' rd_transform(covican) +#' # Minimal usage (project object or data + dictionary) +#' trans <- rd_transform(covican) #' -#' # For customization of checkbox labels (example) -#' rd_transform(covican, -#' checkbox_labels = c("Not present", "Present") -#' ) +#' # Custom checkbox labels +#' trans <- rd_transform(covican, +#' checkbox_labels = c("Not present", "Present")) #' -#' @export +#' # Return only a single form (wide) +#' trans <- rd_transform(covican, +#' final_format = "by_form", +#' which_form = "laboratory_findings", +#' wide = TRUE) #' +#' @export -rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), checkbox_na = FALSE, exclude_recalc = NULL, exclude_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL) { +rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), na_logic = "none", exclude_recalc = NULL, exclude_factor = NULL, delete_vars = NULL, delete_pattern = NULL, final_format = "raw", which_event = NULL, which_form = NULL, wide = NULL) { results <- NULL ind <- 1 + # validate na_logic against allowed choices + na_logic <- match.arg(na_logic, choices = c("none", "missing", "eval")) + # Handle potential overwriting when both `project` and other arguments are provided if (!is.null(project)) { env_vars <- check_proj(project, data, dic, event_form) @@ -85,14 +99,7 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N } # Check if the project has repeated instruments - if ("redcap_repeat_instrument" %in% names(data)) { - repeat_instrument <- dplyr::case_when( - any(!is.na(data$redcap_repeat_instrument)) ~ TRUE, - TRUE ~ FALSE - ) - } else { - repeat_instrument <- FALSE - } + repeat_instrument <- "redcap_repeat_instrument" %in% names(data) && any(!is.na(data$redcap_repeat_instrument)) message("\u23F3 Transformation in progress...") @@ -174,10 +181,13 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N } if (!repeat_instrument) { - if (checkbox_na) { + # Message depends on na_logic option + if (na_logic == "eval") { results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic isn't satisfied or it's missing their values will be set to missing")) - } else { + } else if (na_logic == "missing") { results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options. For checkboxes that have a branching logic, when the logic is missing their values will be set to missing")) + } else { + results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options.")) } } else { results <- c(results, stringr::str_glue("\n\n{ind}. Transforming checkboxes: changing their values to No/Yes and changing their names to the names of its options.")) @@ -193,7 +203,7 @@ rd_transform <- function(project = NULL, data = NULL, dic = NULL, event_form = N } else { if (!repeat_instrument) { # Transform missings of checkboxes with branching logic: - trans <- rd_checkbox(data = data, dic = dic, event_form = event_form, checkbox_na = checkbox_na, checkbox_labels = checkbox_labels, checkbox_names = TRUE) + trans <- rd_checkbox(data = data, dic = dic, event_form = event_form, checkbox_labels = checkbox_labels, checkbox_names = TRUE, na_logic = na_logic) results <- c(results, trans$results[-1]) diff --git a/R/redcap_data.R b/R/redcap_data.R index 3bc31dd..8c3bf29 100644 --- a/R/redcap_data.R +++ b/R/redcap_data.R @@ -2,56 +2,62 @@ #' #' @description #' `r lifecycle::badge('stable')` -#' This function reads datasets from a REDCap project into R for analysis. Data can be imported from REDCap exported files or via an API connection. #' -#' **Options for data import:** +#' Import REDCap data into R either from REDCap's exported R file or directly via the REDCap API. The function returns a list with the dataset, the project dictionary (metadata) and, for longitudinal projects, the instrument–event mapping (`event_form`) when available. #' -#' - **Exported Data**: REDCap's *Export Data* function generates files suitable for R import. -#' - **API Connection**: Use the REDCap API to directly pull data into R. +#' @details +#' Two import modes are supported: +#' * **Exported files** — use `data_path` (REDCap R export) and `dic_path` (dictionary CSV/XLSX). +#' * **API** — use `uri` and `token` to pull data and metadata directly from REDCap. #' -#' **Steps for using exported data:** +#' If the project is longitudinal, provide `event_path` (instrument–event mapping) +#' or the function will attempt to fetch it from the API when using API mode. +#' +#' **Steps for using exported data in REDCap:** #' 1. Use the REDCap *Export Data* function and choose *R Statistical Software* format. #' 2. REDCap generates: #' - A CSV file with observations. #' - An R script to format variables for import. #' 3. Ensure the exported files, dictionary, and event mapping (if any) are in the same directory. #' +#' #' @note To use other package functions effectively, include the `dic_path` argument to load the project dictionary. #' -#' @param data_path Path to the exported R file for data import (if using exported files). -#' @param dic_path Path to the dictionary file (CSV or XLSX). +#' @param data_path Path to exported R file (use with `dic_path`). +#' @param dic_path Path to the dictionary file (CSV or XLSX; use with `data_path`).. #' @param event_path Path to the event-form mapping file (CSV or XLSX) for longitudinal projects (downloadable via the `Designate Instruments for My Events` tab within the `Project Setup` section of REDCap). -#' @param uri The URI of the REDCap project (for API connection). -#' @param token API token for REDCap project access. -#' @param filter_field Fields to include in the import (API connection only). -#' @param survey_fields Logical indicating whether to include survey-related fields (API connection only). +#' @param uri REDCap API base URI (use with `token`). +#' @param token REDCap API token (use with `uri`). +#' @param filter_field Optional character vector of field names to request from the API. +#' @param survey_fields Logical; include survey-related fields when pulling via API. Default `FALSE`. #' -#' @return A list containing: +#' @return A list with: #' - `data`: Imported dataset. -#' - `dictionary`: Variable dictionary. -#' - `event_form` (if applicable): Event-form mapping for longitudinal projects. +#' - `dictionary`: Variable dictionary (project metadata). +#' - `event_form`: Event-form mapping for longitudinal projects (if applicable). #' +#' @note +#' * Use either exported-files mode (`data_path` + `dic_path`) **or** API mode (`uri` + `token`) — not both. +#' * For exported files, REDCap's R export is required for `data_path`. Dictionary and event files must be CSV or XLSX. #' #' @examples #' \dontrun{ -#' # Import using exported files -#' -#' dataset <- redcap_data( -#' data_path = "C:/Users/username/example.r", -#' dic_path = "C:/Users/username/example_dictionary.csv", -#' event_path = "C:/Users/username/events.csv" +#' # From exported files +#' out <- redcap_data( +#' data_path = "project_export.r", +#' dic_path = "project_dictionary.csv", +#' event_path = "instrument_event_map.csv" #' ) #' -#' # Import using API -#' -#' dataset_api <- redcap_data( -#' uri = "https://redcap.idibell.cat/api/", -#' token = "55E5C3D1E83213ADA2182A4BFDEA" -#' ) # This token is fictitious +#' # From API +#' out_api <- redcap_data( +#' uri = "https://redcap.example.org/api/", +#' token = "REPLACE_WITH_TOKEN" +#' ) #' } +#' #' @export #' @importFrom stats setNames -#' redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA, token = NA, filter_field = NULL, survey_fields = FALSE) { @@ -415,7 +421,14 @@ redcap_data <- function(data_path = NA, dic_path = NA, event_path = NA, uri = NA dplyr::pull(.data$field_name) if (length(var_noevent) > 0) { - warning(stringr::str_glue("The following variables were removed since they are not linked to any event: {var_noevent}"), call. = FALSE) + + vars_str <- paste(var_noevent, collapse = ", ") + + warning( + sprintf("The following variable%s were removed since they are not linked to any event: %s", + ifelse(length(var_noevent) > 1, "s", ""), vars_str), + call. = FALSE + ) var_noevent <- intersect(var_noevent, names(data)) diff --git a/R/utils-suplement.R b/R/utils-suplement.R index 6cef016..e9e0cad 100644 --- a/R/utils-suplement.R +++ b/R/utils-suplement.R @@ -10,28 +10,22 @@ #' @param data Dataset containing the REDCap data. fill_data <- function(which_event, which_var, data) { - if (which_event %in% data$redcap_event_name) { - fill_values <- data |> - dplyr::select("record_id", "redcap_event_name", dplyr::all_of(which_var)) |> - dplyr::rename(var = dplyr::all_of(which_var)) |> - dplyr::group_by(.data$record_id) |> - dplyr::mutate( - var = dplyr::case_when( - .data$redcap_event_name != which_event ~ NA, - TRUE ~ .data$var - ), - # Only the first value if the event is repeated - var = stats::na.exclude(unique(.data$var))[1] - ) |> - tidyr::fill("var", .direction = "downup") |> - dplyr::pull("var") - - data[, which_var] <- fill_values - - data - } else { - stop("The logic can't be evaluated after the translation") + + if (!which_event %in% data$redcap_event_name) { + stop("The logic can't be evaluated after the translation", call. = FALSE) } + + fill_values <- data |> + dplyr::select("record_id", "redcap_event_name", dplyr::all_of(which_var)) |> + dplyr::rename(var = dplyr::all_of(which_var)) |> + dplyr::group_by(.data$record_id) |> + dplyr::mutate(var = dplyr::case_when(.data$redcap_event_name != which_event ~ NA, TRUE ~ .data$var)) |> + tidyr::fill("var", .direction = "downup") |> + dplyr::pull("var") + + data[[which_var]] <- fill_values + + data } diff --git a/man/check_queries.Rd b/man/check_queries.Rd index 9c0c686..3c97056 100644 --- a/man/check_queries.Rd +++ b/man/check_queries.Rd @@ -7,40 +7,97 @@ check_queries(old, new, report_title = NULL, return_viewer = TRUE) } \arguments{ -\item{old}{Dataframe containing the previous version of the query report.} +\item{old}{Data frame containing the previous (older) query report. Must include +\code{Identifier}, \code{Description} and \code{Query} columns (character or factor).} -\item{new}{Dataframe containing the new version of the query report.\cr -This is compared against the \code{old} report to determine query statuses.} +\item{new}{Data frame containing the newer query report. Must include +\code{Identifier}, \code{Description} and \code{Query} columns (character or factor). +If \code{new} contains a \code{Code} column, it will be removed at the start of processing.} -\item{report_title}{(Optional) A character string specifying the title for the generated report.\cr -If not provided, the default title will be "Comparison report".} +\item{report_title}{Optional single string used as the caption for the HTML summary table. +Defaults to \code{"Comparison report"} when not supplied or when \code{NA}.} -\item{return_viewer}{logical, whether to return the HTML viewer (default TRUE)} +\item{return_viewer}{Logical; if \code{TRUE} (default) an HTML table (knitr/kable + kableExtra) +summarizing the counts per state is produced and returned in the \code{results} element of the +returned list. If \code{FALSE}, no HTML viewer is produced (useful for non-interactive runs).} } \value{ -A list containing: -\item{queries}{A dataframe with all individual queries from both reports and a status column (\code{new}, \code{solved}, \code{pending}, or \code{miscorrected}).} -\item{results}{A styled HTML summary table showing the total number of queries in each status category.} +A list with two elements: +\describe{ +\item{\code{queries}}{A data frame containing all queries present in either \code{old} or \code{new}. +A factor column \code{Modification} indicates the state for each row (levels: \code{Pending}, +\code{Solved}, \code{Miscorrected}, \code{New}). The function also reassigns \code{Code} +values so codes are consistent per \code{Identifier}.} +\item{\code{results}}{If \code{return_viewer = TRUE}, an HTML \code{knitr::kable} (styled with +\code{kableExtra}) summarising totals per state. If \code{return_viewer = FALSE}, this is \code{NULL}.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function compares an old query report with a new one to identify the status of each query. -Queries are categorized as \code{new}, \code{solved}, \code{pending}, or \code{miscorrected}. -The function generates a detailed comparison dataframe and a summary report. +Compare an older query report (\code{old}) with a newer one (\code{new}) and classify each +query into one of four statuses: +\itemize{ +\item \strong{Pending} — the same query is present in both reports (no change detected), +\item \strong{Solved} — the query was present in the old report but is absent from the new report, +\item \strong{New} — the query appears in the new report but was not present in the old report, +\item \strong{Miscorrected} — a special case where a query in the new report is marked as \code{New} +but shares the same \code{Identifier} and \code{Description} as an existing record (suggesting a +re-issued or modified query for the same identifier). +} + +The function returns a detailed comparison table of queries with a \code{Modification} factor (one of the four statuses) and an HTML summary table showing counts per status. +} +\details{ +Requirements: +\itemize{ +\item Both \code{old} and \code{new} must be data frames. +\item Both data frames must contain at least the following character columns: +\code{Identifier}, \code{Description}, and \code{Query}. +\item A \code{Code} column is optional; if present it will be preserved and considered +for sorting and output. If \code{Code} exists in \code{new}, it is removed at the +beginning of the routine to avoid conflicts with re-assigned codes. +} + +The function merges the two reports, constructs composite keys used for comparison, classifies each row into a modification state, detects and re-labels \code{Miscorrected} cases, reassigns a \code{Code} per \code{Identifier} to keep codes consistent, and returns a detailed dataset plus an optional HTML summary viewer. } +\section{Notes and edge cases}{ + +\itemize{ +\item \strong{Column types:} If \code{Identifier}, \code{Description} or \code{Query} are +factors, they will be used in the comparison — it is recommended to convert them to +character prior to calling \code{check_queries()} to avoid factor-level mismatches. +\item \strong{Sorting:} When \code{Identifier} values contain a dash (e.g. \code{"100-20"}), +the function attempts to split into numeric \code{center} and \code{id} parts for +logical ordering. Otherwise \code{Identifier} is coerced to numeric for ordering. +\item \strong{Miscorrected detection:} A \code{Miscorrected} label is assigned when more +than one row shares the same \code{Identifier + Description} composite and a row is +otherwise classified as \code{New} — this signals a likely re-issued or modified query +for an existing identifier. +} +} + \examples{ -# Example of a query -data_old <- rd_query(covican, - variables = "copd", - expression = "is.na(x)", - event = "baseline_visit_arm_1" +# Minimal reproducible example +old <- data.frame( + Identifier = c("100-1", "100-2", "200-1"), + Description = c("age check", "weight check", "lab miss"), + Query = c("is.na(age)", "is.na(weight)", "missing lab result"), + Code = c("100-1-1", "100-2-1", "200-1-1"), + stringsAsFactors = FALSE ) -data_new <- rbind(data_old$queries[1:5, ], c("100-20", rep("abc", 8))) -# Compare the two query reports -check <- check_queries( - old = data_old$queries, - new = data_new +new <- data.frame( + Identifier = c("100-1", "200-1", "300-1"), + Description = c("age check", "lab miss", "new query"), + Query = c("is.na(age)", "missing lab result (clarify)", "is.na(x)"), + stringsAsFactors = FALSE ) + +res <- check_queries(old = old, new = new, report_title = "My Query Comparison") +# detailed table +head(res$queries) +# HTML summary (if in an RMarkdown or interactive viewer) +res$results + } diff --git a/man/rd_checkbox.Rd b/man/rd_checkbox.Rd index 14b5609..1a4fa7c 100644 --- a/man/rd_checkbox.Rd +++ b/man/rd_checkbox.Rd @@ -10,62 +10,63 @@ rd_checkbox( dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), - checkbox_na = FALSE, - checkbox_names = TRUE + checkbox_names = TRUE, + na_logic = "none" ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{checkbox_labels}{A character vector of length 2 specifying the labels to be used for the checkbox options. Defaults to \code{c("No", "Yes")}.} +\item{checkbox_labels}{Character vector of length 2 for labels of unchecked/checked values. Default: \code{c("No", "Yes")}.} -\item{checkbox_na}{Logical indicating whether to assign \code{NA} to checkbox fields when the branching logic condition is not satisfied. Defaults to \code{FALSE}.} +\item{checkbox_names}{Logical. If \code{TRUE} (default), checkbox columns are renamed using choice labels.} -\item{checkbox_names}{Logical indicating whether to rename the checkbox variables in the dataset and dictionary according to their label options. Defaults to \code{TRUE}.} +\item{na_logic}{Controls how missing values are set based on branching logic. Must be one of \code{"none"} (do nothing), \code{"missing"} (set to \code{NA} only when the logic evaluation is \code{NA}), or \code{"eval"} (set to \code{NA} when the logic evaluates to \code{FALSE}). Defaults to \code{"none"}.} } \value{ -A list containing the following elements: -\item{data}{The transformed dataset with checkbox variables updated.} -\item{dictionary}{The updated dictionary reflecting any changes made to the checkbox fields, including renamed variables.} -\item{event_form}{The event-form mapping (if provided).} -\item{results}{A summary of the transformation process, including any issues with branching logic or fields that need review.} +A list with: +\describe{ +\item{data}{Transformed dataset with checkbox fields as factors and optionally renamed.} +\item{dictionary}{Updated dictionary with checkbox fields expanded and optionally renamed.} +\item{event_form}{The \code{event_form} passed in (if applicable).} +\item{results}{Summary of transformations and any fields needing review.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function is used to convert checkbox variables in a REDCap dataset from their default categories (e.g., "Checked" and "Unchecked") to numeric values (0 and 1), and optionally, relabel and rename them according to user-defined options. It also evaluates branching logic for checkbox fields and adjusts the data and dictionary accordingly. +This function is used to process checkbox variables in a REDCap dataset. By default, it changes their default categories ("Unchecked" and "Checked") to new ones ("No" and "Yes). Optionally, the function can also evaluate the branching logic for checkbox fields and adjust the data and dictionary accordingly. } \details{ -This function is primarily used to process checkbox fields in a REDCap project. It performs the following: -\itemize{ -\item Converts checkbox variables in the dataset from text labels ("Checked" and "Unchecked") to numeric values (0 and 1), and then applies the specified labels. -\item Optionally renames the checkbox variables based on their labels (e.g., transforming variable names like \code{varname___1} to \code{varname_Yes}). -\item Optionally modifies the branching logic in the REDCap dictionary to reflect renamed checkbox options. -} -} -\note{ \itemize{ -\item If \code{event_form} is not provided for a longitudinal project, the function may not be able to evaluate branching logic correctly. +\item Checkbox columns are expected in REDCap wide format (\code{field___code}). +\item Branching logic evaluation requires \code{event_form} for longitudinal projects. +\item Names are cleaned and truncated to 60 characters; uniqueness is enforced. +\item Fields that cannot be evaluated are listed in \code{results}. } } \examples{ -# Example with a project object containing data and dictionary -results <- rd_checkbox(project = covican) +# Basic usage with a project object +res <- rd_checkbox(covican) -# Example with custom labels for the checkboxes -results <- rd_checkbox( - data = covican$data, - dic = covican$dictionary, - checkbox_labels = c("No", "Yes") -) +# With custom labels +res <- rd_checkbox(data = covican$data, + dic = covican$dictionary, + checkbox_labels = c("Not present", "Present")) + +# Keep original checkbox names +res <- rd_checkbox(covican, checkbox_names = FALSE) -# Example without renaming checkbox fields -results <- rd_checkbox(covican, checkbox_names = FALSE) +# Longitudinal project with NA logic +res <- rd_checkbox(data = covican$data, + dic = covican$dictionary, + event_form = covican$event_form,, + na_logic = "eval") } diff --git a/man/rd_dates.Rd b/man/rd_dates.Rd index 90fa921..4cc28b0 100644 --- a/man/rd_dates.Rd +++ b/man/rd_dates.Rd @@ -7,38 +7,38 @@ rd_dates(project = NULL, data = NULL, dic = NULL, event_form = NULL) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} } \value{ -A list containing the following elements: -\item{data}{The transformed dataset with date and datetime variables correctly formatted.} -\item{dictionary}{The original data dictionary passed to the function.} -\item{event_form}{The original event-form mapping passed to the function (if applicable).} +A list with the following elements: +\describe{ +\item{data}{The transformed dataset with date and datetime fields formatted as \code{Date} and \code{POSIXct}.} +\item{dictionary}{The original REDCap dictionary passed to the function.} +\item{event_form}{The original event-form mapping (if applicable).} +\item{results}{A summary of the transformations performed.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function processes and transforms date and datetime fields in a REDCap dataset. +Converts date and datetime fields in a REDCap dataset to appropriate R classes. } \details{ The function performs the following tasks: \itemize{ -\item Extracts date and datetime fields from the data dictionary using validation types -(\verb{date_*} and \verb{datetime_*}). -\item Converts these fields in the dataset to \code{Date} and \code{POSIXct} objects, respectively. +\item Detects date and datetime fields from the REDCap dictionary (\verb{date_*} and \verb{datetime_*} validation types). +\item Converts date fields to \code{Date} class. +\item Converts datetime fields to \code{POSIXct} class, treating empty strings as \code{NA}. } } \examples{ - -# Example usage: -result <- rd_dates(data = covican$data, dic = covican$dictionary) - -result <- covican |> rd_dates() +result <- rd_dates(covican) +transformed_data <- result$data } diff --git a/man/rd_delete_vars.Rd b/man/rd_delete_vars.Rd index 6ca9f6d..0a1529c 100644 --- a/man/rd_delete_vars.Rd +++ b/man/rd_delete_vars.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rd_delete_vars.R \name{rd_delete_vars} \alias{rd_delete_vars} -\title{Delete Variables from REDCap Data and Dictionary} +\title{Delete Variables from REDCap Dataset and Dictionary} \usage{ rd_delete_vars( project = NULL, @@ -14,53 +14,48 @@ rd_delete_vars( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, -typically the output of the \code{redcap_data} function. If provided, -it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, -including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. -Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{vars}{A character vector specifying variable names to delete from the dataset and dictionary. -These variables will be removed from both the \code{data} and \code{dic}.} +\item{vars}{Optional. A character vector of variable names to remove from both the dataset and dictionary.} -\item{pattern}{A character vector of regular expression patterns. Variables matching these patterns -will be removed from the \code{data} and \code{dic}.} +\item{pattern}{Optional. A character vector of regular expression patterns. Variables matching these patterns will be removed from the dataset and dictionary.} } \value{ -A list containing the following elements: +A list containing: +\describe{ \item{data}{The updated dataset with specified variables removed.} -\item{dictionary}{The updated data dictionary with corresponding variables removed.} -\item{event_form}{The original event-form mapping passed to the function (if applicable).} +\item{dictionary}{The updated REDCap dictionary.} +\item{event_form}{The original event-form mapping (if applicable).} +\item{results}{A summary message describing the variable removal operation.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function removes variables from a REDCap dataset and its associated dictionary based on -specific variable names or patterns. It ensures consistency between the data and dictionary -while preserving labels. +Deletes selected variables from a REDCap dataset and its dictionary, keeping them consistent and preserving variable labels. } \details{ -The function performs the following operations: \itemize{ -\item Removes variables specified in the \code{vars} argument from both the dataset and dictionary. -\item Removes variables matching patterns provided in the \code{pattern} argument. +\item Ensure that at least one of \code{vars} or \code{pattern} is specified. +\item Removes specified variables and their factor versions (e.g., \code{variable.factor}) from the dataset. +\item Removes matching variables from the dictionary. +\item Warns about factor versions of variables matching patterns, recommending use of \code{rd_factor()} if necessary. } } \examples{ -# Example usage: - -# Deleting specific variables -result <- rd_delete_vars(covican, +# Delete specific variables by name +result <- rd_delete_vars( + project = covican, vars = c("potassium", "leuk_lymph") ) -# Deleting variables based on patterns +# Delete variables matching patterns result <- rd_delete_vars( data = covican$data, dic = covican$dictionary, diff --git a/man/rd_dictionary.Rd b/man/rd_dictionary.Rd index d30fb9f..3f0a930 100644 --- a/man/rd_dictionary.Rd +++ b/man/rd_dictionary.Rd @@ -7,32 +7,41 @@ rd_dictionary(project = NULL, data = NULL, dic = NULL, event_form = NULL) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} } \value{ -A list containing the following elements: -\item{data}{The original dataset, passed to the function.} -\item{dictionary}{The updated data dictionary, with modified branching logic.} -\item{event_form}{The original event-form mapping, passed to the function (if applicable).} -\item{results}{A string summarizing the results of the transformation process, including any variables with unconverted branching logic.} +A list with the following elements: +\describe{ +\item{data}{The original dataset passed to the function.} +\item{dictionary}{The updated data dictionary with modified branching logic and calculations.} +\item{event_form}{The original event-form mapping (if applicable).} +\item{results}{A summary of the transformations, including any variables with unconverted branching logic.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function updates the data dictionary by evaluating and transforming the branching logic expressions for each field in the dictionary. -It checks if any branching logic is present and attempts to convert it using the specified data, dictionary, and event-form mapping. -If there are any issues with the conversion, those fields are listed in the results. +Updates a REDCap data dictionary by converting branching logic and calculation expressions into valid R expressions. This ensures that conditional display rules and calculated fields in the dictionary can be programmatically evaluated with the dataset. Any variables that cannot be converted are reported in the results. +} +\details{ +The function performs the following tasks: +\itemize{ +\item Evaluates and transforms branching logic expressions into valid R expressions using \code{rd_rlogic}. +\item Evaluates and converts calculation expressions for fields of type \code{calc}. +\item Generates a results summary table listing any variables that could not be converted. +} } \examples{ - -result <- covican |> rd_dictionary() - +\dontrun{ +result <- rd_dictionary(covican) print(result$results) +updated_dic <- result$dictionary +} } diff --git a/man/rd_event.Rd b/man/rd_event.Rd index f7d1646..9a6d5e3 100644 --- a/man/rd_event.Rd +++ b/man/rd_event.Rd @@ -19,52 +19,66 @@ rd_event( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{event}{A character vector specifying the name(s) of the REDCap event(s) to analyze for missing records.} +\item{event}{Character vector with one or more REDCap event names to check for missing records.} -\item{filter}{An optional filter to apply to the dataset. This can be used to identify missing events in a subset of the data.} +\item{filter}{Optional. A single character string containing a filter expression to subset the dataset before checking for missing events. Example: \code{"age >= 18"}.} -\item{query_name}{A description of the query. Defaults to "The event (event_name) is missing" for each event if not provided.} +\item{query_name}{Optional character vector describing each query. Defaults to a standard format: \verb{The event (event_name) is missing}.} -\item{addTo}{A data frame of previous query results to which new queries can be appended. If not provided, the function creates a new data frame.} +\item{addTo}{Optional data frame from a previous query report to which the new results can be appended.} -\item{report_title}{An optional title for the report.} +\item{report_title}{Optional string specifying the title of the final report. Defaults to \code{"Report of queries"}.} -\item{report_zeros}{Logical; if \code{TRUE}, includes a report of variables without missing data.} +\item{report_zeros}{Logical, include variables with zero queries in the report. Default is \code{FALSE}.} -\item{link}{A list containing project information used to generate links for each missing event. Requires \code{domain}, \code{redcap_version}, and \code{proj_id} keys.} +\item{link}{Optional list containing project information (\code{domain}, \code{redcap_version}, \code{proj_id}, \code{event_id}) to generate clickable links for each query.} } \value{ -A list with two elements: -\item{queries}{A data frame listing records with missing events, including metadata for each record.} -\item{results}{A summary table (HTML) showing the count of missing events for each analyzed event.} +A named list with two elements: +\describe{ +\item{\code{queries}}{A data frame listing records missing the specified events. +Columns: \code{Identifier}, \code{DAG}, \code{Event}, \code{Instrument}, +\code{Field}, \code{Repetition}, \code{Description}, \code{Query}, \code{Code}, +and optionally \code{Link}. If no queries are found this will be an empty +data frame with the expected columns.} +\item{\code{results}}{An HTML table (knitr::kable styled with kableExtra) summarising +the number of missing records per event. Returned as \code{knitr::kable} (HTML).} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function identifies records in a REDCap longitudinal project that are missing specific events. -REDCap does not export events with no data by default, which can create challenges in verifying completeness. -This function provides insights into missing events, allowing you to identify which records do not contain information about a particular event. -} -\details{ -The function is designed to work with REDCap longitudinal projects, which may not include empty events in their exports. -By specifying the events of interest, users can quickly identify missing records for a specific event. -Filters can be applied to focus the analysis on specific subsets of the data. - -If project information (\code{link}) is provided, the output will include clickable URLs for each missing record. +Helps identify records in a REDCap longitudinal project that are missing one or more specified events. Because REDCap typically omits empty events from exports, an event that contains no data for a record will not appear. This function finds those absent events and returns a per-record query table and a summarized HTML report. } \examples{ -# Example usage with a REDCap dataset: -example <- covican |> rd_event(event = "follow_up_visit_da_arm_1") +# Minimal reproducible example +data0 <- data.frame( + record_id = c("100-1", "100-2", "200-1"), + redcap_event_name = c("baseline_arm_1", "baseline_arm_1", "follow_up_arm_1"), + redcap_event_name.factor = factor(c("Baseline", "Baseline", "Follow-up")), + stringsAsFactors = FALSE +) + +# Suppose we want to check that every record has the follow-up event +res <- rd_event( + data = data0, + dic = data.frame(), # placeholder dictionary + event = "follow_up_arm_1", + report_zeros = TRUE +) + +# Records missing the event: +res$queries -example$queries -example$results +# HTML summary (in RMarkdown or Viewer) +res$results } diff --git a/man/rd_export.Rd b/man/rd_export.Rd index e2faabe..d545706 100644 --- a/man/rd_export.Rd +++ b/man/rd_export.Rd @@ -14,32 +14,28 @@ rd_export( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the dataframe of queries and results (expected \code{rd_query} or \code{rd_event} output). Overrides \code{queries}.} -\item{queries}{A data frame containing the identified queries. If \code{...} is provided, this argument is ignored.} +\item{queries}{A data frame of identified queries.} -\item{column}{A string specifying the column in the dataset that contains hyperlinks. If not specified, -hyperlinks will not be added unless a column named \code{Link} is detected.} +\item{column}{Name of the column containing URLs to convert into hyperlinks. If \code{NULL}, hyperlinks are added only if a \code{Link} column exists.} -\item{sheet_name}{A string specifying the name of the sheet in the resulting \code{.xlsx} file. Defaults to \code{"Sheet1"}.} +\item{sheet_name}{Name of the Excel sheet in the resulting \code{.xlsx} file. Default: \code{"Sheet1"}.} -\item{path}{A string specifying the file path to save the \code{.xlsx} file. If \code{NULL}, the file is saved in the -current working directory with the name \code{example.xlsx}.} +\item{path}{File path for saving the \code{.xlsx} file. If \code{NULL}, the file is saved as \code{"example.xlsx"} in the working directory.} -\item{password}{An optional string to password-protect the worksheet, preventing unauthorized edits.} +\item{password}{Optional password to protect the worksheet from edits.} } \value{ -An \code{.xlsx} file saved to the specified path, containing the query data and hyperlinks if specified. +An \code{.xlsx} file written to the specified path. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function exports a query dataset, typically generated using \code{rd_query} or \code{rd_event}, into an \code{.xlsx} file. -It supports adding hyperlinks to specified columns and optional password protection for the worksheet. +Export a query dataset (e.g., from \code{rd_query} or \code{rd_event}) to an \code{.xlsx} file. The function can optionally convert a column of URLs into Excel hyperlinks and apply password protection to the worksheet. } \examples{ \dontrun{ -# Export queries to an Excel file rd_export( queries = my_queries, column = "Link", diff --git a/man/rd_factor.Rd b/man/rd_factor.Rd index e8dc051..8a9abb1 100644 --- a/man/rd_factor.Rd +++ b/man/rd_factor.Rd @@ -13,38 +13,38 @@ rd_factor( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{exclude}{A character vector of variable names to exclude from being converted into factors.} +\item{exclude}{Optional character vector of variable names (use original names \strong{without} the \code{.factor} suffix) to exclude from conversion.} } \value{ -A list containing: -\item{data}{The transformed dataset with factor variables applied.} -\item{dictionary}{The dictionary used.} -\item{event_form}{The event-form mapping used (if provided).} -\item{results}{A string summarizing the changes made during the transformation.} +A list with the following elements: +\describe{ +\item{data}{The transformed dataset with \code{.factor} columns applied as factors.} +\item{dictionary}{The dictionary used (unchanged).} +\item{event_form}{The event-form mapping used (if applicable).} +\item{results}{A brief text summary of the transformation.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function converts variables in a REDCap dataset that have associated \code{.factor} columns into actual factor variables. It also allows for the exclusion of specific variables from being converted into factors. +Converts variables in a REDCap dataset with associated \code{.factor} columns into actual factor variables, while allowing the exclusion of specific variables. Ensures consistency with the dataset and preserves variable labels. } \details{ -This function searches for columns in the data that have a \code{.factor} suffix (indicating that they can be converted into factors) and converts them into factors based on their labels. -The \code{exclude} argument allows you to specify which variables should not be converted. -The function also modifies the branching logic in the dictionary to reflect the changes made in the data. - -Variables with the names \code{redcap_event_name.factor} and \code{redcap_data_access_group.factor} are excluded from the conversion process to avoid altering event and access group information. +The function looks for columns ending in \code{.factor} and replaces the original variable values with those \code{.factor} values (converted to factors). It preserves variable labels. The \code{exclude} argument must contain base variable names (no \code{.factor} suffix); if any \code{.factor} names are passed to \code{exclude} the function will throw an informative error. The columns \code{redcap_event_name}, \code{redcap_repeat_instrument} and \code{redcap_data_access_group} (and their \code{.factor} counterparts) are handled specially to avoid altering event or access-group data. } \examples{ -result <- REDCapDM::rd_factor(covican, exclude = c("available_analytics", "urine_culture")) - +\dontrun{ +result <- rd_factor(covican) +result <- rd_factor(covican, exclude = c("available_analytics", "urine_culture")) transformed_data <- result$data +} } diff --git a/man/rd_insert_na.Rd b/man/rd_insert_na.Rd index db3b41a..8e36aac 100644 --- a/man/rd_insert_na.Rd +++ b/man/rd_insert_na.Rd @@ -14,41 +14,50 @@ rd_insert_na( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{vars}{A character vector with the names of the variables to be transformed.} +\item{vars}{Character vector of variable names to set to \code{NA}.} -\item{filter}{A character vector of logical expressions to evaluate. If the evaluation is \code{TRUE}, the corresponding variable in \code{vars} is set to \code{NA}.} +\item{filter}{A single logical expression (as string). Rows where the filter evaluates to \code{TRUE} will have the corresponding \code{vars} set to \code{NA}.} } \value{ -The modified data frame with the specified variables updated. +A list with: +\describe{ +\item{data}{The dataset with \code{NA} inserted where the filter applies.} +\item{dictionary}{The unchanged dictionary.} +\item{event_form}{The \code{event_form} passed in (if applicable).} +\item{results}{Summary message of the changes applied.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function allows you to manually insert a missing value into certain variables (\code{vars}) if the specified filter/s (\code{filter}) are satisfied. -It's particularly useful for managing checkboxes without explicit gatekeeper questions in their branching logic. +Sets selected variables to \code{NA} when a filter condition is satisfied. Useful for managing checkboxes or other fields without explicit gatekeeper questions. +} +\details{ +\itemize{ +\item Each variable is only updated in rows/events where both the variable and filter are present. +\item For longitudinal projects, \code{event_form} must be provided for proper event-level filtering. +\item Only one filter expression is allowed. +\item Variables and filter columns must exist in both \code{data} and \code{dictionary}. } -\note{ -Each variable is only transformed in the events where both the variable and the filter evaluation are present, so they must have at least one event in common. } \examples{ - -# Example usage: -table(is.na(covican$data$potassium)) - -data <- covican |> - rd_insert_na( - vars = "potassium", - filter = "age < 65" - ) - +# Set 'potassium' to NA where age < 65 +\dontrun{ +data <- rd_insert_na( + data = covican$data, + dic = covican$dictionary, + vars = "potassium", + filter = "age < 65" +) table(data$potassium) +} } diff --git a/man/rd_query.Rd b/man/rd_query.Rd index 3690c27..5f823e6 100644 --- a/man/rd_query.Rd +++ b/man/rd_query.Rd @@ -25,77 +25,96 @@ rd_query( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{variables}{A character vector containing the names of the variables to be checked for queries.} +\item{variables}{Character vector of variable names to check for queries.} -\item{expression}{A character vector of expressions to apply to the selected variables.} +\item{expression}{Character vector of R expressions to evaluate for each variable.} -\item{negate}{A logical value indicating whether the defined expression should be negated. The default is \code{FALSE}, meaning the expression will be applied as is. If \code{TRUE}, the function will identify values that do \strong{not} meet the condition defined in \code{expression}.} +\item{negate}{Logical, if \code{TRUE}, identifies values that \strong{do not} meet the condition. Default is \code{FALSE}.} -\item{event}{The name of the REDCap event to analyze. If your REDCap project includes multiple events, you should specify the event to which the variables belong. This is required if your dataset contains multiple events.} +\item{event}{Required for longitudinal projects to avoid overestimation. REDCap event(s) to analyze.} -\item{filter}{A character string specifying a filter to be applied to the dataset. This is useful for applying additional conditions, such as using branching logic or filtering based on a specific characteristic of the data (e.g., \code{filter = "available_analytics=='1'"}).} +\item{filter}{Optional string of filters to apply to the dataset, such as the branching logic of a variable.} -\item{addTo}{A data frame corresponding to a previous query data frame, to which the new query data frame will be appended. If not provided, the function will create a new data frame for each call. Use this argument to combine multiple queries into one report.} +\item{addTo}{Optional data frame from a previous query report to which the new results can be appended.} -\item{variables_names}{A character vector containing the descriptions of each selected variable. By default, the function will pull these descriptions from the REDCap dictionary associated with the variables. You can specify custom descriptions if desired.} +\item{variables_names}{Optional character vector of descriptions for each variable. Defaults to the variables labels in the dictionary.} -\item{query_name}{A character string describing the query. By default, it uses the format \verb{The value is [value] and it should not be [expression]}. You can specify a custom query description for each variable if needed.} +\item{query_name}{Optional character vector describing each query. Defaults to a standard format: \verb{The value is [value] and it should not be [expression]}.} -\item{instrument}{The REDCap instrument(s) that the variables belong to. This can be the same for all variables or you can define different instruments for each variable. By default, the function will retrieve the corresponding instrument from the REDCap dictionary.} +\item{instrument}{Optional REDCap instrument(s) for each variable. Defaults to the instrument reported in the dictionary.} -\item{report_title}{A character string specifying the title of the final report generated by the function.} +\item{report_title}{Optional string specifying the title of the final report. Defaults to \code{"Report of queries"}.} -\item{report_zeros}{A logical value indicating whether queries with zero counts should be included in the report. Default is \code{FALSE}. Set it to \code{TRUE} to include variables with zero queries.} +\item{report_zeros}{Logical, include variables with zero queries in the report. Default is \code{FALSE}.} -\item{by_dag}{A logical value indicating whether the results should be grouped by Data Access Groups (DAGs). Default is \code{FALSE}. Set to \code{TRUE} to split the results by DAG if applicable.} +\item{by_dag}{Logical, split results by Data Access Group (DAG). Default is \code{FALSE}.} -\item{link}{A list containing project information to create a web link for each query. This can be used to include clickable links to the REDCap project or other resources directly in the report. If not specified, no links will be included.} +\item{link}{Optional list containing project information (\code{domain}, \code{redcap_version}, \code{proj_id}, \code{event_id}) to generate clickable links for each query.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} } \value{ A list containing: -\itemize{ -\item A data frame of 9 columns (10 columns if \code{link} is specified), providing detailed information on each identified query. -\item A table showing the total number of queries per variable. +\describe{ +\item{queries}{A data frame or a list of data frames (if \code{by_dag = TRUE}) with detailed query information for each record.} +\item{results}{A formatted report (HTML table) summarizing total queries per variable, event, and DAG if applicable.} } } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function allows you to identify queries based on a specific expression or filter. It is useful for detecting missing values or values that fall outside predefined lower or upper limits of a variable. -The function can also apply branching logic to variables, enabling targeted query identification in REDCap datasets. +Detects and summarizes queries in a REDCap dataset based on specified expressions, filters, or a defined branching logic. Useful for identifying missing values, out-of-range values, or values that do not meet predefined criteria. +} +\details{ +The function performs the following steps: +\itemize{ +\item Applies user-specified expressions to the selected variables to detect queries. +\item Optionally negates the expressions to find values that \strong{do not} satisfy the condition. +\item Handles REDCap branching logic, converting it into R-compatible expressions for evaluation. +\item Applies additional user-specified filters before identifying queries. +\item Generates structured query results with metadata including: +\itemize{ +\item Identifier (record_id) +\item DAG (if present) +\item Event and Instrument +\item Field, Repetition, Description, Query statement +\item Optional link to REDCap entry +} +\item Optionally combines results with previous query outputs using \code{addTo}. +\item Produces a summarized report, optionally including variables with zero queries. +\item Provides warnings for variables with branching logic that could not be automatically evaluated. +} } \examples{ -# Example 1: Identifying missing values for multiple variables -example <- rd_query(covican, +\dontrun{ +# Identify missing values for multiple variables +result <- rd_query(covican, variables = c("copd", "age"), expression = c("is.na(x)", "x \%in\% NA"), event = "baseline_visit_arm_1" ) -example +result$results -# Example 2: Identifying values greater than 20 for the 'age' variable -example <- rd_query(covican, +# Identify values exceeding a threshold +result <- rd_query(covican, variables = "age", - expression = "x>20", + expression = "x > 20", event = "baseline_visit_arm_1" ) -example -# Example 3: Identifying missing values for 'potassium' with a filter -example <- rd_query(covican, +# Apply a filter to select subset of data +result <- rd_query(covican, variables = "potassium", expression = "is.na(x)", event = "baseline_visit_arm_1", - filter = "available_analytics=='1'" + filter = "available_analytics == '1'" ) -example +} } diff --git a/man/rd_recalculate.Rd b/man/rd_recalculate.Rd index 084b888..45e692e 100644 --- a/man/rd_recalculate.Rd +++ b/man/rd_recalculate.Rd @@ -13,57 +13,55 @@ rd_recalculate( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{exclude}{(Optional) A character vector of field names to exclude from recalculation.} +\item{exclude}{Optional. Character vector of field names to exclude from recalculation.} } \value{ -A list containing the following elements: -\item{data}{The updated dataset with recalculated fields (if applicable).} -\item{dictionary}{The updated dictionary with recalculated field entries (if applicable).} -\item{event_form}{The original event-form mapping passed to the function (if applicable).} -\item{results}{A string summarizing the results of the recalculation process.} +A list with: +\describe{ +\item{data}{The dataset with new \verb{_recalc} fields for any differing calculated fields.} +\item{dictionary}{Updated dictionary including the new \verb{_recalc} fields.} +\item{event_form}{The \code{event_form} passed in (if applicable).} +\item{results}{Summary report of the recalculation process, including tables of discrepancies.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function processes REDCap project data, recalculates fields defined as calculated fields in the dictionary, -and compares the recalculated values with the original ones. It also generates a report of discrepancies and -updates the dataset and dictionary with new calculated fields (if applicable). +Recalculates fields marked as calculated in the REDCap dictionary, compares them with the original values, and reports discrepancies. If any differences are found, new recalculated fields are added to the dataset and dictionary with \verb{_recalc} appended to the names. } \details{ -The function: \itemize{ -\item Identifies calculated fields from the dictionary and evaluates the specified formulas. -\item Compares recalculated values with the original values. -\item Adds recalculated fields to the dataset, appending \verb{_recalc} to the original variable names. -\item Updates the dictionary to reflect the new variables. -\item Summarizes the number of calculated fields, discrepancies, and untranslated fields in a report. -} -} -\note{ -\itemize{ -\item Recalculation is only possible for single-event projects unless \code{event_form} is specified for longitudinal projects. -\item If branching logic is incomplete, poorly defined or contains smart-variables, recalculation may fail for some fields. +\item Fields of type \code{calc} in the dictionary are recalculated. +\item Recalculated values are compared with the original values. +\item If differences exist, new fields \verb{[field_name]_recalc} are added to the dataset and dictionary. +\item Works for single-event projects; for longitudinal projects, \code{event_form} must be provided. +\item Fields with incomplete branching logic or smart variables may fail to recalculate. } } \examples{ - -# Example usage with individual arguments +# Recalculate all calculated fields +\dontrun{ results <- rd_recalculate( data = covican$data, dic = covican$dictionary, event_form = covican$event_form ) +} -# Example usage with a project object, excluding variables from the recalculation -results <- covican |> - rd_recalculate(exclude = c("age", "screening_fail_crit")) +# Recalculate but exclude some variables +\dontrun{ +results <- rd_recalculate( + project = covican, + exclude = c("age", "screening_fail_crit") +) +} } diff --git a/man/rd_rlogic.Rd b/man/rd_rlogic.Rd index 139ffb6..ad651e4 100644 --- a/man/rd_rlogic.Rd +++ b/man/rd_rlogic.Rd @@ -14,47 +14,49 @@ rd_rlogic( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{logic}{SA string representing the logic in REDCap format (e.g., \code{"if([exc_1]='1' or [inc_1]='0', 1, 0)"}).} +\item{logic}{A single REDCap logic string (e.g., \code{"if([exc_1]='1' or [inc_1]='0', 1, 0)"}).} -\item{var}{A string containing the name of the variable that holds the logic. This is typically the outcome variable to which the logic applies.} +\item{var}{A single string specifying the target variable the logic applies to.} } \value{ -A list containing: -\itemize{ -\item \code{rlogic}: The translated REDCap logic in R format. -\item \code{eval}: The evaluation result of the R logic applied to the provided dataset. If applicable, the result is filtered by event-specific logic. +A list with: +\describe{ +\item{rlogic}{The translated R-compatible logic as a string.} +\item{eval}{The evaluation of the translated logic on the provided dataset, filtered by event if applicable.} } } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function converts REDCap logic into R-compatible logic. The function processes common REDCap operators (such as \code{and}, \code{or}, \code{=}, \code{<}, \code{>}, etc.) and formats them into their R equivalents. It also handles event-specific logic in longitudinal REDCap projects. -Please note that this function may not be able to accurately transform REDCap logic involving smart variables or certain field types that require specialized handling. +Converts a REDCap logic expression into R-compatible logic. Processes one logic expression (\code{logic}) for one target variable (\code{var}) at a time. Supports common REDCap operators (\code{and}, \code{or}, \code{=}, \code{<}, \code{>}, etc.) and handles event-specific logic in longitudinal projects. Logic involving smart variables or repeated instruments may require manual review. } \details{ -The function performs several transformations to convert the REDCap logic into R logic: \itemize{ -\item It translates REDCap-specific operators (e.g., \code{=} to \code{==}, \code{and} to \code{&}, \code{or} to \code{|}). -\item It removes or replaces certain REDCap-specific syntax that does not directly translate to R (e.g., removing \code{true} values). -\item It handles event-specific variables and ensures that logic is correctly adjusted when the data has multiple events. -\item It also allows for handling of missing values by transforming empty strings (\code{''}) to \code{NA} in R. +\item Translates REDCap operators and functions into R equivalents: +\itemize{ +\item \code{=} → \code{==}, \verb{<>} → \code{!=}, \code{and} → \code{&}, \code{or} → \code{|}. +\item Converts functions like \verb{if()}, \code{rounddown()}, \code{datediff()}, \code{sum()} to R equivalents. +} +\item Handles date transformations and empty strings (\code{''}) → \code{NA}. +\item Adjusts logic for longitudinal data using \code{event_form} if provided. +\item Evaluates the translated R logic against the dataset and returns the results. +\item Logic with repeated instruments, smart variables, or multiple events per variable may require manual inspection. } - -Please be aware that REDCap logic that references smart variables or involves complex field relationships might require manual intervention for an accurate translation. } \examples{ -# Example: Translating a REDCap logic expression into R logic for the variable `screening_fail_crit` +# Translate a single REDCap logic expression for one variable covican |> rd_rlogic( - logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0',1,0)", + logic = "if([exc_1]='1' or [inc_1]='0' or [inc_2]='0' or [inc_3]='0', 1, 0)", var = "screening_fail_crit" ) + } diff --git a/man/rd_split.Rd b/man/rd_split.Rd index 4b2906d..a8bdf77 100644 --- a/man/rd_split.Rd +++ b/man/rd_split.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rd_split.R \name{rd_split} \alias{rd_split} -\title{Split a dataset by form or event based on the data dictionary} +\title{Split a REDCap dataset by form or event} \usage{ rd_split( project = NULL, @@ -15,48 +15,52 @@ rd_split( ) } \arguments{ -\item{project}{A list containing the REDCap data, dictionary, and event mapping, typically the output of the \code{redcap_data} function. If provided, it overrides individual \code{data}, \code{dic}, and \code{event_form} arguments.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{A \code{data.frame} or \code{tibble} representing the REDCap dataset containing the checkbox variables.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{A \code{data.frame} representing the REDCap dictionary with metadata, including field names, field types, and branching logic.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{A \code{data.frame} or \code{list} mapping event names to forms for longitudinal projects. Optional; defaults to \code{NULL} if not applicable.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{which}{A character string specifying which form or event to return (optional). If not provided, all forms or events will be included.} +\item{which}{Optional. A single form or event to extract. If not provided, all forms or events are returned.} -\item{by}{A character string specifying the split criteria: "form" (default) or "event".} +\item{by}{Character. Criteria to split the dataset: \code{"form"} (default) or \code{"event"}.} -\item{wide}{A logical value indicating whether to return the data in wide format when splitting by form. Defaults to \code{FALSE}.} +\item{wide}{Logical. If \code{TRUE} (for form-based splits), repeated instances are returned in wide format. Defaults to \code{FALSE}.} } \value{ -A list or a data frame, depending on the \code{which} and \code{wide} arguments: -\itemize{ -\item If \code{which} is specified, returns the dataset for that particular form or event. -\item If \code{wide} is \code{TRUE} (for form-based splitting), returns the data in wide format (repeated measures are expanded into columns). -\item If neither is specified, returns a list of data frames for each form or event. +Depending on \code{which} and \code{wide}: +\describe{ +\item{data}{A \code{data.frame} or a list of \code{data.frames} representing the split datasets.} +\item{dictionary}{The original REDCap dictionary.} +\item{event_form}{The original event-form mapping (if applicable).} +\item{results}{A summary message of the splitting operation.} } } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -This function splits the provided dataset into separate datasets by form or event, using the data dictionary to define the variables for each form or event. -It handles both longitudinal and non-longitudinal projects. +Splits a REDCap dataset into separate datasets by \strong{form} or \strong{event} using the data dictionary. Supports both longitudinal and non-longitudinal projects and can return wide or long formats for repeated measures. +} +\details{ +\itemize{ +\item Handles checkbox variables and REDCap default variables (\verb{_complete}, \verb{_timestamp}) appropriately. +\item For form-based splits in longitudinal projects, uses \code{event_form} to map variables to events. +\item Wide format expands repeated instances into multiple columns per record. +\item Filtering by \code{which} allows extracting a single form or event. +\item Projects with repeated instruments are handled by filtering on the \code{redcap_repeat_instrument} variable. +} } \examples{ - -# To separate data by form: +# Split by form and return wide format result <- covican |> - rd_factor() |> - rd_checkbox() |> rd_split(by = "form", wide = TRUE) print(result) -# To separate data by event: +# Split by event (long format) result <- covican |> - rd_factor() |> - rd_checkbox() |> rd_split(by = "event") print(result) diff --git a/man/rd_transform.Rd b/man/rd_transform.Rd index 9cb7766..fbd424f 100644 --- a/man/rd_transform.Rd +++ b/man/rd_transform.Rd @@ -10,7 +10,7 @@ rd_transform( dic = NULL, event_form = NULL, checkbox_labels = c("No", "Yes"), - checkbox_na = FALSE, + na_logic = "none", exclude_recalc = NULL, exclude_factor = NULL, delete_vars = NULL, @@ -22,49 +22,60 @@ rd_transform( ) } \arguments{ -\item{project}{Output of the \code{redcap_data} function, which is a list containing the data frames of the data, dictionary and event_form (if needed) of the REDCap project.} +\item{project}{A list containing the REDCap data, dictionary, and event mapping (expected \code{redcap_data()} output). Overrides \code{data}, \code{dic}, and \code{event_form}.} -\item{data}{Data frame containing the data read from REDCap. If the list is specified, this argument is not necessary.} +\item{data}{A \code{data.frame} or \code{tibble} with the REDCap dataset.} -\item{dic}{Data frame containing the dictionary read from REDCap. If the list is specified, this argument is not necessary.} +\item{dic}{A \code{data.frame} with the REDCap dictionary.} -\item{event_form}{Data frame containing the correspondence of each event with each form. If the list is specified, this argument is not necessary.} +\item{event_form}{Only applicable for longitudinal projects (presence of events). Event-to-form mapping for longitudinal projects.} -\item{checkbox_labels}{Character vector with the names for the two options of every checkbox variable. Default is \code{c('No', 'Yes')}.} +\item{checkbox_labels}{Character vector of length 2 for labels of unchecked/checked values. Default: \code{c("No", "Yes")}.} -\item{checkbox_na}{Logical indicating if checkboxes values with branching logic should be set to missing only when the branching logic is missing (\code{FALSE}), or also when the branching logic isn't satisfied (\code{TRUE}). The default is \code{FALSE}.} +\item{na_logic}{Controls how missing values are set based on the branching logic of a checkbox. Must be one of \code{"none"} (do nothing), \code{"missing"} (set to \code{NA} only when the logic evaluation is \code{NA}), or \code{"eval"} (set to \code{NA} when the logic evaluates to \code{FALSE}). Defaults to \code{"none"}.} -\item{exclude_recalc}{Character vector with the names of variables that should not be recalculated. Useful for projects with time-consuming recalculations of certain calculated fields.} +\item{exclude_recalc}{Optional. Character vector of field names to exclude from recalculation.} -\item{exclude_factor}{Character vector with the names of variables that should not be transformed to factors.} +\item{exclude_factor}{Optional character vector of variable names (use original names \strong{without} the \code{.factor} suffix) to exclude from conversion.} -\item{delete_vars}{Character vector specifying the variables to exclude.} +\item{delete_vars}{Optional. A character vector of variable names to remove from both the dataset and dictionary.} -\item{delete_pattern}{Character vector specifying the regex pattern for variables to be excluded.} +\item{delete_pattern}{Optional. A character vector of regular expression patterns. Variables matching these patterns will be removed from the dataset and dictionary.} \item{final_format}{Character string indicating the final format of the data. Options are \code{raw}, \code{by_event} or \code{by_form}. \code{raw} (default) returns the transformed data in its original structure, \code{by_event} returns it as a nested data frame by event, and \code{by_form} returns it as a nested data frame by form.} -\item{which_event}{Character string indicating a specific event to return if the final format is \code{by_event}.} +\item{which_event}{Character. If \code{final_format = "by_event"}, return only this event.} -\item{which_form}{Character string indicating a specific form to return if the final format is \code{by_form}.} +\item{which_form}{Character. If \code{final_format = "by_form"}, return only this form.} -\item{wide}{Logical indicating if the data split by form (if selected) should be in a wide format (\code{TRUE}) or a long format (\code{FALSE}).} +\item{wide}{Logical. If \code{TRUE} (for form-based splits), repeated instances are returned in wide format. Defaults to \code{FALSE}.} } \value{ -A list with the transformed dataset, dictionary, event_form, and the results of each transformation step. +A list with elements: +\describe{ +\item{data}{Transformed data (data.frame or nested list when split).} +\item{dictionary}{Updated dictionary data.frame.} +\item{event_form}{Event–form mapping (if applicable).} +\item{results}{Character summary of transformation steps performed.} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function transforms the raw REDCap data read by the \code{redcap_data} function. It runs in one-step pipeline all the functions dedicated to processing the data. It returns the transformed data and dictionary, along with a summary of the results of each step. +Transforms the raw REDCap data read by the \code{redcap_data} function. The function runs in one-step pipeline all functions dedicated to processing the data and returns the transformed data and dictionary, along with a summary of each step done. } \examples{ -# Basic transformation -rd_transform(covican) - -# For customization of checkbox labels (example) -rd_transform(covican, - checkbox_labels = c("Not present", "Present") -) +# Minimal usage (project object or data + dictionary) +trans <- rd_transform(covican) + +# Custom checkbox labels +trans <- rd_transform(covican, + checkbox_labels = c("Not present", "Present")) + +# Return only a single form (wide) +trans <- rd_transform(covican, + final_format = "by_form", + which_form = "laboratory_findings", + wide = TRUE) } diff --git a/man/redcap_data.Rd b/man/redcap_data.Rd index 98ec2b2..9f65a2d 100644 --- a/man/redcap_data.Rd +++ b/man/redcap_data.Rd @@ -15,39 +15,44 @@ redcap_data( ) } \arguments{ -\item{data_path}{Path to the exported R file for data import (if using exported files).} +\item{data_path}{Path to exported R file (use with \code{dic_path}).} -\item{dic_path}{Path to the dictionary file (CSV or XLSX).} +\item{dic_path}{Path to the dictionary file (CSV or XLSX; use with \code{data_path})..} \item{event_path}{Path to the event-form mapping file (CSV or XLSX) for longitudinal projects (downloadable via the \verb{Designate Instruments for My Events} tab within the \verb{Project Setup} section of REDCap).} -\item{uri}{The URI of the REDCap project (for API connection).} +\item{uri}{REDCap API base URI (use with \code{token}).} -\item{token}{API token for REDCap project access.} +\item{token}{REDCap API token (use with \code{uri}).} -\item{filter_field}{Fields to include in the import (API connection only).} +\item{filter_field}{Optional character vector of field names to request from the API.} -\item{survey_fields}{Logical indicating whether to include survey-related fields (API connection only).} +\item{survey_fields}{Logical; include survey-related fields when pulling via API. Default \code{FALSE}.} } \value{ -A list containing: +A list with: \itemize{ \item \code{data}: Imported dataset. -\item \code{dictionary}: Variable dictionary. -\item \code{event_form} (if applicable): Event-form mapping for longitudinal projects. +\item \code{dictionary}: Variable dictionary (project metadata). +\item \code{event_form}: Event-form mapping for longitudinal projects (if applicable). } } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function reads datasets from a REDCap project into R for analysis. Data can be imported from REDCap exported files or via an API connection. -\strong{Options for data import:} +Import REDCap data into R either from REDCap's exported R file or directly via the REDCap API. The function returns a list with the dataset, the project dictionary (metadata) and, for longitudinal projects, the instrument–event mapping (\code{event_form}) when available. +} +\details{ +Two import modes are supported: \itemize{ -\item \strong{Exported Data}: REDCap's \emph{Export Data} function generates files suitable for R import. -\item \strong{API Connection}: Use the REDCap API to directly pull data into R. +\item \strong{Exported files} — use \code{data_path} (REDCap R export) and \code{dic_path} (dictionary CSV/XLSX). +\item \strong{API} — use \code{uri} and \code{token} to pull data and metadata directly from REDCap. } -\strong{Steps for using exported data:} +If the project is longitudinal, provide \code{event_path} (instrument–event mapping) +or the function will attempt to fetch it from the API when using API mode. + +\strong{Steps for using exported data in REDCap:} \enumerate{ \item Use the REDCap \emph{Export Data} function and choose \emph{R Statistical Software} format. \item REDCap generates: @@ -60,22 +65,26 @@ This function reads datasets from a REDCap project into R for analysis. Data can } \note{ To use other package functions effectively, include the \code{dic_path} argument to load the project dictionary. + +\itemize{ +\item Use either exported-files mode (\code{data_path} + \code{dic_path}) \strong{or} API mode (\code{uri} + \code{token}) — not both. +\item For exported files, REDCap's R export is required for \code{data_path}. Dictionary and event files must be CSV or XLSX. +} } \examples{ \dontrun{ -# Import using exported files - -dataset <- redcap_data( - data_path = "C:/Users/username/example.r", - dic_path = "C:/Users/username/example_dictionary.csv", - event_path = "C:/Users/username/events.csv" +# From exported files +out <- redcap_data( + data_path = "project_export.r", + dic_path = "project_dictionary.csv", + event_path = "instrument_event_map.csv" ) -# Import using API - -dataset_api <- redcap_data( - uri = "https://redcap.idibell.cat/api/", - token = "55E5C3D1E83213ADA2182A4BFDEA" -) # This token is fictitious +# From API +out_api <- redcap_data( + uri = "https://redcap.example.org/api/", + token = "REPLACE_WITH_TOKEN" +) } + } diff --git a/tests/testthat/test-rd_insert_na.R b/tests/testthat/test-rd_insert_na.R index 7690008..f2a22bc 100644 --- a/tests/testthat/test-rd_insert_na.R +++ b/tests/testthat/test-rd_insert_na.R @@ -59,29 +59,6 @@ test_that("rd_insert_na errors if data or dic missing", { ) }) -test_that("rd_insert_na errors if vars and filter lengths differ (with event_form)", { - df <- head(df_single, 4) - v1 <- vars_in_dic[1] - v2 <- vars_in_dic[2] - - dic <- covican$dictionary[covican$dictionary$field_name %in% c(v1, v2), - c("field_name", "form_name")] - names(dic) <- c("field_name", "form_name") - dic$form_name <- as.character(dic$form_name) - dic$field_name <- as.character(dic$field_name) - - # one filter but two vars -> should error about mismatch - expect_error( - rd_insert_na( - data = df, dic = dic, - vars = c(v1, v2), - filter = paste0(v1, " == 1"), - event_form = covican$event_form - ), - "does not match the number of filters" - ) -}) - test_that("rd_insert_na leaves data unchanged when filter matches no rows (with event_form)", { df <- head(df_single, 3) v1 <- vars_in_dic[1] @@ -126,3 +103,99 @@ test_that("rd_insert_na errors if longitudinal but event_form missing", { "The dataset contains multiple events, but the `event_form` mapping was not provided. Please specify it." ) }) + + +test_that("rd_insert_na errors if filter variables not in data", { + df <- head(df_single, 3) + v1 <- vars_in_dic[1] + dic <- data.frame(field_name = v1, form_name = covican$dictionary$form_name[ + covican$dictionary$field_name == v1], stringsAsFactors = FALSE) + + # Filter uses a non-existent variable + expect_error( + rd_insert_na( + data = df, dic = dic, + vars = v1, + filter = "nonexistent_var == 1", + event_form = covican$event_form + ), + "Filter variable\\(s\\) not found in data" + ) +}) + +test_that("rd_insert_na errors if filter variables not in dictionary", { + df <- head(df_single, 3) + v1 <- vars_in_dic[1] + dic <- data.frame(field_name = v1, form_name = covican$dictionary$form_name[ + covican$dictionary$field_name == v1], stringsAsFactors = FALSE) + + # Filter uses a variable not in dic + expect_error( + rd_insert_na( + data = df, dic = dic, + vars = v1, + filter = paste0(v1, " < 100 & missing_in_dic < 1"), + event_form = covican$event_form + ), + "Filter variable\\(s\\) not found in data" + ) +}) + +test_that("rd_insert_na warns when variable is present in more events than the filter", { + + # Create a filter referencing both variables + filter_expr <- "inc_1== 1 & copd== 1" + + expect_warning( + rd_insert_na( + data = covican$data, dic = covican$dictionary, + vars = "resp_rate", filter = filter_expr, + event_form = covican$event_form + ), + "Only rows in common events" + ) +}) + +test_that("rd_insert_na increments results numbering for multiple transformations", { + df <- head(df_single, 6) + v1 <- vars_in_dic[1] + v2 <- vars_in_dic[2] + dic <- covican$dictionary[covican$dictionary$field_name %in% c(v1, v2), + c("field_name", "form_name")] + names(dic) <- c("field_name", "form_name") + dic$form_name <- as.character(dic$form_name) + dic$field_name <- as.character(dic$field_name) + + filter1 <- paste0(v1, " >= 0") + filter2 <- paste0(v1, " < 100") + + result <- rd_insert_na( + data = df, dic = dic, + vars = v2, + filter = filter1, + event_form = covican$event_form + ) + + # Apply second transformation + result2 <- rd_insert_na( + data = result$data, dic = dic, + vars = v2, + filter = filter2, + event_form = covican$event_form + ) + + expect_true(!grepl("1\\.", result$results)) +}) + +test_that("rd_insert_na reapplies variable labels after transformation", { + + filter_expr <- "inc_1== 1 & resp_rate== 1" + + result <- rd_insert_na( + data = covican$data, dic = covican$dictionary, + vars = "copd", filter = filter_expr, + event_form = covican$event_form + ) + + expect_equal(labelled::var_label(result$data)[["type_dm"]], "Type of diabetes") +}) diff --git a/tests/testthat/test-rd_query.R b/tests/testthat/test-rd_query.R index 5a6b421..b56c3ba 100644 --- a/tests/testthat/test-rd_query.R +++ b/tests/testthat/test-rd_query.R @@ -1,12 +1,11 @@ make_toy_dic <- function(fields) { - df <- data.frame( + data.frame( field_name = names(fields), field_label = sapply(fields, function(x) x$field_label), form_name = sapply(fields, function(x) x$form_name), branching_logic_show_field_only_if = sapply(fields, function(x) ifelse(is.null(x$branch), NA_character_, x$branch)), stringsAsFactors = FALSE ) - df } test_that("rd_query errors when data or dic are missing", { @@ -117,7 +116,7 @@ test_that("rd_query repeats a single expression for multiple variables (warning v2 = list(field_label = "V2", form_name = "f1"))) expect_warning( res <- rd_query(data = toy_data, dic = toy_dic, variables = c("v1", "v2"), expression = "is.na(x)"), - regexp = "Fewer expressions than variables" + regexp = "The first expression will be applied to all variables." ) # Both fields should produce queries (identifiers present for the NA rows) expect_true("1" %in% res$queries$Identifier) @@ -432,17 +431,6 @@ test_that("rd_query applies branching logic correctly", { expect_true(all(res$queries$Identifier %in% c("1"))) }) -# --- Helpers used in these tests --- -make_toy_dic <- function(fields) { - data.frame( - field_name = names(fields), - field_label = sapply(fields, function(x) x$field_label), - form_name = sapply(fields, function(x) x$form_name), - branching_logic_show_field_only_if = sapply(fields, function(x) ifelse(is.null(x$branch), NA_character_, x$branch)), - stringsAsFactors = FALSE - ) -} - # --- Extra tests to improve coverage --- test_that("rd_query accepts a 'project' object and uses check_proj result", { @@ -544,3 +532,151 @@ test_that("rd_query handles checkbox-style variable names with '___' suffix when expect_true(all(c("queries", "results") %in% names(res))) }) +test_that("rd_query allows a single custom report_title", { + toy_data <- data.frame(record_id = 1:2, a = c(NA, 1)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + + res <- rd_query(data = toy_data, dic = toy_dic, + variables = "a", expression = "is.na(x)", + report_title = "Missing Report") + + expect_true(all(grepl("Missing Report", as.character(res$results)))) +}) + +test_that("rd_query warns when too many expressions for few variables", { + toy_data <- data.frame(record_id = 1:2, a = c(1, NA)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + + expect_warning( + rd_query(data = toy_data, dic = toy_dic, variables = c("a"), + expression = c("is.na(x)", "x > 0")), + regexp = "The first variable will be used for all expressions." + ) +}) + +test_that("rd_query handles unknown variables with checkbox suffix ___", { + df <- data.frame(record_id = c(1,2,3), flag___1 = c(1, NA, 1)) + toy_dic <- make_toy_dic(list(flag = list(field_label = "Flag", form_name = "flags"))) + + res <- rd_query(data = df, dic = toy_dic, variables = "flag___1", expression = "is.na(x)") + expect_true(is.list(res)) + expect_true(all(c("queries", "results") %in% names(res))) +}) + +test_that("rd_query handles completely empty dataset with report_zeros = TRUE", { + df <- data.frame(record_id = character(0), x = numeric(0)) + toy_dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "demo"))) + + res <- rd_query(data = df, dic = toy_dic, variables = "x", expression = "is.na(x)", report_zeros = TRUE) + expect_true(nrow(res$queries) == 0) # no queries generated + expect_true(all(c("queries", "results") %in% names(res))) +}) + +test_that("rd_query handles expressions that evaluate to NA", { + df <- data.frame(record_id = 1:3, y = c(NA, 1, 2)) + toy_dic <- make_toy_dic(list(y = list(field_label = "Y", form_name = "demo"))) + + # expression that produces NA for first element + res <- rd_query(data = df, dic = toy_dic, variables = "y", expression = "x > 10") + expect_true(all(res$queries$Identifier %in% c("1","2","3") | nrow(res$queries) >= 0)) +}) + + +test_that("rd_query warns when branching logic cannot be parsed", { + df <- data.frame(record_id = 1:2, z = c(NA, 1)) + toy_dic <- make_toy_dic(list(z = list(field_label = "Z", form_name = "f1", branch = "[z] >> 1"))) + + expect_warning( + rd_query(data = df, dic = toy_dic, variables = "z", expression = "is.na(x)"), + regexp = "could not be converted" + ) +}) + +test_that("rd_query ignores empty filter vector", { + df <- data.frame(record_id = 1:2, a = c(NA, 1)) + toy_dic <- make_toy_dic(list(a = list(field_label = "A", form_name = "f1"))) + + res <- rd_query(data = df, dic = toy_dic, variables = "a", expression = "is.na(x)", filter = character(0)) + expect_true(nrow(res$queries) > 0) +}) + +test_that("rd_query handles multiple event_id on longitudinal dataset correctly", { + df <- data.frame(record_id = 1:2, x = c(NA, 5), redcap_event_name = c("e1", "e2"), redcap_event_name.factor = c("E1", "E2")) + toy_dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "demo"))) + + link <- list(domain = "redcap", redcap_version = "10", proj_id = 1, + event_id = setNames(c(101, 102), c("e1","e2"))) + + res <- rd_query(data = df, dic = toy_dic, variables = "x", expression = "is.na(x)", link = link) + expect_true(all(c("Link","Event") %in% names(res$queries))) +}) + +#---------- + +test_that("rd_query auto-maps event from event_form when event is NA", { + toy_data <- data.frame( + record_id = as.character(1:4), + redcap_event_name = c("ev1", "ev1", "ev2", "ev2"), + x = c(1, 2, 3, 4), + stringsAsFactors = FALSE + ) + + toy_dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "f1"))) + event_form <- data.frame(form = "f1", unique_event_name = c("ev1"), stringsAsFactors = FALSE) + + # call with event = NA (default) but providing event_form + out <- rd_query(variables = "x", expression = "x > 1", data = toy_data, dic = toy_dic, event_form = event_form) + + expect_true(is.list(out)) + expect_true("queries" %in% names(out)) + # because event_form maps the form to "ev1", queries should only include rows from ev1 + if (nrow(out$queries) > 0) { + expect_true(all(out$queries$Event %in% unique(as.character(toy_data$redcap_event_name[toy_data$redcap_event_name %in% event_form$unique_event_name])))) + } +}) + +test_that("rd_query accepts scalar link$event_id for non-longitudinal dataset and adds event_id column", { + toy_data <- data.frame(record_id = as.character(1:2), x = c(1,2), stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "demo"))) + + # single event_id provided for a non-longitudinal dataset + link <- list(event_id = 5, domain = "d", redcap_version = 9, proj_id = 1) + + out <- rd_query(variables = "x", expression = "x>0", data = toy_data, dic = toy_dic, link = link) + + # Should not error and queries should exist; the queries data frame should have an event_id column + expect_true(is.list(out)) + # depending on whether queries are present or zero-queries, check that merge did not crash; + # if queries exist, they should include event_id when full link set is provided + if (nrow(out$queries) > 0) { + expect_true("id=1" %in% out$queries$Link || any(grepl("id=2", out$queries$Link))) + } +}) + +test_that("rd_query errors when query_name length mismatches variables", { + toy_data <- data.frame(record_id = 1L, x = 1L, x2 = 1L, redcap_event_name = "ev1", stringsAsFactors = FALSE) + toy_dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "f1"))) + + expect_error( + rd_query(variables = c("x", "x2"), expression = c("x>0", "x>0"), query_name = c("q1", "q2", "q3"), data = toy_data, dic = toy_dic, event = "ev1"), + regexp = "Multiple query names specified, but the number of query names is different from the number of variables" + ) +}) + +test_that("rd_query addTo preserves Link column when present in addTo$queries", { + data <- data.frame(record_id = 1:2, x = c(1, 2), redcap_event_name = c("ev1","ev1"), stringsAsFactors = FALSE) + dic <- make_toy_dic(list(x = list(field_label = "X", form_name = "f1"))) + + # produce a first run with one query + base <- rd_query(variables = "x", expression = "x>1", data = data, dic = dic, event = "ev1") + + addTo <- list(queries = as.data.frame(base$queries)) + # add a Link column to mimic an earlier export + addTo$queries$Link <- "http://example.com/1" + + # call rd_query with addTo; should not error and resulting queries should include a Link column + out <- rd_query(variables = "x", expression = "x>0", data = data, dic = dic, event = "ev1", addTo = addTo) + expect_true(is.list(out)) + expect_true("queries" %in% names(out)) + expect_true("Link" %in% names(out$queries)) +}) diff --git a/tests/testthat/test-rd_rlogic.R b/tests/testthat/test-rd_rlogic.R index 35ba6ba..e0f69ed 100644 --- a/tests/testthat/test-rd_rlogic.R +++ b/tests/testthat/test-rd_rlogic.R @@ -187,7 +187,7 @@ test_that("rd_rlogic handles event-specific logic", { expect_true(is.na(out$eval[2]) || identical(out$eval[2], NA)) }) -test_that("fill_data fills from the specified event across records and uses first non-NA when repeated", { +test_that("fill_data fills from the specified event across records correctly", { # build a small toy dataset with multiple records and repeated events df <- data.frame( record_id = c(1, 1, 1, 2, 2, 3, 3, 4), @@ -200,12 +200,11 @@ test_that("fill_data fills from the specified event across records and uses firs out <- fill_data(which_event = "ev1", which_var = "visit_date", data = df) # Expectations: - # - For record 1: two ev1 entries ("A","A2") -> function should pick the *first* non-NA unique value ("A") - # and fill it to all rows for record 1. - # - For record 2: ev1 exists but is NA -> result for record 2 should be NA for all its rows. - # - For record 3: ev1 is not present for that record -> result NA for its rows. - # - For record 4: ev1 present with "D" -> "D" for its rows. - expected <- c("A", "A", "A", NA, NA, NA, NA, "D") + # - For record 1: ev1 rows remain "A", "A2", propagated to ev2 row with fill -> "A", "A", "A2" + # - For record 2: ev1 is NA -> ev2 row stays NA + # - For record 3: no ev1 -> all NA + # - For record 4: ev1 "D" -> stays "D" + expected <- c("A", "A", "A2", NA, NA, NA, NA, "D") expect_equal(out$visit_date, expected) }) @@ -223,3 +222,126 @@ test_that("fill_data errors when the requested event is not present in the datas "The logic can't be evaluated after the translation" ) }) + +# helper that creates a tiny dictionary row for given fields +make_dic <- function(fields, choices = NULL, text_validation = NA_character_, form = "form1") { + fields <- as.character(fields) + n <- length(fields) + df <- data.frame( + field_name = fields, + form_name = rep(as.character(form), n), + section_header = "", + field_type = "", + field_label = "", + choices_calculations_or_slider_labels = rep(ifelse(is.null(choices), "", choices), n), + field_note = "", + text_validation_type_or_show_slider_number = rep(text_validation, n), + text_validation_min = "", + text_validation_max = "", + identifier = "", + branching_logic_show_field_only_if = "", + required_field = "", + custom_alignment = "", + question_number_surveys_only = "", + matrix_group_name = "", + matrix_ranking = "", + field_annotation = "", + stringsAsFactors = FALSE + ) + df +} + +test_that("rd_rlogic warns when multiple logic expressions or multiple vars are provided and uses first", { + df <- data.frame(a = c(1,0), stringsAsFactors = FALSE) + dic <- make_dic("a") + expect_warning( + out <- rd_rlogic(data = df, dic = dic, + logic = c("if([a]='1',1,0)", "if([a]='0',1,0)"), + var = c("a", "a")), + "`logic` contains more than one expression;|`var` contains more than one variable name" + ) + + # Should have translated the first logic only + expect_true(grepl("ifelse\\(data\\$a==", out$rlogic)) + expect_equal(as.numeric(out$eval), as.numeric(df$a == 1)) +}) + +test_that("rd_rlogic translates rounddown(...) to floor/round variants", { + df <- data.frame(x = c(2.6, 3.2), stringsAsFactors = FALSE) + dic <- make_dic("x") + # test rounddown with 0 -> floor + out0 <- rd_rlogic(data = df, dic = dic, logic = "rounddown([x],0)", var = "x") + expect_true(grepl("floor\\(", out0$rlogic) || grepl("round\\(", out0$rlogic)) + # evaluate should equal floor(x) when used as expression (no ifelse wrapper) + # Because rd_rlogic returns value in `eval` for single-event (no event_form) + expect_equal(as.numeric(out0$eval), floor(df$x)) +}) + +test_that("rd_rlogic converts sum(...) to rowSums and evaluates correctly", { + df <- data.frame(a = c(1,2), b = c(3, NA), stringsAsFactors = FALSE) + dic <- make_dic(c("a", "b")) + out <- rd_rlogic(data = df, dic = dic, + logic = "sum([a],[b])", + var = "a") + expect_true(grepl("rowSums\\(", out$rlogic)) + # result should equal rowSums with NA treated as NA (default) + expect_equal(as.numeric(out$eval), rowSums(cbind(df$a, df$b))) +}) + +test_that("rd_rlogic stops when the same variable is specified for different events ([][] case)", { + # Create a minimal dataset with event names for longitudinal behavior + df <- data.frame(record_id = 1:2, + redcap_event_name = c("ev1", "ev2"), + x = c(1, 0), + stringsAsFactors = FALSE) + dic <- make_dic("x") + # logic references x in two different events explicitly -> should error + logic <- "if([ev1][x]='1' or [ev2][x]='1',1,0)" + expect_error( + rd_rlogic(data = df, dic = dic, event_form = data.frame(form="form1", unique_event_name=c("ev1","ev2"), stringsAsFactors = FALSE), + logic = logic, var = "x"), + "The logic cannot be transcribed because the same variable is specified for different events\\." + ) +}) + +test_that("rd_rlogic errors when logic references variable in a repeated instrument", { + # Build a dataset with redcap_repeat_instrument and a dic marking the form + df <- data.frame(record_id = 1:2, + redcap_event_name = c("ev1", "ev1"), + redcap_repeat_instrument = c("form_repeat", NA), + repvar = c(1, 0), + stringsAsFactors = FALSE) + # dic says repvar belongs to form_repeat (so it's in a repeated instrument) + dic <- make_dic("repvar", form = "form_repeat") + logic <- "if([repvar]='1',1,0)" + expect_error( + rd_rlogic(data = df, dic = dic, event_form = data.frame(form="form_repeat", unique_event_name="ev1", stringsAsFactors = FALSE), + logic = logic, var = "repvar"), + "cannot translate logic involving variables that belong to repeated instruments" + ) +}) + +test_that("rd_rlogic maps factor variables used in arithmetic to numeric via choices_calculations_or_slider_labels", { + # factor variable with labelled choices like "1, Yes|2, No" + df <- data.frame(f = factor(c("Yes", "No")), g = c(1, 2), stringsAsFactors = FALSE) + dic <- make_dic("f", choices = "1, Yes | 2, No") + # logic uses f in arithmetic with g; vars_calc detection should convert factor to numeric + out <- rd_rlogic(data = df, dic = dic, logic = "if([f]+[g] > 1, 1, 0)", var = "f") + expect_true(grepl("data\\$f", out$rlogic)) + # After mapping, evaluation should be numeric and length matches rows + expect_equal(length(out$eval), nrow(df)) + # Confirm at least one TRUE/1 expected value + expect_true(any(as.numeric(out$eval) %in% c(0,1))) +}) + +test_that("rd_rlogic throws an error when final evaluation fails (invalid R code after translation)", { + df <- data.frame(a = c(1, 0), stringsAsFactors = FALSE) + dic <- make_dic("a") + # malformed logic that will produce invalid R code after translation + bad_logic <- "if([a]='1', 1, )" + expect_error( + rd_rlogic(data = df, dic = dic, logic = bad_logic, var = "a"), + "The logic could not be evaluated after translation\\." + ) +}) + diff --git a/tests/testthat/test-utils_transform.R b/tests/testthat/test-utils_transform.R new file mode 100644 index 0000000..1d165f7 --- /dev/null +++ b/tests/testthat/test-utils_transform.R @@ -0,0 +1,78 @@ +test_that("recalculate works as expected", { + + dic <- tibble::tibble( + field_name = c("a", "b", "c"), + field_label = c("a", "b", "c"), + field_type = c("calc", "calc", "calc"), + text_validation_type_or_show_slider_number = "", + choices_calculations_or_slider_labels = c("1+1", "2+2", "error"), + branching_logic_show_field_only_if = "" + ) + + data <- tibble::tibble( + a = 1:3, + b = 2:4, + c = 3:5 + ) + + # Exclude one variable + res <- suppressWarnings(recalculate(data = data, dic = dic, exclude_recalc = "b")) + + expect_true("a_recalc" %in% names(res$data)) + expect_false("b_recalc" %in% names(res$data)) +}) + + +test_that("transform_checkboxes works correctly", { + dic <- tibble::tibble( + field_name = c("chk1", "chk2"), + field_type = c("checkbox", "checkbox"), + branching_logic_show_field_only_if = c(NA, "error") + ) + + data <- tibble::tibble( + chk1___1 = c("0", "1", "0"), + chk1___2 = c("1", "0", "1"), + chk2___1 = c("0", "0", "1") + ) + + res <- suppressWarnings(transform_checkboxes(data, dic, checkbox_na = TRUE)) + expect_true(all(c("chk1___1", "chk1___2") %in% names(res$data))) + expect_true(length(res$results) > 0) +}) + + +test_that("checkbox_names works and renames", { + data <- tibble::tibble(chk___1 = 1:2, chk___2 = 2:3) + dic <- tibble::tibble(field_name = "chk", field_label = "Check", choices_calculations_or_slider_labels = "0, No | 1, Yes", branching_logic_show_field_only_if = "") + labels <- c("chk___1" = "choice=No)", "chk___2" = "choice=Yes)") + + res <- suppressWarnings(checkbox_names(data, dic, labels)) + expect_true(any(grepl("chk_", names(res$data)))) + expect_true(all(c("chk_no", "chk_yes") %in% res$dic$field_name)) +}) + +test_that("split_event handles errors", { + data <- tibble(a=1:2, record_id=1:2) + dic <- tibble(field_name="a", field_type="text", form_name="f1") + event_form <- tibble(form="f1", unique_event_name="e1") + + expect_error(suppressWarnings(split_event(data, dic, event_form))) # Missing redcap_event_name +}) + +test_that("split_form works with wide and longitudinal", { + data <- tibble(record_id = 1:2, redcap_event_name="e1", a=1:2) + dic <- tibble(field_name="a", form_name="f1", field_type="text") + event_form <- tibble(form="f1", unique_event_name="e1") + + res <- suppressWarnings(split_form(data, dic, event_form, wide=TRUE)) + expect_true(is.list(res)) +}) + +test_that("to_factor converts correctly", { + data <- tibble(a = c("x","y"), a.factor=as.factor(a), redcap_event_name="e1", redcap_event_name.factor = "E1", redcap_repeat_instrument=NA, redcap_repeat_instrument.factor =NA) + dic <- tibble(field_name="a", choices_calculations_or_slider_labels="1, x | 2, y", field_type="radio", branching_logic_show_field_only_if = "") + + res <- suppressWarnings(to_factor(data, dic)) + expect_true(is.factor(res$data$a)) +}) diff --git a/vignettes/REDCapDM.Rmd b/vignettes/REDCapDM.Rmd index d420a05..3c0f2f9 100644 --- a/vignettes/REDCapDM.Rmd +++ b/vignettes/REDCapDM.Rmd @@ -79,6 +79,21 @@ Or we can use all these functions at once:

    +# **Installation** + +The release version can be installed from CRAN: + +```{r eval=FALSE} +install.packages("REDCapDM") +``` + +The development version can be installed from GitHub: + +```{r eval=FALSE} +install.packages("remotes") # Run this line if the 'remotes' package isn't installed already. +remotes::install_github("bruigtp/REDCapDM") +``` + # **Built-in dataset** For the following examples, we will use a random sample of the COVICAN study which is included in the package. COVICAN is an international, multicentre cohort study of cancer patients with COVID-19 to describe the epidemiology, risk factors, and clinical outcomes of co-infections and superinfections in onco-hematological patients with COVID-19. @@ -86,6 +101,8 @@ For the following examples, we will use a random sample of the COVICAN study whi We can load the built-in dataset by typing: ```{r message=FALSE, warning=FALSE, comment=NA} +library(REDCapDM) + data(covican) ``` @@ -134,7 +151,7 @@ kable(vars) |> # **Usage** -The package structure can be divided into three main components: reading raw data, processing data and identifying queries. Typically, after collecting data in REDCap, we will have to follow this three components in order to have a final validated dataset for analysis. We will provide a complete basic user guide on how to perform each one of these steps using the package's functions. For the processing of the data and query identification, we will use the `covican` built-in dataset as an example. +The package structure can be divided into three main components: reading raw data, processing data and identifying queries. Typically, after collecting data in REDCap, we will have to follow these three components in order to have a final validated dataset for analysis. We will provide a complete basic user guide on how to perform each one of these steps using the package's functions. For the processing of the data and query identification, we will use the `covican` built-in dataset as an example. ## **Read data** @@ -231,7 +248,7 @@ When variables are deleted: ### **rd_dates** -This function is designed to process and standardize `date` and `datetime` fields in a REDCap dataset. In REDCap projects, date and datetime fields can sometimes be stored as character strings, which can make analyses difficult. It detects which fields should be dates/datetimes from the REDCap dictionary and converts them to `Date` and `POSIXct`, respectively. +This function is designed to process and standardize `date` and `datetime` fields in a REDCap dataset. In REDCap projects, date and datetime fields can sometimes be stored as character strings, which can make analyses difficult. This function detects which fields should be dates/datetimes from the REDCap dictionary and converts them to `Date` and `POSIXct`, respectively. ```{r message=FALSE, warning=FALSE, comment="#>", collapse = TRUE} covican_dates <- covican |> @@ -261,9 +278,9 @@ After this transformation, all `date` and `datetime` variables are standardized ### **rd_recalculate** -This function identifies calculated fields in a REDCap project, translates their logic into R, recalculates them, and compares the recalculated values with the originals. +This function identifies calculated fields in a REDCap project, translates their calculation logic into R, recalculates the values, and compares the results with the values stored in REDCap. -It produces a report, helping users detect discrepancies between REDCap’s stored calculations and the values recomputed in R. +It then produces a structured report that helps users detect discrepancies between REDCap’s stored calculations and the values recalculated in R. ```{r} covican_recalc <- covican |> @@ -273,13 +290,13 @@ covican_recalc <- covican |> covican_recalc$results ``` -The `results` object contains: +The `results` object includes: -- Summary report: total number of calculated fields, how many were successfully transcribed into R logic, and how many recalculated values differ from the originals. +- A summary report outlining the total number of calculated fields, how many were successfully transcribed into R, and how many showed differences between the REDCap values and the recalculated ones. -- Field-level report: lists each calculated field, whether its logic was transcribed, and whether the recalculated value matches the original. +- A field-level report listing each calculated field, whether the logic was successfully converted to R, and whether the recalculated values match the originals. -IN addition, you can exclude certain fields from recalculation (e.g., complex multi-event calculations) to reduce computation time and avoid unnecessary warnings. +You can also exclude specific fields from recalculation (e.g., complex multi-event calculations) to reduce computation time and avoid unnecessary warnings. ```{r} # Exclude specific variables from recalculation @@ -289,48 +306,58 @@ covican_recalc <- covican |> covican_recalc$results ``` -When recalculation succeeds: +After running this function: -- A new variable is added to the dataset with the suffix `_recalc.` +- A new variable with the suffix `_recalc` is added to the dataset, placed immediately after the original variable and containing the recalculated values. -- A corresponding entry is added to the dictionary with the label `". (Recalculate)"`. +- The data dictionary is updated with a corresponding entry, where the original variable label is extended with `"(Recalculated)"` to make these fields easy to identify.
    ### **rd_checkbox** -This function processes REDCap checkbox fields, converting them from "Checked"/"Unchecked" categories into binary-coded variables (0/1) and its corresponding factor variable with user-specified labels. It also renames variables to match checkbox option labels and updates dictionary branching logic and calculations accordingly to the new names. +This function cleans and restructures REDCap checkbox fields. It converts the default `"Unchecked/Checked"` categories of checkbox responses created by REDCap into user-specified labels (default `"No"/"Yes"`) and renames the `varname___code` variables (original REDCap structure) to readable names based on the text of the checkbox options. Additionally, it updates the dictionary to match the new variable names. This includes choices, calculations, and branching logic. ```{r} -# Default transformation: "No"/"Yes" labels, renamed variables +# Default transformation: "No"/"Yes" labels & renamed variables cb <- covican |> rd_checkbox() str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) ``` -If a branching logic exists for a checkbox field, the function attempts to translate it into R, by default. When `checkbox_na = TRUE`, values outside the branching logic are set to NA. A summary of problematic fields (e.g., missing branching logic or logic not transcribable) is included in the results element: +For example, consider the checkbox field of the type of underlying disease present in the `covican` dataset. Originally, the variables were named `type_underlying_disease__0` and `type_underlying_disease__1`, while the option labels were ‘Haematological cancer’ and ‘Solid tumour’. After running the function, the variables are renamed to `type_underlying_disease_haematological_cancer` and `type_underlying_disease_solid_tumour`, reflecting the option text in a readable format.. + +To preserve the original REDCap-style names (e.g., `varname___1`, `varname___2`) instead of renaming variables based on option text: ```{r} -cb$results +# use the argument checkbox_names to choose the final format of the variable names +cb <- covican |> + rd_checkbox(checkbox_names = FALSE) + +str(cb$data$underlying_disease_hemato___1) ``` -You can specify alternative labels: +If a checkbox field has a branching logic, the function will not modify any values. However, you can use the `na_logic` argument, which accepts the following options: + +- `"none"` (default): do not set `NA` based on branching logic during transform. + +- `"missing"`: set `NA` only where the branching logic evaluation is `NA`. + +- `"eval"`: set `NA` where the branching logic evaluates to `FALSE` (i.e., logic not satisfied or missing). ```{r} cb <- covican |> - rd_checkbox(checkbox_labels = c("Absent", "Present")) - -str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) + rd_checkbox(na_logic = "eval") ``` -To retain the original REDCap-style names (e.g., varname___1, varname___2) instead of renaming to option text: +By default, checkbox factors are labeled `"No"` and `"Yes"`, but you can specify alternative labels: ```{r} cb <- covican |> - rd_checkbox(checkbox_names = FALSE) + rd_checkbox(checkbox_labels = c("Absent", "Present")) -str(cb$data$underlying_disease_hemato___1) +str(cb$data$underlying_disease_hemato_acute_myeloid_leukemia) ```
    @@ -338,7 +365,7 @@ str(cb$data$underlying_disease_hemato___1) ### **rd_factor** -This function converts categorical variables in a REDCap dataset into R factors. It replaces categorical columns with the corresponding `.factor` column (created by REDCap for multiple-choice fields). +This function converts categorical variables in a REDCap dataset into R factors by replacing each original variable (numeric version) with its corresponding `.factor` version created by REDCap. ```{r} factored <- covican |> @@ -348,20 +375,20 @@ factored <- covican |> str(factored$data$available_analytics) ``` -You can prevent certain variables from being converted to factors using the `exclude` argument. -This is useful if you need to keep some variables as raw numeric or text data. +If you need to keep certain variables in their raw form, you can list them in the `exclude` argument. This prevents those variables from being replaced (including their `.factor` version) while still allowing the rest of the dataset to be converted. ```{r} factored <- covican |> rd_factor(exclude = c("available_analytics", "urine_culture")) -# Checking class of the variable +# Checking class of both versions of the variable str(covican$data$available_analytics) +str(covican$data$available_analytics.factor) ``` > Note: the function automatically excludes these system variables from conversion: `redcap_event_name`, `redcap_repeat_instrument`, `redcap_data_access_group`. These variables are retained as-is to avoid interfering with longitudinal event mappings or user access groups. -After conversion, original variables are replaced with proper R factor columns and their `.factor` counterparts are dropped. +After conversion only the cleaned factor variables remain in the dataset, the original numeric version of those variables is dropped.
    @@ -436,7 +463,7 @@ head(baseline_data$data) ### **rd_insert_na** -This is a bonus function that can be used to set some values of a variable to missing if a certain logic is fulfilled. It can be used, for example, to insert missings on those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can transform the checkboxes with the `rd_checkbox()` function and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: +This is an auxiliar/bonus function that can be used to set some values of a variable(s) to missing if a certain logic is fulfilled. It can be used, for example, to insert missings on those checkboxes that do not have a branching logic, as mentioned earlier. For instance, we can transform the checkboxes with the `rd_checkbox()` function and then use this function to set the values of the checkbox _type_underlying_disease_haematological_cancer_ to missing when the age is less than 65 years old: ```{r message=FALSE, warning=FALSE, comment=NA} cb <- covican |> @@ -455,13 +482,13 @@ cb2 <- covican |> table(cb2$data$type_underlying_disease_haematological_cancer) ``` -> Recall that both the variable to be transformed (_age_) and the variable included in the filter (_type_underlying_disease_haematological_cancer_) are in the same event. In the contrary, if the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted. +> Note that both the variable to be transformed (`age`) and the variable included in the filter (`type_underlying_disease_haematological_cancer`) are in the same event. If the variable to be transformed and the filter didn't have any event in common then the transformation would give an error. Furthermore, if the variable to be transformed was in more events than the filter, only the rows of the events in common would be converted.
    ### **rd_rlogic** -This is also a bonus function that transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic in R. +This is also an auxiliar/bonus function that transforms the REDCap logic into logic that can be evaluated in R. It returns both the transformed logic and the result of the evaluation of the logic in R. This function is used internally in multiple functions, for example, `rd_dictionary()`. > This function only returns the transformed logic, so it has to be used outside the transform workflow.