transfer from old repo
This commit is contained in:
parent
cfa4a5f9cc
commit
277e2b8cf3
1111 changed files with 83736 additions and 0 deletions
306
REDCap/convert_redcap.R
Normal file
306
REDCap/convert_redcap.R
Normal file
|
|
@ -0,0 +1,306 @@
|
|||
## This approach is based on a folder with several data files to upload to an empty data base
|
||||
|
||||
## Bulk conversion of stata files to CSV
|
||||
library(haven)
|
||||
library(dplyr)
|
||||
|
||||
|
||||
## Export output files??
|
||||
exp_out=TRUE
|
||||
id_data=c("record_id","cpr","rtreat", "rdate", "talos_inkl03x") # Data from keyfile is all marked as identifier
|
||||
auto_upload=FALSE
|
||||
|
||||
## Loading filenames
|
||||
setwd("/Volumes/Data/")
|
||||
files<-list.files("/Volumes/Data/STATA13/.", pattern="*.dta", full.names=FALSE)
|
||||
|
||||
## Loading randomisation key file, keeping only necessary variables,
|
||||
## renaming rnumb to record_id
|
||||
key<-read_dta("/Volumes/Data/STATA13/inkl_rev_v13.dta") %>%
|
||||
as_factor() %>%
|
||||
filter(rnumb!="999") %>%
|
||||
select(cpr,rnumb) %>% # This leads to wrong order, and is mitigated later, but kept here to ensure generalisability in script
|
||||
rename(record_id=rnumb)
|
||||
|
||||
# "rnumb","rtreat","rdate"
|
||||
|
||||
## Excluding undesired datasets
|
||||
## DAP, logfile, randomisation log, randomisation key
|
||||
## These will be kept and uploaded separately
|
||||
files<-files[!grepl("dap",files)&
|
||||
!grepl("transactions",files)&
|
||||
!grepl("rand",files)]
|
||||
|
||||
## Get "first name" from all files
|
||||
fnames<-sapply(strsplit(files, "[_]"),"[[",1) # Just discovered the subset functions "[" and "[[". Wow!
|
||||
|
||||
## Loading data sets to list
|
||||
ls<-list()
|
||||
for (i in 1:length(files)){
|
||||
## Get dataset, factorise labels,
|
||||
## join with key-file, drop cpr and remove NA's
|
||||
d<-left_join(key,
|
||||
as_factor(read_dta(paste0("STATA13/",files[i]))),by="cpr") %>%
|
||||
# select(.,!"cpr") %>%
|
||||
filter(.,!is.na(SYS_SITE)) ## SYS_DATA is in all sets, but fmed, uses SYS_SITE
|
||||
d<-data.frame(d)
|
||||
|
||||
## Append dataframe to list
|
||||
ls[[i]]<-d
|
||||
names(ls)[i]<-fnames[i]
|
||||
|
||||
## Export original data frame
|
||||
if (exp_out){
|
||||
write.csv(d,paste0("REDCap/orig/",fnames[i],".csv"),row.names = FALSE)
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
## DAP variables to include, incl record_id
|
||||
dap_vars<-c("record_id","cpr","hojde","vaegt","vaegt_anslaaet","rygning","alkohol","civil",
|
||||
"bolig","diabetes","hyperten","perifer_arteriel","atriefli","ami",
|
||||
"tidl_tci","trombolyse","trombektomi","nhiss_foer")
|
||||
|
||||
# ## Importing and subsetting DAP-data- All in one style
|
||||
|
||||
dap_d<-read_dta("STATA13/dap_rapport_2017.dta") %>% ## Loading file with correct name
|
||||
filter(!duplicated(cpr))%>% ## Limiting to first event
|
||||
right_join(key,by="cpr")%>% ## Join with key for record_id's, to only keep entries also in key
|
||||
select(all_of(dap_vars)) ## Select only specified variables, leaving out cpr's
|
||||
|
||||
ls[[length(ls)+1]]<-dap_d
|
||||
names(ls)[length(ls)]<-"reg"
|
||||
|
||||
###### Alternative DAP read - HOW FUCKED AM I??
|
||||
######
|
||||
######
|
||||
######
|
||||
######
|
||||
|
||||
clin <- dplyr::left_join(ls$basis,key) |> tibble::as_tibble()
|
||||
|
||||
|
||||
dap_d<-read_dta("STATA13/dap_rapport_2017.dta") %>% ## Loading file with correct name
|
||||
dplyr::filter(cpr %in% clin$cpr) |>
|
||||
dplyr::left_join(dplyr::select(clin,cpr,TALOS_basis01a)) |>
|
||||
dplyr::mutate(difftime=abs(difftime(TALOS_basis01a,akutdato)))
|
||||
|
||||
dap_ls <- split(dap_d,dap_d$cpr) |>
|
||||
purrr::map(\(.x){
|
||||
.x |> dplyr::mutate(instance.i=dplyr::row_number()) |>
|
||||
dplyr::filter(difftime==min(difftime))
|
||||
})
|
||||
|
||||
dap_ls |> dplyr::bind_rows() |>
|
||||
dplyr::select(instance.i) |>
|
||||
summary()
|
||||
|
||||
## Looks like all instances are actually the first in DAP. Whoop whoop! Relief!
|
||||
|
||||
######
|
||||
######
|
||||
######
|
||||
######
|
||||
|
||||
## Exporting attributes
|
||||
for (i in 1:length(ls)) {
|
||||
## Lists all attributes for export
|
||||
l <- lapply(ls[[i]], attr, "label")
|
||||
|
||||
for (j in 1:length(l)){
|
||||
l[[j]]<-ifelse(is.null(l[[j]]),"No attr",l[[j]])
|
||||
}
|
||||
|
||||
la<-data.frame(names=names(l),attr=unlist(l))
|
||||
|
||||
## Export individual attribute files for data overview
|
||||
if (exp_out){
|
||||
write.csv(la,paste0("/Users/au301842/PAaSO/REDCap/attr/attr_",fnames[i],".csv"),row.names = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
## Naming and splitting in unique instruments for DataDictionary creation and data upload
|
||||
|
||||
## Leave inklusion file, adverse events and other medication.
|
||||
## These are not needed for upload or will be uploaded seperately
|
||||
|
||||
r_sel<-!grepl("^(ae|medicin)",names(ls))
|
||||
|
||||
# Selecting elements in list
|
||||
r_ls<-"["(ls,r_sel)
|
||||
|
||||
# New list for wrangling to rename variables and splitting by instance
|
||||
r_lup<-list()
|
||||
|
||||
for (i in 1:length(r_ls)){
|
||||
## Suffix generic variable names
|
||||
d<-r_ls[[i]]
|
||||
name<-names(r_ls)[[i]]
|
||||
dn<-!(grepl(name,colnames(d))|colnames(d)%in%id_data)## Test colnames that does not contain instrument name
|
||||
|
||||
colnames(d)[dn]<-paste0(name,"_",colnames(d)[dn]) ## Adds suffix to colnames to ensure unique names
|
||||
# First entry is omitted, as this is the record_id
|
||||
|
||||
## Test for if conditions
|
||||
## Uses redundant double if, as else wasn't consistent
|
||||
test<-grepl("INSTANCE",colnames(d),ignore.case = T )
|
||||
|
||||
if (any(test)){
|
||||
d[,test]<-factor(d[,test]) # Factorise to secure ordering
|
||||
ins<-levels(d[,test]) # Instance numbers drawn from factor levels
|
||||
|
||||
ds<-split(d[,!test] ,d[,test]) # Splits by instance and drops instance variable
|
||||
names(ds)<-paste0(name,"_",ins) # Names frames by instrument, appends instance
|
||||
for (j in 1:length(ds)){
|
||||
colnames(ds[[j]])[!colnames(ds[[j]])%in%id_data]<-paste0(colnames(ds[[j]])[!colnames(ds[[j]])%in%id_data],"_",ins[j])
|
||||
## Append instance number
|
||||
}
|
||||
|
||||
r_lup<-append(r_lup,ds)
|
||||
}
|
||||
|
||||
if (!any(test)) {
|
||||
r_lup[[length(r_lup)+1]]<-d
|
||||
names(r_lup)[length(r_lup)]<-name
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
## Load REDCap instrument example file for variable names
|
||||
icname<-colnames(read.csv("/Volumes/Data/REDCap/examples/examlpe instrument.csv"))
|
||||
dd<-data.frame(matrix(ncol = length(icname))) ## Data frame to collect all
|
||||
colnames(dd)<-icname
|
||||
|
||||
## Instrument for DataDictionary
|
||||
## Format dataset for REDCap upload
|
||||
|
||||
for (i in 1:length(r_lup)){
|
||||
dd_i<-data.frame(matrix(ncol = length(icname),nrow = ncol("[["(r_lup,i)))) ## Data frame to collect all
|
||||
|
||||
colnames(dd_i)<-icname ## for easier reading
|
||||
|
||||
## Variable names
|
||||
dd_i[1]<-colnames("[["(r_lup,i))
|
||||
|
||||
## Form Name
|
||||
dd_i[2]<-names(r_lup)[i]
|
||||
|
||||
## Field Type
|
||||
# dd_i[4]<-ifelse(sapply(r_lup[[i]], class)=="factor","radio","text")
|
||||
dd_i[4]<-"text"
|
||||
|
||||
## Field Label
|
||||
## Using original attributes as field labels
|
||||
fl<-lapply(r_lup[[i]], attr, "label")
|
||||
for (j in 1:length(fl)){
|
||||
fl[[j]]<-ifelse(is.null(fl[[j]]),
|
||||
names(fl)[[j]],
|
||||
fl[[j]])
|
||||
## If no attributes, variable name is used as "placeholder"
|
||||
}
|
||||
dd_i[5]<-unlist(fl)
|
||||
|
||||
## Choices
|
||||
# for (j in 1:ncol(r_lup[[i]])){
|
||||
# if (is.factor(r_lup[[i]][[j]])){
|
||||
# lvl<-levels(r_lup[[i]][[j]])
|
||||
# lvl_ch<-paste("1,",lvl[1])
|
||||
# for (k in 2:length(lvl)){
|
||||
# lvl_ch<-c(paste0(lvl_ch," | ",k,", ",lvl[k]))
|
||||
# }
|
||||
# dd_i[j,6]<-lvl_ch
|
||||
# }
|
||||
# }
|
||||
|
||||
## Text Validation
|
||||
## Only used for date and time data
|
||||
# for (j in 1:ncol(r_lup[[i]])){
|
||||
# dd_i[j,8]<-case_when(class(r_lup[[i]][[j]])[1]%in%c("POSIXct","POSIXt") ~"datetime_seconds_ymd",
|
||||
# class(r_lup[[i]][[j]])[1]%in%c("Date") ~"date_ymd")
|
||||
# }
|
||||
|
||||
## Merge all
|
||||
dd<-rbind(dd,dd_i)
|
||||
|
||||
## Lower-casing field and form names
|
||||
dd[,1] <- REDCapCAST::clean_redcap_name(dd[,1])
|
||||
dd[,2] <- REDCapCAST::clean_redcap_name(dd[,2])
|
||||
|
||||
if (exp_out){
|
||||
# dir.create(file.path("/Volumes/Data/REDCap/data",names(r_lup)[[i]]))
|
||||
write.csv(r_lup[[i]],paste0("/Volumes/Data/REDCap/data/",names(r_lup)[[i]],".csv"),row.names = FALSE)
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# Readies the DataDictionary for export by limiting to unique identifier (leaving out multiple record ids) and omitting NAs
|
||||
dd_exp<-dd %>% filter(.,!(duplicated(Variable...Field.Name)|is.na(Variable...Field.Name)))
|
||||
|
||||
row2top <- function(ds,top="record_id",id_col=1){
|
||||
## Sort record_id at the top
|
||||
is_id <- ds[id_col]==top
|
||||
rbind(ds[is_id,],ds[!is_id,])
|
||||
}
|
||||
|
||||
dd_exp <- dd_exp |> row2top()
|
||||
|
||||
## Marking identifier variables
|
||||
dd_exp$Identifier.[dd_exp$Variable...Field.Name%in%id_data]<-"y"
|
||||
|
||||
|
||||
write.csv(dd_exp,"/Volumes/Data/REDCap/data_dictionary.csv",row.names = FALSE,na="")
|
||||
# Copy to local folder
|
||||
write.csv(dd_exp,"/Users/au301842/PAaSO/REDCap/data_dictionary.csv",row.names = FALSE,na="")
|
||||
|
||||
|
||||
## ONE DATA SET TO RULE THEM ALL
|
||||
ds_all <- purrr::reduce(r_lup,full_join,by=c("cpr","record_id"))
|
||||
|
||||
colnames(ds_all)<-colnames(ds_all)%>%REDCapCAST::clean_redcap_name() ## All names in REDCap are lower case.
|
||||
|
||||
# Ensuring correct order
|
||||
ds_all <- ds_all |> select(record_id,everything())
|
||||
|
||||
if (exp_out){
|
||||
write.csv(ds_all,"/Volumes/Data/REDCap/complete_dataset.csv",row.names = FALSE,na="")
|
||||
}
|
||||
|
||||
|
||||
## =============================================================================
|
||||
## REDCap upload
|
||||
## - worked, but headers should be lower case
|
||||
##
|
||||
## - 02aug22 not allowed to export or import.
|
||||
## Try manual data upload after attribute merge.
|
||||
## =============================================================================
|
||||
|
||||
if (auto_upload==TRUE){
|
||||
|
||||
## Trying out native piping
|
||||
# token_talos<-read.csv("/Users/au301842/talos_redcap_token.csv",colClasses = "character")|>
|
||||
# names()|>
|
||||
# # (\(x){ ## Shorthand for "anonymous lambda function". New "_" placeholder does not work.
|
||||
# # substr(x,2,33)})()|>
|
||||
# suppressWarnings()
|
||||
|
||||
|
||||
|
||||
token_talos <- keyring::key_get("TALOS_REDCAP_API")
|
||||
|
||||
## See https://towardsdatascience.com/understanding-the-native-r-pipe-98dea6d8b61b"
|
||||
## OBS: new placeholder "_" in >4.2.
|
||||
|
||||
|
||||
stts<-REDCapR::redcap_write(ds=ds_all,
|
||||
redcap_uri = "https://redcap.rm.dk/api/",
|
||||
token = token_talos
|
||||
)
|
||||
|
||||
records_mod <- REDCapR::redcap_read_oneshot(
|
||||
redcap_uri = "https://redcap.rm.dk/api/",
|
||||
token = token_talos
|
||||
)
|
||||
}
|
||||
|
||||
## Notes:
|
||||
## - Validation and data selection options are not applied, as these are not necessary for upload.
|
||||
Loading…
Reference in a new issue