Working on #7. Appears to be a functioning patch

NEEDS UNIT TESTS!!!
This commit is contained in:
pegeler 2018-06-23 02:04:26 -04:00
parent ef4819e1fc
commit 4f2974701c
4 changed files with 4217 additions and 6 deletions

View File

@ -174,11 +174,24 @@ REDCap_split <- function(records, metadata) {
subtables <- unique(records$redcap_repeat_instrument)
subtables <- subtables[subtables != ""]
# Variables to be at the beginning of each repeating instrument
repeat_instrument_fields <- c(
vars_in_data[1:3],
grep("redcap_repeat_instrument\\.factor", vars_in_data, value = TRUE)
# Variables to be present in each output table
universal_fields <- c(
vars_in_data[1],
grep(
"^redcap_(?!(repeat)).*",
vars_in_data,
value = TRUE,
perl = TRUE
)
)
# Variables to be at the beginning of each repeating instrument
repeat_instrument_fields <- grep(
"^redcap_repeat.*",
vars_in_data,
value = TRUE
)
# Split the table based on instrument
out <- split.data.frame(records, records$redcap_repeat_instrument)
@ -188,12 +201,23 @@ REDCap_split <- function(records, metadata) {
if (i == "") {
out_fields <- which(vars_in_data %in% fields[!fields[,2] %in% subtables, 1])
out_fields <- which(
vars_in_data %in% c(
universal_fields,
fields[!fields[,2] %in% subtables, 1]
)
)
out[[which(names(out) == "")]] <- out[[which(names(out) == "")]][out_fields]
} else {
out_fields <- which(vars_in_data %in% c(repeat_instrument_fields, fields[fields[,2] == i, 1]))
out_fields <- which(
vars_in_data %in% c(
universal_fields,
repeat_instrument_fields,
fields[fields[,2] == i, 1]
)
)
out[[i]] <- out[[i]][out_fields]
}

View File

@ -0,0 +1,11 @@
record_id,redcap_event_name,redcap_repeat_instrument,redcap_repeat_instance,redcap_data_access_group,redcap_survey_identifier,informed_consent_and_addendum_timestamp,icf_first_name,icf_last_name,icf_date,icf_sign,icf_consenter_name,icf_consentee_info,icf_consentee_sign,icf_consentee_date,informed_consent_and_addendum_complete,signed_consent_1,signed_consent_2,signed_consent_3,signed_addendum1,signed_addendum2,signed_addendum3,upload_of_signed_icfs_complete,demo_date,demo_name_first,demo_name_init,demo_name_last,demo_date_birth,demo_street_ad,demo_city_ad,demo_state_ad,demo_zip,demo_daytime,demo_email,demo_ethnic,demo_racial,demo_racial_oth,demo_military_mrn,demo_ssn,demographics_complete,elig_icf,elig_ischem,elig_signs___1,elig_signs___2,elig_signs___3,elig_signs___4,elig_card_cath,elig_card_cath_details,elig_cath_disease_severity,elig_cath_vessel,elig_ejection_fraction,elig_cath_ffr,elig_ccta,elig_card_cath_details_2,elig_cath_disease_severity_2,elig_ejection_fraction_2,elig_cta_score,elig_nocom_med,elig_ischemia_dilated,elig_doc_acs,elig_lvef,elig_nyha_class,elig_hos_hfref,elig_stroke,elig_carnial_hemo,elig_renal,elig_valvular,elig_life_expect,elig_enroll_clinic,elig_intol_ace,elig_intol_arb,elig_intol_statin,elig_intol_pcsk,elig_preg,elig_liver_dis,elig_hist_rhab,elig_high_dose,elig_study_yes,elig_date,elig_study_no,eligibility_complete
806-1,baseline_arm_1,,,uf_test,,,,,,,,,,,,[document],,,[document],,,2,2018-05-08,Philip,B,Chase,1964-04-09,"5959 NW 13th Ave",Gainesville,FL,32605,"(352) 555-0760",bobsyouruncle@example.org,2,5,,2,111-22-3333,2,1,1,1,0,0,0,1,1,,,60,1,1,1,,60,24,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,,0,0,0,0,1,2018-05-08,,2
806-1,followup_month_3_arm_1,,,uf_test,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-1,baseline_arm_1,informed_consent,1,uf_test,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-1,baseline_arm_1,informed_consent_and_addendum,1,uf_test,,"2018-05-08 21:15:12",Philip,Chase,2018-05-08,[document],"Philip B Chase",UF,[document],2018-05-08,2,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-1,baseline_arm_1,informed_consent_and_addendum,2,uf_test,,,Bobs,Youruncle,2018-06-21,[document],"Yo Mama","Anywhere she wants",[document],2018-06-21,2,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-1,baseline_arm_1,informed_consent_and_addendum,3,uf_test,,,Bobs,Youruncle,2018-06-21,[document],zsdf,DF,[document],2018-06-21,2,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-2,baseline_arm_1,,,uf_test,,,,,,,,,,,,[document],,,[document],,,2,2018-05-08,afadgs,afd,afdsgfd,1977-06-26,24325543,2352453,fwef,32601,"(352) 294-5299",,2,89,,,123-45-6789,2,1,1,0,1,0,0,0,,,,,,0,,,,,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,,0,0,0,0,1,2018-05-08,,2
806-2,followup_month_3_arm_1,,,uf_test,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-2,baseline_arm_1,informed_consent,1,uf_test,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
806-2,baseline_arm_1,informed_consent_and_addendum,1,uf_test,,"2018-05-08 21:02:39",test,test,2018-05-08,[document],taryn,stoffs,[document],2018-05-08,2,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
1 record_id redcap_event_name redcap_repeat_instrument redcap_repeat_instance redcap_data_access_group redcap_survey_identifier informed_consent_and_addendum_timestamp icf_first_name icf_last_name icf_date icf_sign icf_consenter_name icf_consentee_info icf_consentee_sign icf_consentee_date informed_consent_and_addendum_complete signed_consent_1 signed_consent_2 signed_consent_3 signed_addendum1 signed_addendum2 signed_addendum3 upload_of_signed_icfs_complete demo_date demo_name_first demo_name_init demo_name_last demo_date_birth demo_street_ad demo_city_ad demo_state_ad demo_zip demo_daytime demo_email demo_ethnic demo_racial demo_racial_oth demo_military_mrn demo_ssn demographics_complete elig_icf elig_ischem elig_signs___1 elig_signs___2 elig_signs___3 elig_signs___4 elig_card_cath elig_card_cath_details elig_cath_disease_severity elig_cath_vessel elig_ejection_fraction elig_cath_ffr elig_ccta elig_card_cath_details_2 elig_cath_disease_severity_2 elig_ejection_fraction_2 elig_cta_score elig_nocom_med elig_ischemia_dilated elig_doc_acs elig_lvef elig_nyha_class elig_hos_hfref elig_stroke elig_carnial_hemo elig_renal elig_valvular elig_life_expect elig_enroll_clinic elig_intol_ace elig_intol_arb elig_intol_statin elig_intol_pcsk elig_preg elig_liver_dis elig_hist_rhab elig_high_dose elig_study_yes elig_date elig_study_no eligibility_complete
2 806-1 baseline_arm_1 uf_test [document] [document] 2 2018-05-08 Philip B Chase 1964-04-09 5959 NW 13th Ave Gainesville FL 32605 (352) 555-0760 bobsyouruncle@example.org 2 5 2 111-22-3333 2 1 1 1 0 0 0 1 1 60 1 1 1 60 24 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 2018-05-08 2
3 806-1 followup_month_3_arm_1 uf_test
4 806-1 baseline_arm_1 informed_consent 1 uf_test
5 806-1 baseline_arm_1 informed_consent_and_addendum 1 uf_test 2018-05-08 21:15:12 Philip Chase 2018-05-08 [document] Philip B Chase UF [document] 2018-05-08 2
6 806-1 baseline_arm_1 informed_consent_and_addendum 2 uf_test Bobs Youruncle 2018-06-21 [document] Yo Mama Anywhere she wants [document] 2018-06-21 2
7 806-1 baseline_arm_1 informed_consent_and_addendum 3 uf_test Bobs Youruncle 2018-06-21 [document] zsdf DF [document] 2018-06-21 2
8 806-2 baseline_arm_1 uf_test [document] [document] 2 2018-05-08 afadgs afd afdsgfd 1977-06-26 24325543 2352453 fwef 32601 (352) 294-5299 2 89 123-45-6789 2 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 2018-05-08 2
9 806-2 followup_month_3_arm_1 uf_test
10 806-2 baseline_arm_1 informed_consent 1 uf_test
11 806-2 baseline_arm_1 informed_consent_and_addendum 1 uf_test 2018-05-08 21:02:39 test test 2018-05-08 [document] taryn stoffs [document] 2018-05-08 2

View File

@ -0,0 +1,61 @@
# Installing the latest REDCapRITS from GitHub ------------------------------
#devtools::install_github("SpectrumHealthResearch/REDCapRITS/R@s3methods")
devtools::install_github("SpectrumHealthResearch/REDCapRITS/R@longitudinal-data")
# Debugging reading in longitudinal datasets ------------------------------
# Reading in the files
file_paths <- file.path(
"../test-data/test_splitr/",
c(
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"
)
)
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)
names(redcap) <- c("records", "metadata")
str(redcap)
# A bunch of blank rows
redcap[["metadata"]] <- redcap[["metadata"]][as.logical(nchar(redcap[["metadata"]][,1])),]
str(redcap, 1)
setdiff(redcap[["metadata"]][,1], names(redcap[["records"]]))
# Viewing the files
View(redcap[["records"]])
View(redcap[["metadata"]])
# Playing with the names --------------------------------------------------
vars_in_data <- names(redcap$records)
universal_fields <- c(
vars_in_data[1],
grep("^redcap_(?!(repeat)).*", vars_in_data, value = TRUE, perl = TRUE)
)
repeat_instrument_fields <- grep("^redcap_repeat.*", vars_in_data, value = TRUE)
# Give it a shot ----------------------------------------------------------
testCheck <- with(redcap, REDCap_split(records, metadata))
lapply(testCheck, names)
commonFields <- Reduce(intersect, lapply(testCheck, names))
commonFields
library(dplyr)
lapply(testCheck, glimpse) %>% invisible
testCheck[[1]] %>%
left_join(testCheck$informed_consent, by = commonFields) %>%
glimpse