260 lines
8 KiB
R
260 lines
8 KiB
R
##
|
|
## 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<sdmt_cut|sdmt_corr$value==60,60,90,missing = 90)
|
|
|
|
# Write for database upload and easier future handling
|
|
# write.csv(select(sdmt_corr, rnumb, instance, value),"2 Longterm/sdmt_time_correction.csv")
|
|
|
|
# Multiplying meassure by correction valued turned weight and rounded
|
|
sdmt_corr$talos_sdmt01a <- round(as.numeric(sdmt_corr$talos_sdmt01a)*(90/sdmt_corr$value),0)
|
|
|
|
|
|
|
|
ls_nas$sdmt <- sdmt_corr
|
|
}
|
|
|
|
## PASE sum score
|
|
|
|
pase_index <- stRoke::str_extract(colnames(stRoke::pase),"[0-9]{2}.*$")
|
|
|
|
## Sourcing the newest pase_calc()
|
|
source("/Users/au301842/stRoke/R/pase_calc.R")
|
|
|
|
pase_scores <- ls_nas$pase |> 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)])
|
|
|
|
|