From aa4563746d461e64a2c034c2673da9d2b7c937a7 Mon Sep 17 00:00:00 2001 From: Benjamin Date: Fri, 30 Jun 2023 03:50:22 -0400 Subject: [PATCH] Remove most function for version 3..0.0 Issue #113 Will need to stabilize tests before proceeding --- NAMESPACE | 14 - R/Extraction.R | 41 - R/checkbox_suffixes.R | 63 - R/cleanseMetaData.R | 74 - R/deprecated_recapProjectInfo.R | 70 - R/exportBundle.R | 168 --- R/exportRecords.R | 577 -------- R/exportRecords_offline.R | 183 --- R/exportReports.R | 231 --- R/fieldToVar.R | 240 ---- R/makeRedcapFactor.R | 112 -- R/massert.R | 86 -- R/recodeCheck.R | 96 -- R/redcapFactorFlip.R | 49 - R/syncUnderscoreCodings.R | 148 -- R/zzz.R | 4 - man/Extraction.Rd | 22 - man/checkbox_suffixes.Rd | 19 - man/cleanseMetaData.Rd | 31 - man/deprecated_redcapProjectInfo.Rd | 73 - man/exportBundle.Rd | 89 -- man/exportRecords.Rd | 249 ---- man/exportReports.Rd | 105 -- man/fieldToVar.Rd | 58 - man/massert.Rd | 41 - man/recodeCheck.Rd | 56 - man/redcapFactorFlip.Rd | 27 - man/syncUnderscoreCodings.Rd | 70 - .../testthat/test-11-records-exportRecords.R | 61 - .../testthat/test-13-reports-arg-validation.R | 118 -- .../testthat/test-13-reports-functionality.R | 11 - tests/testthat/test-checkbox_suffixes.R | 42 - tests/testthat/test-fieldToVar.R | 122 -- tests/testthat/test-validateImport_methods.R | 1242 ----------------- 34 files changed, 4592 deletions(-) delete mode 100644 R/Extraction.R delete mode 100644 R/checkbox_suffixes.R delete mode 100644 R/cleanseMetaData.R delete mode 100644 R/deprecated_recapProjectInfo.R delete mode 100644 R/exportBundle.R delete mode 100644 R/fieldToVar.R delete mode 100644 R/makeRedcapFactor.R delete mode 100644 R/massert.R delete mode 100644 R/recodeCheck.R delete mode 100644 R/redcapFactorFlip.R delete mode 100644 R/syncUnderscoreCodings.R delete mode 100644 man/Extraction.Rd delete mode 100644 man/checkbox_suffixes.Rd delete mode 100644 man/cleanseMetaData.Rd delete mode 100644 man/deprecated_redcapProjectInfo.Rd delete mode 100644 man/exportBundle.Rd delete mode 100644 man/exportRecords.Rd delete mode 100644 man/exportReports.Rd delete mode 100644 man/fieldToVar.Rd delete mode 100644 man/massert.Rd delete mode 100644 man/recodeCheck.Rd delete mode 100644 man/redcapFactorFlip.Rd delete mode 100644 man/syncUnderscoreCodings.Rd delete mode 100644 tests/testthat/test-checkbox_suffixes.R delete mode 100644 tests/testthat/test-fieldToVar.R delete mode 100644 tests/testthat/test-validateImport_methods.R diff --git a/NAMESPACE b/NAMESPACE index 39415811..057593c8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method("[",redcapFactor) S3method(allocationTable,redcapApiConnection) S3method(createFileRepositoryFolder,redcapApiConnection) S3method(deleteArms,redcapApiConnection) @@ -9,7 +8,6 @@ S3method(deleteFiles,redcapApiConnection) S3method(deleteFromFileRepository,redcapApiConnection) S3method(deleteRecords,redcapApiConnection) S3method(exportArms,redcapApiConnection) -S3method(exportBundle,redcapApiConnection) S3method(exportDags,redcapApiConnection) S3method(exportEvents,redcapApiConnection) S3method(exportFieldNames,redcapApiConnection) @@ -24,11 +22,9 @@ S3method(exportMetaData,redcapApiConnection) S3method(exportNextRecordName,redcapApiConnection) S3method(exportPdf,redcapApiConnection) S3method(exportProjectInformation,redcapApiConnection) -S3method(exportRecords,redcapApiConnection) S3method(exportRecordsTyped,redcapApiConnection) S3method(exportRecordsTyped,redcapOfflineConnection) S3method(exportRepeatingInstrumentsEvents,redcapApiConnection) -S3method(exportReports,redcapApiConnection) S3method(exportReportsTyped,redcapApiConnection) S3method(exportSurveyParticipants,redcapApiConnection) S3method(exportUsers,redcapApiConnection) @@ -49,10 +45,8 @@ S3method(missingSummary,redcapApiConnection) S3method(preserveProject,redcapApiConnection) S3method(print,invalid) S3method(print,redcapApiConnection) -S3method(print,redcapFactor) S3method(print,redcapOfflineConnection) S3method(purgeProject,redcapApiConnection) -S3method(redcapProjectInfo,redcapApiConnection) S3method(restoreProject,list) S3method(restoreProject,redcapApiConnection) S3method(summary,invalid) @@ -74,7 +68,6 @@ export(castLabel) export(castRaw) export(castTimeHHMM) export(castTimeMMSS) -export(checkbox_suffixes) export(createFileRepositoryFolder) export(deleteArms) export(deleteEvents) @@ -84,7 +77,6 @@ export(deleteFromFileRepository) export(deleteRecords) export(exportArms) export(exportBulkRecords) -export(exportBundle) export(exportDags) export(exportEvents) export(exportFieldNames) @@ -99,11 +91,8 @@ export(exportMetaData) export(exportNextRecordName) export(exportPdf) export(exportProjectInformation) -export(exportRecords) export(exportRecordsTyped) -export(exportRecords_offline) export(exportRepeatingInstrumentsEvents) -export(exportReports) export(exportReportsTyped) export(exportSurveyParticipants) export(exportUsers) @@ -133,11 +122,8 @@ export(preserveProject) export(purgeProject) export(raw_cast) export(recastRecords) -export(recodeCheck) export(reconstituteFileFromExport) export(redcapConnection) -export(redcapFactorFlip) -export(redcapProjectInfo) export(restoreProject) export(splitForms) export(stripHTMLTags) diff --git a/R/Extraction.R b/R/Extraction.R deleted file mode 100644 index 140e5592..00000000 --- a/R/Extraction.R +++ /dev/null @@ -1,41 +0,0 @@ -#' @name Extraction -#' @title Extraction and Assignment for \code{redcapFactor}s -#' -#' @description Extract elements and make assignments to \code{redcapFactor}s -#' -#' @param x an object of class \code{redcapFactor} -#' @param drop \code{logical}. If \code{TRUE}, unused levels are dropped. -#' @param ... additional arguments to pass to other methods -#' -#' @export - -`[.redcapFactor` <- function(x, ..., drop = FALSE){ - redcap_labels <- attr(x, "redcapLabels") - redcap_levels <- attr(x, "redcapLevels") - - has_label <- labelVector::is.labelled(x) - - if (has_label) - label <- labelVector::get_label(x) - - class(x) <- class(x)[!class(x) %in% c("labelled", "redcapFactor")] - - x <- x[..., drop = drop] - - attr(x, "redcapLabels") <- redcap_labels - attr(x, "redcapLevels") <- redcap_levels - if (has_label) - x <- labelVector::set_label(x, label) - x -} - -#' @rdname Extraction -#' @export - -print.redcapFactor <- function(x, ...){ - attr(x, "redcapLabels") <- NULL - attr(x, "redcapLevels") <- NULL - - print.factor(x) -} - diff --git a/R/checkbox_suffixes.R b/R/checkbox_suffixes.R deleted file mode 100644 index 7f18a1cf..00000000 --- a/R/checkbox_suffixes.R +++ /dev/null @@ -1,63 +0,0 @@ -#' @name checkbox_suffixes -#' @title Checkbox Suffixes -#' -#' @description Checkbox variables return one vector of data for each option defined -#' in the variable. The variables are returned with the suffix \code{___[option]}. -#' \code{exportRecords} needs these suffixes in order to retrieve all of the -#' variables and to apply the correct labels. -#' -#' @param fields The current field names of interest -#' @param meta_data The metadata data frame. -#' -#' @export - -checkbox_suffixes <- function(fields, meta_data) -{ - name_suffix <- sapply(X = fields, - FUN = manual_checkbox_suffixes, - meta_data, - simplify = FALSE) - - label_suffix <- - sapply(X = fields, - FUN = manual_checkbox_label_suffixes, - meta_data, - simplify = FALSE) - - list(name_suffix = unlist(name_suffix), - label_suffix = unlist(label_suffix)) -} - -#*********************************************** -#* Unexported methods - -#* Get full variable names (appends ___[option] to checkboxes) -manual_checkbox_suffixes <- function(x, meta_data) -{ - #* If x is a checkbox variable - if (meta_data$field_type[meta_data$field_name %in% x] == "checkbox"){ - field_choice <- meta_data$select_choices_or_calculations[meta_data$field_name %in% x] - opts <- fieldChoiceMapping(field_choice, x) - opts <- tolower(opts)[, 1] - - x <- paste(x, opts, sep="___") - } - x -} - -#* Get full variable label (appends ": [option label]" for checkboxes) -manual_checkbox_label_suffixes <- function(x, meta_data) -{ - #* If x is a checkbox variable - if (meta_data$field_type[meta_data$field_name %in% x] == "checkbox"){ - #* Select choices - field_choice <- meta_data$select_choices_or_calculations[meta_data$field_name %in% x] - opts <- fieldChoiceMapping(field_choice, x)[, 2] - - paste0(meta_data$field_label[meta_data$field_name %in% x], ": ", opts) - } - else - { - meta_data$field_label[meta_data$field_name %in% x] - } -} diff --git a/R/cleanseMetaData.R b/R/cleanseMetaData.R deleted file mode 100644 index ca86716b..00000000 --- a/R/cleanseMetaData.R +++ /dev/null @@ -1,74 +0,0 @@ -#' @name cleanseMetaData -#' @title Clean Meta Data of UTF Characters -#' -#' @description There have been isolated cases observed where certain -#' characters in the data dictionary prevent it from being downloaded -#' correctly. In one case, the data dictionary could not be downloaded -#' at all through the API. It is suspected that these problematic -#' characters are a result of copying and pasting text out of word -#' processing programs. The problematic characters are not necessarily -#' visible and their exact location can be difficult to identify. As -#' a last resort, \code{cleanseMetaData} can read a meta data file -#' downloaded through the user interface, purge it of any UTF-8 characters, -#' and write an alternate data dictionary that contains only ASCII -#' characters. -#' -#' @param meta_data_file \code{character(1)} the path to a meta data file -#' that has been downloaded using the REDCap user interface. -#' @param meta_data_clean \code{character(1)} the path of the file to which -#' the cleaned meta data will be written. -#' @param overwrite \code{logical(1)} Permit the new file to overwrite an -#' existing file. -#' - -cleanseMetaData <- function(meta_data_file, meta_data_clean, - overwrite = FALSE) -{ - coll <- checkmate::makeAssertCollection() - - checkmate::assert_character(x = meta_data_file, - len = 1, - add = coll) - - checkmate::assert_character(x = meta_data_clean, - len = 1, - add = coll) - - checkmate::reportAssertions(coll) - - if (!file.exists(meta_data_file)){ - coll$push(sprintf("File not found: %s", meta_data_file)) - } - - if (file.exists(meta_data_clean) && !overwrite){ - coll$push(sprintf("File exists and overwrite is set to FALSE: %s", - meta_data_clean)) - } - - if (meta_data_clean == meta_data_file){ - coll$push(sprintf("%s %s", - "Sorry. I won't allow you to overwrite your file. ", - "Please use a different path for 'meta_data_clean.")) - } - - checkmate::reportAssertions(coll) - - if (file.exists(meta_data_clean) && overwrite){ - warning("Attempting to overwrite ", meta_data_clean) - } - - dd <- readLines(meta_data_file) - dd <- paste0(dd, collapse = "\n") - dd <- iconv(dd, - from = "utf8", - to = "ASCII", - sub = "") - - dd <- utils::read.csv(text = dd, - stringsAsFactors = FALSE) - - utils::write.csv(dd, - meta_data_clean, - row.names = FALSE, - na = "") -} diff --git a/R/deprecated_recapProjectInfo.R b/R/deprecated_recapProjectInfo.R deleted file mode 100644 index 0ed64b7e..00000000 --- a/R/deprecated_recapProjectInfo.R +++ /dev/null @@ -1,70 +0,0 @@ -#' @name deprecated_redcapProjectInfo -#' @title Deprecated Functions -#' @description The \code{redcapProjectInfo} function has been deprecated to avoid -#' confusion with the API method now executed by \code{exportProjectInformation}. -#' The replacement function is \code{\link{exportBundle}}. -#' -#' @param rcon A REDCap connection object as generated by \code{redcapConnection} -#' @param date Logical. If \code{TRUE}, user expiration dates are converted to -#' \code{POSIXct} objects. -#' @param label Logical. If \code{TRUE}, the user form permissions are -#' converted to labelled factors. -#' @param meta_data Logical. Indicates if the meta data (data dictionary) -#' should be exported. -#' @param users Logical. Indicates if the users table should be exported. -#' @param instruments Logical. Indicates if the instruments table should be exported. -#' @param events Logical. Indicates if the event names should be exported. -#' @param arms Logical. Indicates if the arms table should be exported. -#' @param mappings Logical. Indicates if the form-event mappings should -#' be exported. -#' @param version Indicates if the REDCap version number should be exported. -#' Only applicable in REDCap 6.0.0 and higher. -#' @param ... Arguments to be passed to other methods -#' @param v.number A character string given the desired version number should the -#' API method not be available. -#' -#' @export - -redcapProjectInfo <- function(rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, ...){ - UseMethod("redcapProjectInfo") -} - -#' @rdname deprecated_redcapProjectInfo -#' @export - -redcapProjectInfo.redcapApiConnection <- function(rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, ..., - v.number = ""){ - - message("'redcapProjectInfo' has been deprected. Please use 'exportBundle'") - exportBundle.redcapApiConnection(rcon, - date, - label, - meta_data, - users, - instruments, - events, - arms, - mappings, - version, - ..., - v.number = "") - -} diff --git a/R/exportBundle.R b/R/exportBundle.R deleted file mode 100644 index 2a6f2f7c..00000000 --- a/R/exportBundle.R +++ /dev/null @@ -1,168 +0,0 @@ -#' @name exportBundle -#' @title Perform a bundle of API calls. -#' -#' @description Several of the API calls return objects that can be used to perform -#' various validations in \code{exportRecords}, \code{exportReports}, and other -#' methods. Using an export bundle allows you to call these methods once and -#' store the result instead of issuing an additional call to the API each -#' time a method is invoked. -#' -#' For example, if you are uploading several files to the API, without an -#' export bundle, \code{importFiles} will utilize the \code{exportMetaData} -#' on each call in order to perform validations. Using a bundle allows you -#' to download the meta data once and refer to it on every subsequent call -#' that requires the data dictionary. -#' -#' @param rcon A REDCap connection object as generated by \code{redcapConnection} -#' @param date Logical. If \code{TRUE}, user expiration dates are converted to -#' \code{POSIXct} objects. -#' @param label Logical. If \code{TRUE}, the user form permissions are -#' converted to labelled factors. -#' @param meta_data Logical. Indicates if the meta data (data dictionary) -#' should be exported. -#' @param users Logical. Indicates if the users table should be exported. -#' @param instruments Logical. Indicates if the instruments table should be exported. -#' @param events Logical. Indicates if the event names should be exported. -#' @param arms Logical. Indicates if the arms table should be exported. -#' @param mappings Logical. Indicates if the form-event mappings should -#' be exported. -#' @param version Indicates if the REDCap version number should be exported. -#' Only applicable in REDCap 6.0.0 and higher. -#' @param ... Arguments to be passed to other methods -#' @param return_object Logical. When \code{TRUE}, the \code{exportBundle} object -#' is returned to the workspace. -#' -#' @details The project information is stored in the option -#' \code{redcap_project_info}. If the project is not longitudinal, the -#' events, arms, and event-form mappings elements will be assigned character -#' vectors instead of data frames. -#' -#' @author Benjamin Nutter -#' -#' @export - -exportBundle <- function(rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ...) { - UseMethod("exportBundle") -} - -#' @rdname exportBundle -#' @export - -exportBundle.redcapApiConnection <- function(rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ..., - return_object = TRUE){ - - ################################################################## - # Argument Validation - - coll <- checkmate::makeAssertCollection() - - checkmate::assert_class(x = rcon, - classes = "redcapApiConnection", - add = coll) - - checkmate::assert_logical(x = date, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = label, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = meta_data, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = users, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = instruments, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = events, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = arms, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = mappings, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = version, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = return_object, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::reportAssertions(coll) - - ################################################################## - # Deprecation messages - - if (return_object) - message("It appears you are saving your export bundle to an object.\n ", - "This is only necessary when working with multiple projects in the same session.\n ", - "'return_object = FALSE' will become the default behavior in a future version of redcapAPI.") - - - if (!is.na(match("v.number", names(list(...))))) - message("In redcapAPI 2.0, the 'v.number' argument is obsolete and deprecated. ", - "Please discontinue its use") - - ################################################################## - # Make the bundle - - bundle <- - structure( - list( - version = if (version) exportVersion(rcon) else NULL, - meta_data = if (meta_data) exportMetaData(rcon) else NULL, - users = if (users) exportUsers(rcon, date, label, - bundle = NULL) else NULL, - instruments = if (instruments) exportInstruments(rcon) else NULL, - events = if (events) exportEvents(rcon) else NULL, - arms = if (arms) exportArms(rcon) else NULL, - mappings = if (mappings) exportMappings(rcon) else NULL - ), - class = c("redcapBundle", "redcapProject", "list") - ) - - options(redcap_bundle = bundle) - if (return_object) return(bundle) -} diff --git a/R/exportRecords.R b/R/exportRecords.R index a6214582..e69de29b 100644 --- a/R/exportRecords.R +++ b/R/exportRecords.R @@ -1,577 +0,0 @@ -#' @name exportRecords -#' -#' @title Export Records from a REDCap Database -#' @description Exports records from a REDCap Database, allowing for -#' subsets of subjects, fields, records, and events. -#' -#' @param rcon A REDCap connection object as created by \code{redcapConnection}. -#' @param dataFile For the offline version, a character string giving the location -#' of the dataset downloaded from REDCap. Note that this should be the raw -#' (unlabeled) data set. -#' @param metaDataFile A text string giving the location of the data dictionary -#' downloaded from REDCap. -#' @param factors Logical. Determines if categorical data from the database is -#' returned as numeric codes or labelled factors. See 'Checkbox Variables' -#' for more on how this interacts with the \code{checkboxLabels} argument. -#' @param labels Logical. Determines if the variable labels are applied to -#' the data frame. -#' @param dates Logical. Determines if date variables are converted to POSIXct -#' format during the download. -#' @param fields A character vector of fields to be returned. If \code{NULL}, -#' all fields are returned. -#' @param forms A character vector of forms to be returned. If \code{NULL}, -#' all forms are returned. -#' @param records A vector of study id's to be returned. If \code{NULL}, all -#' subjects are returned. -#' @param events A character vector of events to be returned from a -#' longitudinal database. If \code{NULL}, all events are returned. -#' @param survey specifies whether or not to export the survey identifier field -#' (e.g., "redcap_survey_identifier") or survey timestamp fields -#' (e.g., form_name+"_timestamp") when surveys are utilized in the project. -#' If you do not pass in this flag, it will default to "true". If set to -#' "true", it will return the redcap_survey_identifier field and also the -#' survey timestamp field for a particular survey when at least -#' one field from that survey is being exported. NOTE: If the survey -#' identifier field or survey timestamp fields are imported via API data -#' import, they will simply be ignored since they are not real fields in -#' the project but rather are pseudo-fields. -#' @param dag specifies whether or not to export the "redcap_data_access_group" -#' field when data access groups are utilized in the project. If you do not -#' pass in this flag, it will default to "false". NOTE: This flag is only -#' viable if the user whose token is being used to make the API request is -#' *not* in a data access group. If the user is in a group, then this -#' flag will revert to its default value. -#' @param batch.size Integer. Specifies the number of subjects to be included -#' in each batch of a batched export. Non-positive numbers export the -#' entire project in a single batch. Batching the export may be beneficial -#' to prevent tying up smaller servers. See details for more explanation. -#' @param checkboxLabels Logical. Determines the format of labels in checkbox -#' variables. If \code{FALSE} labels are applies as "Unchecked"/"Checked". -#' If \code{TRUE}, they are applied as ""/"[field_label]" where [field_label] -#' is the label assigned to the level in the data dictionary. -#' This option is only available after REDCap version 6.0. See Checkbox Variables -#' for more on how this interacts with the \code{factors} argument. -#' @param colClasses A (named) vector of column classes passed to -#' \code{\link[utils]{read.csv}} calls. -#' Useful to force the interpretation of a column in a specific type and -#' avoid an unexpected recast. -#' @param ... Additional arguments to be passed between methods. -#' @param error_handling An option for how to handle errors returned by the API. -#' see \code{\link{redcap_error}} -#' @param config \code{list} Additional configuration parameters to pass to -#' \code{\link[httr]{POST}}. These are appended to any parameters in -#' \code{rcon$config}. -#' @param api_param \code{list} Additional API parameters to pass into the -#' body of the API call. This provides users to execute calls with options -#' that may not otherwise be supported by \code{redcapAPI}. -#' @param form_complete_auto \code{logical(1)}. When \code{TRUE} -#' (default), the \code{[form]_complete} fields for any form -#' from which at least one variable is requested will automatically -#' be retrieved. When \code{FALSE}, these fields must be -#' explicitly requested. -#' @param meta_data Deprecated version of \code{metaDataFile} -#' @param drop An optional character vector of REDCap variable names to remove from the -#' dataset; defaults to NULL. E.g., \code{drop=c("date_dmy", "treatment")} -#' It is OK for drop to contain variables not present; these names are ignored. -#' @details -#' A record of exports through the API is recorded in the Logging section -#' of the project. -#' -#' The 'offline' version of the function operates on the raw (unlabeled) data -#' file downloaded from REDCap along with the data dictionary. -#' This is made available for instances where the API can not be accessed for -#' some reason (such as waiting for API approval from the REDCap administrator). -#' -#' It is unnecessary to include "redcap_event_name" in the fields argument. -#' This field is automatically exported for any longitudinal database. -#' If the user does include it in the fields argument, it is removed quietly -#' in the parameter checks. -#' -#' A 'batched' export is one where the export is performed over a series of -#' API calls rather than one large call. For large projects on small servers, -#' this may prevent a single user from tying up the server and forcing others -#' to wait on a larger job. The batched export is performed by first -#' calling the API to export the subject identifier field (the first field -#' in the meta data). The unique ID's are then assigned a batch number with -#' no more than \code{batch.size} ID's in any single batch. The batches are -#' exported from the API and stacked together. -#' -#' In longitudinal projects, \code{batch.size} may not necessarily be the -#' number of records exported in each batch. If \code{batch.size} is 10 and -#' there are four records per patient, each batch will consist of 40 records. -#' Thus, if you are concerned about tying up the server with a large, -#' longitudinal project, it would be prudent to use a smaller batch size. -#' -#' @section Checkbox Variables: -#' -#' There are four ways the data from checkbox variables may be -#' represented depending on the values of \code{factors} and -#' \code{checkboxLabels}. The most common are the first and third -#' rows of the table below. When \code{checkboxLabels = TRUE}, either -#' the coded value or the labelled value is returned if the box is -#' checked, or an empty string if it is not. -#' -#' \tabular{lll}{ -#' \code{factors} \tab \code{checkboxLabels} \tab Output \cr -#' \code{FALSE} \tab \code{FALSE} \tab 0 / 1 \cr -#' \code{FALSE} \tab \code{TRUE} \tab "" / value \cr -#' \code{TRUE} \tab \code{FALSE} \tab Unchecked / Checked \cr -#' \code{TRUE} \tab \code{TRUE} \tab "" / label -#' } -#' -#' @section REDCap API Documentation (6.5.0): -#' This function allows you to export a set of records for a project -#' -#' Note about export rights (6.0.0+): Please be aware that Data Export user rights will be -#' applied to this API request. For example, if you have "No Access" data export rights -#' in the project, then the API data export will fail and return an error. And if you -#' have "De-Identified" or "Remove all tagged Identifier fields" data export rights, -#' then some data fields *might* be removed and filtered out of the data set returned -#' from the API. To make sure that no data is unnecessarily filtered out of your API -#' request, you should have "Full Data Set" export rights in the project. -#' -#' @section REDCap Version: -#' 5.8.2 (Perhaps earlier) -#' -#' @section Known REDCap Limitations: -#' None -#' -#' @section Deidentified Batched Calls: -#' Batched calls to the API are not a feature of the REDCap API, but may be imposed -#' by making multiple calls to the API. The process of batching the export requires -#' that an initial call be made to the API to retrieve only the record IDs. The -#' list of IDs is then broken into chunks, each about the size of \code{batch.size}. -#' The batched calls then force the \code{records} argument in each call. -#' -#' When a user's permissions require a de-identified data export, a batched call -#' should be expected to fail. This is because, upon export, REDCap will hash the -#' identifiers. When R attempts to pass the hashed identifiers back to REDCap, -#' REDCap will try to match the hashed identifiers to the unhashed identifiers in the -#' database. No matches will be found, and the export will fail. -#' -#' Users who are exporting de-identified data will have to settle for using unbatched -#' calls to the API (ie, \code{batch.size = -1}) -#' -#' @author Jeffrey Horner -#' -#' @export - -exportRecords <- - function(rcon, - factors = TRUE, - fields = NULL, - forms = NULL, - records = NULL, - events = NULL, - labels = TRUE, - dates = TRUE, - drop = NULL, - survey = TRUE, - dag = TRUE, - checkboxLabels = FALSE, - colClasses = character(0), - ...) - - UseMethod("exportRecords") - -#' @rdname exportRecords -#' @export - -exportRecords.redcapApiConnection <- - function(rcon, - factors = TRUE, - fields = NULL, - forms = NULL, - records = NULL, - events = NULL, - labels = TRUE, - dates = TRUE, - drop = NULL, - survey = TRUE, - dag = TRUE, - checkboxLabels = FALSE, - colClasses = character(0), - ..., - batch.size = -1, - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list(), - form_complete_auto = TRUE) -{ - message("Please use exportRecordsTyped instead. exportRecords is DEPRECATED.") - - if (is.numeric(records)) records <- as.character(records) - - ################################################################## - # Argument Validation - - coll <- checkmate::makeAssertCollection() - - checkmate::assert_class(x = rcon, - classes = "redcapApiConnection", - add = coll) - - checkmate::assert_logical(x = factors, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_character(x = fields, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_character(x = forms, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_character(x = records, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_character(x = events, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_logical(x = labels, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = dates, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_character(x = drop, - null.ok = TRUE, - add = coll) - - checkmate::assert_logical(x = survey, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = dag, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = checkboxLabels, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = form_complete_auto, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_integerish(x = batch.size, - len = 1, - add = coll) - - error_handling <- checkmate::matchArg(x = error_handling, - choices = c("null", "error"), - .var.name = "error_handling", - add = coll) - - checkmate::assert_list(x = config, - names = "named", - add = coll) - - checkmate::assert_list(x = api_param, - names = "named", - add = coll) - - if (is.list(colClasses)){ - colClasses <- unlist(colClasses) - } - - checkmate::assert_character(x = colClasses, - names = "named", - add = coll) - - checkmate::reportAssertions(coll) - - MetaData <- rcon$metadata() - - #* for purposes of the export, we don't need the descriptive fields. - #* Including them makes the process more error prone, so we'll ignore them. - MetaData <- MetaData[!MetaData$field_type %in% "descriptive", ] - - #* Secure the events table - events_list <- rcon$events() - - #* Secure the REDCap version - version <- rcon$version() - - form_complete_fields <- - sprintf("%s_complete", - unique(MetaData$form_name)) - form_complete_fields <- - form_complete_fields[!is.na(form_complete_fields)] - - #* Check that all fields exist in the meta data - if (!is.null(fields)) - { - bad_fields <- fields[!fields %in% c(MetaData$field_name, - form_complete_fields)] - if (length(bad_fields)) - coll$push(paste0("The following are not valid field names: ", - paste0(bad_fields, collapse = ", "))) - } - - #* Check that all form names exist in the meta data - if (!is.null(forms)) - { - bad_forms <- forms[!forms %in% MetaData$form_name] - if (length(bad_forms)) - coll$push(paste0("The following are not valid form names: ", - paste0(bad_forms, collapse = ", "))) - } - - #* Check that all event names exist in the events list - if (!is.null(events) && inherits(events_list, "data.frame")) - { - bad_events <- events[!events %in% events_list$unique_event_name] - if (length(bad_events)) - coll$push(paste0("The following are not valid event names: ", - paste0(bad_events, collapse = ", "))) - } - - checkmate::reportAssertions(coll) - - ################################################################## - # Create the vector of field names - if (!is.null(fields)) #* fields were provided - { - # redcap_event_name is automatically included in longitudinal projects - field_names <- fields[!fields %in% "redcap_event_name"] - } - else if (!is.null(forms)) - { - field_names <- MetaData$field_name[MetaData$form_name %in% forms] - } - else - #* fields were not provided, default to all fields. - field_names <- MetaData$field_name - - #* Expand 'field_names' to include fields from specified forms. - if (!is.null(forms)) - field_names <- - unique(c(field_names, - MetaData$field_name[MetaData$form_name %in% forms])) - - ################################################################## - # Checkbox Suffixes - - suffixed <- - checkbox_suffixes( - # The subset prevents `[form]_complete` fields from - # being included here. - fields = field_names[field_names %in% MetaData$field_name], - meta_data = MetaData) - - ################################################################## - # Identify the forms from which the chosen fields are found - included_form <- - unique( - MetaData$form_name[MetaData$field_name %in% field_names] - ) - - ################################################################## - # Add the form_name_complete column to the export - if (form_complete_auto){ - field_names <- c(field_names, - sprintf("%s_complete", included_form)) - } - - ################################################################## - # Make API Body List - body <- list(token = rcon$token, - content = 'record', - format = 'csv', - type = 'flat', - exportSurveyFields = tolower(survey), - exportDataAccessGroups = tolower(dag), - returnFormat = 'csv') - - body <- c(body, - vectorToApiBodyList(field_names, "fields"), - vectorToApiBodyList(forms, "forms"), - vectorToApiBodyList(events, "events"), - vectorToApiBodyList(records, "records"), - api_param) - - body <- body[lengths(body) > 0] - - ################################################################## - # Call API - - if (batch.size < 1){ - Records <- unbatched(rcon = rcon, - body = body, - id = MetaData$field_name[1], - colClasses = colClasses, - error_handling = error_handling, - config = config) - } - else - { - Records <- batched(rcon = rcon, - body = body, - batch.size = batch.size, - id = MetaData$field_name[1], - colClasses = colClasses, - error_handling = error_handling, - config = config) - } - - #* synchronize underscore codings between records and meta data - #* Only affects calls in REDCap versions earlier than 5.5.21 - if (utils::compareVersion(version, "6.0.0") == -1) - MetaData <- syncUnderscoreCodings(Records, MetaData) - - Records <- fieldToVar(records = Records, - meta_data = MetaData, - factors = factors, - dates = dates, - labels = labels, - checkboxLabels = checkboxLabels, - ...) - - if (labels){ - Records[,suffixed$name_suffix] <- - mapply(nm = suffixed$name_suffix, - lab = suffixed$label_suffix, - FUN = function(nm, lab){ - if(is.null(Records[[nm]])){ - warning("Missing field for suffix ", nm) - } else { - labelVector::set_label(Records[[nm]], lab) - } - }, - SIMPLIFY = FALSE) - } - - - - # drop - if(length(drop)) { - Records <- Records[!names(Records) %in% drop] - } # end drop - - Records -} - - - -#*** UNBATCHED EXPORT -unbatched <- function(rcon, body, id, colClasses, error_handling, config) -{ - colClasses[[id]] <- "character" - colClasses <- colClasses[!vapply(colClasses, - is.na, - logical(1))] - - response <- makeApiCall(rcon, - body = body, - config = config) - - if (response$status_code != 200) redcap_error(response, error_handling = error_handling) - - response <- as.character(response) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # x <- iconv(x, "utf8", "ASCII", sub = "") - utils::read.csv(text = response, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses) -} - - -#*** BATCHED EXPORT -batched <- function(rcon, body, batch.size, id, colClasses, error_handling, config) -{ - colClasses[[id]] <- "character" - colClasses <- colClasses[!vapply(colClasses, - is.na, - logical(1))] - - #* 1. Get the IDs column - #* 2. Restrict to unique IDs - #* 3. Determine if the IDs look hashed (de-identified) - #* 4. Give warning about potential problems joining hashed IDs - #* 5. Read batches - #* 6. Combine tables - #* 7. Return full data frame - - - #* 1. Get the IDs column - id_body <- c(body[!grepl("^fields", names(body))], - vectorToApiBodyList(id, "fields")) - - IDs <- makeApiCall(rcon, - body = body, - config = config) - - if (IDs$status_code != 200) redcap_error(IDs, error_handling) - - IDs <- as.character(IDs) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # IDs <- iconv(IDs, "utf8", "ASCII", sub = "") - IDs <- utils::read.csv(text = IDs, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses[id]) - - #* 2. Restrict to unique IDs - unique_id <- unique(IDs[[id]]) - - #* 3. Determine if the IDs look hashed (de-identified) - #* 4. Give warning about potential problems joining hashed IDs - if (all(nchar(unique_id) == 32L)) - { - warning("The record IDs in this project appear to be de-identified. ", - "Subject data may not match across batches. ", - "See 'Deidentified Batched Calls' in '?exportRecords'") - } - - #* Determine batch numbers for the IDs. - batch.number <- rep(seq_len(ceiling(length(unique_id) / batch.size)), - each = batch.size, - length.out = length(unique_id)) - - #* Make a list to hold each of the batched calls - #* Borrowed from http://stackoverflow.com/a/8099431/1017276 - batch_list <- vector("list", max(batch.number)) - - #* 5. Read batches - for (i in unique(batch.number)) - { - this_body <- c(body[!grepl("^records", names(body))], - vectorToApiBodyList(unique_id[batch.number == i], "records")) - - this_response <- makeApiCall(rcon, - body = body, - config = config) - - if (this_response$status_code != 200) redcap_error(this_response, error_handling = "error") - - this_response <- as.character(this_response) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # x <- iconv(x, "utf8", "ASCII", sub = "") - batch_list[[i]] <- utils::read.csv(text = this_response, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses) - Sys.sleep(1) - } - - #* 6. Combine tables and return - do.call("rbind", batch_list) -} diff --git a/R/exportRecords_offline.R b/R/exportRecords_offline.R index dd1d7474..e69de29b 100644 --- a/R/exportRecords_offline.R +++ b/R/exportRecords_offline.R @@ -1,183 +0,0 @@ -#' @rdname exportRecords -#' @export - -exportRecords_offline <- function(dataFile, - metaDataFile, - factors = TRUE, - fields = NULL, - forms=NULL, - labels = TRUE, - dates = TRUE, - checkboxLabels = FALSE, - colClasses = NA, - ..., - meta_data) -{ - if (!missing(meta_data)){ - warning("Argument `meta_data` has been deprecated. Please use `metaDataFile` instead.") - if (missing(metaDataFile)){ - metaDataFile <- meta_data - } - } - - ################################################################## - # Argument Validation - - coll <- checkmate::makeAssertCollection() - - checkmate::assert_character(x = dataFile, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_character(x = metaDataFile, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = factors, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_character(x = fields, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_character(x = forms, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - checkmate::assert_logical(x = labels, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = dates, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = checkboxLabels, - len = 1, - any.missing = FALSE, - add = coll) - - if (is.list(colClasses)) colClasses <- unlist(colClasses) - - checkmate::assert_character(x = colClasses, - names = "named", - add = coll) - - checkmate::reportAssertions(coll) - - ################################################################## - # Prepare the Meta Data - MetaData <- utils::read.csv(metaDataFile, - stringsAsFactors = FALSE, - na.strings = "") - - col.names=c('field_name', 'form_name', 'section_header', - 'field_type', 'field_label', 'select_choices_or_calculations', - 'field_note', 'text_validation_type_or_show_slider_number', - 'text_validation_min', 'text_validation_max', 'identifier', - 'branching_logic', 'required_field', 'custom_alignment', - 'question_number', 'matrix_group_name', 'matrix_ranking', - 'field_annotation') - - names(MetaData) <- col.names[1:length(col.names)] - - # for purposes of the export, we don't need the descriptive fields. - # Including them makes the process more error prone, so we'll ignore them. - MetaData <- MetaData[!MetaData$field_type %in% "descriptive", ] - - # Check that all fields exist in the meta data - if (!is.null(fields)) - { - bad_fields <- fields[!fields %in% MetaData$field_name] - if (length(bad_fields)) - coll$push(paste0("The following are not valid field names: ", - paste0(bad_fields, collapse = ", "))) - } - - # Check that all form names exist in the meta data - if (!is.null(forms)) - { - bad_forms <- forms[!forms %in% MetaData$form_name] - if (length(bad_forms)) - coll$push(paste0("The following are not valid form names: ", - paste0(bad_forms, collapse = ", "))) - } - - checkmate::reportAssertions(coll) - - ################################################################## - # Create the vector of field names - if (!is.null(fields)) #* fields were provided - { - # redcap_event_name is automatically included in longitudinal projects - field_names <- fields[!fields %in% "redcap_event_name"] - } - else if (!is.null(forms)) - { - field_names <- MetaData$field_name[MetaData$form_name %in% forms] - } - else - #* fields were not provided, default to all fields. - field_names <- MetaData$field_name - - ################################################################## - # Expand 'field_names' to include fields from specified forms. - if (!is.null(forms)) - { - field_names <- - unique(c(field_names, - MetaData$field_name[MetaData$form_name %in% forms])) - } - - ################################################################## - # Manage checkbox suffixes - - suffixed <- checkbox_suffixes(fields = field_names, - meta_data = MetaData) - - - ################################################################## - # Load and process data - - Records <- utils::read.csv(dataFile, - stringsAsFactors = FALSE, - colClasses = colClasses) - - Records <- fieldToVar(records = Records, - meta_data = MetaData, - factors = factors, - dates = dates, - labels=labels, - checkboxLabels = checkboxLabels, - ...) - - if (labels){ - Records[,suffixed$name_suffix] <- - mapply(nm = suffixed$name_suffix, - lab = suffixed$label_suffix, - FUN = function(nm, lab){ - if(is.null(Records[[nm]])){ - warning("Missing field for suffix ", nm) - } else { - labelVector::set_label(Records[[nm]], lab) - } - }, - SIMPLIFY = FALSE) - } - - - # drop - if(length(drop)) { - Records <- Records[!names(Records) %in% drop] - } # end drop - - Records -} diff --git a/R/exportReports.R b/R/exportReports.R index 0fe64f05..e69de29b 100644 --- a/R/exportReports.R +++ b/R/exportReports.R @@ -1,231 +0,0 @@ -#' @name exportReports -#' @title Export Reports from a REDCap Database -#' -#' @description Exports reports from a REDCap Database and formats data if requested -#' -#' @param rcon A REDCap connection object as created by \code{redcapConnection}. -#' @param report_id Integer. Gives the report id of the desired report. -#' This is located on the Report Builder page of the user interface on REDCap. -#' @param factors Logical. Determines if categorical data from the database -#' is returned as numeric codes or labelled factors. -#' @param labels Logical. Determines if the variable labels are applied to the data frame. -#' @param dates Logical. Determines if date variables are converted to POSIXct format during the download. -#' @param checkboxLabels Logical. Determines the format of labels in checkbox -#' variables. If \code{FALSE} labels are applies as "Unchecked"/"Checked". -#' If \code{TRUE}, they are applied as ""/"[field_labe]" where [field_label] -#' is the label assigned to the level in the data dictionary. This option -#' is only available after REDCap version 6.0. -#' @param drop An optional character vector of REDCap variable names to remove from the -#' dataset; defaults to NULL. E.g., \code{drop=c("date_dmy", "treatment")} -#' It is OK for drop to contain variables not present; these names are ignored. -#' @param ... Additional arguments to be passed between methods. -#' @param error_handling An option for how to handle errors returned by the API. -#' see \code{\link{redcap_error}} -#' @param config \code{list} Additional configuration parameters to pass to -#' \code{\link[httr]{POST}}. These are appended to any parameters in -#' \code{rcon$config}. -#' @param api_param \code{list} Additional API parameters to pass into the -#' body of the API call. This provides users to execute calls with options -#' that may not otherwise be supported by \code{redcapAPI}. -#' -#' @details -#' A record of exports through the API is recorded in the Logging section of -#' the project. -#' -#' Reports are exported based on their id number, which can be looked up in -#' the Reports page of a project -#' -#' @section REDCap API Documentation (6.5.0): -#' This function allows you to export the data set of a report created on a project's -#' "Data Exports, Reports, and Stats" page. -#' -#' Note about export rights (6.0.0+): Please be aware that Data Export user rights will be -#' applied to this API request. For example, if you have "No Access" data export rights -#' in the project, then the API report export will fail and return an error. And if you -#' have "De-Identified" or "Remove all tagged Identifier fields" data export rights, -#' then some data fields *might* be removed and filtered out of the data set returned -#' from the API. To make sure that no data is unnecessarily filtered out of your API -#' request, you should have "Full Data Set" export rights in the project. -#' -#' @section REDCap Version: -#' 6.0.0+ -#' -#' @section Known REDCap Limitations: -#' None -#' -#' @author Benjamin Nutter -#' -#' @export - -exportReports <- function(rcon, - report_id, - factors = TRUE, - labels = TRUE, - dates = TRUE, - drop = NULL, - checkboxLabels = FALSE, - ...){ - UseMethod("exportReports") -} - -#' @rdname exportReports -#' @export - -exportReports.redcapApiConnection <- function(rcon, - report_id, - factors = TRUE, - labels = TRUE, - dates = TRUE, - drop = NULL, - checkboxLabels = FALSE, - ..., - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list()){ - - if (!is.numeric(report_id)) report_id <- as.numeric(report_id) - - ################################################################## - # Argument Validation - - coll <- checkmate::makeAssertCollection() - - checkmate::assert_class(x = rcon, - classes = "redcapApiConnection", - add = coll) - - checkmate::assert_integerish(x = report_id, - len = 1, - add = coll) - - checkmate::assert_logical(x = factors, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = labels, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = dates, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_logical(x = checkboxLabels, - len = 1, - any.missing = FALSE, - add = coll) - - checkmate::assert_character(x = drop, - any.missing = FALSE, - null.ok = TRUE, - add = coll) - - error_handling <- checkmate::matchArg(x = error_handling, - choices = c("null", "error"), - .var.name = "error_handling", - add = coll) - - checkmate::assert_list(x = config, - names = "named", - add = coll) - - checkmate::assert_list(x = api_param, - names = "named", - add = coll) - - checkmate::reportAssertions(coll) - - ################################################################## - # Get required information - - MetaData <- rcon$metadata() - - #* for purposes of the export, we don't need the descriptive fields. - #* Including them makes the process more error prone, so we'll ignore them. - MetaData <- MetaData[!MetaData$field_type %in% "descriptive", ] - - version <- rcon$version() - - ################################################################## - # Make API Body List - - body <- list(token = rcon$token, - content = 'report', - format = 'csv', - returnFormat = 'csv', - report_id = report_id) - - body <- body[lengths(body) > 0] - - ################################################################## - # Call the API - - response <- makeApiCall(rcon, - body = c(body, api_param), - config = config) - - if (response$status_code != 200) redcap_error(response, error_handling) - - Report <- utils::read.csv(text = as.character(response), - stringsAsFactors = FALSE, - na.strings = "") - - ################################################################## - # Process the data - - #* synchronize underscore codings between records and meta data - #* Only affects calls in REDCap versions earlier than 5.5.21 - if (utils::compareVersion(version, "6.0.0") == -1) - MetaData <- syncUnderscoreCodings(Report, MetaData) - - - Report <- fieldToVar(records = Report, - meta_data = MetaData, - factors = factors, - dates = dates, - labels=labels, - checkboxLabels = checkboxLabels, - ...) - - - if (labels) - { - field_names <- names(Report) - field_names <- unique(sub(REGEX_CHECKBOX_FIELD_NAME, #defined in constants.R - "\\1", field_names, perl = TRUE)) - - # For reports, there is not check on the field names, since - # the user may only select fields using the interface. - # However, [form]_complete fields do not appear in the - # meta data and need to be removed to avoid an error. - # See #108 - field_names <- field_names[field_names %in% MetaData$field_name] - - suffixed <- checkbox_suffixes(fields = field_names, - meta_data = MetaData) - - Report[suffixed$name_suffix] <- - mapply(nm = suffixed$name_suffix, - lab = suffixed$label_suffix, - FUN = function(nm, lab){ - if(is.null(Report[[nm]])){ - warning("Missing field for suffix ", nm) - } else { - labelVector::set_label(Report[[nm]], lab) - } - }, - SIMPLIFY = FALSE) - } - - ################################################################## - # Drop fields from Report - - if(length(drop)) { - Report <- Report[!names(Report) %in% drop] - } # end drop - - Report -} diff --git a/R/fieldToVar.R b/R/fieldToVar.R deleted file mode 100644 index 08871667..00000000 --- a/R/fieldToVar.R +++ /dev/null @@ -1,240 +0,0 @@ -#' @name fieldToVar -#' @importFrom chron times -#' -#' @title Convert a REDCap Data Field to an R Vector -#' @description Converts a field exported from REDCap into a valid R vector -#' -#' @param records A data frame of records returned by \code{exportRecords} -#' or \code{exportReports} -#' @param meta_data A data frame giving the data dictionary, as returned -#' by \code{exportMetaData} -#' @param factors Logical, determines if checkbox, radio button, dropdown and yesno -#' variables are converted to factors -#' @param dates Logical, determines if date variables are converted to POSIXct format -#' @param checkboxLabels Logical, determines if checkbox variables are labeled as -#' "Checked" or using the checkbox label. Only applicable when \code{factors = TRUE} -#' @param labels Logical. Determines if the variable labels are applied to -#' the data frame. -#' @param handlers List, Specify type conversion overrides for specific REDCap field types. -#' E.g., \code{handlers=list(date_ = as.Date)}. For datetime specifications the -#' datetime ordering directive from the tail is dropped. The following field -#' types are supported: date_, datetime_, datetime_seconds_, time_mm_ss, time, -#' float, number, calc, int, integer, select, radio, dropdown, yesno, truefalse, -#' checkbox, and form_complete. -#' @param mChoice logical; defaults to TRUE. Convert checkboxes to mChoice if -#' Hmisc is installed. -#' @param ..., additional arguments that are ignored. -#' -#' @details This function is called internally by \code{exportRecords} and -#' \code{exportReports}. it is not available to the user. -#' -#' @author Jeffrey Horner -fieldToVar <- function(records, - meta_data, - factors = TRUE, - dates = TRUE, - checkboxLabels = FALSE, - labels = TRUE, - handlers =list(), - mChoice = NULL, - ...) -{ - records_raw <- records - - # See if mChoice argument is passed, otherwise default to state of Hmisc - if("package:Hmisc" %in% search()) # Hmisc Loaded? - { - if(is.null(mChoice)) mChoice <- TRUE - # Otherwise do what user requests for mChoice - } else # Hmisc not loaded - { - if(is.null(mChoice)) - { - mChoice <- FALSE - } else if(mChoice) - { - warning("mChoice=TRUE requires the package Hmisc to be loaded to function properly.") - mChoice <- FALSE - } - } - - recordnames <- names(records) - for (i in seq_along(records)) - { - # Establish basic info about field/record - field_name <- recordnames[i] - field_base <- sub(REGEX_CHECKBOX_FIELD_NAME, #defined in constants.R - "\\1", field_name, perl = TRUE) - field_text_type <- meta_data$text_validation_type_or_show_slider_number[meta_data$field_name == field_base] - field_type <- meta_data$field_type[meta_data$field_name == field_base] - - withCallingHandlers( - warning=function(w) {w$message<-paste(field_name,":", w$message); - warning(w); - invokeRestart("muffleWarning")}, - { - #* If the variable isn't in the data dictionary (usually it's a field added by REDCap, - #* such as redcap_event_name, instrument_complete, etc), give it a generic name to - #* pass to switch. - if (!length(field_type)) - { - if (grepl("_complete$", field_base)) - { - field_type <- "form_complete" - } - else - { - field_type <- "unrecognized field type" - } - } - # autocomplete was added to the text_validation... column for - # dropdown menus with the autocomplete feature. - # field_type[is.na(field_type)] <- - # meta_data$field_type[meta_data$field_name == field_base] - field_type[field_type == "text" & - !is.na(field_text_type)] <- field_text_type - - field_type <- gsub(pattern = "_(dmy|mdy|ymd)$", - replacement = "_", - x = field_type) - - records[[i]] <- - if(field_type %in% names(handlers)) - { - handlers[[field_type]](records[[i]]) - } else { - switch(field_type, - "date_" = - { - if (dates) - as.POSIXct(records[[i]], format = "%Y-%m-%d") - else - records[[i]] - }, - "datetime_" = - { - if (dates) - as.POSIXct(records[[i]], format = "%Y-%m-%d %H:%M") - else - records[[i]] - }, - "datetime_seconds_" = - { - if (dates) - as.POSIXct(records[[i]], format = "%Y-%m-%d %H:%M:%S") - else - records[[i]] - }, - "time_mm_ss" = - { - if (dates) - chron::times(ifelse(!is.na(records[[i]]), - paste0("00:", records[[i]]), - records[[i]]), - format=c(times="h:m:s")) - else - records[[i]] - }, - "time_hh_mm_ss" = - { - if (dates) - chron::times(records[[i]], - format=c(times="h:m:s")) - else - records[[i]] - }, - "time" = - { - if (dates) - chron::times(gsub("(^\\d{2}:\\d{2}$)", "\\1:00", records[[i]]), - format=c(times="h:m:s")) - else - records[[i]] - }, - "float" = as.numeric(records[[i]]), - "number" = as.numeric(records[[i]]), - "calc" = as.numeric(records[[i]]), - "int" = as.integer(records[[i]]), - "integer"= as.numeric(records[[i]]), - "select" = - makeRedcapFactor(x = records[[i]], - coding = meta_data$select_choices_or_calculations[meta_data$field_name == field_base], - factors = factors, - var_name = meta_data$field_name[meta_data$field_name == field_base]), - "radio" = - makeRedcapFactor(x = records[[i]], - coding = meta_data$select_choices_or_calculations[meta_data$field_name == field_base], - factors = factors, - var_name = meta_data$field_name[meta_data$field_name == field_base]), - "dropdown" = - makeRedcapFactor(x = records[[i]], - coding = meta_data$select_choices_or_calculations[meta_data$field_name == field_base], - factors = factors, - var_name = meta_data$field_name), - "yesno" = makeRedcapYN(records[[i]], - factors), - "truefalse" = - { - if (factors) - as.logical(records[[i]]) - else - records[[i]] - }, - "checkbox" = - { - makeRedcapCheckbox(x = records[[i]], - suffix = gsub("^.+___", "", names(records)[i]), - coding = meta_data$select_choices_or_calculations[meta_data$field_name == field_base], - factors = factors, - checkboxLabels = checkboxLabels) - }, - "form_complete" = - { - makeRedcapFactor(x = records[[i]], - coding = "0, Incomplete | 1, Unverified | 2, Complete", - factors, - var_name = meta_data$field_name[meta_data$field_name == field_base]) - }, - records[[i]] - ) # End switch - } # End of Records[[i]] if - }) # End of withCallingHandlers - } # End for loop - - if(mChoice) - { - # Convert checkboxes to mChoice if Hmisc is installed and requested - checkbox_meta <- meta_data[which(meta_data$field_type == 'checkbox'),] - for(i in seq_len(nrow(checkbox_meta))) - { - checkbox_fieldname <- checkbox_meta$field_name[i] - fields <- recordnames[grepl(sprintf("^%s", checkbox_fieldname), recordnames)] - if(length(fields) > 0) - { - opts <- fieldChoiceMapping(checkbox_meta[i,'select_choices_or_calculations'], - fields[i]) - levels <- opts[, 1 + labels] - - opts <- as.data.frame(matrix(rep(seq_along(fields), nrow(records)), nrow=nrow(records), byrow=TRUE)) - checked <- records_raw[,fields] != '1' - opts[which(checked,arr.ind=TRUE)] <- "" - z <- structure( - gsub(";$|^;", "",gsub(";{2,}",";", do.call('paste', c(opts, sep=";")))), - label = checkbox_fieldname, - levels = levels, - class = c("mChoice", "labelled")) - - records[[checkbox_fieldname]] <- z - } - } - - } # mChoice - - records -} - - - - - - diff --git a/R/makeRedcapFactor.R b/R/makeRedcapFactor.R deleted file mode 100644 index 6ae903a9..00000000 --- a/R/makeRedcapFactor.R +++ /dev/null @@ -1,112 +0,0 @@ -makeRedcapFactor <- function(x, coding, factors, var_name) -{ - if (is.na(coding)){ - warning(sprintf("- No coding available for variable `%s`. Data is left in raw form.\n This may indicate an problem in the Data Dictionary.\n", var_name)) - return(x) - } - # parses the string "0, Birth \\n 1, Death \\n 2, Unknown" into a - # character vector for creating a factor - coding <- unlist(strsplit(coding,"[\n|]")) - if (length(coding) > 0) - { - coding <- regmatches(coding, regexpr(",", coding), invert = TRUE) - coding <- do.call("rbind", coding) - coding <- trimws(coding) - - if (factors) - { - x <- factor(x, - levels=coding[, 1], - labels=coding[, 2]) - class(x) <- c("redcapFactor", "factor") - attr(x,'redcapLabels') <- coding[, 2] - attr(x,'redcapLevels') <- - suppressWarnings(tryCatch(as.integer(coding[, 1]), - warning = function(cond) coding[, 1])) - } - else - { - x <- suppressWarnings(tryCatch(as.integer(x), - warning = function(cond) as.character(x))) - class(x) <- c("redcapFactor", class(x)) - attr(x,'redcapLabels') <- coding[, 2] - attr(x,'redcapLevels') <- - suppressWarnings(tryCatch(as.integer(coding[, 1]), - warning = function(cond) coding[, 1])) - } - } - else - { - # Create integer since the meta data about choices are bungled. - x <- suppressWarnings(as.integer(x)) - } - x -} - -makeRedcapYN <- function(x, factors) -{ - if (factors) - x <- factor(x, 0:1, c("No", "Yes")) - - class(x) <- c("redcapFactor", class(x)) - attr(x,'redcapLabels') <- c("No", "Yes") - attr(x,'redcapLevels') <- 0:1 - x -} - -makeRedcapCheckbox <- function(x, suffix, coding, factors, checkboxLabels) -{ - # parses the string "0, Birth \\n 1, Death \\n 2, Unknown" into a - # character vector for creating a factor - coding <- unlist(strsplit(coding,"[\n|]")) - if (length(coding) > 0) - { - coding <- regmatches(coding, regexpr(",", coding), invert = TRUE) - coding <- do.call("rbind", coding) - coding <- trimws(coding) - coding <- coding[coding[, 1] == suffix, ] - - - use_labels <- - if (!factors && !checkboxLabels) - c("0", "1") - else if (!factors && checkboxLabels) - c("", coding[1]) - else if (factors && !checkboxLabels) - c("Unchecked", "Checked") - else if (factors && checkboxLabels) - c("", coding[2]) - - - if (!factors){ - if (checkboxLabels) - x <- use_labels[x+1] - # no else needed. If checkboxLabels = FALSE, leave as 0/1 - - class(x) <- c("redcapFactor", class(x)) - } - else { - if (!checkboxLabels) - x <- factor(x, - levels = 0:1, - labels = c("Unchecked", "Checked")) - else - x <- factor(x, - levels = 0:1, - labels = use_labels) - - class(x) <- c("redcapFactor", "factor") - } - - attr(x,'redcapLabels') <- use_labels - attr(x,'redcapLevels') <- 0:1 - - } - else - { - # Create integer since the meta data about choices are bungled. - x <- suppressWarnings(as.integer(x)) - } - x -} - diff --git a/R/massert.R b/R/massert.R deleted file mode 100644 index faf5bc8f..00000000 --- a/R/massert.R +++ /dev/null @@ -1,86 +0,0 @@ -#' @name massert -#' @title Conduct Multiple Assertions -#' -#' @description This documentation attempts to describe arguments to make assertions -#' on arguments. In order to prevent confusion, it is imperative to develop some -#' terminology up front. We will use \emph{function argument} to refer to an argument -#' of the function for which we are conducting assertions. We will use -#' \emph{assertion argument} to refer to arguments to pass to the assertion function -#' being applied to a function argument. Lastly, we will use \emph{massert argument} -#' to refer to arguments to \code{massert} -#' -#' @param formula A one sided formula naming the arguments on which the assertion -#' will be performed. -#' @param fun An assertion function to perform. -#' @param ... Additional lists. Each argument provided is a named list of \code{assertion -#' arguments}. The name of each element in a list should match the name of a -#' \code{function argument}. \code{lower = list(var1 = 0, var2 = 10)} sets -#' the \emph{assertion argument} \code{lower = 0} for \emph{function argument} -#' \code{var1}; and sets the \emph{assertion argument} \code{lower = 10} for -#' \code{function argument} \code{var2}. The \emph{massert arguments} in \code{...} -#' may themselves be named or unnamed. -#' @param fixed A named list of arguments that are fixed across all assertions. -#' -#' @details Only one assert function may be utilized in each call to \code{massert}. -#' This allows for all numeric variables to be checked in one call, all logical -#' variables to be checked in a subsequent call, etc. -#' -#' @author Benjamin Nutter - - -massert <- function(formula, fun, ..., fixed = list()) -{ - checkmate::assert_class(x = formula, - classes = "formula") - - massert_coll <- checkmate::makeAssertCollection() - - # `fm` has no left hand side - lhs <- all.vars(stats::update(formula, . ~ 0)) - - if (!all(lhs == ".")) - { - massert_coll$push("`formula` may not have a left hand side.") - } - - checkmate::assert_function(x = fun, - add = massert_coll) - - checkmate::assert_list(x = fixed, - names = "named", - add = massert_coll) - - checkmate::reportAssertions(massert_coll) - - fun <- match.fun(fun) - terms <- terms(formula) - vnames <- attr(terms, "term.labels") - ee <- attr(terms, ".Environment") - - unfixed <- list(...) - - unfixed_name <- unique(unlist(lapply(unfixed, names))) - - checkmate::assert_subset(x = unfixed_name, - choices = vnames) - - for (vname in vnames){ - # Get list elements from ... that match vname - # These are the assertion arguments. - this_var_arg <- lapply(unfixed, - function(x, n) x[[n]] , - vname) - # Remove NULL values - this_var_arg <- this_var_arg[!vapply(this_var_arg, is.null, logical(1))] - - # Make the argument list - args <- c(list(x = get(vname, envir = ee), - .var.name = vname), - this_var_arg, - fixed) - - # Perform the assertion - do.call(fun, args) - } - invisible(NULL) -} diff --git a/R/recodeCheck.R b/R/recodeCheck.R deleted file mode 100644 index dc859c49..00000000 --- a/R/recodeCheck.R +++ /dev/null @@ -1,96 +0,0 @@ -#' @name recodeCheck -#' @export recodeCheck -#' -#' @title Change labelling of \code{checkbox} variables -#' @description Rewrites the labelling of \code{checkbox} variables from -#' Checked/Unchecked to Yes/No (or some other user-specified labelling). -#' -#' @param df A data frame, presumably retrieved from REDCap, though not a -#' strict requirement. -#' @param vars Optional character vector of variables to convert. If left -#' missing, all of the variables in \code{df} that are identified as -#' \code{checkbox} variables are relabelled. See 'Details' for more about -#' identifying \code{checkbox} variables. -#' @param old A character vector to be passed to \code{factor}. -#' This indicates the levels to be replaced and their order. -#' @param new A character vector of labels to replace the values in -#' \code{levels}. The first value becomes the reference value. -#' @param reverse For convenience, if the user would prefer to reverse the -#' order of the elements in \code{levels} and \code{labels}, -#' simply set this to \code{TRUE}. -#' -#' @details -#' \code{checkbox} variables are \emph{not} identified using the metadata -#' from the REDCap database. Instead, variables are scanned, and those -#' variables in which every value is in \code{levels} are assumed to be -#' \code{checkbox} variables. -#' -#' Realistically, this could be used to relabel any set of factors with -#' identical labels, regardless of the data source. The number of labels is -#' not limited, but \code{levels} and \code{labels} should have the same length. -#' -#' The actual code to perform this is not particularly difficult -#' (\code{df[checkbox] <- lapply(df[checkbox], factor, levels=levels, labels=labels)}), -#' but \code{checkbox} variables are common enough in REDCap -#' (and the Checked/Unchecked scheme so unpalatable) that a quick way to -#' replace the labels was highly desirable -#' -#' @author Benjamin Nutter - -recodeCheck <- function(df, vars, - old=c("Unchecked", "Checked"), new=c("No", "Yes"), - reverse=FALSE){ - # If no variable names are provided, check the data frame for all variables in which all values - # are either "Checked" or "Unchecked" - if (missing(vars)){ - checkbox <- vapply(X = df, - FUN = function(x) all(attributes(x)$redcapLabels %in% old), - FUN.VALUE = logical(1)) - } - - #* If variable names are given, ensure that they are checkbox variables. Ignore them if anything - #* other than "Checked" or "Unchecked" appears in the values. - else { - vars_are_check <- vapply(X = df, - FUN = function(x) all(attributes(x)$redcapLabels %in% old), - FUN.VALUE = logical(1)) - - vars_not_check <- vars[!vars_are_check] - if (any(!vars_are_check)) warning(paste0("'", paste(vars[!vars_are_check], collapse = "', '"), - "' do not appear to be 'checkbox' variables.", - "\nThese variables were not recoded.")) - checkbox <- vars[vars_are_check] - } - - var.label <- - vapply(X = df, - FUN = labelVector::get_label, - FUN.VALUE = character(1)) - - #* Utility function for recoding check variables - recodeFn <- function(v, old=old, new=new, reverse=reverse){ - if (is.factor(v)) v <- redcapFactorFlip(v) - attributes(v)$redcapLabels <- if (reverse) rev(new) else new - if (reverse) attributes(v)$redcapLevels <- rev(attributes(v)$redcapLevels) - return(redcapFactorFlip(v)) - } - - #* Apply the new labels - df[checkbox] <- lapply(X = df[checkbox], - FUN = recodeFn, - old, new, reverse) - - df[checkbox] <- - mapply(nm = checkbox, - lab = var.label, - FUN = function(nm, lab){ - if(is.null(df[[nm]])){ - warning("Missing field for suffix ", nm) - } else { - labelVector::set_label(df[[nm]], lab) - } - }, - SIMPLIFY = FALSE) - - df -} \ No newline at end of file diff --git a/R/redcapFactorFlip.R b/R/redcapFactorFlip.R deleted file mode 100644 index d9f3c5ce..00000000 --- a/R/redcapFactorFlip.R +++ /dev/null @@ -1,49 +0,0 @@ -#' @name redcapFactorFlip -#' @export redcapFactorFlip -#' -#' @title Convert REDCap factors between labelled and coded -#' @description Factors exported from REDCap can be toggled between the coded -#' and labelled values with the use of the attributes assigned to the -#' factors during export. -#' -#' @param v A factor exported from REDCap. The REDCap type may be radio, -#' dropdown, check, yesno, etc. -#' -#' @details Each factor type variable in REDCap is given the attributes -#' \code{redcapLabels} and \code{redcapLevels}. With these attached to the -#' vector, switching between the coded and labelled values can be done with -#' ease. This may be helpful when the coded value has importance, -#' such as 0/1 for death, or if a yes is worth 6 points (instead of 1). -#' -#' @author Benjamin Nutter -#' - -redcapFactorFlip <- function(v){ - #* extract attributes to be applied later - redcapLabels <- attributes(v)$redcapLabels - redcapLevels <- attributes(v)$redcapLevels - - if (is.null(redcapLabels) | is.null(redcapLevels)) - stop("This does not appear to be a REDCap factor.") - - #* labelled to coded - if ("factor" %in% class(v)){ - v <- factor(as.character(v), - redcapLabels, - redcapLevels) - v <- as.character(v) - if (is.numeric(redcapLevels)) v <- as.numeric(v) - } - - #* coded to labelled - else{ - v <- factor(v, - attributes(v)$redcapLevels, - attributes(v)$redcapLabels) - } - - #* reapply attributes - attr(v, 'redcapLabels') <- redcapLabels - attr(v, 'redcapLevels') <- redcapLevels - return(v) -} \ No newline at end of file diff --git a/R/syncUnderscoreCodings.R b/R/syncUnderscoreCodings.R deleted file mode 100644 index 6985f2fc..00000000 --- a/R/syncUnderscoreCodings.R +++ /dev/null @@ -1,148 +0,0 @@ -#' @name syncUnderscoreCodings -#' -#' @title Synchronize coding of checkbox variables between meta data and -#' records field names. -#' @description Due to a bug in the REDCap export module, underscores in -#' checkbox codings are not retained in the suffixes of the field names -#' in the exported records. For example, if variable \code{chk} is a -#' checkbox with a coding 'a_b, A and B', the field name in the data -#' export becomes \code{chk___ab}. The loss of the underscore causes -#' \code{fieldToVar} to fail as it can't match variable names to the -#' meta data. \code{syncUnderscoreCodings} rectifies this problem by -#' searching the suffixes and meta data for underscores. If a -#' discrepancy is found, the underscores are removed from the metadata -#' codings, restoring harmony to the universe. This bug was fixed in -#' REDCap version 5.5.21 and this function does not apply to that and -#' later versions. -#' -#' @param records The data frame object returned from the API export -#' prior to applying factors, labels, and dates via the \code{fieldToVar} -#' function. -#' @param meta_data Metadata export from \code{exportMetaData} -#' @param export Logical. Specifies if data are being synchronized for -#' import or export -#' -#' @details -#' \code{syncUnderscoreCodings} performs a series of evaluations. First, it -#' determines if any underscores are found in the checkbox codings. -#' If none are found, the function terminates without changing anything. -#' -#' If the checkbox codings have underscores, the next evaluation is to -#' determine if the variable names suffixes have matching underscores. -#' If they do, then the function terminates with no changes to the meta data. -#' -#' For data exports, if the prior two checks find underscores in the meta data -#' and no underscores in the suffixes, the underscores are removed from the -#' meta data and the new meta data returned. -#' -#' For data imports, the meta data are not altered and the -#' \code{checkbox_field_name_map} attribute is used to synchronize field -#' names to the meta data and the expectations of REDCap (for import, -#' REDCap expects the underscore codings to be used. -#' -#' @section Backward Compatibility: -#' In retrospect, we realize that the way \code{syncUnderscoreCodings} is written -#' is backwards. We should have altered the field names in the records -#' data frame. Any scripts that make use of \code{syncUnderscoreCodings} and were -#' written prior to version 5.5.21 will fail because the underscores in the codings -#' will now be present where they weren't before. -#' -#' For backward compatibility of \code{redcapAPI}, we continue to alter the codings -#' in the meta data. We do not anticipate many problems, as most people don't use -#' underscores in the checkbox codings -#' -#' If your scripts were written under REDCap 5.5.21 or higher, you will have no backward -#' compatibility problems related to this issue. -#' -#' @author Benjamin Nutter -#' - -syncUnderscoreCodings <- function(records, meta_data, export = TRUE){ - #* Deterimine if there are any underscores in checkbox codings - .checkbox <- meta_data[meta_data$field_type %in% c('checkbox'), ] - - if (nrow(.checkbox) == 0) return(meta_data) - - codings <- lapply(X = .checkbox$field_name, - FUN = manual_checkbox_suffixes, - meta_data) - codings <- lapply(X = codings, - FUN = function(x) sub("^.+___", "", x)) - - metaUnderscore <- any(sapply(codings, function(x) any(grepl("_", x)))) - - #* If there are no underscores in checkbox codings, return meta_data. - #* No futher work needed. - if (!metaUnderscore) return(meta_data) - - - #* If the function reaches this point, there were underscores in the codings - #* Now check the variable names in the exported records for underscores in the coding suffixes - ptrn <- paste0("(", - paste(.checkbox$field_name, - collapse="|"), - ")") - ptrn_suff <- paste0("(", - paste(.checkbox$field_name, - "___", - sep="", - collapse="|"), - ")") - checkNames <- names(records)[grepl(pattern = ptrn, - x = names(records))] - checkNames <- gsub(pattern = ptrn_suff, - replacement = "", - x = checkNames) - recordUnderscore <- any(grepl(pattern = "_", - x = checkNames)) - - #* if underscores are found in the meta_data codings and the records suffixes, return meta_data - #* No further work needed - if (metaUnderscore & recordUnderscore) return(meta_data) - - - #* If the function reaches this point, the meta_data codings do not match the record suffixes. - #* This will remove underscores from the meta_data codings and return the - #* meta_data so that it matches the records suffixes. - oldCoding <- strsplit(x = .checkbox$select_choices_or_calculations, - " [|] ") - newCoding <- lapply(X = oldCoding, - FUN = function(x) do.call(what = "rbind", - args = strsplit(x, ", "))) - newCoding <- lapply(X = newCoding, - FUN = function(x) - { - x[, 1] <- gsub(pattern = "_", - replacement = "", - x = x[,1]) - return(x) - } - ) - newCoding <- lapply(X = newCoding, - FUN = apply, - MARGIN = 1, - paste, - collapse=", ") - newCodingStr <- sapply(X = newCoding, - FUN = paste, - collapse = " | ") - if (export) meta_data$select_choices_or_calculations[meta_data$field_type == "checkbox"] <- newCodingStr - - field_names <- cbind(rep(x = meta_data$field_name[meta_data$field_type == "checkbox"], - sapply(X = oldCoding, - FUN = length)), - gsub(pattern = ",[[:print:]]+", - replacement = "", - x = unlist(oldCoding)), - gsub(pattern = ",[[:print:]]+", - replacement = "", - x = unlist(newCoding))) - field_names <- cbind(paste(field_names[, 1], - field_names[, 2], - sep="___"), - paste(field_names[, 1], - field_names[, 3], - sep="___")) - attr(meta_data, "checkbox_field_name_map") <- field_names - return(meta_data) -} \ No newline at end of file diff --git a/R/zzz.R b/R/zzz.R index 4372a923..f2465d5b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,7 +1,3 @@ -packageStartupMessage( - "Welcome to redcapAPI. Please Note:\n", - " - 'exportBundle' has been made redundant. See ?redcapConnection for details about caching project data.") - .onLoad <- function(libname,pkgname) { options(redcap_api_url = character(0), diff --git a/man/Extraction.Rd b/man/Extraction.Rd deleted file mode 100644 index c1f0957d..00000000 --- a/man/Extraction.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Extraction.R -\name{Extraction} -\alias{Extraction} -\alias{[.redcapFactor} -\alias{print.redcapFactor} -\title{Extraction and Assignment for \code{redcapFactor}s} -\usage{ -\method{[}{redcapFactor}(x, ..., drop = FALSE) - -\method{print}{redcapFactor}(x, ...) -} -\arguments{ -\item{x}{an object of class \code{redcapFactor}} - -\item{...}{additional arguments to pass to other methods} - -\item{drop}{\code{logical}. If \code{TRUE}, unused levels are dropped.} -} -\description{ -Extract elements and make assignments to \code{redcapFactor}s -} diff --git a/man/checkbox_suffixes.Rd b/man/checkbox_suffixes.Rd deleted file mode 100644 index 2027e2a5..00000000 --- a/man/checkbox_suffixes.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkbox_suffixes.R -\name{checkbox_suffixes} -\alias{checkbox_suffixes} -\title{Checkbox Suffixes} -\usage{ -checkbox_suffixes(fields, meta_data) -} -\arguments{ -\item{fields}{The current field names of interest} - -\item{meta_data}{The metadata data frame.} -} -\description{ -Checkbox variables return one vector of data for each option defined - in the variable. The variables are returned with the suffix \code{___[option]}. - \code{exportRecords} needs these suffixes in order to retrieve all of the - variables and to apply the correct labels. -} diff --git a/man/cleanseMetaData.Rd b/man/cleanseMetaData.Rd deleted file mode 100644 index c9d35fdf..00000000 --- a/man/cleanseMetaData.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cleanseMetaData.R -\name{cleanseMetaData} -\alias{cleanseMetaData} -\title{Clean Meta Data of UTF Characters} -\usage{ -cleanseMetaData(meta_data_file, meta_data_clean, overwrite = FALSE) -} -\arguments{ -\item{meta_data_file}{\code{character(1)} the path to a meta data file -that has been downloaded using the REDCap user interface.} - -\item{meta_data_clean}{\code{character(1)} the path of the file to which -the cleaned meta data will be written.} - -\item{overwrite}{\code{logical(1)} Permit the new file to overwrite an -existing file.} -} -\description{ -There have been isolated cases observed where certain - characters in the data dictionary prevent it from being downloaded - correctly. In one case, the data dictionary could not be downloaded - at all through the API. It is suspected that these problematic - characters are a result of copying and pasting text out of word - processing programs. The problematic characters are not necessarily - visible and their exact location can be difficult to identify. As - a last resort, \code{cleanseMetaData} can read a meta data file - downloaded through the user interface, purge it of any UTF-8 characters, - and write an alternate data dictionary that contains only ASCII - characters. -} diff --git a/man/deprecated_redcapProjectInfo.Rd b/man/deprecated_redcapProjectInfo.Rd deleted file mode 100644 index 25bd4d02..00000000 --- a/man/deprecated_redcapProjectInfo.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_recapProjectInfo.R -\name{deprecated_redcapProjectInfo} -\alias{deprecated_redcapProjectInfo} -\alias{redcapProjectInfo} -\alias{redcapProjectInfo.redcapApiConnection} -\title{Deprecated Functions} -\usage{ -redcapProjectInfo( - rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ... -) - -\method{redcapProjectInfo}{redcapApiConnection}( - rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ..., - v.number = "" -) -} -\arguments{ -\item{rcon}{A REDCap connection object as generated by \code{redcapConnection}} - -\item{date}{Logical. If \code{TRUE}, user expiration dates are converted to -\code{POSIXct} objects.} - -\item{label}{Logical. If \code{TRUE}, the user form permissions are -converted to labelled factors.} - -\item{meta_data}{Logical. Indicates if the meta data (data dictionary) -should be exported.} - -\item{users}{Logical. Indicates if the users table should be exported.} - -\item{instruments}{Logical. Indicates if the instruments table should be exported.} - -\item{events}{Logical. Indicates if the event names should be exported.} - -\item{arms}{Logical. Indicates if the arms table should be exported.} - -\item{mappings}{Logical. Indicates if the form-event mappings should -be exported.} - -\item{version}{Indicates if the REDCap version number should be exported. -Only applicable in REDCap 6.0.0 and higher.} - -\item{...}{Arguments to be passed to other methods} - -\item{v.number}{A character string given the desired version number should the -API method not be available.} -} -\description{ -The \code{redcapProjectInfo} function has been deprecated to avoid - confusion with the API method now executed by \code{exportProjectInformation}. - The replacement function is \code{\link{exportBundle}}. -} diff --git a/man/exportBundle.Rd b/man/exportBundle.Rd deleted file mode 100644 index b2c09cba..00000000 --- a/man/exportBundle.Rd +++ /dev/null @@ -1,89 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exportBundle.R -\name{exportBundle} -\alias{exportBundle} -\alias{exportBundle.redcapApiConnection} -\title{Perform a bundle of API calls.} -\usage{ -exportBundle( - rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ... -) - -\method{exportBundle}{redcapApiConnection}( - rcon, - date = TRUE, - label = TRUE, - meta_data = TRUE, - users = TRUE, - instruments = TRUE, - events = TRUE, - arms = TRUE, - mappings = TRUE, - version = TRUE, - ..., - return_object = TRUE -) -} -\arguments{ -\item{rcon}{A REDCap connection object as generated by \code{redcapConnection}} - -\item{date}{Logical. If \code{TRUE}, user expiration dates are converted to -\code{POSIXct} objects.} - -\item{label}{Logical. If \code{TRUE}, the user form permissions are -converted to labelled factors.} - -\item{meta_data}{Logical. Indicates if the meta data (data dictionary) -should be exported.} - -\item{users}{Logical. Indicates if the users table should be exported.} - -\item{instruments}{Logical. Indicates if the instruments table should be exported.} - -\item{events}{Logical. Indicates if the event names should be exported.} - -\item{arms}{Logical. Indicates if the arms table should be exported.} - -\item{mappings}{Logical. Indicates if the form-event mappings should -be exported.} - -\item{version}{Indicates if the REDCap version number should be exported. -Only applicable in REDCap 6.0.0 and higher.} - -\item{...}{Arguments to be passed to other methods} - -\item{return_object}{Logical. When \code{TRUE}, the \code{exportBundle} object -is returned to the workspace.} -} -\description{ -Several of the API calls return objects that can be used to perform - various validations in \code{exportRecords}, \code{exportReports}, and other - methods. Using an export bundle allows you to call these methods once and - store the result instead of issuing an additional call to the API each - time a method is invoked. - - For example, if you are uploading several files to the API, without an - export bundle, \code{importFiles} will utilize the \code{exportMetaData} - on each call in order to perform validations. Using a bundle allows you - to download the meta data once and refer to it on every subsequent call - that requires the data dictionary. -} -\details{ -The project information is stored in the option - \code{redcap_project_info}. If the project is not longitudinal, the - events, arms, and event-form mappings elements will be assigned character - vectors instead of data frames. -} -\author{ -Benjamin Nutter -} diff --git a/man/exportRecords.Rd b/man/exportRecords.Rd deleted file mode 100644 index a99d6be1..00000000 --- a/man/exportRecords.Rd +++ /dev/null @@ -1,249 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exportRecords.R, R/exportRecords_offline.R -\name{exportRecords} -\alias{exportRecords} -\alias{exportRecords.redcapApiConnection} -\alias{exportRecords_offline} -\title{Export Records from a REDCap Database} -\usage{ -exportRecords( - rcon, - factors = TRUE, - fields = NULL, - forms = NULL, - records = NULL, - events = NULL, - labels = TRUE, - dates = TRUE, - drop = NULL, - survey = TRUE, - dag = TRUE, - checkboxLabels = FALSE, - colClasses = character(0), - ... -) - -\method{exportRecords}{redcapApiConnection}( - rcon, - factors = TRUE, - fields = NULL, - forms = NULL, - records = NULL, - events = NULL, - labels = TRUE, - dates = TRUE, - drop = NULL, - survey = TRUE, - dag = TRUE, - checkboxLabels = FALSE, - colClasses = character(0), - ..., - batch.size = -1, - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list(), - form_complete_auto = TRUE -) - -exportRecords_offline( - dataFile, - metaDataFile, - factors = TRUE, - fields = NULL, - forms = NULL, - labels = TRUE, - dates = TRUE, - checkboxLabels = FALSE, - colClasses = NA, - ..., - meta_data -) -} -\arguments{ -\item{rcon}{A REDCap connection object as created by \code{redcapConnection}.} - -\item{factors}{Logical. Determines if categorical data from the database is -returned as numeric codes or labelled factors. See 'Checkbox Variables' -for more on how this interacts with the \code{checkboxLabels} argument.} - -\item{fields}{A character vector of fields to be returned. If \code{NULL}, -all fields are returned.} - -\item{forms}{A character vector of forms to be returned. If \code{NULL}, -all forms are returned.} - -\item{records}{A vector of study id's to be returned. If \code{NULL}, all -subjects are returned.} - -\item{events}{A character vector of events to be returned from a -longitudinal database. If \code{NULL}, all events are returned.} - -\item{labels}{Logical. Determines if the variable labels are applied to -the data frame.} - -\item{dates}{Logical. Determines if date variables are converted to POSIXct -format during the download.} - -\item{drop}{An optional character vector of REDCap variable names to remove from the -dataset; defaults to NULL. E.g., \code{drop=c("date_dmy", "treatment")} -It is OK for drop to contain variables not present; these names are ignored.} - -\item{survey}{specifies whether or not to export the survey identifier field -(e.g., "redcap_survey_identifier") or survey timestamp fields -(e.g., form_name+"_timestamp") when surveys are utilized in the project. -If you do not pass in this flag, it will default to "true". If set to -"true", it will return the redcap_survey_identifier field and also the -survey timestamp field for a particular survey when at least -one field from that survey is being exported. NOTE: If the survey -identifier field or survey timestamp fields are imported via API data -import, they will simply be ignored since they are not real fields in -the project but rather are pseudo-fields.} - -\item{dag}{specifies whether or not to export the "redcap_data_access_group" -field when data access groups are utilized in the project. If you do not -pass in this flag, it will default to "false". NOTE: This flag is only -viable if the user whose token is being used to make the API request is -*not* in a data access group. If the user is in a group, then this -flag will revert to its default value.} - -\item{checkboxLabels}{Logical. Determines the format of labels in checkbox -variables. If \code{FALSE} labels are applies as "Unchecked"/"Checked". -If \code{TRUE}, they are applied as ""/"[field_label]" where [field_label] -is the label assigned to the level in the data dictionary. -This option is only available after REDCap version 6.0. See Checkbox Variables -for more on how this interacts with the \code{factors} argument.} - -\item{colClasses}{A (named) vector of column classes passed to -\code{\link[utils]{read.csv}} calls. -Useful to force the interpretation of a column in a specific type and -avoid an unexpected recast.} - -\item{...}{Additional arguments to be passed between methods.} - -\item{batch.size}{Integer. Specifies the number of subjects to be included -in each batch of a batched export. Non-positive numbers export the -entire project in a single batch. Batching the export may be beneficial -to prevent tying up smaller servers. See details for more explanation.} - -\item{error_handling}{An option for how to handle errors returned by the API. -see \code{\link{redcap_error}}} - -\item{config}{\code{list} Additional configuration parameters to pass to -\code{\link[httr]{POST}}. These are appended to any parameters in -\code{rcon$config}.} - -\item{api_param}{\code{list} Additional API parameters to pass into the -body of the API call. This provides users to execute calls with options -that may not otherwise be supported by \code{redcapAPI}.} - -\item{form_complete_auto}{\code{logical(1)}. When \code{TRUE} -(default), the \code{[form]_complete} fields for any form -from which at least one variable is requested will automatically -be retrieved. When \code{FALSE}, these fields must be -explicitly requested.} - -\item{dataFile}{For the offline version, a character string giving the location -of the dataset downloaded from REDCap. Note that this should be the raw -(unlabeled) data set.} - -\item{metaDataFile}{A text string giving the location of the data dictionary -downloaded from REDCap.} - -\item{meta_data}{Deprecated version of \code{metaDataFile}} -} -\description{ -Exports records from a REDCap Database, allowing for - subsets of subjects, fields, records, and events. -} -\details{ -A record of exports through the API is recorded in the Logging section -of the project. - -The 'offline' version of the function operates on the raw (unlabeled) data -file downloaded from REDCap along with the data dictionary. -This is made available for instances where the API can not be accessed for -some reason (such as waiting for API approval from the REDCap administrator). - -It is unnecessary to include "redcap_event_name" in the fields argument. -This field is automatically exported for any longitudinal database. -If the user does include it in the fields argument, it is removed quietly -in the parameter checks. - -A 'batched' export is one where the export is performed over a series of -API calls rather than one large call. For large projects on small servers, -this may prevent a single user from tying up the server and forcing others -to wait on a larger job. The batched export is performed by first -calling the API to export the subject identifier field (the first field -in the meta data). The unique ID's are then assigned a batch number with -no more than \code{batch.size} ID's in any single batch. The batches are -exported from the API and stacked together. - -In longitudinal projects, \code{batch.size} may not necessarily be the -number of records exported in each batch. If \code{batch.size} is 10 and -there are four records per patient, each batch will consist of 40 records. -Thus, if you are concerned about tying up the server with a large, -longitudinal project, it would be prudent to use a smaller batch size. -} -\section{Checkbox Variables}{ - - -There are four ways the data from checkbox variables may be -represented depending on the values of \code{factors} and -\code{checkboxLabels}. The most common are the first and third -rows of the table below. When \code{checkboxLabels = TRUE}, either -the coded value or the labelled value is returned if the box is -checked, or an empty string if it is not. - -\tabular{lll}{ -\code{factors} \tab \code{checkboxLabels} \tab Output \cr -\code{FALSE} \tab \code{FALSE} \tab 0 / 1 \cr -\code{FALSE} \tab \code{TRUE} \tab "" / value \cr -\code{TRUE} \tab \code{FALSE} \tab Unchecked / Checked \cr -\code{TRUE} \tab \code{TRUE} \tab "" / label -} -} - -\section{REDCap API Documentation (6.5.0)}{ - -This function allows you to export a set of records for a project - -Note about export rights (6.0.0+): Please be aware that Data Export user rights will be -applied to this API request. For example, if you have "No Access" data export rights -in the project, then the API data export will fail and return an error. And if you -have "De-Identified" or "Remove all tagged Identifier fields" data export rights, -then some data fields *might* be removed and filtered out of the data set returned -from the API. To make sure that no data is unnecessarily filtered out of your API -request, you should have "Full Data Set" export rights in the project. -} - -\section{REDCap Version}{ - -5.8.2 (Perhaps earlier) -} - -\section{Known REDCap Limitations}{ - -None -} - -\section{Deidentified Batched Calls}{ - -Batched calls to the API are not a feature of the REDCap API, but may be imposed -by making multiple calls to the API. The process of batching the export requires -that an initial call be made to the API to retrieve only the record IDs. The -list of IDs is then broken into chunks, each about the size of \code{batch.size}. -The batched calls then force the \code{records} argument in each call. - -When a user's permissions require a de-identified data export, a batched call -should be expected to fail. This is because, upon export, REDCap will hash the -identifiers. When R attempts to pass the hashed identifiers back to REDCap, -REDCap will try to match the hashed identifiers to the unhashed identifiers in the -database. No matches will be found, and the export will fail. - -Users who are exporting de-identified data will have to settle for using unbatched -calls to the API (ie, \code{batch.size = -1}) -} - -\author{ -Jeffrey Horner -} diff --git a/man/exportReports.Rd b/man/exportReports.Rd deleted file mode 100644 index 573c8ab0..00000000 --- a/man/exportReports.Rd +++ /dev/null @@ -1,105 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exportReports.R -\name{exportReports} -\alias{exportReports} -\alias{exportReports.redcapApiConnection} -\title{Export Reports from a REDCap Database} -\usage{ -exportReports( - rcon, - report_id, - factors = TRUE, - labels = TRUE, - dates = TRUE, - drop = NULL, - checkboxLabels = FALSE, - ... -) - -\method{exportReports}{redcapApiConnection}( - rcon, - report_id, - factors = TRUE, - labels = TRUE, - dates = TRUE, - drop = NULL, - checkboxLabels = FALSE, - ..., - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list() -) -} -\arguments{ -\item{rcon}{A REDCap connection object as created by \code{redcapConnection}.} - -\item{report_id}{Integer. Gives the report id of the desired report. -This is located on the Report Builder page of the user interface on REDCap.} - -\item{factors}{Logical. Determines if categorical data from the database -is returned as numeric codes or labelled factors.} - -\item{labels}{Logical. Determines if the variable labels are applied to the data frame.} - -\item{dates}{Logical. Determines if date variables are converted to POSIXct format during the download.} - -\item{drop}{An optional character vector of REDCap variable names to remove from the -dataset; defaults to NULL. E.g., \code{drop=c("date_dmy", "treatment")} -It is OK for drop to contain variables not present; these names are ignored.} - -\item{checkboxLabels}{Logical. Determines the format of labels in checkbox -variables. If \code{FALSE} labels are applies as "Unchecked"/"Checked". -If \code{TRUE}, they are applied as ""/"[field_labe]" where [field_label] -is the label assigned to the level in the data dictionary. This option -is only available after REDCap version 6.0.} - -\item{...}{Additional arguments to be passed between methods.} - -\item{error_handling}{An option for how to handle errors returned by the API. -see \code{\link{redcap_error}}} - -\item{config}{\code{list} Additional configuration parameters to pass to -\code{\link[httr]{POST}}. These are appended to any parameters in -\code{rcon$config}.} - -\item{api_param}{\code{list} Additional API parameters to pass into the -body of the API call. This provides users to execute calls with options -that may not otherwise be supported by \code{redcapAPI}.} -} -\description{ -Exports reports from a REDCap Database and formats data if requested -} -\details{ -A record of exports through the API is recorded in the Logging section of -the project. - -Reports are exported based on their id number, which can be looked up in -the Reports page of a project -} -\section{REDCap API Documentation (6.5.0)}{ - -This function allows you to export the data set of a report created on a project's -"Data Exports, Reports, and Stats" page. - -Note about export rights (6.0.0+): Please be aware that Data Export user rights will be -applied to this API request. For example, if you have "No Access" data export rights -in the project, then the API report export will fail and return an error. And if you -have "De-Identified" or "Remove all tagged Identifier fields" data export rights, -then some data fields *might* be removed and filtered out of the data set returned -from the API. To make sure that no data is unnecessarily filtered out of your API -request, you should have "Full Data Set" export rights in the project. -} - -\section{REDCap Version}{ - -6.0.0+ -} - -\section{Known REDCap Limitations}{ - -None -} - -\author{ -Benjamin Nutter -} diff --git a/man/fieldToVar.Rd b/man/fieldToVar.Rd deleted file mode 100644 index d7594831..00000000 --- a/man/fieldToVar.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fieldToVar.R -\name{fieldToVar} -\alias{fieldToVar} -\title{Convert a REDCap Data Field to an R Vector} -\usage{ -fieldToVar( - records, - meta_data, - factors = TRUE, - dates = TRUE, - checkboxLabels = FALSE, - labels = TRUE, - handlers = list(), - mChoice = NULL, - ... -) -} -\arguments{ -\item{records}{A data frame of records returned by \code{exportRecords} -or \code{exportReports}} - -\item{meta_data}{A data frame giving the data dictionary, as returned -by \code{exportMetaData}} - -\item{factors}{Logical, determines if checkbox, radio button, dropdown and yesno -variables are converted to factors} - -\item{dates}{Logical, determines if date variables are converted to POSIXct format} - -\item{checkboxLabels}{Logical, determines if checkbox variables are labeled as -"Checked" or using the checkbox label. Only applicable when \code{factors = TRUE}} - -\item{labels}{Logical. Determines if the variable labels are applied to -the data frame.} - -\item{handlers}{List, Specify type conversion overrides for specific REDCap field types. -E.g., \code{handlers=list(date_ = as.Date)}. For datetime specifications the -datetime ordering directive from the tail is dropped. The following field -types are supported: date_, datetime_, datetime_seconds_, time_mm_ss, time, -float, number, calc, int, integer, select, radio, dropdown, yesno, truefalse, -checkbox, and form_complete.} - -\item{mChoice}{logical; defaults to TRUE. Convert checkboxes to mChoice if -Hmisc is installed.} - -\item{..., }{additional arguments that are ignored.} -} -\description{ -Converts a field exported from REDCap into a valid R vector -} -\details{ -This function is called internally by \code{exportRecords} and - \code{exportReports}. it is not available to the user. -} -\author{ -Jeffrey Horner -} diff --git a/man/massert.Rd b/man/massert.Rd deleted file mode 100644 index 4e542389..00000000 --- a/man/massert.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/massert.R -\name{massert} -\alias{massert} -\title{Conduct Multiple Assertions} -\usage{ -massert(formula, fun, ..., fixed = list()) -} -\arguments{ -\item{formula}{A one sided formula naming the arguments on which the assertion -will be performed.} - -\item{fun}{An assertion function to perform.} - -\item{...}{Additional lists. Each argument provided is a named list of \code{assertion -arguments}. The name of each element in a list should match the name of a -\code{function argument}. \code{lower = list(var1 = 0, var2 = 10)} sets -the \emph{assertion argument} \code{lower = 0} for \emph{function argument} -\code{var1}; and sets the \emph{assertion argument} \code{lower = 10} for -\code{function argument} \code{var2}. The \emph{massert arguments} in \code{...} -may themselves be named or unnamed.} - -\item{fixed}{A named list of arguments that are fixed across all assertions.} -} -\description{ -This documentation attempts to describe arguments to make assertions -on arguments. In order to prevent confusion, it is imperative to develop some -terminology up front. We will use \emph{function argument} to refer to an argument -of the function for which we are conducting assertions. We will use -\emph{assertion argument} to refer to arguments to pass to the assertion function -being applied to a function argument. Lastly, we will use \emph{massert argument} -to refer to arguments to \code{massert} -} -\details{ -Only one assert function may be utilized in each call to \code{massert}. - This allows for all numeric variables to be checked in one call, all logical - variables to be checked in a subsequent call, etc. -} -\author{ -Benjamin Nutter -} diff --git a/man/recodeCheck.Rd b/man/recodeCheck.Rd deleted file mode 100644 index a7e2b00f..00000000 --- a/man/recodeCheck.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/recodeCheck.R -\name{recodeCheck} -\alias{recodeCheck} -\title{Change labelling of \code{checkbox} variables} -\usage{ -recodeCheck( - df, - vars, - old = c("Unchecked", "Checked"), - new = c("No", "Yes"), - reverse = FALSE -) -} -\arguments{ -\item{df}{A data frame, presumably retrieved from REDCap, though not a -strict requirement.} - -\item{vars}{Optional character vector of variables to convert. If left -missing, all of the variables in \code{df} that are identified as -\code{checkbox} variables are relabelled. See 'Details' for more about -identifying \code{checkbox} variables.} - -\item{old}{A character vector to be passed to \code{factor}. -This indicates the levels to be replaced and their order.} - -\item{new}{A character vector of labels to replace the values in -\code{levels}. The first value becomes the reference value.} - -\item{reverse}{For convenience, if the user would prefer to reverse the -order of the elements in \code{levels} and \code{labels}, -simply set this to \code{TRUE}.} -} -\description{ -Rewrites the labelling of \code{checkbox} variables from - Checked/Unchecked to Yes/No (or some other user-specified labelling). -} -\details{ -\code{checkbox} variables are \emph{not} identified using the metadata -from the REDCap database. Instead, variables are scanned, and those -variables in which every value is in \code{levels} are assumed to be -\code{checkbox} variables. - -Realistically, this could be used to relabel any set of factors with -identical labels, regardless of the data source. The number of labels is -not limited, but \code{levels} and \code{labels} should have the same length. - -The actual code to perform this is not particularly difficult -(\code{df[checkbox] <- lapply(df[checkbox], factor, levels=levels, labels=labels)}), -but \code{checkbox} variables are common enough in REDCap -(and the Checked/Unchecked scheme so unpalatable) that a quick way to -replace the labels was highly desirable -} -\author{ -Benjamin Nutter -} diff --git a/man/redcapFactorFlip.Rd b/man/redcapFactorFlip.Rd deleted file mode 100644 index 52316ed8..00000000 --- a/man/redcapFactorFlip.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/redcapFactorFlip.R -\name{redcapFactorFlip} -\alias{redcapFactorFlip} -\title{Convert REDCap factors between labelled and coded} -\usage{ -redcapFactorFlip(v) -} -\arguments{ -\item{v}{A factor exported from REDCap. The REDCap type may be radio, -dropdown, check, yesno, etc.} -} -\description{ -Factors exported from REDCap can be toggled between the coded - and labelled values with the use of the attributes assigned to the - factors during export. -} -\details{ -Each factor type variable in REDCap is given the attributes -\code{redcapLabels} and \code{redcapLevels}. With these attached to the -vector, switching between the coded and labelled values can be done with -ease. This may be helpful when the coded value has importance, -such as 0/1 for death, or if a yes is worth 6 points (instead of 1). -} -\author{ -Benjamin Nutter -} diff --git a/man/syncUnderscoreCodings.Rd b/man/syncUnderscoreCodings.Rd deleted file mode 100644 index 0d6ff78f..00000000 --- a/man/syncUnderscoreCodings.Rd +++ /dev/null @@ -1,70 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/syncUnderscoreCodings.R -\name{syncUnderscoreCodings} -\alias{syncUnderscoreCodings} -\title{Synchronize coding of checkbox variables between meta data and - records field names.} -\usage{ -syncUnderscoreCodings(records, meta_data, export = TRUE) -} -\arguments{ -\item{records}{The data frame object returned from the API export -prior to applying factors, labels, and dates via the \code{fieldToVar} -function.} - -\item{meta_data}{Metadata export from \code{exportMetaData}} - -\item{export}{Logical. Specifies if data are being synchronized for -import or export} -} -\description{ -Due to a bug in the REDCap export module, underscores in - checkbox codings are not retained in the suffixes of the field names - in the exported records. For example, if variable \code{chk} is a - checkbox with a coding 'a_b, A and B', the field name in the data - export becomes \code{chk___ab}. The loss of the underscore causes - \code{fieldToVar} to fail as it can't match variable names to the - meta data. \code{syncUnderscoreCodings} rectifies this problem by - searching the suffixes and meta data for underscores. If a - discrepancy is found, the underscores are removed from the metadata - codings, restoring harmony to the universe. This bug was fixed in - REDCap version 5.5.21 and this function does not apply to that and - later versions. -} -\details{ -\code{syncUnderscoreCodings} performs a series of evaluations. First, it -determines if any underscores are found in the checkbox codings. -If none are found, the function terminates without changing anything. - -If the checkbox codings have underscores, the next evaluation is to -determine if the variable names suffixes have matching underscores. -If they do, then the function terminates with no changes to the meta data. - -For data exports, if the prior two checks find underscores in the meta data -and no underscores in the suffixes, the underscores are removed from the -meta data and the new meta data returned. - -For data imports, the meta data are not altered and the -\code{checkbox_field_name_map} attribute is used to synchronize field -names to the meta data and the expectations of REDCap (for import, -REDCap expects the underscore codings to be used. -} -\section{Backward Compatibility}{ - -In retrospect, we realize that the way \code{syncUnderscoreCodings} is written -is backwards. We should have altered the field names in the records -data frame. Any scripts that make use of \code{syncUnderscoreCodings} and were -written prior to version 5.5.21 will fail because the underscores in the codings -will now be present where they weren't before. - -For backward compatibility of \code{redcapAPI}, we continue to alter the codings -in the meta data. We do not anticipate many problems, as most people don't use -underscores in the checkbox codings - -If your scripts were written under REDCap 5.5.21 or higher, you will have no backward -compatibility problems related to this issue. -} - -\author{ -Benjamin Nutter -} diff --git a/tests/testthat/test-11-records-exportRecords.R b/tests/testthat/test-11-records-exportRecords.R index ed7e0269..98b725a8 100644 --- a/tests/testthat/test-11-records-exportRecords.R +++ b/tests/testthat/test-11-records-exportRecords.R @@ -1,63 +1,2 @@ context("exportRecords") -test_that("records can be exported",{ - expect_message(rec <- exportRecords(rcon)) - expect_gte(length(rec), 1) -}) - -#!! for tests regarding variable conversions, see test-fieldToVar.R - - -# Tests for fields, forms, records ---------------------------------- -test_that( - "Records returned for designated fields", - { - fields_to_get <- c("record_id", - "date_ymd", - "prereq_number") - Records <- exportRecords(rcon, - fields = fields_to_get) - expect_subset(fields_to_get, - choices = names(Records)) - } -) - -test_that( - "fields in the designated forms are returned", - { - forms_to_get <- c("fieldtovar_datetimes", - "branching_logic") - Records <- exportRecords(rcon, - forms = forms_to_get) - expect_false("treatment" %in% names(Records)) - } -) - -test_that( - "fields in the drop= arg are not returned", - { - forms_to_drop <- c("treatment") - Records <- exportRecords(rcon, - drop = forms_to_drop) - expect_false("treatment" %in% names(Records)) - } -) - -test_that( - "records returned only for designated records", - { - records_to_get <- 1:3 - Records <- exportRecords(rcon, - records = records_to_get) - expect_true(all(Records$record_id %in% records_to_get)) - } -) - -test_that( - "Data returned only for designated event", - { - Records <- exportRecords(rcon, - events = "event_1_arm_1") - expect_true(all(Records$redcap_event_name %in% "event_1_arm_1")) - } -) diff --git a/tests/testthat/test-13-reports-arg-validation.R b/tests/testthat/test-13-reports-arg-validation.R index b5e646e9..c0a288cb 100644 --- a/tests/testthat/test-13-reports-arg-validation.R +++ b/tests/testthat/test-13-reports-arg-validation.R @@ -9,124 +9,6 @@ restoreProject(RedcapProject_RedcapTestApi, rcon) ##################################################################### # exportReports #### -test_that( - "Return an error if rcon is not a redcapConnection", - { - local_reproducible_output(width = 200) - expect_error(exportReports("not an rcon"), - "no applicable method for 'exportReports'") - } -) - -test_that( - "Return an error if report_id is not integerish(1)", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = c(123, 456)), - "'report_id': Must have length 1") - } -) - -test_that( - "Return an error if factors is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - factors = c(TRUE, FALSE)), - "'factors'[:] Must have length 1") - expect_error(exportReports(rcon, - report_id = 100, - factors = "TRUE"), - "Variable 'factors'[:] Must be of type 'logical'") - } -) - -test_that( - "Return an error if labels is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - labels = c(TRUE, FALSE)), - "'labels'[:] Must have length 1") - expect_error(exportReports(rcon, - report_id = 100, - labels = "TRUE"), - "'labels'[:] Must be of type 'logical'") - } -) - -test_that( - "Return an error if dates is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - dates = c(TRUE, FALSE)), - "'dates'[:] Must have length 1") - expect_error(exportReports(rcon, - report_id = 100, - dates = "TRUE"), - "'dates'[:] Must be of type 'logical'") - } -) - -test_that( - "Return an error if drop is not character", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - drop = 1:3), - "'drop': Must be of type 'character'") - } -) - -test_that( - "Return an error if checkboxLabels is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - checkboxLabels = c(TRUE, FALSE)), - "'checkboxLabels'[:] Must have length 1") - expect_error(exportReports(rcon, - report_id = 100, - checkboxLabels = "TRUE"), - "'checkboxLabels'[:] Must be of type 'logical'") - } -) - -test_that( - "Validate error_handling, config, api_param", - { - local_reproducible_output(width = 200) - expect_error(exportReports(rcon, - report_id = 100, - error_handling = "not an option"), - "'error[_]handling': Must be element of set [{]'null','error'[}]") - - expect_error(exportReports(rcon, - report_id = 100, - config = list(1)), - "'config': Must have names") - expect_error(exportReports(rcon, - report_id = 100, - config = "not a list"), - "'config': Must be of type 'list'") - - expect_error(exportReports(rcon, - report_id = 100, - api_param = list(1)), - "'api_param': Must have names") - expect_error(exportReports(rcon, - report_id = 100, - api_param = "not a list"), - "'api_param': Must be of type 'list'") - } -) ##################################################################### # exportReportsTyped #### diff --git a/tests/testthat/test-13-reports-functionality.R b/tests/testthat/test-13-reports-functionality.R index 1cd941e6..2eac8aaa 100644 --- a/tests/testthat/test-13-reports-functionality.R +++ b/tests/testthat/test-13-reports-functionality.R @@ -4,18 +4,7 @@ context("exportReports functionality") ##################################################################### # exportReports #### -test_that("reports can be exported",{ - expect_silent(rep <- exportReports(rcon, 357209)) -}) -test_that( - "fields in the drop= arg are not returned", - { - fields_to_drop <- c("treatment") - Report <- exportReports(rcon, 357209, - drop = fields_to_drop) - } -) ##################################################################### # exportReportsTyped #### diff --git a/tests/testthat/test-checkbox_suffixes.R b/tests/testthat/test-checkbox_suffixes.R deleted file mode 100644 index da30cf13..00000000 --- a/tests/testthat/test-checkbox_suffixes.R +++ /dev/null @@ -1,42 +0,0 @@ -context("checkbox_suffixes.R") - -load(test_path("testdata", "RedcapProject_RedcapTestApi.Rdata")) -purgeProject(rcon, purge_all = TRUE) -rcon$flush_all() -restoreProject(RedcapProject_RedcapTestApi, - rcon) - -CheckboxMetaData <- exportMetaData(rcon) -CheckboxMetaData <- CheckboxMetaData[CheckboxMetaData$field_name %in% c("prereq_checkbox"), ] -# For the purpose of testing, we are going to add a couple more options to these meta data -# Doing it this way allows us to add tests for any code/label mapping without having to -# alter the testing database. -CheckboxMetaData$select_choices_or_calculations <- - paste0(CheckboxMetaData$select_choices_or_calculations, - " | lowercase, Lowercase code | mixedCase, Mixed case code | 12ab, alpha, numeric | use_underscore, Use an underscore") - -test_that( - "Checkbox suffixes are correctly generated", - { - expect_equal( - checkbox_suffixes(fields = c("prereq_checkbox"), - meta_data = CheckboxMetaData), - list(name_suffix = c(prereq_checkbox1 = "prereq_checkbox___1", - prereq_checkbox2 = "prereq_checkbox___2", - prereq_checkbox3 = "prereq_checkbox___abc", - prereq_checkbox4 = "prereq_checkbox___4", - prereq_checkbox5 = "prereq_checkbox___lowercase", - prereq_checkbox6 = "prereq_checkbox___mixedcase", - prereq_checkbox7 = "prereq_checkbox___12ab", - prereq_checkbox8 = "prereq_checkbox___use_underscore"), - label_suffix = c(prereq_checkbox1 = "Pre-requisite as a checkbox: Checkbox1", - prereq_checkbox2 = "Pre-requisite as a checkbox: Checkbox2", - prereq_checkbox3 = "Pre-requisite as a checkbox: CheckboxABC", - prereq_checkbox4 = "Pre-requisite as a checkbox: Do not use in branching logic", - prereq_checkbox5 = "Pre-requisite as a checkbox: Lowercase code", - prereq_checkbox6 = "Pre-requisite as a checkbox: Mixed case code", - prereq_checkbox7 = "Pre-requisite as a checkbox: alpha, numeric", - prereq_checkbox8 = "Pre-requisite as a checkbox: Use an underscore")) - ) - } -) diff --git a/tests/testthat/test-fieldToVar.R b/tests/testthat/test-fieldToVar.R deleted file mode 100644 index 81941520..00000000 --- a/tests/testthat/test-fieldToVar.R +++ /dev/null @@ -1,122 +0,0 @@ -context("fieldToVar") - -# pull data for tests with handler -rec_ht <- exportRecords(rcon, handlers = list(date_ = as.Date, time = function(x) 1.23, time_mm_ss = function(x) 1.23, time_hh_mm_ss = function(x) 1.23, datetime_ = as.Date, datetime_seconds_ = as.Date)) -test_that("date_ = as.Date returns class Date for date_dmy", expect_is(rec_ht$date_dmy, "Date")) -test_that("date_ = as.Date returns class Date for date_mdy", expect_is(rec_ht$date_mdy, "Date")) -test_that("date_ = as.Date returns class Date for date_ymd", expect_is(rec_ht$date_ymd, "Date")) - -test_that("time = function(x) 1.23 returns class numeric for time_hhmm", expect_is(rec_ht$time_hhmm, "numeric")) -test_that("time_mm_ss = function(x) 1.23 returns class numeric for time_mmss", expect_is(rec_ht$time_mmss, "numeric")) -test_that("time_ = function(x) 1.23 returns class numeric for time_hhmmss", expect_is(rec_ht$time_hhmmss, "numeric")) - -test_that("datetime_ = as.Date returns class Date for datetime_dmy_hm", expect_is(rec_ht$datetime_dmy_hm, "Date")) -test_that("datetime_ = as.Date returns class Date for datetime_mdy_hm", expect_is(rec_ht$datetime_mdy_hm, "Date")) -test_that("datetime_ = as.Date returns class Date for datetime_ymd_hm", expect_is(rec_ht$datetime_ymd_hm, "Date")) - -test_that("datetime_seconds_ = as.Date returns class Date for datetime_dmy_hms", expect_is(rec_ht$datetime_dmy_hms, "Date")) -test_that("datetime_seconds_ = as.Date returns class Date for datetime_mdy_hms", expect_is(rec_ht$datetime_mdy_hms, "Date")) -test_that("datetime_seconds_ = as.Date returns class Date for datetime_ymd_hms", expect_is(rec_ht$datetime_ymd_hms, "Date")) - -# pull data for tests with dates = true -rec_dt <- exportRecords(rcon, dates = TRUE) -test_that("dates = TRUE returns class POSIXt for date_dmy", expect_is(rec_dt$date_dmy, "POSIXt")) -test_that("dates = TRUE returns class POSIXt for date_mdy", expect_is(rec_dt$date_mdy, "POSIXt")) -test_that("dates = TRUE returns class POSIXt for date_ymd", expect_is(rec_dt$date_ymd, "POSIXt")) - -test_that("dates = TRUE returns class times for time_hhmmss", expect_is(rec_dt$time_hhmmss, "times")) -test_that("dates = TRUE returns class times for time_hhmm", expect_is(rec_dt$time_hhmm, "times")) -test_that("dates = TRUE returns class times for time_mmss", expect_is(rec_dt$time_mmss, "times")) - -test_that("dates = TRUE returns class Date for datetime_dmy_hm", expect_is(rec_dt$datetime_dmy_hm, "POSIXt")) -test_that("dates = TRUE returns class Date for datetime_mdy_hm", expect_is(rec_dt$datetime_mdy_hm, "POSIXt")) -test_that("dates = TRUE returns class Date for datetime_ymd_hm", expect_is(rec_dt$datetime_ymd_hm, "POSIXt")) - -test_that("dates = TRUE returns class Date for datetime_dmy_hms", expect_is(rec_dt$datetime_dmy_hms, "POSIXt")) -test_that("dates = TRUE returns class Date for datetime_mdy_hms", expect_is(rec_dt$datetime_mdy_hms, "POSIXt")) -test_that("dates = TRUE returns class Date for datetime_ymd_hms", expect_is(rec_dt$datetime_ymd_hms, "POSIXt")) - -test_that("dates = TRUE returns 2023-02-24 for date_dmy in first rec", - expect_true(rec_dt$date_dmy[1] == as.POSIXct("2023-02-24"))) -test_that("dates = TRUE returns 2023-02-24 for date_mdy in first rec", - expect_true(rec_dt$date_mdy[1] == as.POSIXct("2023-02-24"))) -test_that("dates = TRUE returns 2023-02-24 for date_ymd in first rec", - expect_true(rec_dt$date_ymd[1] == as.POSIXct("2023-02-24"))) - -test_that("dates = TRUE returns 12:04:55 for time_hhmmss in first rec", - expect_true(rec_dt$time_hhmmss[1] == - chron::times("12:04:55", format=c(times="h:m:s")))) -test_that("dates = TRUE returns 12:04:55 for time_hhmm in first rec", - expect_true(rec_dt$time_hhmm[1] == - chron::times("12:04:00", format=c(times="h:m:s")))) -test_that("dates = TRUE returns 12:04:55 for time_mmss in first rec", - expect_true(rec_dt$time_mmss[1] == - chron::times("00:02:45", format=c(times="h:m:s")))) - -test_that("dates = TRUE returns 2023-02-24 12:04 for datetime_dmy_hm in first rec", - expect_true(rec_dt$datetime_dmy_hm[1] == - as.POSIXct("2023-02-24 12:04", format="%Y-%m-%d %H:%M"))) -test_that("dates = TRUE returns 2023-02-24 12:04 for datetime_mdy_hm in first rec", - expect_true(rec_dt$datetime_mdy_hm[1] == - as.POSIXct("2023-02-24 12:04", format="%Y-%m-%d %H:%M"))) -test_that("dates = TRUE returns 2023-02-24 12:04 datetime_ymd_hm in first rec", - expect_true(rec_dt$datetime_ymd_hm[1] == - as.POSIXct("2023-02-24 12:04", format="%Y-%m-%d %H:%M"))) - -test_that("dates = TRUE returns 2023-02-24 12:40:50 for datetime_dmy_hms in first rec", - expect_true(rec_dt$datetime_dmy_hms[1] == - as.POSIXct("2023-02-24 12:40:50", format="%Y-%m-%d %H:%M:%S"))) -test_that("dates = TRUE returns 2023-02-24 12:40:50 for datetime_mdy_hms in first rec", - expect_true(rec_dt$datetime_mdy_hms[1] == - as.POSIXct("2023-02-24 12:40:50", format="%Y-%m-%d %H:%M:%S"))) -test_that("dates = TRUE returns 2023-02-24 12:40:50 for datetime_ymd_hms in first rec", - expect_true(rec_dt$datetime_ymd_hms[1] == - as.POSIXct("2023-02-24 12:40:50", format="%Y-%m-%d %H:%M:%S"))) - - -# pull data for tests with dates = false -rec_df <- exportRecords(rcon, dates = FALSE) -test_that("dates = FALSE returns class character for date_dmy", expect_is(rec_df$date_dmy, "character")) -test_that("dates = FALSE returns class character for date_mdy", expect_is(rec_df$date_mdy, "character")) -test_that("dates = FALSE returns class character for date_ymd", expect_is(rec_df$date_ymd, "character")) - -test_that("dates = FALSE returns class character for time_hhmmss", expect_is(rec_df$time_hhmmss, "character")) -test_that("dates = FALSE returns class character for time_hhmm", expect_is(rec_df$time_hhmm, "character")) -test_that("dates = FALSE returns class character for time_mmss", expect_is(rec_df$time_mmss, "character")) - -test_that("dates = FALSE returns class character for datetime_dmy_hm", expect_is(rec_df$datetime_dmy_hm, "character")) -test_that("dates = FALSE returns class character for datetime_mdy_hm", expect_is(rec_df$datetime_mdy_hm, "character")) -test_that("dates = FALSE returns class character for datetime_ymd_hm", expect_is(rec_df$datetime_ymd_hm, "character")) - -test_that("dates = FALSE returns class character for datetime_dmy_hms", expect_is(rec_df$datetime_dmy_hms, "character")) -test_that("dates = FALSE returns class character for datetime_mdy_hms", expect_is(rec_df$datetime_mdy_hms, "character")) -test_that("dates = FALSE returns class character for datetime_ymd_hms", expect_is(rec_df$datetime_ymd_hms, "character")) - -test_that("dates = FALSE returns '2023-02-24' for date_dmy first rec", - expect_true(rec_df$date_dmy[1] == "2023-02-24")) -test_that("dates = FALSE returns '2023-02-24' for date_mdy first rec", - expect_true(rec_df$date_mdy[1] == "2023-02-24")) -test_that("dates = FALSE returns '2023-02-24' for date_ymd first rec", - expect_true(rec_df$date_ymd[1] == "2023-02-24")) - -test_that("dates = FALSE returns '12:04:55' for time_hhmmss first rec", - expect_true(rec_df$time_hhmmss[1] == "12:04:55")) -test_that("dates = FALSE returns '12:04' for time_hhmm first rec", - expect_true(rec_df$time_hhmm[1] == "12:04")) -test_that("dates = FALSE returns '02:45' for time_mmss first rec", - expect_true(rec_df$time_mmss[1] == "02:45")) - -test_that("dates = FALSE returns '2023-02-24 12:04' for datetime_dmy_hm first rec", - expect_true(rec_df$datetime_dmy_hm[1] == "2023-02-24 12:04")) -test_that("dates = FALSE returns '2023-02-24 12:04' for datetime_mdy_hm first rec", - expect_true(rec_df$datetime_mdy_hm[1] == "2023-02-24 12:04")) -test_that("dates = FALSE returns '2023-02-24 12:04' for datetime_ymd_hm first rec", - expect_true(rec_df$datetime_ymd_hm[1] == "2023-02-24 12:04")) - -test_that("dates = FALSE returns 2023-02-24 12:40:50 for datetime_dmy_hms first rec", - expect_true(rec_df$datetime_dmy_hms[1] == "2023-02-24 12:40:50")) -test_that("dates = FALSE returns 2023-02-24 12:40:50 for datetime_mdy_hms first rec", - expect_true(rec_df$datetime_mdy_hms[1] == "2023-02-24 12:40:50")) -test_that("dates = FALSE returns 2023-02-24 12:40:50 for datetime_ymd_hms first rec", - expect_true(rec_df$datetime_ymd_hms[1] == "2023-02-24 12:40:50")) - diff --git a/tests/testthat/test-validateImport_methods.R b/tests/testthat/test-validateImport_methods.R deleted file mode 100644 index 2f4fe0bb..00000000 --- a/tests/testthat/test-validateImport_methods.R +++ /dev/null @@ -1,1242 +0,0 @@ -context("validateteImport_methods") - -# validate_import_checkbox ------------------------------------------ - -test_that( - "0, 1, Unchecked, Checked, '', NA all pass", - { - test_checkbox <- c("0", "1", - "Unchecked", "UNCHECKED", "UnChEcKeD", "unchecked", - "Checked", "CHECKED", "ChEcKeD", "checked", - "", NA_character_) - check_define <- "check1, Guitar | check2, Lute | check3 , Harp " - expect_equal( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___check1", - field_choice = check_define, - logfile = ""), - c("0", "1", - "0", "0", "0", "0", - "1", "1", "1", "1", - "0", NA_character_) - ) - } -) - -test_that( - "0, 1, NA all pass (numeric)", - { - test_checkbox <- c(0, 1, NA_real_) - check_define <- "check1, Guitar | check2, Lute | check3 , Harp " - expect_equal( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___check1", - field_choice = check_define, - logfile = ""), - c("0", "1", NA_character_) - ) - } -) - -test_that( - "codes and labels pass", - { - test_checkbox <- c("check1", "Guitar") - check_define <- "check1, Guitar | check2, Lute | check3 , Harp " - expect_equal( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___check1", - field_choice = check_define, - logfile = ""), - c("1", "1") - - ) - } -) -# Tests for validate_import_form_complete --------------------------- - -test_that( - "Acceptable values are properly mapped and returned.", - { - input_value <- c("Incomplete", "Unverified", "Complete", - "0", "1", "2", - NA) - expect_equal( - validate_import_form_complete(input_value, - field_name = "form_complete", - logfile = ""), - c("0", "1", "2", - "0", "1", "2", - NA) - ) - } -) - -test_that( - "codes and labels pass (second option)", - { - test_checkbox <- c("check2", "Lute") - check_define <- "check1, Guitar | check2, Lute | check3 , Harp " - expect_equal( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___check2", - field_choice = check_define, - logfile = ""), - c("1", "1") - ) - } -) - - -test_that( - "0 code or 0 label returns 0", - { - test_checkbox <- c("0") - check_define <- "0, 0 | 1, 1" - expect_equal( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___0", - field_choice = check_define, - logfile = ""), - c("0") - ) - } -) - - -test_that( - "unmapped values produce a message", - { - local_reproducible_output(width = 200) - test_checkbox <- c("check_lute") - check_define <- "check1, Guitar | check2, Lute | check3 , Harp " - expect_message( - validate_import_checkbox(test_checkbox, - field_name = "checkbox___check2", - field_choice = check_define, - logfile = ""), - "must be one of '0', '1', 'Checked', 'Unchecked', 'check2', 'Lute', ''" - ) - } -) - -test_that( - "Unacceptable values return a message", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_form_complete("Invalid", - field_name = "form_complete", - logfile = ""), - "Values[(]s[)] must be one of: 0, 1, 2, Incomplete, Unverified, or Complete." - ) - } -) - - -# validate_import_date ---------------------------------------------- - -test_that( - "Date values are converted to YYYY-mm-dd format", - { - date_test <- Sys.Date() - expect_equal( - validate_import_date(date_test, - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - format(date_test, "%Y-%m-%d") - ) - } -) - -test_that( - "POSIXct values are converted to YYYY-mm-dd format", - { - datetime_test <- Sys.time() - expect_equal( - validate_import_date(datetime_test, - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - format(datetime_test, "%Y-%m-%d") - ) - } -) - -test_that( - "ymd, ymd HMS map to YYYY-mm-dd format", - { - test_strings <- c("2023-01-01", "2023-01-02 03:04:05") - - compare_string <- seq(from = as.Date("2023-01-01"), - to = as.Date("2023-01-02"), - by = "1 day") - compare_string <- format(compare_string, - format = "%Y-%m-%d") - expect_equal( - validate_import_date(test_strings, - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "mdy, mdy HMS YYYY-mm-dd format", - { - test_strings <- c("01-01-2023", "01-02-2023 03:04:05") - - compare_string <- as.Date(c("2023-01-01", "2023-01-02")) - compare_string <- format(compare_string, - format = "%Y-%m-%d") - expect_equal( - validate_import_date(test_strings, - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "dmy, dmy HMS YYYY-mm-dd format", - { - test_strings <- c("13-01-2023", "01-01-2023 03:04:05") - - compare_string <- as.Date(c("2023-01-13", "2023-01-01")) - compare_string <- format(compare_string, - format = "%Y-%m-%d") - expect_equal( - validate_import_date(test_strings, - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "NA passes without a message", - { - expect_equal( - validate_import_date(c("2023-01-01", NA), - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - c("2023-01-01", NA) - ) - } -) - -test_that( - "Unmappable values return a message", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_date(c("2023-01-33", "not a date"), - field_name = "date", - field_min = NA, - field_max = NA, - logfile = ""), - "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format" - ) - } -) - -test_that( - "When a date is less than field_min, a message is returned", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_date(as.Date(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = as.Date("2023-02-01"), - field_max = NA, - logfile = ""), - "before the stated minimum date" - ) - } -) - -test_that( - "When a date is greater than field_max, a message is returned", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_date(as.Date(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = NA, - field_max = as.Date("2023-02-01"), - logfile = ""), - "after the stated maximum date" - ) - } -) - -# validate_import_datetime ------------------------------------------ -test_that( - "Date values are converted to YYYY-mm-dd format", - { - date_test <- Sys.Date() - expect_equal( - validate_import_datetime(date_test, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - format(date_test, "%Y-%m-%d %H:%M") - ) - } -) - -test_that( - "POSIXct values are converted to YYYY-mm-dd format", - { - datetime_test <- Sys.time() - expect_equal( - validate_import_datetime(datetime_test, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - format(datetime_test, "%Y-%m-%d %H:%M") - ) - } -) - -test_that( - "ymd, ymd HMS map to YYYY-mm-dd format", - { - test_strings <- c("2023-01-01", "2023-01-02 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-01 00:00:00", - "2023-01-02 03:04:05"), - tz = "UTC") - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M") - expect_equal( - validate_import_datetime(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "mdy, mdy HMS YYYY-mm-dd format", - { - test_strings <- c("01-01-2023", "01-02-2023 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05")) - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M") - expect_equal( - validate_import_datetime(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "dmy, dmy HMS YYYY-mm-dd format", - { - test_strings <- c("13-01-2023", "01-01-2023 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-13 00:00:00", - "2023-01-01 03:04:05"), - tz = "UTC") - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M") - expect_equal( - validate_import_datetime(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "NA passes without a message", - { - expect_equal( - validate_import_datetime(c("2023-01-01", NA), - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - c("2023-01-01 00:00", NA) - ) - } -) - -test_that( - "Unmappable values return a message", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_datetime(c("2023-01-33", "not a date"), - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format" - ) - } -) - -test_that( - "When a date is less than field_min, a message is returned", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_datetime(as.POSIXct(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = as.POSIXct("2023-02-01 00:00:00"), - field_max = NA, - logfile = ""), - "before the stated minimum date" - ) - } -) - -test_that( - "When a date is greater than field_max, a message is returned", - { - local_reproducible_output(width = 200) - expect_message( - validate_import_datetime(as.Date(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = NA, - field_max = as.POSIXct("2023-02-01"), - logfile = ""), - "after the stated maximum date" - ) - } -) - -# validate_import_datetime seconds ---------------------------------- -test_that( - "Date values are converted to YYYY-mm-dd format", - { - date_test <- Sys.Date() - expect_equal( - validate_import_datetime_seconds(date_test, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - format(date_test, "%Y-%m-%d %H:%M:%S") - ) - } -) - -test_that( - "POSIXct values are converted to YYYY-mm-dd format", - { - datetime_test <- Sys.time() - expect_equal( - validate_import_datetime_seconds(datetime_test, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - format(datetime_test, "%Y-%m-%d %H:%M:%S") - ) - } -) - -test_that( - "ymd, ymd HMS map to YYYY-mm-dd format", - { - test_strings <- c("2023-01-01", "2023-01-02 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-01 00:00:00", - "2023-01-02 03:04:05"), - tz = "UTC") - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M:%S") - expect_equal( - validate_import_datetime_seconds(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "mdy, mdy HMS YYYY-mm-dd format", - { - test_strings <- c("01-01-2023", "01-02-2023 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05")) - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M:%S") - expect_equal( - validate_import_datetime_seconds(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "dmy, dmy HMS YYYY-mm-dd format", - { - test_strings <- c("13-01-2023", "01-01-2023 03:04:05") - - compare_string <- as.POSIXct(c("2023-01-13 00:00:00", - "2023-01-01 03:04:05"), - tz = "UTC") - compare_string <- format(compare_string, - format = "%Y-%m-%d %H:%M:%S") - expect_equal( - validate_import_datetime_seconds(test_strings, - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - compare_string - ) - } -) - -test_that( - "NA passes without a message", - { - expect_equal( - validate_import_datetime_seconds(c("2023-01-01", NA), - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - c("2023-01-01 00:00:00", NA) - ) - } -) - -test_that( - "Unmappable values return a message", - { - expect_message( - validate_import_datetime_seconds(c("2023-01-33", "not a date"), - field_name = "datetime", - field_min = NA, - field_max = NA, - logfile = ""), - "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format" - ) - } -) - -test_that( - "When a date is less than field_min, a message is returned", - { - expect_message( - validate_import_datetime_seconds(as.POSIXct(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = as.POSIXct("2023-02-01 00:00:00"), - field_max = NA, - logfile = ""), - "before the stated minimum date" - ) - } -) - -test_that( - "When a date is greater than field_max, a message is returned", - { - expect_message( - validate_import_datetime_seconds(as.Date(c("2023-01-01", "2023-03-01")), - field_name = "date", - field_min = NA, - field_max = as.POSIXct("2023-02-01"), - logfile = ""), - "after the stated maximum date" - ) - } -) - -# validate_import_time ---------------------------------------------- - -test_that( - "Character forms of HH:MM and HH:MM:SS pass", - { - time_test <- c("06:15", "06:15:00") - expect_equal( - validate_import_time(time_test, - field_name = "time", - field_min = NA, - field_max = NA, - logfile = ""), - rep("06:15", 2) - ) - } -) - -test_that( - "objects of class time pass. Also, NA", - { - time_test <- chron::as.times(c("06:15:00", NA)) - expect_equal( - validate_import_time(time_test, - field_name = "time", - field_min = NA, - field_max = NA, - logfile = ""), - c("06:15", NA) - ) - } -) - -test_that( - "Times before field_min produce a message", - { - time_test <- c("06:00", "07:00", "08:00", "09:00") - expect_message( - validate_import_time(time_test, - field_name = "time", - field_min = "07:30", - field_max = NA, - logfile = ""), - "are before the stated minimum time" - ) - } -) - -test_that( - "Times after field_max produce a message", - { - time_test <- c("06:00", "07:00", "08:00", "09:00") - expect_message( - validate_import_time(time_test, - field_name = "time", - field_min = NA, - field_max = "07:30", - logfile = ""), - "are after the stated maximum time" - ) - } -) - -# validate_import_time_mm_ss ---------------------------------------- - -test_that( - "Character forms of HH:MM and HH:MM:SS pass", - { - time_test <- c("06:15", "00:06:15") - expect_equal( - validate_import_time_mm_ss(time_test, - field_name = "time", - field_min = NA, - field_max = NA, - logfile = ""), - rep("06:15", 2) - ) - } -) - -test_that( - "objects of class time pass. Also, NA", - { - time_test <- chron::as.times(c("00:06:15", NA)) - expect_equal( - validate_import_time_mm_ss(time_test, - field_name = "time", - field_min = NA, - field_max = NA, - logfile = ""), - c("06:15", NA) - ) - } -) - -test_that( - "Times before field_min produce a message", - { - local_reproducible_output(width = 200) - time_test <- c("06:00", "07:00", "08:00", "09:00") - expect_message( - validate_import_time_mm_ss(time_test, - field_name = "time", - field_min = "07:30", - field_max = NA, - logfile = ""), - "are before the stated minimum time" - ) - } -) - -test_that( - "Times after field_max produce a message", - { - local_reproducible_output(width = 200) - time_test <- c("06:00", "07:00", "08:00", "09:00") - expect_message( - validate_import_time_mm_ss(time_test, - field_name = "time", - field_min = NA, - field_max = "07:30", - logfile = ""), - "are after the stated maximum time" - ) - } -) -# validate_import_numeric ------------------------------------------- - -test_that( - "Values that can be coerced to numeric pass (including NA)", - { - test_numeric <- c("1.2", pi, NA_character_) - expect_equal( - validate_import_numeric(test_numeric, - field_name = "numeric", - field_min = NA, - field_max = NA, - logfile = ""), - c(1.2, pi, NA_real_) - ) - } -) - -test_that( - "Values that cannot be coerced to numeric produce a message", - { - local_reproducible_output(width = 200) - test_numeric <- c("a", "b", pi) - expect_message( - validate_import_numeric(test_numeric, - field_name = "numeric", - field_min = NA, - field_max = NA, - logfile = ""), - "must be numeric or coercible to numeric" - ) - } -) - -test_that( - "Values less than field_min produce a message", - { - local_reproducible_output(width = 200) - test_numeric <- 1:5 - expect_message( - validate_import_numeric(test_numeric, - field_name = "numeric", - field_min = 3, - field_max = NA, - logfile = ""), - "are less than the stated minimum" - ) - } -) - -test_that( - "Values less than field_min produce a message", - { - local_reproducible_output(width = 200) - test_numeric <- 1:5 - expect_message( - validate_import_numeric(test_numeric, - field_name = "numeric", - field_min = NA, - field_max = 3, - logfile = ""), - "are greater than the stated maximum" - ) - } -) - -# validate_import_zipcode ------------------------------------------- - -test_that( - "values in 12345, format or NA pass (from numeric)", - { - test_zip <- c(48169, NA_real_) - expect_equal( - validate_import_zipcode(test_zip, - field_name = "zip", - logfile = ""), - c("48169", NA_character_) - ) - } -) - -test_that( - "values in 12345, 12345-1234 format or NA pass (from character)", - { - test_zip <- c("48169", "48169-0133", NA_real_) - expect_equal( - validate_import_zipcode(test_zip, - field_name = "zip", - logfile = ""), - c("48169", "48169-0133", NA_real_) - ) - } -) - -test_that( - "values not in 12345 or 12345-1234 format are converted to NA (so they won't write)", - { - test_zip <- c("8169", "48169-01", "48169-abc", "zipcode") - expect_equal( - validate_import_zipcode(test_zip, - field_name = "zip", - logfile = ""), - rep(NA_character_, length(test_zip)) - ) - } -) - -test_that( - "values not in 12345 or 12345-1234 format produce a message", - { - test_zip <- c("8169", "48169-01", "48169-abc", "zipcode") - expect_message( - validate_import_zipcode(test_zip, - field_name = "zip", - logfile = ""), - "must be in the format `12345` or `12345-1234`" - ) - } -) -# validate_import_yesno --------------------------------------------- - -test_that( - "yes, no, 0, 1, and NA are accepted (character)", - { - test_yes_no <- c("no", "yes", "0", "1", "No", "Yes", "NO", "YEs", "YES", NA_character_) - expect_equal( - validate_import_yesno(test_yes_no, - field_name = "yesno", - logfile = ""), - as.character(c(0, 1, 0, 1, 0, 1, 0, 1, 1, NA_real_)) - ) - } -) - -test_that( - "0, 1, and NA are accepted (numeric)", - { - test_yes_no <- c(0, 1, NA_real_) - expect_equal( - validate_import_yesno(test_yes_no, - field_name = "yesno", - logfile = ""), - as.character(c(0, 1, NA_real_)) - ) - } -) - -test_that( - "Unacceptable values are converted to NA to prevent writing (character)", - { - expect_equal( - validate_import_yesno(c("negative", "affirmative"), - field_name = "yesno", - logfile = ""), - rep(NA_character_, 2) - ) - } -) - -test_that( - "unacceptable values produce a message (character)", - { - expect_message( - validate_import_yesno(c("negative", "affirmative"), - field_name = "yesno", - logfile = ""), - "must be one of `0`, `1`, `No`, or `Yes`" - ) - } -) - -test_that( - "Unacceptable values are converted to NA to prevent writing (numeric)", - { - expect_equal( - validate_import_yesno(c(-1, pi, 12), - field_name = "yesno", - logfile = ""), - rep(NA_character_, 3) - ) - } -) - -test_that( - "unacceptable values produce a message (numeric)", - { - expect_message( - validate_import_yesno(c(-1, pi, 12), - field_name = "yesno", - logfile = ""), - "must be one of `0`, `1`, `No`, or `Yes`" - ) - } -) - -# validate_import_truefalse ----------------------------------------- - -test_that( - "true, false, yes, no, 0, 1, and NA are accepted (character)", - { - test_true_false <- c("true", "True", "TRUE", "truE", - "false", "False", "FALSE", "falsE", - "yes", "Yes", "YES", "yeS", - "no", "No", "NO", "nO", - "0", "1", NA_character_) - expect_equal( - validate_import_truefalse(test_true_false, - field_name = "truefalse", - logfile = ""), - as.character(c(1, 1, 1, 1, - 0, 0, 0, 0, - 1, 1, 1, 1, - 0, 0, 0, 0, - 0, 1, NA_real_)) - ) - } -) - -test_that( - "0, 1, and NA are accepted (numeric)", - { - test_true_false <- c(0, 1, NA_real_) - expect_equal( - validate_import_truefalse(test_true_false, - field_name = "truefalse", - logfile = ""), - as.character(c(0, 1, NA_real_)) - ) - } -) - -test_that( - "TRUE, FALSE, and NA are accepted (logical)", - { - test_true_false <- c(TRUE, FALSE, NA) - expect_equal( - validate_import_truefalse(test_true_false, - field_name = "truefalse", - logfile = ""), - as.character(c(1, 0, NA_real_)) - ) - } -) - -test_that( - "Unacceptable values are converted to NA to prevent writing (character)", - { - expect_equal( - validate_import_truefalse(c("negative", "affirmative"), - field_name = "truefalse", - logfile = ""), - rep(NA_character_, 2) - ) - } -) - -test_that( - "unacceptable values produce a message (character)", - { - expect_message( - validate_import_truefalse(c("negative", "affirmative"), - field_name = "truefalse", - logfile = ""), - "must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`" - ) - } -) - -test_that( - "Unacceptable values are converted to NA to prevent writing (numeric)", - { - expect_equal( - validate_import_truefalse(c(-1, pi, 12), - field_name = "truefalse", - logfile = ""), - rep(NA_character_, 3) - ) - } -) - -test_that( - "unacceptable values produce a message (numeric)", - { - expect_message( - validate_import_truefalse(c(-1, pi, 12), - field_name = "truefalse", - logfile = ""), - "must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`" - ) - } -) - - -# validate_import_select_dropdown_radio ----------------------------- - -test_that( - "mapped pairings with numeric and character codes pass (also NA)", - { - test_select <- c("-1", "0", "1", "a", "abc", - "negative one", "zero", "one", "A", "ABC", - NA_character_) - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_equal( - validate_import_select_dropdown_radio(test_select, - field_name = "select", - field_choice = mapping, - logfile = ""), - c("-1", "0", "1", "a", "abc", - "-1", "0", "1", "a", "abc", - NA_character_) - ) - } -) - -test_that( - "mapped pairings with numeric and character codes pass (also NA)", - { - test_select <- c(-1, 0, 1, NA_real_) - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_equal( - validate_import_select_dropdown_radio(test_select, - field_name = "select", - field_choice = mapping, - logfile = ""), - c("-1", "0", "1",NA_character_) - ) - } -) - -test_that( - "unmapped values are converted to NA (character)", - { - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_equal( - validate_import_select_dropdown_radio(c("XYZ", "15"), - field_name = "select", - field_choice = mapping, - logfile = ""), - c(NA_character_, NA_character_) - ) - } -) - -test_that( - "unmapped values are converted to NA (numeric)", - { - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_equal( - validate_import_select_dropdown_radio(c(pi, 10), - field_name = "select", - field_choice = mapping, - logfile = ""), - c(NA_character_, NA_character_) - ) - } -) - -test_that( - "unmapped values produce a message (character)", - { - local_reproducible_output(width = 200) - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_message( - validate_import_select_dropdown_radio(c("XYZ", "15"), - field_name = "select", - field_choice = mapping, - logfile = ""), - "must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'" - ) - } -) - -test_that( - "unmapped values produce a message (numeric)", - { - local_reproducible_output(width = 200) - mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC" - expect_message( - validate_import_select_dropdown_radio(c(pi, 10), - field_name = "select", - field_choice = mapping, - logfile = ""), - "must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'" - ) - } -) - -# validate_import_email --------------------------------------------- - -test_that( - "common email addresses pass", - { - email <- c("somebody@domain.net", - "some.body1@domain.org", - "345somebody789@domain.net", - "somebody-else@domain.com", - "salesperson@dash-company.biz", - "percy_jackson@camp-half-blood.edu", - "someone+spam@domain.widget", - "high%shooting@sports.ball", - NA_character_) - expect_equal( - validate_import_email(email, - field_name = "email", - logfile = ""), - email - ) - } -) - -test_that( - "Invalid e-mails are changed to NA", - { - email <- c("Im@work@nowhere.net", - "no-suffix@junkmail", - "one-length-suffix@email.g", - "long-suffix@email.sunburst") - expect_equal( - validate_import_email(email, - field_name = "email", - logfile = ""), - rep(NA_character_, length(email)) - ) - } -) - -test_that( - "Invalid e-mails are changed to NA", - { - email <- c("Im@work@nowhere.net", - "no-suffix@junkmail", - "one-length-suffix@email.g", - "long-suffix@email.sunburst") - expect_message( - validate_import_email(email, - field_name = "email", - logfile = ""), - "are not valid e-mail addresses" - ) - } -) - -# validate_import_phone --------------------------------------------- - -test_that( - "valid phone numbers pass (including NA)", - { - phone_punct <- c("(207) 555-1234", - "207.555.1234", - "207-555-1234", - "207 555 1234") - # to test all valid phone numbers would be overly tedious. - # we'll just a sample. Change n_size to match your desired rigor - n_size <- 10 - phone_random <- sprintf("%s%s%s %s%s%s %s%s%s%s", - sample(2:9, n_size, replace = TRUE), - sample(0:8, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(2:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE), - sample(0:9, n_size, replace = TRUE)) - test_phone <- c(phone_punct, phone_random, NA_character_) - - expect_equal( - validate_import_phone(test_phone, - field_name = "phone", - logfile = ""), - gsub("[[:punct:][:space:]]", "", test_phone) - ) - } -) - -test_that( - "phone numbers of more than 10 digits become NA", - { - expect_equal( - validate_import_phone(c("555-555-5555-5", - "555-555-5555-5555"), - field_name = "phone", - logfile = ""), - c(NA_character_, NA_character_) - ) - } -) - -test_that( - "phone numbers of more than 10 digits produce a message", - { - expect_message( - validate_import_phone(c("555-555-5555-5", - "555-555-5555-5555"), - field_name = "phone", - logfile = ""), - "are not 10 digit phone numbers" - ) - } -) - -test_that( - "phone numbers with invalid format become NA", - { - # The fives are valid digits. The non-five digits - # are placed where those values are not allowed - expect_equal( - validate_import_phone(c("055-555-5555", - "155-555-5555", - "595-555-5555", - "555-155-5555"), - field_name = "phone", - logfile = ""), - c(NA_character_, NA_character_, NA_character_, NA_character_) - ) - } -) - -test_that( - "phone numbers with invalid format produce a message", - { - expect_message( - validate_import_phone(c("055-555-5555", - "155-555-5555", - "595-555-5555", - "555-155-5555"), - field_name = "phone", - logfile = ""), - "are not valid North American phone numbers" - ) - } -)