DD-HTE/DD IV Regression.Rmd at main · Transconnectome/DD-HTE · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
---
title: "DD IV Regression"
author: "PJH"
date: '2022-11-15'
output: html_document
---

```{r}
rm(list=ls())

data$sex_0y<-as.factor(data$sex_0y)
data$married_0y<-as.factor(data$married_0y)
data$parent_identity_0y<-as.factor(data$parent_identity_0y)
data$race_ethnicity_0y<-as.factor(data$race_ethnicity_0y)


library(fastDummies)

data<-dummy_cols(data, select_columns = c('sex_0y', 'married_0y', 'race_g', 'parent_identity_0y', 'race_ethnicity_0y'))

```


```{r IV Regression}
library(ivreg)

outcomes<-c('distress_score_pps_1y', 'distress_score_pps_2y',
            'distress_score_di_1y', 'distress_score_pd_1y', 'distress_score_di_2y', 'distress_score_pd_2y')
cov_con<-c('age_0y', 'bmi_0y', 'income_0y', 'high_educ_0y', 'parent_age_0y', 'history_ratio_0y')
cov_cat<-c('sex_0y', 'married_0y', 'parent_identity_0y', 'race_ethnicity_0y')

cov1<-paste0(cov_con, collapse="+")
cov2<-paste0(cov_cat, collapse = '+')
cov_list<-paste0(cov1, "+", cov2)


beta_iv<-data.frame()
se_iv<-data.frame()
p_iv<-data.frame()
weak_iv<-data.frame()
hausman_iv<-data.frame()
lowci_iv<-data.frame()
highci_iv<-data.frame()


formula <- formula(paste0("discount_rate_1y~nihtbx_totalcomp_uncorrected_0y+", cov_list,
                            '| rh_adi_perc1_0y | section8_0y+nihtbx_totalcomp_uncorrected_0y+', cov_list))
res<-ivreg(formula, data = data)
beta<-as.matrix(round(summary(res)$coefficients[2,1],4))
se<-as.matrix(round(summary(res)$coefficients[2,2],4))
p<-as.matrix(round(summary(res)$coefficients[2,4],4))
weak<-(summary(res, diagnostics = TRUE)$diagnostics)[1, 3:4]
hausman<-round((summary(res, diagnostics = TRUE)$diagnostics)[2, 3:4], 4)
lowci<- beta + -1 * qnorm(0.975) * se
highci<- beta + 1 * qnorm(0.975) * se

beta_iv<-rbind(beta_iv, beta)
se_iv<-rbind(se_iv, se)
lowci_iv<-rbind(lowci_iv, lowci)
highci_iv<-rbind(highci_iv, highci)
p_iv<-rbind(p_iv, p)
weak_iv<-rbind(weak_iv, weak)
hausman_iv<-rbind(hausman_iv, hausman)


for (y in outcomes) {
  formula <- formula(paste0(y, "~nihtbx_totalcomp_uncorrected_0y+", cov_list,
                            '| rh_adi_perc1_0y | section8_0y+nihtbx_totalcomp_uncorrected_0y+', cov_list))
  res<-ivreg(formula, data = data)
  beta<-as.matrix(round(summary(res)$coefficients[2,1],4))
  se<-as.matrix(round(summary(res)$coefficients[2,2],4))
  p<-as.matrix(round(summary(res)$coefficients[2,4],4))
  weak<-(summary(res, diagnostics = TRUE)$diagnostics)[1, 3:4]
  hausman<-round((summary(res, diagnostics = TRUE)$diagnostics)[2, 3:4], 4)
  lowci<- beta + -1 * qnorm(0.975) * se
  highci<- beta + 1 * qnorm(0.975) * se

  beta_iv<-rbind(beta_iv, beta)
  se_iv<-rbind(se_iv, se)
  lowci_iv<-rbind(lowci_iv, lowci)
  highci_iv<-rbind(highci_iv, highci)
  p_iv<-rbind(p_iv, p)
  weak_iv<-rbind(weak_iv, weak)
  hausman_iv<-rbind(hausman_iv, hausman)
  }

p_iv_fdr<-round((p.adjust(as.matrix(p_iv), method = 'fdr')),4)

res_all<-cbind(beta_iv, se_iv, lowci_iv, highci_iv, p_iv, p_iv_fdr, weak_iv, hausman_iv)
colnames(res_all)<-c("Estimates", "Std.Err", "95% Lower CI", "95% Upper CI", "P-value", "P-FDR", "stat_Weak IV", "p_Weak IV", "stat_Hausman", "p_Hausman")
rownames(res_all)<-c('Delay Discounting',
                     'Distress PLEs (1-year)', 'Distress PLEs (2-year)', 'Distress DI (1-year)',
                     'Distress PD (1-year)', 'Distress DI (2-year)', 'Distress PD (2-year)')
print(res_all)


# openxlsx::write.xlsx(res_all, rowNames=TRUE, "ABCD DD IV Regression_results_new.xlsx")

```