Skip to content

Commit 5107d1c

Browse files
author
Matt Secrest
committed
refactor out tidyverse
1 parent f542c2f commit 5107d1c

19 files changed

Lines changed: 115 additions & 92 deletions

‎DESCRIPTION‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,8 +50,6 @@ Imports:
5050
checkmate,
5151
futile.logger,
5252
mvtnorm,
53-
dplyr,
54-
tidyr,
5553
boot,
5654
Matrix,
5755
CVXR,
@@ -61,16 +59,18 @@ Imports:
6159
stats,
6260
utils,
6361
methods
64-
Suggests:
62+
Suggests:
6563
covr,
64+
dplyr,
6665
ECOSolveR,
6766
knitr,
6867
pkgdown,
6968
rmarkdown,
7069
lintr,
7170
spelling,
7271
styler,
73-
testthat (>= 3.0.0)
72+
testthat (>= 3.0.0),
73+
tidyr
7474
Config/testthat/edition: 3
7575
Collate:
7676
'EC_AIPW_OPT_bootstrap.R'

‎NAMESPACE‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,12 +27,10 @@ export(simulate_trial_status)
2727
export(simulate_trt_assign)
2828
import(boot)
2929
import(checkmate)
30-
import(dplyr)
3130
import(futile.logger)
3231
import(future.apply)
3332
import(mvtnorm)
3433
import(progress)
35-
import(tidyr)
3634
importFrom(CVXR,Minimize)
3735
importFrom(CVXR,Problem)
3836
importFrom(CVXR,Variable)

