transfer from old repo
This commit is contained in:
parent
cfa4a5f9cc
commit
277e2b8cf3
1111 changed files with 83736 additions and 0 deletions
260
2 Longterm/data.R
Normal file
260
2 Longterm/data.R
Normal file
|
|
@ -0,0 +1,260 @@
|
|||
##
|
||||
## 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)])
|
||||
|
||||
|
||||
Loading…
Reference in a new issue