talos-pa-depression/Archive/dep_data.Rmd

305 lines
11 KiB
Plaintext
Raw Normal View History

2022-08-01 13:57:03 +02:00
---
title: "Data export and wrangling"
author: "Andreas Gammelgaard Damsbo"
date: "Knitted: `r format(Sys.time(), '%d %B, %Y')`"
output:
pdf_document: default
html_document: default
toc: TRUE
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE)
```
```{r message=FALSE}
library(haven)
library(plyr)
library(dplyr)
library(reshape2)
```
```{r}
dta<-read.csv("/Volumes/Data/exercise/source/background.csv",
na.strings = c("NA",""),colClasses = "character")
# dta_b<-dta
```
# Variables
List of variables included in dataset
```{r}
dput(names(dta))
```
## New additions and formatting
```{r}
dta$mors_delay<-difftime(as.Date(dta$mors_d),as.Date(dta$rdate),units = "days")
dta$mors_v1<-factor(ifelse(dta$mors_delay<=38&
(dta$mors_delay-as.numeric(dta$inc_time))<=1,
"yes","no"))
# Tæller som død hvis død inden 38 dage og dødsdato og EOS ligger indenfor 1 døgn.
dta$mors_v1[is.na(dta$mors_v1)]<-"no"
```
```{r}
dta$mors_v16<-factor(ifelse(dta$mors_v1=="no"&
(dta$mors_delay-as.numeric(dta$inc_time))<=1,
"yes","no"))
# Tæller som død mellem 1 til 6 mdr, hvis ikke død inden 1 mdr,
# og dødsdato og EOS ligger indenfor 1 døgn.
dta$mors_v16[is.na(dta$mors_v16)]<-"no"
```
PASE score dichotomisation at median score.
```{r}
dta$pase_0<-as.numeric(dta$pase_0)
dta$pase_0_bin<-cut(dta$pase_0,
c(min(dta$pase_0,na.rm = T),median(dta$pase_0,na.rm = T),
max(dta$pase_0,na.rm = T)),include.lowest = T,
labels = c("lower","higher"))
quantile(dta$pase_0,na.rm = T)
```
### Formatting
```{r}
dta$inc_time<-as.numeric(dta$inc_time)
```
# Cleaning MDI scores
The following contains a serious bit of data wrangling. Reasons are the occasional recording of visit 1 data at 6 months due to LOCF approach. Additionally some patients have data recorded at 6 months, but later end date has been defined as prior to the visit 6.
Additionally the definition of when to define a MDI recording as 1 month or 6 months have added a bit of extra work..
This work should be applied for all endpoint data. If needed, a general script or function should be written.
Steps used for the correction:
1. If the inc_time is 38 days or less MDI 6 scores are moved to MDI 1 and visit 6 is defined as visit 1.
2. If both visit 1 and 6 dates are NA, use enddate as visit 1 date. This is the case if patients were excluded early.
3. If visit 6 is recorded later than enddate, use enddate instead. MDI 6 score is dropped.
4. If visit delay is 7 days or less, and inclusion time is more than 38, MDI 1 is moved to MDI 6 and dropped. If MDI 1 and 6 are different both are kept. Enddate is moved to visit 6 date.
5. Defining the visit 6 date as same as enddate if visit delay is <7.
```{r}
summary(inc196<-dta$inc_time>196)
dt1<-dta[inc196,c("rnumb","rdate","visit_1","visit_6","enddate","inc_time","mdi_1","mdi_6","mors_delay")]
```
## Step 1
```{r}
summary(inc38<-dta$inc_time<=38)
dt1<-dta[inc38,c("rnumb","rdate","visit_1","visit_6","inc_time","mdi_1","mdi_6")]
dta$visit_1<-ifelse(inc38&!is.na(dta$visit_6),dta$visit_6,dta$visit_1)
dta$mdi_1<-ifelse(inc38&is.na(dta$mdi_1),dta$mdi_6,dta$mdi_1)
dta$mdi_6[inc38]<-NA
dta$visit_6[inc38]<-NA
# If the inc_time is 38 days or less MDI 6 scores are moved to MDI 1 and visit 6 is defined as visit 1.
# LOCF correction.
```
## Step 2
```{r}
summary(na16enddate<-is.na(dta$visit_1)&is.na(dta$visit_6))
dt2<-dta[na16enddate,c("rnumb","rdate","visit_1","visit_6","inc_time","mdi_1","mdi_6")]
dta$visit_1<-ifelse(na16enddate,dta$enddate,dta$visit_1)
# If both visit 1 and 6 dates are NA, use enddate as visit 1 date. This is the case if patients were excluded early.
```
## Step 3
```{r}
summary(late61<-as.Date(dta$visit_6)>as.Date(dta$enddate)&difftime(as.Date(dta$visit_6),as.Date(dta$enddate),units = "days")<=1)
summary(late62<-as.Date(dta$visit_6)>as.Date(dta$enddate)&difftime(as.Date(dta$visit_6),as.Date(dta$enddate),units = "days")>1)
late61[is.na(late61)]<-FALSE
late62[is.na(late62)]<-FALSE
# dt5<-dta[late61,c("rnumb","rdate","visit_1","visit_6","enddate","inc_time","mdi_1","mdi_6")]
# dt6<-dta[late62,c("rnumb","rdate","visit_1","visit_6","enddate","inc_time","mdi_1","mdi_6")]
dta$visit_6<-ifelse(late61,dta$enddate,dta$visit_6)
dta$visit_6<-ifelse(late62,dta$enddate,dta$visit_6)
dta$mdi_6[late62]<-NA
# If visit 6 is recorded later than enddate, use enddate instead
# A group of patients have visit 6 and MDI 6 recorded, but enddate is before visit 6 data.
# After manual lookups, this is likely due to some patients coming for visit 6, but the
# interviewer later realizing, that the patients should have been excluded earlier on.
# Due to this, patients with enddate more than 1 day (leaving room for simple recording errors) prior to visit 6 date, MDI 6 will be dropped.
# Patients with 1 day difference the enddate is moved to visit 6 date.
```
## Step 4
```{r}
summary(locflate<-(difftime(as.Date(dta$visit_6),as.Date(dta$visit_1))<=7|is.na(dta$visit_1))&dta$inc_time>38)
locflate[is.na(locflate)]<-FALSE
dt2<-dta[locflate,c("rnumb","rdate","visit_1","visit_6","inc_time","mdi_1","mdi_6")]
dta$mdi_6<-ifelse(locflate&is.na(dta$mdi_6),dta$mdi_1,dta$mdi_6)
dta$mdi_1[locflate&dta$mdi_1==dta$mdi_6]<-NA
dta$visit_1[locflate&is.na(dta$mdi_1)]<-NA
dta$visit_6<-ifelse(locflate,dta$enddate,dta$visit_6)
# If visit delay is 7 days or less, and inclusion time is more than 38, MDI 1 is moved to MDI 6 and dropped. If MDI 1 and 6 are different both are kept. Enddate is moved to visit 6 date.
```
## Step 5
```{r}
summary(same1n6date<-difftime(as.Date(dta$visit_6),as.Date(dta$visit_1),units = "days")<7)
same1n6date[is.na(same1n6date)]<-FALSE
# dt5<-dta[same1n6date,c("rnumb","rdate","visit_1","visit_6","enddate","inc_time","mdi_1","mdi_6",drops)]
dta$visit_6<-ifelse(same1n6date,dta$enddate,dta$visit_6)
# Defining the visit 6 date as same as enddate if visit delay is <7.
```
# Visit delay
```{r}
dta$visit_delay<-difftime(as.Date(dta$visit_6),as.Date(dta$visit_1),units = "days")
# Final calculation of days between visits
summary(as.numeric(dta$visit_delay))
```
# newobs definition - DEPRECATED
The definition of a truly new observation is a recorded score at least 7 days after the first score. This was relevant prior to the work of redefining time points for scoring.
```{r}
dta$mdi_6_newobs<-dta$mdi_6
# The newobs variable is later used, but is obsolete due to the previous change in definitions. The previous definition of newobs were a delay between visits of at least 7 days. No cases matched. Minimum is 13.
```
```{r}
# dta$mdi_6_166<-ifelse(dta$inc_time>166,NA,dta$mdi_6)
# dta$mdi_6_80<-ifelse(dta$inc_time>80,NA,dta$mdi_6)
# dta$mdi_6_protocol<-ifelse(dta$protocol=="2",NA,ifelse(is.na(dta$mdi_6),dta$mdi_1,dta$mdi_6))
# dta$mdi_6_locf<-ifelse(is.na(dta$mdi_6),dta$mdi_1,dta$mdi_6)
```
# Drops
Streamlining drop out data to avoid NA's.
```{r}
drops<-c("side_effect2","side_effect","wants_out","open_treat")
for (i in drops) {
dta[i]<-ifelse(dta[i]=="1. Ja","yes","no")
dta[i][is.na(dta[i])]<-"no"
}
```
Defining a common all cause drop variable
```{r}
dta$drop<-ifelse(dta$side_effect2=="yes"|dta$side_effect=="yes"|dta$wants_out=="yes"|dta$open_treat=="yes","yes","no")
```
Defining drop before or at day 38 (Following protocol design) as drop before 1 month and drop after day 38 as drop between 1 and 6 months
```{r}
cut_line<-38
dta$inc_time<-as.numeric(dta$inc_time)
dta$drop1<-ifelse(dta$drop=="yes"&dta$inc_time<=cut_line,"yes","no")
summary(factor(dta$drop1))
# dt3<-dta[,c("rnumb","rdate","visit_1","visit_6","inc_time","mdi_1","mdi_6","mdi_6_newobs","drop1","drop16",drops)]
dta$drop16<-ifelse(dta$drop=="yes"&dta$inc_time>cut_line,"yes","no")
summary(factor(dta$drop16))
summary(factor(dta$drop))
# dtf<-dta[dta$drop1=="yes",c("mdi_6_newobs","inc_time")]
# dtf<-dta[,c("mdi_1","mdi_6_newobs","inc_time","drop","drop1","drop16")]
```
# Enriching
With patients excluded due to open treatment need and defining populations to include/exclude
```{r}
summary(sel_enr_1<-dta$open_treat=="yes"&is.na(dta$mdi_1)&dta$drop1=="yes")
dta$mdi_1_enr<-ifelse(sel_enr_1,21,dta$mdi_1) # Per agreement, patients excluded due to open treatment need a given the fictive MDI score "21".
```
Vectorising ex/inclusions at 1 month, to keep patients with data or with later data.
```{r}
summary(dta$excluded_1<-factor(case_when(dta$mors_v1=="yes"|
is.na(dta$mdi_1_enr)&
dta$drop1=="yes"~"ex_1", # Excluded
is.na(dta$mdi_1_enr)&!is.na(dta$mdi_6_newobs)~"ca_1", # Missing, but carried to 6 months
is.na(dta$mdi_1_enr)~"mi_1", # Missing,
is.na(dta$mdi_1)&!is.na(dta$mdi_1_enr)~"en_1",
TRUE ~ "dt_1"))) # Data available
```
```{r}
summary(sel_enr_6<-dta$open_treat=="yes"&dta$drop16=="yes"&is.na(dta$mdi_6_newobs)&dta$excluded_1%in%c("ca_1","dt_1")&dta$mors_v16=="no")
# Entries to be enriched are entries with need for open treatment after 1 month, with missing mdi_6_newobs and with data at or "carried" from 1 month
dta$mdi_6_newobs_enr<-as.numeric(ifelse(sel_enr_6,21,dta$mdi_6_newobs)) # Per agreement, patients excluded due to open treatment need a given the fictive MDI score "21".
```
```{r}
summary(dta$excluded_6<-factor(case_when(is.na(dta$mdi_6_newobs_enr)&dta$excluded_1%in%c("ca_1","dt_1","en_1")~"ex_6", # Excluded due to death or other dropout
is.na(dta$mdi_6_newobs_enr)~"mi_6", # Missing data due to exclusion at 1 month
is.na(dta$mdi_6_newobs)&!is.na(dta$mdi_6_newobs_enr)~"en_6", # Enriched entries
dta$excluded_1%in%c("ca_1","dt_1")~"dt_6" # Organic data available
))) # Data available
```
```{r}
# dtf<-cbind(dta[,c("rnumb","mdi_1","mdi_6_newobs","inc_time","drop","drop1","drop16","mdi_1_enr","mdi_6_newobs_enr","excluded_1","excluded_6","mors_v16","mors_delay")],"excluded"=is.na(dta$mdi_6_newobs_enr)&dta$excluded_1%in%c("ca_1","dt_1","en_1"))
#
# summary(dtf %>% filter(excluded==TRUE))
```
# Main Dataset export
```{r}
variable_namebits<-c("rnumb","rtreat","age","sex",
"bmi",
"smoke_ever",
"civil",
"diabetes",
"hypertension",
"pad",
"afli",
"ami",
"tci",
"nihss_0",
"thrombolysis",
"thrombechtomy",
"rep_any",
"pase_0",
"pase_6",
"mrs_0","mrs_1","mrs_6",
# "who5_score",
"mdi",
# "ham_score_1","ham_score_6",
"mors",
"drop",
"wants_out",
"side_effect",
"open_treat",
"side_effect2",
"excluded",
"protocol","eos_early","inc_time",
"rdate","visit","enddate"
)
```
```{r}
export<-dta %>% select(contains(variable_namebits))
```
```{r}
write.csv(export,"/Volumes/Data/depression/dep_dataset.csv",row.names = FALSE)
```