‎R/EC_AIPW_OPT.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -106,10 +106,10 @@ EC_AIPW_OPT <- function(data,
106106
piS.model <- glm(model_form_piS, data = df, family = "binomial")
107107
# outcome regression model
108108
Y0.model <- lapply(model_form_mu0_ext, function(x) {
109-
lm(as.formula(x), data = filter(df, A == 0))
109+
lm(as.formula(x), data = dplyr::filter(df, A == 0))
110110
})
111111
Y0.model.dummy <- lapply(model_form_mu0_ext, function(x) {
112-
lm(as.formula(x), data = filter(df))
112+
lm(as.formula(x), data = dplyr::filter(df))
113113
})
114114

115115
# predict Y0 from outcome regression models
@@ -124,13 +124,13 @@ EC_AIPW_OPT <- function(data,
124124
# estimate ATE
125125
temp <- df |>
126126
cbind(Y0, Yr) |>
127-
mutate(
127+
dplyr::mutate(
128128
piA = sum(A[S == 1]) / n,
129129
piS = sum(S) / (n + m),
130130
piSX = predict(piS.model, newdata = df, type = "response"),
131131
rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
132132
) |>
133-
mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
133+
dplyr::mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
134134

135135
### create outcomes: obs * T
136136
Ys <- as.matrix(Yr)
@@ -277,8 +277,8 @@ EC_AIPW_OPT <- function(data,
277277

278278
if (Bootstrap == TRUE) {
279279
Group_ID <- df |>
280-
group_by(S, A) |>
281-
mutate(group_id = cur_group_id())
280+
dplyr::group_by(S, A) |>
281+
dplyr::mutate(group_id = dplyr::cur_group_id())
282282
Group_ID <- Group_ID$group_id
283283

284284
boot.ci.type <- switch(bootstrap_CI_type,

‎R/EC_AIPW_OPT_bootstrap.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -62,9 +62,9 @@ EC_AIPW_OPT_bootstrap <- function(data,
6262
# estimate ATE
6363
## TODO: why do use the true propensity score?
6464
temp <- df |>
65-
filter(S == 1) |>
66-
mutate(`piA` = sum(A) / n) |>
67-
mutate(w11 = `piA`, w10 = 1 - `piA`)
65+
dplyr::filter(S == 1) |>
66+
dplyr::mutate(`piA` = sum(A) / n) |>
67+
dplyr::mutate(w11 = `piA`, w10 = 1 - `piA`)
6868

6969
### create outcomes: obs by T
7070
Ys <- as.matrix(Y[S == 1, ])
@@ -93,10 +93,10 @@ EC_AIPW_OPT_bootstrap <- function(data,
9393
piS.model <- glm(model_form_piS, data = df, family = "binomial")
9494
# outcome regression model
9595
Y0.model <- lapply(model_form_mu0_ext, function(x) {
96-
lm(as.formula(x), data = filter(df, A == 0))
96+
lm(as.formula(x), data = dplyr::filter(df, A == 0))
9797
})
9898
Y0.model.dummy <- lapply(model_form_mu0_ext, function(x) {
99-
lm(as.formula(x), data = filter(df))
99+
lm(as.formula(x), data = dplyr::filter(df))
100100
})
101101

102102
# predict Y0 from outcome regression models
@@ -113,13 +113,13 @@ EC_AIPW_OPT_bootstrap <- function(data,
113113
# estimate ATE
114114
suppressWarnings({
115115
temp <- cbind(df, Y0, Yr) |>
116-
mutate(
116+
dplyr::mutate(
117117
piA = sum(A[S == 1]) / n,
118118
piS = sum(S) / (n + m),
119119
piSX = predict(piS.model, newdata = df, type = "response"),
120120
rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
121121
) |>
122-
mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
122+
dplyr::mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
123123
})
124124
### create outcomes: obs * T
125125
Ys <- as.matrix(Yr)

‎R/EC_IPW_OPT.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -73,9 +73,9 @@ EC_IPW_OPT <- function(data,
7373
# estimate ATE
7474
## TODO: why do use the true propensity score?
7575
temp <- df |>
76-
filter(S == 1) |>
77-
mutate(piA = sum(A) / n) |>
78-
mutate(w11 = piA, w10 = 1 - piA)
76+
dplyr::filter(S == 1) |>
77+
dplyr::mutate(piA = sum(A) / n) |>
78+
dplyr::mutate(w11 = piA, w10 = 1 - piA)
7979

8080
### create outcomes: obs by T
8181
Ys <- as.matrix(Y[S == 1, ])
@@ -113,14 +113,14 @@ EC_IPW_OPT <- function(data,
113113

114114
# estimate ATE
115115
temp <- df |>
116-
mutate(
116+
dplyr::mutate(
117117
piA = sum(A[S == 1]) / n,
118118
piS = sum(S) / (n + m),
119119
piSX = predict(piS.model, newdata = df, type = "response"),
120120
# piSX = exp(log(2) + df$X - 3 * df$U)/(1+exp(log(2) + df$X - 3 * df$U)),
121121
rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
122122
) |>
123-
mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
123+
dplyr::mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
124124

125125
# temp$w00[temp$w00 > 0.9] = 0.9
126126
# temp$w00[temp$w00 < 0.1] = 0.1
@@ -225,8 +225,8 @@ EC_IPW_OPT <- function(data,
225225

226226
if (Bootstrap == TRUE) {
227227
Group_ID <- df |>
228-
group_by(S, A) |>
229-
mutate(group_id = cur_group_id())
228+
dplyr::group_by(S, A) |>
229+
dplyr::mutate(group_id = dplyr::cur_group_id())
230230
Group_ID <- Group_ID$group_id
231231

232232
boot.ci.type <- switch(bootstrap_CI_type,

‎R/EC_IPW_OPT_bootstrap.R‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -59,9 +59,9 @@ EC_IPW_OPT_bootstrap <- function(data,
5959
# estimate ATE
6060
## TODO: why do use the true propensity score?
6161
temp <- df |>
62-
filter(S == 1) |>
63-
mutate(piA = sum(A) / n) |>
64-
mutate(w11 = piA, w10 = 1 - piA)
62+
dplyr::filter(S == 1) |>
63+
dplyr::mutate(piA = sum(A) / n) |>
64+
dplyr::mutate(w11 = piA, w10 = 1 - piA)
6565

6666
### create outcomes: obs by T
6767
Ys <- as.matrix(Y[S == 1, ])
@@ -81,13 +81,13 @@ EC_IPW_OPT_bootstrap <- function(data,
8181

8282
# estimate ATE
8383
temp <- df |>
84-
mutate(
84+
dplyr::mutate(
8585
piA = sum(A[S == 1]) / n,
8686
piS = sum(S) / (n + m),
8787
piSX = predict(piS.model, newdata = df, type = "response"),
8888
rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
8989
) |>
90-
mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
90+
dplyr::mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
9191

9292
### create outcomes: obs * T
9393
Ys <- as.matrix(Y)

‎R/legacy_DID_EC_AIPW.R‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -60,33 +60,33 @@ DID_EC_AIPW <- function(data,
6060

6161
#
6262
piS <- glm(as.formula(model_form_piS), data = df, family = "binomial")
63-
piSX <- predict(piS, newdata = filter(df), type = "response")
63+
piSX <- predict(piS, newdata = dplyr::filter(df), type = "response")
6464
if (model_form_piA == "") {
6565
piAX <- sum(A) / n
6666
} else {
67-
piA <- glm(as.formula(model_form_piA), data = filter(df, S == 1), family = "binomial")
68-
piAX <- predict(piA, newdata = filter(df), type = "response")
67+
piA <- glm(as.formula(model_form_piA), data = dplyr::filter(df, S == 1), family = "binomial")
68+
piAX <- predict(piA, newdata = dplyr::filter(df), type = "response")
6969
}
7070

7171
# predict Y0 from outcome regression models
7272
model_list_ext <- lapply(1:T_follow, function(x) {
73-
assign(paste0("m.ext", x), lm(as.formula(model_form_mu0_ext[x]), data = filter(df, S == 0)))
73+
assign(paste0("m.ext", x), lm(as.formula(model_form_mu0_ext[x]), data = dplyr::filter(df, S == 0)))
7474
})
7575
Y0 <- data.frame(sapply(1:T_follow, function(x) {
76-
predict(model_list_ext[[x]], newdata = filter(df))
76+
predict(model_list_ext[[x]], newdata = dplyr::filter(df))
7777
}))
7878
colnames(Y0) <- paste0("y", 1:T_follow, "_0")
7979
# for residual
8080
Yr <- Y - Y0
8181
colnames(Yr) <- paste0("y", 1:T_follow, "_r")
8282

8383
temp <- cbind(df, Y0, Yr) |>
84-
mutate(
84+
dplyr::mutate(
8585
piAX = piAX,
8686
piSX = piSX,
8787
rx = piSX * (1 - pi.S) / (1 - piSX) / pi.S
8888
) |>
89-
mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
89+
dplyr::mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
9090

9191
# create outcomes
9292
Ys <- as.matrix(Yr)
@@ -111,8 +111,8 @@ DID_EC_AIPW <- function(data,
111111

112112
if (Bootstrap) {
113113
Group_ID <- df |>
114-
group_by(S, A) |>
115-
mutate(group_id = cur_group_id())
114+
dplyr::group_by(S, A) |>
115+
dplyr::mutate(group_id = dplyr::cur_group_id())
116116
Group_ID <- Group_ID$group_id
117117

118118
boot.ci.type <- switch(bootstrap_CI_type,

‎R/legacy_DID_EC_AIPW_bootstrap.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -61,30 +61,30 @@ DID_EC_AIPW_bootstrap <- function(data,
6161

6262
piS <- glm(as.formula(model_form_piS), data = df, family = "binomial")
6363
suppressWarnings({
64-
piSX <- predict(piS, newdata = filter(df), type = "response")
64+
piSX <- predict(piS, newdata = dplyr::filter(df), type = "response")
6565
})
6666
if (model_form_piA == "") {
6767
piAX <- sum(A) / n
6868
} else {
6969
piA <- glm(
7070
as.formula(model_form_piA),
71-
data = filter(df, S == 1), family = "binomial"
71+
data = dplyr::filter(df, S == 1), family = "binomial"
7272
)
7373
suppressWarnings({
74-
piAX <- predict(piA, newdata = filter(df), type = "response")
74+
piAX <- predict(piA, newdata = dplyr::filter(df), type = "response")
7575
})
7676
}
7777

7878
# predict Y0 from outcome regression models
7979
model_list_ext <- lapply(seq_len(T_follow), function(x) {
8080
assign(
8181
paste0("m.ext", x),
82-
lm(as.formula(model_form_mu0_ext[x]), data = filter(df, S == 0))
82+
lm(as.formula(model_form_mu0_ext[x]), data = dplyr::filter(df, S == 0))
8383
)
8484
})
8585
suppressWarnings({
8686
Y0 <- data.frame(sapply(seq_len(T_follow), function(x) {
87-
predict(model_list_ext[[x]], newdata = filter(df))
87+
predict(model_list_ext[[x]], newdata = dplyr::filter(df))
8888
}))
8989
})
9090
colnames(Y0) <- paste0("y", seq_len(T_follow), "_0")
@@ -93,12 +93,12 @@ DID_EC_AIPW_bootstrap <- function(data,
9393
colnames(Yr) <- paste0("y", seq_len(T_follow), "_r")
9494

9595
temp <- cbind(df, Y0, Yr) |>
96-
mutate(
96+
dplyr::mutate(
9797
piAX = piAX,
9898
piSX = piSX,
9999
rx = piSX * (1 - pi.S) / (1 - piSX) / pi.S
100100
) |>
101-
mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
101+
dplyr::mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
102102

103103
# create outcomes
104104
Ys <- as.matrix(Yr)

‎R/legacy_DID_EC_IPW.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -60,22 +60,22 @@ DID_EC_IPW <- function(data,
6060

6161
#
6262
piS <- glm(as.formula(model_form_piS), data = df, family = "binomial")
63-
piSX <- predict(piS, newdata = filter(df), type = "response")
63+
piSX <- predict(piS, newdata = dplyr::filter(df), type = "response")
6464
if (model_form_piA == "") {
6565
piAX <- sum(A) / n
6666
} else {
67-
piA <- glm(as.formula(model_form_piA), data = filter(df, S == 1), family = "binomial")
68-
piAX <- predict(piA, newdata = filter(df), type = "response")
67+
piA <- glm(as.formula(model_form_piA), data = dplyr::filter(df, S == 1), family = "binomial")
68+
piAX <- predict(piA, newdata = dplyr::filter(df), type = "response")
6969
}
7070

7171

7272
temp <- df |>
73-
mutate(
73+
dplyr::mutate(
7474
piAX = piAX,
7575
piSX = piSX,
7676
rx = piSX * (1 - pi.S) / (1 - piSX) / pi.S
7777
) |>
78-
mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
78+
dplyr::mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
7979

8080

8181
# create outcomes
@@ -101,8 +101,8 @@ DID_EC_IPW <- function(data,
101101

102102
if (Bootstrap) {
103103
Group_ID <- df |>
104-
group_by(S, A) |>
105-
mutate(group_id = cur_group_id())
104+
dplyr::group_by(S, A) |>
105+
dplyr::mutate(group_id = dplyr::cur_group_id())
106106
Group_ID <- Group_ID$group_id
107107

108108
boot.ci.type <- switch(bootstrap_CI_type,

‎R/legacy_DID_EC_IPW_bootstrap.R‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -47,22 +47,22 @@ DID_EC_IPW_bootstrap <- function(data,
4747

4848
#
4949
piS <- glm(as.formula(model_form_piS), data = df, family = "binomial")
50-
piSX <- predict(piS, newdata = filter(df), type = "response")
50+
piSX <- predict(piS, newdata = dplyr::filter(df), type = "response")
5151
if (model_form_piA == "") {
5252
piAX <- sum(A) / n
5353
} else {
54-
piA <- glm(as.formula(model_form_piA), data = filter(df, S == 1), family = "binomial")
55-
piAX <- predict(piA, newdata = filter(df), type = "response")
54+
piA <- glm(as.formula(model_form_piA), data = dplyr::filter(df, S == 1), family = "binomial")
55+
piAX <- predict(piA, newdata = dplyr::filter(df), type = "response")
5656
}
5757

5858

5959
temp <- df |>
60-
mutate(
60+
dplyr::mutate(
6161
piAX = piAX,
6262
piSX = piSX,
6363
rx = piSX * (1 - pi.S) / (1 - piSX) / pi.S
6464
) |>
65-
mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
65+
dplyr::mutate(w11 = 1 / piAX, w10 = 1 / (1 - piAX), w00 = rx)
6666

6767

6868
# create outcomes

0 commit comments

Comments
 (0)