finish lint

Author: Matt Secrest

R/EC_IPW_OPT.R

@@ -72,9 +72,9 @@ EC_IPW_OPT <- function(data,
   if ((!optimal_weight_flag) && wt == 0) {
     # estimate ATE
     ## TODO: why do use the true propensity score?
-    temp <- df %>%
-      filter(S == 1) %>%
-      mutate(piA = sum(A) / n) %>%
+    temp <- df |>
+      filter(S == 1) |>
+      mutate(piA = sum(A) / n) |>
       mutate(w11 = piA, w10 = 1 - piA)
 
     ### create outcomes: obs by T
@@ -112,14 +112,14 @@ EC_IPW_OPT <- function(data,
     # print(piS.model)
 
     # estimate ATE
-    temp <- df %>%
+    temp <- df |>
       mutate(
         piA = sum(A[S == 1]) / n,
         piS = sum(S) / (n + m),
         piSX = predict(piS.model, newdata = df, type = "response"),
         # piSX = exp(log(2) + df$X - 3 * df$U)/(1+exp(log(2) + df$X - 3 * df$U)),
         rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
-      ) %>%
+      ) |>
       mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
 
     # temp$w00[temp$w00 > 0.9] = 0.9
@@ -130,7 +130,10 @@ EC_IPW_OPT <- function(data,
     ### create outcomes: obs * T
     Ys <- as.matrix(Y)
 
-    potential <- data.frame((temp$S * temp$A / temp$w11 + temp$S * (1 - temp$A) / temp$w10 + (1 - temp$S) * temp$w00) * Ys)
+    potential <- data.frame(
+      (temp$S * temp$A / temp$w11 + temp$S * (1 - temp$A) / temp$w10 +
+        (1 - temp$S) * temp$w00) * Ys
+    )
     mu1 <- colSums(potential[temp$S == 1 & temp$A == 1, , drop = FALSE]) / sum(temp$S * temp$A / temp$w11)
     mu10 <- colSums(potential[temp$S == 1 & temp$A == 0, , drop = FALSE]) / sum(temp$S * (1 - temp$A) / temp$w10)
     mu00 <- colSums(potential[temp$S == 0, , drop = FALSE]) / (sum((1 - temp$S) * temp$w00))
@@ -143,8 +146,12 @@ EC_IPW_OPT <- function(data,
     A11 <- diag(rep(-1, T_follow), nrow = T_follow)
     A22 <- diag(rep(-1, T_follow), nrow = T_follow)
     A33 <- diag(rep(-mean((1 - temp$S) * temp$w00 / (1 - temp$piS)), T_follow), nrow = T_follow)
-    A34 <- t((as.vector((1 - temp$S) * temp$piSX / (temp$piS * (1 - temp$piSX))) * sweep(Ys, 2, mu00))) %*% model.matrix(piS.model) / (n + m)
-    piS.beta <- t(model.matrix(piS.model)) %*% diag(-temp$`piSX` * (1 - temp$`piSX`)) %*% model.matrix(piS.model) / (n + m)
+    A34 <- t((as.vector((1 - temp$S) * temp$piSX /
+      (temp$piS * (1 - temp$piSX))) * sweep(Ys, 2, mu00))) %*%
+      model.matrix(piS.model) / (n + m)
+    piS.beta <- t(model.matrix(piS.model)) %*%
+      diag(-temp$`piSX` * (1 - temp$`piSX`)) %*%
+      model.matrix(piS.model) / (n + m)
     A44 <- piS.beta
 
     n1 <- dim(A11)[1]
@@ -179,7 +186,8 @@ EC_IPW_OPT <- function(data,
     # fit1 = lm(as.formula(paste("Y2","~",form_x)), data = filter(temp,S==1&A==0) )
     # sigma10 = (summary(fit1)$sigma)**2
     num <- sum(temp$S * (1 - temp$A) / temp$w10^2 / (sum(temp$S * (1 - temp$A) / temp$w10))^2)
-    #+ sum(temp$S*(1-temp$A))*var(temp$S*(1-temp$A)*predict(fit1,newdata =temp)/temp$w10/sum(temp$S*(1-temp$A)/temp$w10))
+    #+ sum(temp$S*(1-temp$A))*var(temp$S*(1-temp$A)*     # nolint: line_length_linter.
+    #+ predict(fit1,newdata =temp)/temp$w10/sum(temp$S*(1-temp$A)/temp$w10))
 
     # fit0 = lm(as.formula(paste("Y2","~",form_x)), data = filter(temp,S==0) )
     # sigma00 = (summary(fit0)$sigma)**2
@@ -216,8 +224,8 @@ EC_IPW_OPT <- function(data,
   cutoff <- qnorm(1 - alpha / 2, lower.tail = TRUE)
 
   if (Bootstrap == TRUE) {
-    Group_ID <- df %>%
-      group_by(S, A) %>%
+    Group_ID <- df |>
+      group_by(S, A) |>
       mutate(group_id = cur_group_id())
     Group_ID <- Group_ID$group_id
 
@@ -267,14 +275,14 @@ EC_IPW_OPT <- function(data,
       lower_CI_boot = lower_CI_boot,
       upper_CI_boot = upper_CI_boot
     )
-    return(list(results = results, borrow_weight = wt))
+    list(results = results, borrow_weight = wt)
   } else {
     results <- data.frame(
       point_estimates = tau,
       standard_deviation = sd.tau,
       lower_CI_normal = tau - sd.tau * cutoff,
       upper_CI_normal = tau + sd.tau * cutoff
     )
-    return(list(results = results, borrow_weight = wt))
+    list(results = results, borrow_weight = wt)
   }
 }

R/EC_IPW_OPT_bootstrap.R

@@ -58,9 +58,9 @@ EC_IPW_OPT_bootstrap <- function(data,
   if ((!optimal_weight_flag) && wt == 0) {
     # estimate ATE
     ## TODO: why do use the true propensity score?
-    temp <- df %>%
-      filter(S == 1) %>%
-      mutate(piA = sum(A) / n) %>%
+    temp <- df |>
+      filter(S == 1) |>
+      mutate(piA = sum(A) / n) |>
       mutate(w11 = piA, w10 = 1 - piA)
 
     ### create outcomes: obs by T
@@ -80,13 +80,13 @@ EC_IPW_OPT_bootstrap <- function(data,
     piS.model <- glm(as.formula(model_form_piS), data = df, family = "binomial")
 
     # estimate ATE
-    temp <- df %>%
+    temp <- df |>
       mutate(
         piA = sum(A[S == 1]) / n,
         piS = sum(S) / (n + m),
         piSX = predict(piS.model, newdata = df, type = "response"),
         rx = (piSX / (1 - piSX)) * ((1 - piS) / piS)
-      ) %>%
+      ) |>
       mutate(w11 = piA, w10 = 1 - piA, w00 = rx)
 
     ### create outcomes: obs * T
@@ -102,7 +102,8 @@ EC_IPW_OPT_bootstrap <- function(data,
     # fit1 = lm(as.formula(paste("Y2","~",form_x)), data = filter(temp,S==1&A==0) )
     # sigma10 = (summary(fit1)$sigma)**2
     num <- sum(temp$S * (1 - temp$A) / temp$w10^2 / (sum(temp$S * (1 - temp$A) / temp$w10))^2)
-    #+ sum(temp$S*(1-temp$A))*var(temp$S*(1-temp$A)*predict(fit1,newdata =temp)/temp$w10/sum(temp$S*(1-temp$A)/temp$w10))
+    #+ sum(temp$S*(1-temp$A))*var(temp$S*(1-temp$A)*     # nolint: line_length_linter.
+    #+ predict(fit1,newdata =temp)/temp$w10/sum(temp$S*(1-temp$A)/temp$w10))
 
     # fit0 = lm(as.formula(paste("Y2","~",form_x)), data = filter(temp,S==0) )
     # sigma00 = (summary(fit0)$sigma)**2
@@ -121,5 +122,5 @@ EC_IPW_OPT_bootstrap <- function(data,
     names(tau) <- paste0("tau", 1:T_follow)
   }
 
-  return(tau)
+  tau
 }