edit match function when assigning weights

R/maic_anchored.R

@@ -154,9 +154,9 @@ maic_anchored <- function(weights_object,
 
   # : assign weights to real and pseudo ipd
   if (normalize_weights) {
-    ipd$weights <- weights_object$data$scaled_weights[match(weights_object$data$USUBJID, ipd$USUBJID)]
+    ipd$weights <- weights_object$data$scaled_weights[match(ipd$USUBJID, weights_object$data$USUBJID)]
   } else {
-    ipd$weights <- weights_object$data$weights[match(weights_object$data$USUBJID, ipd$USUBJID)]
+    ipd$weights <- weights_object$data$weights[match(ipd$USUBJID, weights_object$data$USUBJID)]
   }
   pseudo_ipd$weights <- 1
   if (!"USUBJID" %in% names(pseudo_ipd)) pseudo_ipd$USUBJID <- paste0("ID", seq_len(nrow(pseudo_ipd)))

R/maic_unanchored.R

@@ -140,9 +140,9 @@ maic_unanchored <- function(weights_object,
 
   # : assign weights to real and pseudo ipd
   if (normalize_weights) {
-    ipd$weights <- weights_object$data$scaled_weights[match(weights_object$data$USUBJID, ipd$USUBJID)]
+    ipd$weights <- weights_object$data$scaled_weights[match(ipd$USUBJID, weights_object$data$USUBJID)]
   } else {
-    ipd$weights <- weights_object$data$weights[match(weights_object$data$USUBJID, ipd$USUBJID)]
+    ipd$weights <- weights_object$data$weights[match(ipd$USUBJID, weights_object$data$USUBJID)]
   }
   pseudo_ipd$weights <- 1
 

tests/testthat/test-maic_unanchored.R

@@ -115,6 +115,52 @@ test_that("test binary case", {
 })
 
 
+
+test_that("check if match properly", {
+  data(centered_ipd_twt)
+  data(adrs_twt)
+
+  centered_colnames <- c("AGE", "AGE_SQUARED", "SEX_MALE", "ECOG0", "SMOKE", "N_PR_THER_MEDIAN")
+  centered_colnames <- paste0(centered_colnames, "_CENTERED")
+
+  weighted_data <- estimate_weights(
+    data = centered_ipd_twt,
+    centered_colnames = centered_colnames
+  )
+
+  # get dummy binary IPD
+  pseudo_adrs <- get_pseudo_ipd_binary(
+    binary_agd = data.frame(
+      ARM = c("B", "C", "B", "C"),
+      RESPONSE = c("YES", "YES", "NO", "NO"),
+      COUNT = c(280, 120, 200, 200)
+    ),
+    format = "stacked"
+  )
+
+  testout2 <- maic_anchored(
+    weights_object = weighted_data,
+    ipd = adrs_twt,
+    pseudo_ipd = pseudo_adrs,
+    trt_ipd = "A",
+    trt_agd = "B",
+    trt_common = "C",
+    normalize_weight = FALSE,
+    endpoint_type = "binary",
+    endpoint_name = "Binary Endpoint",
+    eff_measure = "OR",
+    # binary specific args
+    binary_robust_cov_type = "HC3"
+  )
+
+  weights_before_wrapper <- weighted_data$data$weights
+  adrs_twt_dummy <- adrs_twt
+  adrs_twt_dummy$weights <- weighted_data$data$weights[match(adrs_twt_dummy$USUBJID, weighted_data$data$USUBJID)]
+
+  weights_after_wrapper <- testout2$inferential$fit$model_after$data$weights
+  expect_equal(adrs_twt_dummy$weights, weights_after_wrapper)
+})
+
 test_that("test time to event case", {
   data(centered_ipd_sat)
   data(agd)

vignettes/anchored_binary.Rmd

@@ -102,7 +102,7 @@ result$inferential$fit$res_AB
 # merge in adrs with ipd_matched
 
 ipd <- adrs_twt
-ipd$weights <- weighted_data$data$weights[match(weighted_data$data$USUBJID, ipd$USUBJID)]
+ipd$weights <- weighted_data$data$weights[match(ipd$USUBJID, weighted_data$data$USUBJID)]
 
 pseudo_ipd <- pseudo_adrs
 pseudo_ipd$weights <- 1

vignettes/anchored_survival.Rmd

@@ -104,7 +104,7 @@ result$inferential$fit$res_AB
 # merge in adtte with ipd_matched
 
 ipd <- adtte_twt
-ipd$weights <- weighted_data$data$weights[match(weighted_data$data$USUBJID, ipd$USUBJID)]
+ipd$weights <- weighted_data$data$weights[match(ipd$USUBJID, weighted_data$data$USUBJID)]
 
 pseudo_ipd <- pseudo_ipd_twt
 pseudo_ipd$weights <- 1