talos-pa-depression/Archive/regression_rev.Rmd

508 lines
12 KiB
Plaintext

---
title: "revised statistics"
author: "AGDamsbo"
date: "8/1/2022"
output: html_document
toc: true
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
library(REDCapR)
library(gtsummary)
theme_gtsummary_compact()
library(REDCapR)
library(gt)
library(lubridate)
library(dplyr)
library(tidyr)
```
# Import
```{r}
dta_all<-read.csv("/Volumes/Data/depression/dep_dataset.csv")
```
# Defining patients to include for analysis
Only including cases with complete pase_0 and MDI at 1 & 6 months
```{r}
dta<-dta_all[!is.na(dta_all$pase_0),]
# &!is.na(dta$mdi_1)&!is.na(dta$mdi_6)
```
## Formatting
```{r echo=FALSE}
dta$diabetes<-factor(dta$diabetes)
dta$pad<-factor(dta$pad)
dta$cohab<-ifelse(dta$civil=="partner","yes","no")|>
factor()
dta$hypertension<-factor(dta$hypertension)
dta$afli[dta$afli=="unknown"]<-NA
dta$afli<-factor(dta$afli)
dta$ever_smoker<-ifelse(dta$smoke_ever=="ever","yes","no")|>
factor()
dta$ami<-factor(dta$ami)
dta$tci<-factor(dta$tci)
dta$thrombolysis<-factor(dta$thrombolysis)
dta$thrombechtomy<-factor(dta$thrombechtomy)
dta$any_reperf<-ifelse(dta$rep_any=="rep","yes","no")|>
factor()
dta$pad<-factor(dta$pad)
dta$nihss_0<-as.numeric(dta$nihss_0)
dta$age<-as.numeric(dta$age)
dta$active_treat<-ifelse(dta$rtreat=="Active","yes","no")|>
factor()
# dta$rtreat<-factor(dta$rtreat)
dta$female<-ifelse(dta$sex=="female","yes","no")|>
factor()
dta$pase_0<-as.numeric(dta$pase_0)
dta$pase_6<-as.numeric(dta$pase_6)
dta$bmi<-as.numeric(dta$bmi)
dta$mdi_6<-as.numeric(dta$mdi_6)
dta$pase_0_bin<-factor(dta$pase_0_bin,levels=c("lower","higher"))
dta$nihss_0_isna<-is.na(dta$nihss_0)
```
```{r}
vars<-c("pase_0",
"female",
"age",
"cohab",
"ever_smoker",
"diabetes",
"hypertension",
"afli",
"ami",
"tci",
"pad",
"nihss_0",
"any_reperf")
# tbl1_vars<-c("thrombolysis", "thrombechtomy","inc_time")
labels_all<-list(active_treat~"Active trial treatment",
pase_0~"PASE score",
age~"Age",
female~"Female sex",
ever_smoker~"History of smoking",
cohab~"Cohabitation",
diabetes~"Known diabetes",
hypertension~"Known hypertension",
afli~"Known Atrialfibrillation",
ami~"Previos myocardial infarction",
tci~"Previos TIA",
pad~"Known peripheral arteriosclerotic disease",
nihss_0~"NIHSS score",
thrombolysis~"Thrombolytic therapy",
thrombechtomy~"Endovascular treatment",
any_reperf~"Any reperfusion treatment",
inc_time~"Study inclusion time",
'[Intercept]'~"Intercept")
lab_sel<-function(label_list,variables_vector){
## Helper function to select labels for gtsummary function from list of all labels based on selected variables.
## Long names in try to ease reading.
include_index<-c()
for (i in 1:length(label_list)) {
include_index[i]<-as.character(label_list[[i]])[2] %in% variables_vector
}
return(label_list[include_index])
}
dta_backup<-dta
```
# Table 1
```{r}
tbl1_vars<-c("active_treat",vars,"inc_time")
dta|>
tbl_summary(missing = "ifany",
include = all_of(tbl1_vars),
missing_text="(Missing)",
label = lab_sel(labels_all,tbl1_vars)
)|>
add_n()|>
as_gt() |>
# modify with gt functions
gt::tab_header("Baseline Characteristics") |>
gt::tab_options(
table.font.size = "small",
data_row.padding = gt::px(1))
```
# Regression - all
```{r}
outs<-c("mdi_1_enr","mdi_6_newobs_enr")
```
## Non-stratified
```{r}
source("biv_mul.R")
bm_16_tbl_rtf <- file("bm_16_tbl.RTF", "w")
writeLines(bm_16_tbl%>%as_gt()%>%as_rtf(), bm_16_tbl_rtf)
close(bm_16_tbl_rtf)
bm_16_tbl %>% # build gtsummary table
as_gt() %>% # convert to gt table
gt::gtsave( # save table as image
filename = "bm_16_tbl.png"
)
```
## Stratified by treatment
```{r}
source("biv_mul_strat.R")
bm_16_tbl_strat_rtf <- file("bm_16_tbl_strat.RTF", "w")
writeLines(bm_16_tbl_strat%>%as_gt()%>%as_rtf(), bm_16_tbl_strat_rtf)
close(bm_16_tbl_strat_rtf)
bm_16_tbl_strat %>% # build gtsummary table
as_gt() %>% # convert to gt table
gt::gtsave( # save table as image
filename = "bm_16_tbl_strat.png"
)
```
# Regression - sensitivity
```{r}
outs<-c("mdi_1","mdi_6")
```
## Non-stratified
```{r}
source("biv_mul.R")
bm_16_sens_tbl_rtf <- file("bm_16_sens_tbl.RTF", "w")
writeLines(bm_16_tbl%>%as_gt()%>%as_rtf(), bm_16_sens_tbl_rtf)
close(bm_16_sens_tbl_rtf)
bm_16_tbl %>% # build gtsummary table
as_gt() %>% # convert to gt table
gt::gtsave( # save table as image
filename = "bm_16_tbl_sens.png"
)
```
## Stratified by treatment
```{r}
source("biv_mul_strat.R")
bm_16_tbl_strat_sens_rtf <- file("bm_16_tbl_strat_sens.RTF", "w")
writeLines(bm_16_tbl_strat%>%as_gt()%>%as_rtf(), bm_16_tbl_strat_sens_rtf)
close(bm_16_tbl_strat_sens_rtf)
bm_16_tbl_strat %>% # build gtsummary table
as_gt() %>% # convert to gt table
gt::gtsave( # save table as image
filename = "bm_16_tbl_strat_sens.png"
)
```
# Regression - interaction
```{r}
outs<-c("mdi_1_enr","mdi_6_newobs_enr")
```
```{r}
## =============================================================================
## Loop
## =============================================================================
bm_list<-list()
for (i in 1:length(outs)){
## Multivariate
mul<-dta |>
dplyr::select(all_of(c("active_treat",vars,outs[i])))|>
lm(formula(
paste(c(paste(c(outs[i],paste(c("active_treat","pase_0"),collapse="*")),collapse="~"),"."),collapse="+")),
data = _)|>
tbl_regression(label = lab_sel(labels_all,c(vars,"active_treat")))|>
add_n() |>
add_global_p() |>
bold_p() |>
bold_labels() |>
italicize_levels()
bm_list[[i]]<-mul
}
## =============================================================================
## Big merge
## =============================================================================
tbl_merge(
tbls = bm_list,
tab_spanner = c("**One month follow up**",
"**Six months follow up**")
)
```
```{r}
library(aod)
for (i in 1:length(outs)){
model<-dta |>
dplyr::select(all_of(c("active_treat",vars,outs[i])))|>
lm(formula(
paste(c(paste(c(outs[i],paste(c("active_treat","pase_0"),collapse="*")),collapse="~"),"."),collapse="+")),
data = _)
wt<-wald.test(Sigma = vcov(model),
b = coef(model),
Terms = model$rank # Rank gives number of coefficients. The interaction is the last.
)
print(wt)
}
```
# Regression - nihss ~ pase_0
```{r}
vars_nihss<-c(
"pase_0",
"female",
"age",
"cohab",
"ever_smoker",
"diabetes",
"hypertension",
"afli",
"ami",
"tci",
"pad",
"nihss_0")
## Bivariate
biv<-dta|>
dplyr::select(all_of(vars_nihss))|>
tbl_uvregression(data=_,
y="nihss_0",
method=lm#,
#label = lab_sel(labels_all,vars)
) |>
add_global_p()|>
bold_p() |>
bold_labels() |>
italicize_levels()
## Multivariate
mul<-dta |>
dplyr::select(all_of(vars_nihss))|>
lm(nihss_0~pase_0+.,
data = _) |>
tbl_regression(
#label = lab_sel(labels_all,vars),
#intercept=FALSE
)|>
add_n() |>
add_global_p() |>
bold_p() |>
bold_labels() |>
italicize_levels()
## Merge
tbl_merge(
tbls = list(biv, mul),
tab_spanner = c("**Bivariate linear regression**",
"**Multivariate linear regression**")
)
```
# Transformed data
```{r}
# dta<-dta_backup
dta<-dta|>
mutate(pase_0=sqrt(pase_0),
nihss_0=log1p(nihss_0),
mdi_1_enr=log1p(mdi_1_enr), # log1p(x) svarer til log(x+1)
mdi_6_newobs_enr=log1p(mdi_6_newobs_enr))|>
data.frame()
library(dplyr)
# source("biv_mul.R")
```
```{r}
## =============================================================================
## Loop
## =============================================================================
bm_list<-list()
for (i in 1:length(outs)){
## Bivariate
dta_l<-dta|>
dplyr::select(all_of(c("active_treat",vars,outs[i])))
sel<-dta_l|>
sapply(is.factor)
# i=1
biv<-dta_l|>
tbl_uvregression(data=_,
y=outs[i],
method=lm,
label = lab_sel(labels_all,vars),
show_single_row=colnames(dta_l)[sel]
) |>
add_global_p()|>
bold_p() |>
bold_labels() |>
italicize_levels()
## What follows is the pragmatic transformation and reformatting
## Transforming log2() to 2^()
# biv$table_body$estimate<-expm1(biv$table_body$estimate)
# biv$table_body$conf.low<-expm1(biv$table_body$conf.low)
# biv$table_body$conf.high<-expm1(biv$table_body$conf.high)
#
# ## Transforming sqrt(pase_0) to pase_0^2
# biv$table_body$estimate[biv$table_body$variable=="pase_0"]<-
# biv$table_body$estimate[biv$table_body$variable=="pase_0"]^2
#
# low<-biv$table_body$conf.low[biv$table_body$variable=="pase_0"]^2
# high<-biv$table_body$conf.high[biv$table_body$variable=="pase_0"]^2
#
# biv$table_body$conf.low[biv$table_body$variable=="pase_0"]<-high
# biv$table_body$conf.high[biv$table_body$variable=="pase_0"]<-low
#
# ## New confidence intervals
# # biv$table_body$estimate<-format(biv$table_body$estimate, drop0trailing = F,digits =2)
# biv$table_body$ci<-paste(formatC(biv$table_body$conf.low, digits = 3, format = "f"),
# formatC(biv$table_body$conf.high, digits = 3, format = "f"),
# sep=", ")
# biv$table_body$ci<-paste(format(biv$table_body$conf.low, digits = 2, drop0trailing = FALSE),
# format(biv$table_body$conf.high, digits = 2, drop0trailing = FALSE),
# sep=", ")
# Formatting from this: https://stackoverflow.com/questions/12243071/r-keeping-0-0-when-using-paste-or-paste0
## multivariate
mul<-dta_l |>
lm(formula(paste(c(outs[i],"."),collapse="~")),
data = _) |>
tbl_regression(label = lab_sel(labels_all,vars),
show_single_row=colnames(dta_l)[sel]
)|>
add_n() |>
add_global_p() |>
bold_p() |>
bold_labels() |>
italicize_levels()
## Merge
biv_mul<-tbl_merge(
tbls = list(biv, mul),
tab_spanner = c("**Bivariate linear regression**",
"**Multivariate linear regression**")
)
bm_list[[i]]<-biv_mul
}
## =============================================================================
## Big merge
## =============================================================================
bm_16_tbl<-tbl_merge(
tbls = bm_list,
tab_spanner = c("**One month follow up**",
"**Six months follow up**")
)
bm_16_tbl
```
```{r}
bm_16_tbl_rtf <- file("bm_16_tbl_trans.RTF", "w")
writeLines(bm_16_tbl%>%as_gt()%>%as_rtf(), bm_16_tbl_rtf)
close(bm_16_tbl_rtf)
bm_16_tbl %>% # build gtsummary table
as_gt() %>% # convert to gt table
gt::gtsave( # save table as image
filename = "bm_16_tbl_trans.png"
)
```
## Tests and visualisation
Box-Cox power transformation performs comparably to logarithmic transformation. The latter is much easier to explain.
```{r}
library(MASS)
dta_bc<-dta_backup|>
dplyr::select(all_of(c("mdi_6_newobs_enr",vars)))|>
mutate(pase_0=sqrt(pase_0),
mdi_6_newobs_enr=mdi_6_newobs_enr+1)#|>
# na.omit()
bc<-boxcox(mdi_6_newobs_enr~.,data=dta_bc)
lambda <- bc$x[which.max(bc$y)]
```
Q-Q plots to compare the two different approaches, and the non-transformed
```{r}
qqnorm(lm(((mdi_6_newobs_enr^lambda-1)/lambda) ~ .,data=dta_bc)$residuals)
qqnorm(lm(log(mdi_6_newobs_enr) ~ .,data=dta_bc)$residuals)
```
Histograms for reference
```{r}
hist(dta$pase_0,40); hist(sqrt(dta$pase_0),40)
```
```{r}
hist(expm1(dta$mdi_6_newobs_enr),40); hist((dta$mdi_6_newobs_enr),40) ## Observed MDI, and log transformed MDI
```