## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 5 ) # Check if suggested packages are available has_matchit <- requireNamespace("MatchIt", quietly = TRUE) has_weightit <- requireNamespace("WeightIt", quietly = TRUE) has_survival <- requireNamespace("survival", quietly = TRUE) has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE) # Set evaluation based on package availability eval_matching <- has_matchit && has_survival eval_weighting <- has_weightit && has_survival eval_plots <- has_ggplot2 ## ----setup, message = FALSE, warning = FALSE---------------------------------- library(mccount) library(dplyr) library(WeightIt) library(MatchIt) library(patchwork) # Create example data with binary treatment bladder_nested <- survival::bladder1 |> mutate(status = if_else(status > 2, 2, status)) |> filter(treatment %in% c("placebo", "thiotepa")) |> tidyr::nest(.by = c(id, treatment, number, size)) |> mutate(treatment_binary = if_else(treatment == "thiotepa", 1, 0)) ## ----iptw--------------------------------------------------------------------- # Estimate propensity scores and create IPTW weights using WeightIt weight_obj <- weightit( treatment_binary ~ number + size, data = bladder_nested, ) # Extract weights bladder_nested$iptw_weights <- weight_obj$weights bladder_example <- bladder_nested |> tidyr::unnest(data) ## ----weighted_mcc------------------------------------------------------------- # Estimate MCC with IPTW weights mcc_weighted <- mcc( data = bladder_example, id_var = "id", time_var = "stop", cause_var = "status", by = "treatment", weights = "iptw_weights", method = "equation" ) # Display results summary(mcc_weighted) ## ----comparison--------------------------------------------------------------- # Estimate unweighted MCC for comparison mcc_unweighted <- mcc( data = bladder_example, id_var = "id", time_var = "stop", cause_var = "status", by = "treatment", method = "equation" ) # Extract final MCC values for comparison weighted_final <- mcc_final_values(mcc_weighted) unweighted_final <- mcc_final_values(mcc_unweighted) # Create comparison table comparison_table <- data.frame( Method = c("Unweighted", "IPTW Weighted"), Control_MCC = c( cards::round5(unweighted_final[1], digits = 2), cards::round5(weighted_final[1], digits = 2) ), Treated_MCC = c( cards::round5(unweighted_final[2], digits = 2), cards::round5(weighted_final[2], digits = 2) ) ) knitr::kable(comparison_table) ## ----nn_matching-------------------------------------------------------------- # Perform 1:1 nearest neighbor matching match_nn <- matchit( treatment_binary ~ size + number, data = bladder_nested ) ## ----nn_matching cont--------------------------------------------------------- # Extract matched data (no additional weights needed) matched_nn_data <- match.data(match_nn) |> tidyr::unnest(data) # Estimate MCC on matched data without additional weights mcc_nn_matched <- mcc( data = matched_nn_data, id_var = "id", time_var = "stop", cause_var = "status", by = "treatment_binary", method = "equation" # No weights argument needed for simple 1:1 matching (all weights are 1) ) summary(mcc_nn_matched) ## ----full_matching------------------------------------------------------------ # Perform full matching (creates matching weights) match_obj <- matchit( treatment_binary ~ size + number, data = bladder_nested, method = "full", # Full matching creates weights estimand = "ATE" ) # Check matching balance summary(match_obj) # Extract matched data with weights matched_data <- match_data(match_obj) |> tidyr::unnest(data) # The 'weights' column contains the matching weights head(matched_data[c("id", "treatment", "weights")]) ## ----matched_mcc-------------------------------------------------------------- # Estimate MCC using matching weights mcc_matched <- mcc( data = matched_data, id_var = "id", time_var = "stop", cause_var = "status", by = "treatment", weights = "weights", # Use matching weights from MatchIt method = "equation" ) summary(mcc_matched) ## ----plotting_comparison------------------------------------------------------ p_unwt <- plot(mcc_unweighted) + geom_line_mcc(mcc_unweighted) + labs(subtitle = element_blank(), color = "Treatment") + scale_y_continuous(limits = c(0, 2.75)) + ggtitle("Unweighted") p_wt <- plot(mcc_weighted) + geom_line_mcc(mcc_weighted) + ggtitle("IPTW") + labs(subtitle = "Estimand: ATE", color = "Treatment") + scale_y_continuous(limits = c(0, 2.75)) + theme(axis.title.y = element_blank()) p_mwt <- plot(mcc_matched) + geom_line_mcc(mcc_matched) + ggtitle("Full Matching") + labs(subtitle = "Estimand: ATE", color = "Treatment") + scale_y_continuous(limits = c(0, 2.75)) + theme(axis.title.y = element_blank()) combined <- p_unwt | p_wt | p_mwt combined + plot_layout(guides = "collect") & theme(legend.position = "bottom")