diff --git a/NEWS.md b/NEWS.md index 52f685af..c2b0d935 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # redcapAPI (development version) +* Fixed bug in pulling batched data that has zero padded record ids. #521 + # redcapAPI 2.12.0 ## Breaking changes diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 7527f8f6..35beb5d0 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -693,7 +693,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, body=body, response=as.character(record_response)) - records <- as.data.frame(record_response, sep = csv_delimiter) + records <- as.data.frame(record_response, sep = csv_delimiter, colClasses='character') if (nrow(records) == 0) { diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index c3f3023e..071f850f 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -679,6 +679,8 @@ mChoiceCast <- function(data, field_types[field_types == "text" & grepl("BIOPORTAL", choices, ignore.case = TRUE)] <- "bioportal" + field_types[field_bases == rcon$metadata()$field_name[1]] <- "text" + field_types } diff --git a/R/validateImport.R b/R/validateImport.R index cb2e3994..209ba7b2 100644 --- a/R/validateImport.R +++ b/R/validateImport.R @@ -1,117 +1,118 @@ #' @name validateImport -#' +#' #' @title Validate Data Frames for Import -#' @description Validates the variables in a data frame prior to attempting +#' @description Validates the variables in a data frame prior to attempting #' an import to REDCap -#' +#' #' @param data `data.frame` being prepared for import to REDCap. #' @param meta_data REDCap database meta data. -#' @param logfile A character string giving the filepath to which the -#' results of the validation are printed. If `""`, the results +#' @param logfile A character string giving the filepath to which the +#' results of the validation are printed. If `""`, the results #' are printed in the console. -#' +#' #' @details -#' `validateImport` is called internally by `importRecords` and is +#' `validateImport` is called internally by `importRecords` and is #' not available to the user. -#' -#' Each variable is validated by matching they type of variable with the type -#' listed in the REDCap database. -#' -#' Although the log messages will indicate a preference for dates to be in -#' mm/dd/yyyy format, the function will accept mm/dd/yy, yyyy-mm-dd, -#' yyyy/mm/dd, and yyyymmdd formats as well. When possible, pass dates as -#' Date objects or POSIXct objects to avoid confusion. Dates are also compared -#' to minimum and maximum values listed in the data dictionary. Records where -#' a date is found out of range are allowed to import and a message +#' +#' Each variable is validated by matching they type of variable with the type +#' listed in the REDCap database. +#' +#' Although the log messages will indicate a preference for dates to be in +#' mm/dd/yyyy format, the function will accept mm/dd/yy, yyyy-mm-dd, +#' yyyy/mm/dd, and yyyymmdd formats as well. When possible, pass dates as +#' Date objects or POSIXct objects to avoid confusion. Dates are also compared +#' to minimum and maximum values listed in the data dictionary. Records where +#' a date is found out of range are allowed to import and a message #' is printed in the log. -#' -#' For continuous/numeric variables, the values are checked against the -#' minimum and maximum allowed in the data dictionary. Records where a value -#' is found out of range are allowed to import and a message is printed +#' +#' For continuous/numeric variables, the values are checked against the +#' minimum and maximum allowed in the data dictionary. Records where a value +#' is found out of range are allowed to import and a message is printed #' in the log. -#' -#' ZIP codes are tested to see if they fit either the five digit or -#' five digit + four format. When these conditions are not met, the data point is +#' +#' ZIP codes are tested to see if they fit either the five digit or +#' five digit + four format. When these conditions are not met, the data point is #' deleted and a message printed in the log. -#' -#' YesNo fields permit any of the values 'yes', 'no', '0', '1' to be imported -#' to REDCap with 0=No, and 1=Yes. The values are converted to lower case -#' for validation, so any combination of lower and upper case values +#' +#' YesNo fields permit any of the values 'yes', 'no', '0', '1' to be imported +#' to REDCap with 0=No, and 1=Yes. The values are converted to lower case +#' for validation, so any combination of lower and upper case values #' will pass (ie, the data frame is not case-sensitive). -#' -#' TrueFalse fields will accept 'TRUE', 'FALSE', 0, 1, and logical values +#' +#' TrueFalse fields will accept 'TRUE', 'FALSE', 0, 1, and logical values #' and are also not case-sensitive. -#' -#' Radio and dropdown fields may have either the coding in the data -#' dictionary or the labels in the data dictionary. The validation will use -#' the meta data to convert any matching values to the appropriate coding -#' before importing to REDCap. Values that cannot be reconciled are +#' +#' Radio and dropdown fields may have either the coding in the data +#' dictionary or the labels in the data dictionary. The validation will use +#' the meta data to convert any matching values to the appropriate coding +#' before importing to REDCap. Values that cannot be reconciled are #' deleted with a message printed in the log. These variables #' are not case-sensitive. -#' -#' Checkbox fields require a value of "Checked", "Unchecked", "0", or "1". -#' These are currently case-sensitive. Values that do not match these are +#' +#' Checkbox fields require a value of "Checked", "Unchecked", "0", or "1". +#' These are currently case-sensitive. Values that do not match these are #' deleted with a warning printed in the log. -#' -#' Phone numbers are required to be ten digit numbers. The phone number is -#' broken into three parts: 1) a three digit area code, 2) a three digit exchange code, -#' and 3) a four digit station code. The exchange code must start with a number -#' from 2-9, followed by 0-8, and then any third digit. -#' The exchange code starts with a number from 2-9, followed by any two +#' +#' Phone numbers are required to be ten digit numbers. The phone number is +#' broken into three parts: 1) a three digit area code, 2) a three digit exchange code, +#' and 3) a four digit station code. The exchange code must start with a number +#' from 2-9, followed by 0-8, and then any third digit. +#' The exchange code starts with a number from 2-9, followed by any two #' digits. The station code is four digits with no restrictions. -#' -#' E-mail addresses are considered valid when they have three parts. The first -#' part comes before the @@ symbol, and may be number of characters from +#' +#' E-mail addresses are considered valid when they have three parts. The first +#' part comes before the @@ symbol, and may be number of characters from #' a-z, A-Z, a period, underscore, percent, plus, or minus. The second part -#' comes after the @@, but before the period, and may consist of any -#' number of letters, numbers, periods, or dashes. Finally, the string ends +#' comes after the @@, but before the period, and may consist of any +#' number of letters, numbers, periods, or dashes. Finally, the string ends #' with a period then anywhere from two to six letters. -#' +#' validateImport <- function(data, meta_data, logfile = "") { coll <- checkmate::makeAssertCollection() - + # Validating e-mail addresses taken from # \url{https://www.regular-expressions.info/email.html} - + checkmate::assert_data_frame(x = data, add = coll) - + checkmate::assert_data_frame(x = meta_data, add = coll) - + checkmate::assert_character(x = logfile, len = 1, add = coll) - + checkmate::reportAssertions(coll) - + for (i in seq_along(data)) { field_name <- names(data)[i] - field_meta <- sub(pattern = "___[a-z,A-Z,0-9,_]+", - replacement = "", + field_meta <- sub(pattern = "___[a-z,A-Z,0-9,_]+", + replacement = "", x = field_name) meta_index <- which(meta_data$field_name == field_meta) field_type <- meta_data[meta_index, "field_type"] - - if (length(field_type)){ + + if (length(field_type) && field_name != meta_data$field_name[1]) + { if (field_type == "text" && - !is.na(meta_data[meta_index, + !is.na(meta_data[meta_index, "text_validation_type_or_show_slider_number"])){ - field_type <- meta_data[meta_index, + field_type <- meta_data[meta_index, "text_validation_type_or_show_slider_number"] } } - + field_min <- meta_data[meta_index, "text_validation_min"] field_max <- meta_data[meta_index, "text_validation_max"] - + field_choice <- meta_data[meta_index, "select_choices_or_calculations"] - + if (!length(field_type)) { if (grepl("complete$", field_name)) @@ -123,163 +124,163 @@ validateImport <- function(data, meta_data, logfile = "") field_type <- "redcap_internal_type" } } - + if (field_type %in% c("float", "integer", "number")) field_type <- "numeric" - - data[[field_name]] <- + + data[[field_name]] <- switch( EXPR = field_type, "redcap_internal_type" = data[[field_name]], - "form_complete" = + "form_complete" = validate_import_form_complete(x = data[[field_name]], field_name = field_name, logfile = logfile), - "date_dmy" = + "date_dmy" = validate_import_date(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "date_mdy" = + "date_mdy" = validate_import_date(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "date_ymd" = + "date_ymd" = validate_import_date(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_dmy" = + "datetime_dmy" = validate_import_datetime(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_mdy" = + "datetime_mdy" = validate_import_datetime(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_ymd" = + "datetime_ymd" = validate_import_datetime(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_seconds_dmy" = + "datetime_seconds_dmy" = validate_import_datetime_seconds(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_seconds_mdy" = + "datetime_seconds_mdy" = validate_import_datetime_seconds(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "datetime_seconds_ymd" = + "datetime_seconds_ymd" = validate_import_datetime_seconds(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "time" = + "time" = validate_import_time(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "time_mm_ss" = + "time_mm_ss" = validate_import_time_mm_ss(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "numeric" = + "numeric" = validate_import_numeric(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, logfile = logfile), - "zipcode" = + "zipcode" = validate_import_zipcode(x = data[[field_name]], field_name = field_name, logfile = logfile), - "yesno" = + "yesno" = validate_import_yesno(x = data[[field_name]], field_name = field_name, logfile = logfile), - "truefalse" = + "truefalse" = validate_import_truefalse(x = data[[field_name]], field_name = field_name, logfile = logfile), - "select" = + "select" = validate_import_select_dropdown_radio(x = data[[field_name]], field_name = field_name, field_choice = field_choice, logfile = logfile), - "dropdown" = + "dropdown" = validate_import_select_dropdown_radio(x = data[[field_name]], field_name = field_name, field_choice = field_choice, logfile = logfile), - "radio" = + "radio" = validate_import_select_dropdown_radio(x = data[[field_name]], field_name = field_name, field_choice = field_choice, logfile = logfile), - "checkbox" = + "checkbox" = validate_import_checkbox(x = data[[field_name]], field_name = field_name, field_choice = field_choice, logfile), - "email" = + "email" = validate_import_email(x = data[[field_name]], field_name = field_name, logfile = logfile), - "phone" = + "phone" = validate_import_phone(x = data[[field_name]], field_name = field_name, logfile = logfile), - "number_1dp" = + "number_1dp" = validate_import_ndp(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, - logfile = logfile, - ndp = 1), - "number_2dp" = + logfile = logfile, + ndp = 1), + "number_2dp" = validate_import_ndp(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, - logfile = logfile, - ndp = 2), - "number_1dp_comma_decimal" = + logfile = logfile, + ndp = 2), + "number_1dp_comma_decimal" = validate_import_ndp(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, - logfile = logfile, - ndp = 1, - comma = TRUE), - "number_2dp_comma_decimal" = + logfile = logfile, + ndp = 1, + comma = TRUE), + "number_2dp_comma_decimal" = validate_import_ndp(x = data[[field_name]], field_name = field_name, field_min = field_min, field_max = field_max, - logfile = logfile, + logfile = logfile, ndp = 2, - comma = TRUE), + comma = TRUE), data[[field_name]] ) } - + invisible(data) } diff --git a/tests/testthat/test-259-zeroPaddedId.R b/tests/testthat/test-259-zeroPaddedId.R new file mode 100644 index 00000000..2dd070ae --- /dev/null +++ b/tests/testthat/test-259-zeroPaddedId.R @@ -0,0 +1,56 @@ +purgeProject(rcon, records=TRUE) +load(file.path(test_path("testdata"), + "test_redcapAPI_MetaData.Rdata")) +load(file.path(test_path("testdata"), + "test_redcapAPI_Data.Rdata")) +load(file.path(test_path("testdata"), + "test_redcapAPI_Arms.Rdata")) +load(file.path(test_path("testdata"), + "test_redcapAPI_Events.Rdata")) + +forms <- c("record_id", "text_fields") +MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$form_name %in% forms, ] + +MetaData$field_name[1] <- "zero_padded_id" +MetaData$text_validation_type_or_show_slider_number[1] <- "integer" + +importMetaData(rcon, MetaData) +importArms(rcon, test_redcapAPI_Arms) +importEvents(rcon, test_redcapAPI_Events) +importProjectInformation(rcon, + data.frame(is_longitudinal = 1, + record_autonumbering_enabled = 0)) + +Mappings <- data.frame(arm_num = rep(1, length(forms)), + unique_event_name = rep("event_1_arm_1", length(forms)), + form = forms) +importMappings(rcon, Mappings) + + +names(test_redcapAPI_Data)[1] <- "zero_padded_id" +ImportData <- test_redcapAPI_Data[names(test_redcapAPI_Data) %in% MetaData$field_name] +ImportData <- ImportData[!is.na(ImportData$email_test), ] +ImportData$zero_padded_id <- sprintf("%06d", 1:nrow(ImportData)) + + +test_that("cast preserves zeropadded id",{ + + # castForImport only needed until 3.0.0 + castImport <- castForImport(ImportData, + rcon, + validation = list(bioportal = valSkip), + cast = list(number_1dp = as.numeric, + number_2dp = as.numeric, + number_1dp_comma_decimal = as.numeric, + number_2dp_comma_decimal = as.numeric, + bioportal = as.character)) + expect_equal(ImportData$zero_padded_id, castImport$zero_padded_id) +}) + +test_that("zeropadded id makes a round trip",{ + importRecords(rcon, ImportData) + x <- exportRecordsTyped(rcon) + expect_equal(ImportData$zero_padded_id, sort(as.vector(x$zero_padded_id))) +}) + +