## ## Data pull and export for Forskermaskinen ## ## Exports are made in REDCap instead ## ## Data set is made here, not in REDCap, as data here is better organised. ## library(haven) library(dplyr) library(purrr) ## All data # source("2 Longterm/data_import_files.R") source("/Users/au301842/PAaSO/2 Longterm/data_import_api.R") ## Helpers source("/Users/au301842/PAaSO/2 Longterm/funs.R") # Streamlining missings for easier handling # NA values ## Empty fields ("") are not included as NA, to ease later corrections. nas <- c("9.", "9. NA", "Not available", "Not relevant (filter/fold)") # Replaces all NAs in factors, and rejoins data frame # Factors keeps old levels; doesn't matter when exported as .csv and reimported... ls_nas <- lapply(seq_along(ls_sel), function(i) { ds <- ls_sel[[i]] |> select(starts_with("talos_") # & where(is.factor) ) |> data.frame() ds_n <- lapply(seq_len(ncol(ds)),function(j){ as.character(if_else(ds[,j] %in% nas, NA, ds[,j])) }) |> bind_cols() colnames(ds_n) <- colnames(ds) ds_sub <- ls_sel[[i]] |> select(-colnames(ds_n)) ds_fin <- tibble(ds_sub,ds_n) ds_fin |> select(colnames(ls_sel[[i]])) |> select(-grep("[0-9]x$",colnames(ls_sel[[i]]))) }) names(ls_nas) <- names(ls_sel) ## MFI domain scores # MFI variables to reverse # -> Create MFI function mfi_rev <- tolower(c("TALOS_MFI02","TALOS_MFI05","TALOS_MFI09","TALOS_MFI10","TALOS_MFI13","TALOS_MFI14","TALOS_MFI16","TALOS_MFI17","TALOS_MFI18","TALOS_MFI19")) match(mfi_rev,colnames(ls_nas$mfi|> select(matches(paste0("talos_mfi",stRoke::add_padding(1:20)))))) domain_scores <- ls_nas$mfi |> select(matches(paste0("talos_mfi",stRoke::add_padding(1:20)))) |> mfi_domains(var = mfi_rev) colnames(domain_scores) <- paste0("talos_mfi_",colnames(domain_scores)) ls_nas$mfi <- tibble(ls_nas$mfi,domain_scores) ## SDMT score correction # Correction table # # Holds manually determined 90 second times, additionally, "2015-02-18" is used # as cut date for change from 60 seconds to 90 seconds # # if (FALSE){ sdmt_time<-openxlsx::read.xlsx("/Volumes/Data/source/tid.sdmt.xlsx") |> tidyr::pivot_longer(cols = c(tid.1md, tid.6md)) |> mutate(deltager=as.character(deltager)) sdmt_time$name <- as.double(as.character(factor(sdmt_time$name,labels = c("2","4")))) # Setting cut date sdmt_cut<-as.Date("2015-02-18") # Joining datasets to have date of visit sdmt_corr <- left_join(ls_nas$sdmt,sdmt_time |> mutate(name=as.character(name)), by = c("rnumb"="deltager","instance"="name")) # Modyfying old correction table to be complete sdmt_corr$value <- if_else(sdmt_corr$talos_sdmt00 select(ends_with(pase_index)) |> pase_calc(adjust_work = FALSE) ensure_prefix <- function(vec,prefix){ ifelse(!grepl(paste0("^",prefix),vec),paste0(prefix,vec),vec) } colnames(pase_scores) <- colnames(pase_scores)# |> ensure_prefix(prefix="pase_") last_cols <- function(ds, n){ ds[,(ncol(ds)-n+1):ncol(ds)]} pase_scores_work <- ls_nas$pase |> select(ends_with(pase_index)) |> pase_calc(adjust_work = TRUE) |> last_cols(4) %>% rename_with(~ paste0(., "_w")) colnames(pase_scores_work) <- colnames(pase_scores_work) #|> ensure_prefix(prefix="pase_") ls_nas$pase <- tibble(ls_nas$pase,pase_scores,pase_scores_work) ## Registration correction # Mutate all ends_with "00" as.Date in original data import file # source("2 Longterm/funs.R") ls_corr <- lapply(ls_nas,time_reg_correction, ref=subjects) run_eval=FALSE if (run_eval){ library(compareDF) ls_comp <- lapply(seq_along(ls_nas),function(i){ compare_df(ls_corr[[i]],ls_nas[[i]],group_col = c("rnumb","instance"),stop_on_error = FALSE) }) ls_comp[[1]] |> create_output_table() } ls_wide <- ls_corr |> longlist2wide() df_wide <- ls_wide |> purrr::reduce(full_join,by="rnumb") ## The final assembly df_ddv <- subjects |> mutate(rnumb=as.character(rnumb)) |> left_join(df_wide %>% ## Keep only first "SITE" occurance ## Using magrittr pipe for easy placeholder use select(-grep("_site_",colnames(.))[-1]) ) # write.csv(df_ddv,"/Volumes/Data/REDCap/DDV/talos_ddv.csv",row.names = FALSE) ## Generate data description attr_files <- list.files("/Users/au301842/PAaSO/REDCap/attr",pattern = ".csv$",full.names = TRUE) attr_files_short <- list.files("/Users/au301842/PAaSO/REDCap/attr",pattern = ".csv$",full.names = FALSE) nms <- do.call(c,lapply(strsplit(attr_files_short,"_"),"[[",2)) |> gsub("['.']csv","",x=_) |> tolower() attr_lst <- lapply(attr_files,read.csv) names(attr_lst) <- nms attr_df <- lapply(seq_along(attr_lst),function(i){ data.frame(name = tolower(ifelse( !grepl("^TALOS|cpr|record_id", attr_lst[[i]][, 1]), paste0(nms[i], "_", attr_lst[[i]][, 1]), attr_lst[[i]][, 1] )), attr = attr_lst[[i]][, 2], instr = paste(toupper(nms[i]),"instrument")) }) |> bind_rows() attr_df$attr[grepl("sys_date$",attr_df$name)] <- "System date" attr_df$attr[grepl("sys_site$",attr_df$name)] <- "Trial site" attr_uni <- attr_df[!duplicated(attr_df$name),] # data.frame(variabel=colnames(df_ddv), # visit=stRoke::str_extract(colnames(df_ddv),"[0124]$"), # attr_df[match(gsub("_[0124]$","",colnames(df_ddv)),attr_df$name),-1]) |> # write.csv("REDCap/ddv_variabelbeskrivelse_raw.csv",row.names = FALSE) # # read.csv("REDCap/ddv_variabelbeskrivelse.csv") |> # filter_at(1,all_vars(.%in%colnames(df_ddv))) |> # write.csv("REDCap/ddv_variabelbeskrivelse_mod.csv",row.names = FALSE) is.na(ds$talos_pase01_0) |> summary() ## Cumulated data # dta<-read.csv("/Volumes/Data/exercise/source/background.csv",colClasses = "character", na.strings = c("NA","","unknown")) # # export<-dta[,c("pase_0", # "age", # "sex", # "civil", # "smoker", # "rtreat", # "alc", # "afli", # "hypertension", # "diabetes", # "mrs_0", # "nihss_c", # "thrombolysis", # "pad", # "thrombechtomy", # "ami", # "tci", # "rdate", # "cpr", # "rnumb", # "height", # "weight", # "weight_est", # "inc_time", # "compliant", # "mrs_1", # "mrs_6", # "pase_6", # "visit_1", # "visit_6")] # export$diabetes[is.na(export$diabetes)]<-"no" # export$hypertension[is.na(export$hypertension)]<-"no" # export$thrombolysis[is.na(export$thrombolysis)]<-"no" # export$thrombechtomy[is.na(export$thrombechtomy)]<-"no" # export$pad[is.na(export$pad)]<-"no" # export$ami[is.na(export$ami)]<-"no" # export$inc_time[export$inc_time<0]<-0 # export$compliant<-as.numeric(factor(export$compliant)) # export$rdate<-as.Date(export$rdate) # export$mrs_0[export$mrs_0==3]<-NA # export <- export|> # mutate(any_rep=factor(ifelse(thrombolysis=="yes"|thrombechtomy=="yes","yes","no")), # If not noted, no therapy was received # weight=ifelse(is.na(weight),weight_est,weight))|> # select(-c(weight_est)) # # dput(names(export)) # write.csv(export|>select(c(rnumb,rtreat)),"/Volumes/Data/SDS upload/study_treatment.csv",row.names = FALSE) # write.csv(export,"/Volumes/Data/SDS upload/data_all.csv",row.names = FALSE) # write.csv(export|>select(-c(rtreat)),"/Volumes/Data/SDS upload/background.csv",row.names = FALSE) # max(export$visit_6[!is.na(export$visit_6)])