Skip to content

Commit 88ccfc5

Browse files
juliettelimozinjuliettelimozin
committed
Fixed some Lint errors in bootstrap.R
1 parent 6e7b88c commit 88ccfc5

File tree

1 file changed

+154
-153
lines changed

1 file changed

+154
-153
lines changed

‎R/bootstrap.R

Lines changed: 154 additions & 153 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,9 @@
2323
#' \item{cense_models}{a list containing a summary table of regression models for censoring weights}
2424
#' }
2525
#'
26-
#'
26+
#' @importFrom stats predict.glm
2727
#' @export
28-
weight_func_bootstrap <- function(object = trial_pp,
28+
weight_func_bootstrap <- function(object,
2929
remodel = TRUE,
3030
new_coef_sw_d0 = NA,
3131
new_coef_sw_n0 = NA,
@@ -37,8 +37,8 @@ weight_func_bootstrap <- function(object = trial_pp,
3737
new_coef_c_n1 = NA,
3838
new_coef_c_d = NA,
3939
new_coef_c_n = NA,
40-
boot_idx = unique(trial_pp@data@data$id),
41-
quiet = T,
40+
boot_idx,
41+
quiet = TRUE,
4242
...) {
4343
# Dummy variables used in data.table calls declared to prevent package check NOTES:
4444
eligible0 <- eligible1 <- id <- period <- eligible0.y <- eligible1.y <- am_1 <- eligible_wts_0 <- eligible_wts_1 <-
@@ -52,56 +52,56 @@ weight_func_bootstrap <- function(object = trial_pp,
5252

5353
quiet_msg(quiet, "Starting switching weights")
5454
switch_models <- list()
55-
if(remodel == TRUE){
56-
57-
switch_results <- fit_switch_weights_bootstrap(
58-
switch_d_cov = object@switch_weights@denominator,
59-
switch_n_cov = object@switch_weights@numerator,
60-
sw_data = object@data@data,
61-
boot_idx = boot_idx,
62-
quiet = quiet,
63-
save_dir = data_dir,
64-
save_weight_models = save_weight_models,
65-
glm_function = glm_function,
66-
...
67-
)
68-
sw_data <- switch_results$sw_data
69-
switch_models <- switch_results$switch_models
70-
rm(switch_results)
71-
} else{ #only need to fetch the glm objects if we are recalculating weights from new coefficients
72-
weight_model_d0 <- readRDS(object@switch_weights@fitted$d0@summary$save_path$path)
73-
weight_model_n0 <- readRDS(object@switch_weights@fitted$n0@summary$save_path$path)
74-
weight_model_d1 <- readRDS(object@switch_weights@fitted$d1@summary$save_path$path)
75-
weight_model_n1 <- readRDS(object@switch_weights@fitted$n1@summary$save_path$path)
55+
if (remodel == TRUE) {
56+
57+
switch_results <- fit_switch_weights_bootstrap(
58+
switch_d_cov = object@switch_weights@denominator,
59+
switch_n_cov = object@switch_weights@numerator,
60+
sw_data = object@data@data,
61+
boot_idx = boot_idx,
62+
quiet = quiet,
63+
save_dir = data_dir,
64+
save_weight_models = save_weight_models,
65+
glm_function = glm_function,
66+
...
67+
)
68+
sw_data <- switch_results$sw_data
69+
switch_models <- switch_results$switch_models
70+
rm(switch_results)
71+
} else { #only need to fetch the glm objects if we are recalculating weights from new coefficients
72+
weight_model_d0 <- readRDS(object@switch_weights@fitted$d0@summary$save_path$path)
73+
weight_model_n0 <- readRDS(object@switch_weights@fitted$n0@summary$save_path$path)
74+
weight_model_d1 <- readRDS(object@switch_weights@fitted$d1@summary$save_path$path)
75+
weight_model_n1 <- readRDS(object@switch_weights@fitted$n1@summary$save_path$path)
7676

77-
weight_model_d0$coefficients <- new_coef_sw_d0
78-
weight_model_n0$coefficients <- new_coef_sw_n0
79-
weight_model_d1$coefficients <- new_coef_sw_d1
80-
weight_model_n1$coefficients <- new_coef_sw_n1
77+
weight_model_d0$coefficients <- new_coef_sw_d0
78+
weight_model_n0$coefficients <- new_coef_sw_n0
79+
weight_model_d1$coefficients <- new_coef_sw_d1
80+
weight_model_n1$coefficients <- new_coef_sw_n1
8181

82-
switch_d0 <- cbind(p0_d = predict.glm(weight_model_d0, weight_model_d0$data, type = 'response' ),
83-
weight_model_d0$data[, c("eligible0", "id", "period")])
82+
switch_d0 <- cbind(p0_d = predict.glm(weight_model_d0, weight_model_d0$data, type = "response" ),
83+
weight_model_d0$data[, c("eligible0", "id", "period")])
8484

85-
switch_n0 <- cbind(p0_n = predict.glm(weight_model_n0, weight_model_n0$data, type = 'response' ),
86-
weight_model_n0$data[, c("eligible0", "id", "period")])
85+
switch_n0 <- cbind(p0_n = predict.glm(weight_model_n0, weight_model_n0$data, type = "response" ),
86+
weight_model_n0$data[, c("eligible0", "id", "period")])
8787

88-
switch_d1 <- cbind(p1_d = predict.glm(weight_model_d1, weight_model_d1$data, type = 'response' ),
89-
weight_model_d1$data[, c("eligible1", "id", "period")])
88+
switch_d1 <- cbind(p1_d = predict.glm(weight_model_d1, weight_model_d1$data, type = "response" ),
89+
weight_model_d1$data[, c("eligible1", "id", "period")])
9090

91-
switch_n1 <- cbind(p1_n = predict.glm(weight_model_n1, weight_model_n1$data, type = 'response' ),
92-
weight_model_n1$data[, c("eligible1", "id", "period")])
91+
switch_n1 <- cbind(p1_n = predict.glm(weight_model_n1, weight_model_n1$data, type = "response" ),
92+
weight_model_n1$data[, c("eligible1", "id", "period")])
9393

94-
switch_0 <- merge.data.table(switch_d0,switch_n0,
95-
by= c("id", "period", "eligible0"))
96-
switch_1 <- merge.data.table(switch_d1,switch_n1,
97-
by= c("id", "period", "eligible1"))
94+
switch_0 <- merge.data.table(switch_d0, switch_n0,
95+
by= c("id", "period", "eligible0"))
96+
switch_1 <- merge.data.table(switch_d1, switch_n1,
97+
by= c("id", "period", "eligible1"))
9898

99-
rm(switch_d0, switch_d1, switch_n0, switch_n1)
99+
rm(switch_d0, switch_d1, switch_n0, switch_n1)
100100

101-
sw_data <- merge.data.table(object@data@data, switch_0 %>% dplyr::select(-eligible0), by = c("id", "period"), all = TRUE)
102-
sw_data <- merge.data.table(sw_data, switch_1 %>% dplyr::select(-eligible1), by = c("id", "period"), all = TRUE)
101+
sw_data <- merge.data.table(object@data@data, switch_0 %>% dplyr::select(-eligible0), by = c("id", "period"), all = TRUE)
102+
sw_data <- merge.data.table(sw_data, switch_1 %>% dplyr::select(-eligible1), by = c("id", "period"), all = TRUE)
103103

104-
rm(switch_1, switch_0)
104+
rm(switch_1, switch_0)
105105

106106
}
107107
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -110,119 +110,119 @@ weight_func_bootstrap <- function(object = trial_pp,
110110
quiet_msg(quiet, "Starting censor weights")
111111
censor_models <- list()
112112

113-
if (remodel == TRUE){
114-
censor_results <- fit_censor_weights_bootstrap(
115-
cense_d_cov = object@censor_weights@denominator,
116-
cense_n_cov = object@censor_weights@numerator,
117-
pool_cense_d = object@censor_weights@pool_denominator,
118-
pool_cense_n = object@censor_weights@pool_numerator,
119-
sw_data = sw_data,
120-
boot_idx = boot_idx,
121-
quiet = quiet,
122-
save_dir = data_dir,
123-
save_weight_models = save_weight_models,
124-
glm_function = glm_function,
125-
...
126-
)
127-
sw_data <- censor_results$sw_data
128-
censor_models <- censor_results$censor_models
129-
rm(censor_results)
130-
} else{
131-
if (object@censor_weights@pool_denominator) { # Fit pooled denominator models
132-
cense_model_d <- readRDS(object@censor_weights@fitted$d@summary$save_path$path)
133-
cense_model_d$coeefficients <- new_coef_c_d
134-
135-
cense_d <- cbind(pC_d = predict.glm(cense_model_d, cense_model_d$data, type = 'response'),
136-
cense_model_d$data[, c("id", "period")])
137-
138-
rm(cense_model_d)
139-
} else{
140-
cense_model_d0 <- readRDS(object@censor_weights@fitted$d0@summary$save_path$path)
141-
cense_model_d1 <- readRDS(object@censor_weights@fitted$d1@summary$save_path$path)
142-
143-
cense_model_d0$coefficients <- new_coef_c_d0
144-
cense_model_d1$coefficients <- new_coef_c_d1
145-
146-
147-
cense_d0 <- cbind(pC_d0 = predict.glm(cense_model_d0, cense_model_d0$data, type = 'response'),
148-
cense_model_d0$data[, c("id", "period")])
149-
censor_models$cense_d0 <- process_weight_model(
150-
cense_model_d0,
151-
save_weight_models,
152-
save_dir,
153-
"cense_model_pool_n.rds",
154-
"Model for P(cense = 0 | X, previous treatment = 0) for denominator",
155-
quiet
156-
)
157-
rm(cense_model_d0)
158-
159-
cense_d1 <- cbind(pC_d1 = predict.glm(cense_model_d1, cense_model_d1$data, type = 'response'),
160-
cense_model_d1$data[, c("id", "period")])
161-
162-
rm(cense_model_d1)
163-
}
113+
if (remodel == TRUE) {
114+
censor_results <- fit_censor_weights_bootstrap(
115+
cense_d_cov = object@censor_weights@denominator,
116+
cense_n_cov = object@censor_weights@numerator,
117+
pool_cense_d = object@censor_weights@pool_denominator,
118+
pool_cense_n = object@censor_weights@pool_numerator,
119+
sw_data = sw_data,
120+
boot_idx = boot_idx,
121+
quiet = quiet,
122+
save_dir = data_dir,
123+
save_weight_models = save_weight_models,
124+
glm_function = glm_function,
125+
...
126+
)
127+
sw_data <- censor_results$sw_data
128+
censor_models <- censor_results$censor_models
129+
rm(censor_results)
130+
} else {
131+
if (object@censor_weights@pool_denominator) { # Fit pooled denominator models
132+
cense_model_d <- readRDS(object@censor_weights@fitted$d@summary$save_path$path)
133+
cense_model_d$coeefficients <- new_coef_c_d
164134

165-
if (object@censor_weights@pool_numerator) {
166-
cense_n <- readRDS(object@censor_weights@fitted$n@summary$save_path$path)
135+
cense_d <- cbind(pC_d = predict.glm(cense_model_d, cense_model_d$data, type = "response"),
136+
cense_model_d$data[, c("id", "period")])
167137

168-
cense_model_n$coefficients <- new_coef_c_n
138+
rm(cense_model_d)
139+
} else {
140+
cense_model_d0 <- readRDS(object@censor_weights@fitted$d0@summary$save_path$path)
141+
cense_model_d1 <- readRDS(object@censor_weights@fitted$d1@summary$save_path$path)
142+
143+
cense_model_d0$coefficients <- new_coef_c_d0
144+
cense_model_d1$coefficients <- new_coef_c_d1
145+
146+
147+
cense_d0 <- cbind(pC_d0 = predict.glm(cense_model_d0, cense_model_d0$data, type = "response"),
148+
cense_model_d0$data[, c("id", "period")])
149+
censor_models$cense_d0 <- process_weight_model(
150+
cense_model_d0,
151+
save_weight_models,
152+
save_dir,
153+
"cense_model_pool_n.rds",
154+
"Model for P(cense = 0 | X, previous treatment = 0) for denominator",
155+
quiet
156+
)
157+
rm(cense_model_d0)
169158

170-
cense_n <- cbind(pC_n = predict.glm(cense_model_n, cense_model_n$data, type = 'response'), cense_model_n$data[, c("id", "period")])
159+
cense_d1 <- cbind(pC_d1 = predict.glm(cense_model_d1, cense_model_d1$data, type = "response"),
160+
cense_model_d1$data[, c("id", "period")])
171161

172-
rm(cense_model_n)
173-
} else{
162+
rm(cense_model_d1)
163+
}
174164

175-
cense_model_n0 <- readRDS(object@censor_weights@fitted$n0@summary$save_path$path)
176-
cense_model_n1 <- readRDS(object@censor_weights@fitted$n1@summary$save_path$path)
165+
if (object@censor_weights@pool_numerator) {
166+
cense_n <- readRDS(object@censor_weights@fitted$n@summary$save_path$path)
177167

178-
cense_model_n0$coefficients <- new_coef_c_n0
179-
cense_model_n1$coefficients <- new_coef_c_n1
168+
cense_model_n$coefficients <- new_coef_c_n
180169

181-
cense_n0 <- cbind(pC_n0 = predict.glm(cense_model_n0, cense_model_n0$data, type = 'response'), cense_model_n0$data[, c("id", "period")])
170+
cense_n <- cbind(pC_n = predict.glm(cense_model_n, cense_model_n$data, type = "response"), cense_model_n$data[, c("id", "period")])
182171

172+
rm(cense_model_n)
173+
} else {
183174

184-
rm(cense_model_n0)
175+
cense_model_n0 <- readRDS(object@censor_weights@fitted$n0@summary$save_path$path)
176+
cense_model_n1 <- readRDS(object@censor_weights@fitted$n1@summary$save_path$path)
185177

178+
cense_model_n0$coefficients <- new_coef_c_n0
179+
cense_model_n1$coefficients <- new_coef_c_n1
186180

187-
cense_n1 <- cbind(pC_n1 = predict.glm(cense_model_n1, cense_model_n1$data, type = 'response'), cense_model_n1$data[, c("id", "period")])
181+
cense_n0 <- cbind(pC_n0 = predict.glm(cense_model_n0, cense_model_n0$data, type = "response"), cense_model_n0$data[, c("id", "period")])
188182

189-
rm(cense_model_n1)
190-
}
191183

192-
# combine ------------------------------
193-
if (object@censor_weights@pool_denominator && object@censor_weights@pool_numerator) {
194-
# all pooled
195-
sw_data <- merge.data.table(sw_data, cense_d, by = c("id", "period"), all = TRUE)
196-
sw_data <- merge.data.table(sw_data, cense_n, by = c("id", "period"), all = TRUE)
197-
rm(cense_d, cense_n)
198-
} else if (!object@censor_weights@pool_denominator && !object@censor_weights@pool_numerator) {
199-
# no pooled
200-
cense_0 <- cense_d0[cense_n0, on = list(id = id, period = period)]
201-
cense_1 <- cense_d1[cense_n1, on = list(id = id, period = period)]
202-
rm(cense_n1, cense_d1, cense_n0, cense_d0)
184+
rm(cense_model_n0)
203185

204-
sw_data <- merge.data.table(sw_data, cense_0, by = c("id", "period"), all = TRUE)
205-
sw_data <- merge.data.table(sw_data, cense_1, by = c("id", "period"), all = TRUE)
206186

207-
rm(cense_0, cense_1)
208-
sw_data[am_1 == 0, `:=`(pC_n = pC_n0, pC_d = pC_d0)]
209-
sw_data[am_1 == 1, `:=`(pC_n = pC_n1, pC_d = pC_d1)]
210-
} else if (!object@censor_weights@pool_denominator && object@censor_weights@pool_numerator) {
211-
# only numerator pooled
212-
sw_data <- sw_data[cense_n, on = list(id = id, period = period)]
213-
sw_data <- merge.data.table(sw_data, cense_d0, by = c("id", "period"), all = TRUE)
214-
sw_data <- merge.data.table(sw_data, cense_d1, by = c("id", "period"), all = TRUE)
215-
rm(cense_d1, cense_n, cense_d0)
187+
cense_n1 <- cbind(pC_n1 = predict.glm(cense_model_n1, cense_model_n1$data, type = "response"), cense_model_n1$data[, c("id", "period")])
216188

217-
sw_data[am_1 == 0, `:=`(pC_d = pC_d0)]
218-
sw_data[am_1 == 1, `:=`(pC_d = pC_d1)]
219-
} else if (object@censor_weights@pool_denominator && !object@censor_weights@pool_numerator) {
220-
# only denominator pooled
221-
stop("Check the arguments for pooling censoring models!")
222-
}
189+
rm(cense_model_n1)
190+
}
223191

192+
# combine ------------------------------
193+
if (object@censor_weights@pool_denominator && object@censor_weights@pool_numerator) {
194+
# all pooled
195+
sw_data <- merge.data.table(sw_data, cense_d, by = c("id", "period"), all = TRUE)
196+
sw_data <- merge.data.table(sw_data, cense_n, by = c("id", "period"), all = TRUE)
197+
rm(cense_d, cense_n)
198+
} else if (!object@censor_weights@pool_denominator && !object@censor_weights@pool_numerator) {
199+
# no pooled
200+
cense_0 <- cense_d0[cense_n0, on = list(id = id, period = period)]
201+
cense_1 <- cense_d1[cense_n1, on = list(id = id, period = period)]
202+
rm(cense_n1, cense_d1, cense_n0, cense_d0)
203+
204+
sw_data <- merge.data.table(sw_data, cense_0, by = c("id", "period"), all = TRUE)
205+
sw_data <- merge.data.table(sw_data, cense_1, by = c("id", "period"), all = TRUE)
206+
207+
rm(cense_0, cense_1)
208+
sw_data[am_1 == 0, `:=`(pC_n = pC_n0, pC_d = pC_d0)]
209+
sw_data[am_1 == 1, `:=`(pC_n = pC_n1, pC_d = pC_d1)]
210+
} else if (!object@censor_weights@pool_denominator && object@censor_weights@pool_numerator) {
211+
# only numerator pooled
212+
sw_data <- sw_data[cense_n, on = list(id = id, period = period)]
213+
sw_data <- merge.data.table(sw_data, cense_d0, by = c("id", "period"), all = TRUE)
214+
sw_data <- merge.data.table(sw_data, cense_d1, by = c("id", "period"), all = TRUE)
215+
rm(cense_d1, cense_n, cense_d0)
216+
217+
sw_data[am_1 == 0, `:=`(pC_d = pC_d0)]
218+
sw_data[am_1 == 1, `:=`(pC_d = pC_d1)]
219+
} else if (object@censor_weights@pool_denominator && !object@censor_weights@pool_numerator) {
220+
# only denominator pooled
221+
stop("Check the arguments for pooling censoring models!")
224222
}
225223

224+
}
225+
226226

227227

228228

@@ -328,11 +328,11 @@ weight_func_bootstrap <- function(object = trial_pp,
328328

329329
quiet_msg(quiet, "Placer 3")
330330
#### New data is merged with existing expanded data to add the new weights
331-
output_data <- new_data[object@outcome_data@data, on = list( id = id, trial_period = trial_period,
332-
followup_time = followup_time)] %>%
331+
output_data <- new_data[object@outcome_data@data,
332+
on = list( id = id, trial_period = trial_period,followup_time = followup_time)] %>%
333333
rowwise() %>%
334334
dplyr::mutate(weight_boot = length(boot_idx[boot_idx == id])) %>%
335-
dplyr::mutate(weight = ifelse(weight_boot !=0,weight*weight_boot,0)) %>%
335+
dplyr::mutate(weight = ifelse(weight_boot !=0,weight*weight_boot, 0)) %>%
336336
dplyr::select(names(object@outcome_data@data))
337337

338338

@@ -344,16 +344,16 @@ weight_func_bootstrap <- function(object = trial_pp,
344344
}
345345

346346
fit_switch_weights_bootstrap <- function(switch_d_cov,
347-
switch_n_cov,
348-
eligible_wts_0 = NA,
349-
eligible_wts_1 = NA,
350-
sw_data,
351-
boot_idx,
352-
quiet,
353-
save_dir,
354-
save_weight_models,
355-
glm_function,
356-
...) {
347+
switch_n_cov,
348+
eligible_wts_0 = NA,
349+
eligible_wts_1 = NA,
350+
sw_data,
351+
boot_idx,
352+
quiet,
353+
save_dir,
354+
save_weight_models,
355+
glm_function,
356+
...) {
357357
eligible0 <- eligible1 <- id <- period <- NULL
358358
# Fit the models for the weights in the four scenarios
359359
switch_models <- list()
@@ -367,7 +367,8 @@ fit_switch_weights_bootstrap <- function(switch_d_cov,
367367
model_0_index <- sw_data[eval(data_0_expr), which = TRUE]
368368
# --------------- denominator ------------------
369369
model1 <- fit_glm(
370-
data = sw_data[model_0_index, ] %>% rowwise() %>%
370+
data = sw_data[model_0_index, ] %>%
371+
rowwise() %>%
371372
dplyr::mutate(weight_boot = length(boot_idx[boot_idx == id])),
372373
formula = switch_d_cov,
373374
weights = weight_boot,

0 commit comments

Comments
 (0)