add back obs_weights to est_tml()

nhejazi · Sep 6, 2023 · 77ae49d · 77ae49d
1 parent 15f938f
commit 77ae49d
Showing 1 changed file with 9 additions and 4 deletions.
diff --git a/R/estimators.R b/R/estimators.R
@@ -776,7 +776,7 @@ est_tml <- function(data,
         weights_b_tilt <- as.numeric(data[R == 1, A] == contrast[1]) / g_prime *
           as.numeric(data[R == 1, two_phase_weights])
       } else {
-        weights_b_tilt <- (data$A == contrast[1]) / g_prime
+        weights_b_tilt <- data$obs_weights * (data$A == contrast[1]) / g_prime
       }
 
       suppressWarnings(
@@ -829,7 +829,7 @@ est_tml <- function(data,
          weights_q_tilt <- as.numeric(data[R == 1, A] == contrast[1]) /
            g_prime * as.numeric(data[R == 1, two_phase_weights])
       } else {
-        weights_q_tilt <- (data$A == contrast[1]) / g_prime
+        weights_q_tilt <- data$obs_weights * (data$A == contrast[1]) / g_prime
       }
       suppressWarnings(
         q_tilt_fit <- stats::glm(
@@ -906,15 +906,20 @@ est_tml <- function(data,
     stats::qlogis()
 
   # fit tilting model for substitution estimator
+  if (tilt_two_phase_weights) {
+    weights_v_tilt <- (as.numeric(data[R == 1, A]) == contrast[2]) / g_star *
+        (as.numeric(data[R == 1, two_phase_weights]))
+  } else {
+    weights_v_tilt <- data$obs_weights * (data$A == contrast[2]) / g_star
+  }
   suppressWarnings(
     v_tilt_fit <- stats::glm(
       stats::as.formula("v_pseudo ~ offset(v_star_logit)"),
       data = data.table::as.data.table(list(
         v_pseudo = v_pseudo,
         v_star_logit = v_star_logit
       )),
-      weights = (as.numeric(data[R == 1, A]) == contrast[2]) / g_star *
-        (as.numeric(data[R == 1, two_phase_weights])),
+      weights = weights_v_tilt,
       family = "binomial",
       start = 0
     )