## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) options(rmarkdown.html_vignette.check_title = FALSE) ## ----example, warning=FALSE, message = FALSE---------------------------------- library(senseweight) library(ggplot2) # Load in JTPA data: data(jtpa_women) ## ----------------------------------------------------------------------------- # Summarize sites jtpa_women |> dplyr::group_by(site) |> dplyr::summarize( length(prevearn), dplyr::across( c(prevearn, age, married, hrwage, black, hispanic, hsorged, yrs_educ), mean ) ) ## ----estimate----------------------------------------------------------------- site_name <- "NE" df_site <- jtpa_women[which(jtpa_women$site == site_name), ] df_else <- jtpa_women[which(jtpa_women$site != site_name), ] # Estimate unweighted estimator: model_dim <- estimatr::lm_robust(Y ~ T, data = df_site) PATE <- coef(lm(Y ~ T, data = df_else))[2] DiM <- coef(model_dim)[2] # Generate weights using observed covariates: df_all <- jtpa_women df_all$S <- ifelse(jtpa_women$site == "NE", 1, 0) model_ps <- WeightIt::weightit( (1 - S) ~ . - site - T - Y, data = df_all, method = "ebal", estimand = "ATT" ) weights <- model_ps$weights[df_all$S == 1] # Estimate IPW model: model_ipw <- estimatr::lm_robust(Y ~ T, data = df_site, weights = weights) ipw <- coef(model_ipw)[2] # Estimate bound for var(tau): m <- sqrt(stats::var(df_site$Y[df_site$T == 1]) / stats::var(df_site$Y[df_site$T == 0])) # Since m > 1: vartau <- stats::var(df_site$Y[df_site$T == 1]) - stats::var(df_site$Y[df_site$T == 0]) ## ----summaries---------------------------------------------------------------- summarize_sensitivity( weights = weights, Y = df_site$Y, Z = df_site$T, sigma2 = vartau, estimand = "PATE" ) ## ----------------------------------------------------------------------------- RV = robustness_value(estimate = ipw, b_star = 0, sigma2 = vartau, weights = weights) print(RV) ## ----benchmarking------------------------------------------------------------- # Select weighting variables: weighting_vars = names(df_all)[which(!names(df_all) %in% c("site", "S", "Y", "T"))] # Run bechmarking: df_benchmark <- run_benchmarking( weighting_vars = weighting_vars, data = df_all[, -1], treatment = "T", outcome = "Y", selection = "S", estimate = ipw, RV = RV, sigma2 = vartau, estimand = "PATE" ) print(df_benchmark) ## ----contour_plot, warning=FALSE, fig.width=6.5, fig.height=5----------------- contour_plot( var(weights), vartau, ipw, df_benchmark, benchmark = TRUE, shade = TRUE, shade_var = c("age", "prevearn"), label_size = 4 )