## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 8, fig.height = 5, message = FALSE, warning = FALSE ) library(ggplot2); library(dplyr); library(tidyr) data.table::setDTthreads(1L) options(dplyr.summarise.inform = FALSE, scipen = 999, digits = 5) theme_set(theme_bw(base_size = 12)) ## ----simulate_and_estimate---------------------------------------------------- library(childpen) data <- simulate_data(n_individuals = 2000, treatment_groups = 24:30) res <- multiple_treatment_group_analysis( data = data, treatment_groups = 24:27, periods_post = 2, periods_pre = NULL, verbose = FALSE ) ## ----basic_agg---------------------------------------------------------------- agg <- aggregate_estimands(res) head(agg) ## ----plot_avg_of_ratios------------------------------------------------------- agg |> filter(agg_type == "avg_of_ratios", method == "NTD_Conv", estimand == "theta") |> ggplot(aes(x = event_time, y = est, ymin = ci_l, ymax = ci_h)) + geom_ribbon(fill = "steelblue", alpha = 0.25, color = NA) + geom_line(color = "steelblue") + geom_point(color = "steelblue") + geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") + labs( x = "Event time", y = expression(theta[Agg * "," * 1] ~ "(avg of ratios)"), title = "NTD_Conv aggregate: avg_of_ratios" ) ## ----compare_agg_types-------------------------------------------------------- agg |> filter( agg_type %in% c("avg_of_ratios", "ratio_of_avgs"), method == "DID_Female", estimand == "theta" ) |> ggplot(aes( x = event_time, y = est, ymin = ci_l, ymax = ci_h, color = agg_type, fill = agg_type )) + geom_ribbon(alpha = 0.2, color = NA) + geom_line() + geom_point() + geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") + labs( x = "Event time", y = expression(theta ~ "estimate"), title = "DID_Female: avg_of_ratios vs ratio_of_avgs", color = "Aggregation type", fill = "Aggregation type" ) + theme(legend.position = "bottom") ## ----custom_weights----------------------------------------------------------- groups <- as.character(24:27) # Right-skewed: more weight on younger groups w_us <- setNames(c(0.40, 0.30, 0.20, 0.10), groups) # Left-skewed: more weight on older groups w_se <- setNames(c(0.10, 0.20, 0.30, 0.40), groups) agg_us <- aggregate_estimands(res, weights = w_us) agg_se <- aggregate_estimands(res, weights = w_se) bind_rows( mutate(agg_us, population = "US (right-skewed)"), mutate(agg_se, population = "Southern Europe (left-skewed)") ) |> filter( agg_type == "avg_of_ratios", method == "NTD_Conv", estimand == "theta" ) |> ggplot(aes( x = event_time, y = est, ymin = ci_l, ymax = ci_h, color = population, fill = population )) + geom_ribbon(alpha = 0.2, color = NA) + geom_line() + geom_point() + geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") + labs( x = "Event time", y = expression(theta[Agg * "," * 1]), title = "Aggregate NTD_Conv estimate under different first-birth distributions", color = "Population weights", fill = "Population weights" ) + theme(legend.position = "bottom") ## ----gender_ineq-------------------------------------------------------------- agg |> filter(agg_type == "gender_ineq", estimand == "Delta_rho", method == "NTD_New") |> ggplot(aes(x = event_time, y = est, ymin = ci_l, ymax = ci_h)) + geom_ribbon(fill = "tomato", alpha = 0.25, color = NA) + geom_line(color = "tomato") + geom_point(color = "tomato") + geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") + labs( x = "Event time", y = expression(Delta * rho[Agg]), title = "Gender inequality aggregate (NTD_New, avg of ratios)" )