tests/testthat/test-EventStudyPlot.R

In eventstudyr: Estimation and Visualization of Linear Panel Event Studies

test_that("Dimension of OLS and FHS estimation output is the same", {

    estimates_ols <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_smooth_m",
                                policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                                post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    estimates_fhs <- EventStudy(estimator = "FHS", data = example_data, outcomevar = "y_smooth_m",
                                policyvar = "z", idvar = "id", timevar = "t", proxy = "eta_r", controls = "x_r",
                                post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    expect_equal(length(estimates_ols), length(estimates_fhs))

    # Compare first element of list
    coeffs_ols <- names(estimates_ols[[1]]$coefficients)
    coeffs_fhs <- names(estimates_fhs[[1]]$coefficients)

    expect_true(all(coeffs_fhs %in% c(coeffs_ols, "eta_r")))
    expect_equal(length(coeffs_ols), length(coeffs_fhs))     # FHS: Norm coeff removes one coeff and proxy adds one

    expect_true(all(names(estimates_ols[[1]]) %in% names(estimates_fhs[[1]])))

    # Compare second element of list
    expect_true(all(names(estimates_ols[[2]]) %in% names(estimates_fhs[[2]])))
    expect_true(all(names(estimates_fhs[[2]]) %in% names(estimates_ols[[2]])))
})


test_that("correctly changes x-axis and y-axis labels", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                            post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_labels <- EventStudyPlot(estimates = estimates,
                               conf_level = .95,
                               xtitle     = "Event Time",
                               ytitle     = "Event-study Coefficients",)

    expect_equal(p_labels$labels$x, "Event Time")
    expect_equal(p_labels$labels$y, "Event-study Coefficients")

})

test_that("x- and y-axis breaks and limits are correct", {

    estimates = EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                           policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                           post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_Addmean <- EventStudyPlot(estimates = estimates,
                                ybreaks   = c(-1.5, -.5, 0, .5, 1.5),
                                add_mean   = TRUE)

    p_noAddmean <- EventStudyPlot(estimates = estimates,
                                  ybreaks   = c(-1.5, -.5, 0, .5, 1.5),
                                  add_mean   = FALSE)

    v_limits_addmeans    <- p_Addmean$scales$scales[[2]]$limits
    v_limits_no_addmeans <- p_noAddmean$scales$scales[[2]]$limits
    v_breaks_addmeans    <- p_Addmean$scales$scales[[2]]$breaks
    v_breaks_no_addmeans <- p_noAddmean$scales$scales[[2]]$breaks

    expect_equal(v_limits_addmeans,    c(-1.5, 1.5))
    expect_equal(v_limits_no_addmeans, c(-1.5, 1.5))

    expect_equal(v_breaks_addmeans,    c(-1.5, -.5, 0, .5, 1.5))
    expect_equal(v_breaks_no_addmeans, c(-1.5, -.5, 0, .5, 1.5))
})

test_that("correctly adds mean of outcome var", {

    estimates = EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                           policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                           post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_Addmean <- EventStudyPlot(estimates = estimates,
                                ybreaks   = c(-1.5, -.5, 0, .5, 1.5),
                                add_mean   = TRUE)

    p_noAddmean <- EventStudyPlot(estimates = estimates,
                                  ybreaks   = c(-1.5, -.5, 0, .5, 1.5),
                                  add_mean   = FALSE)

    y_mean <- AddMeans(estimates$arguments$data, estimates$arguments$normalization_column,
                       "z", "y_base")
    y_mean <- round(y_mean, 2)

    v_labels_addmeans    <- p_Addmean$scales$scales[[2]]$labels
    v_labels_no_addmeans <- p_noAddmean$scales$scales[[2]]$labels

    expect_equal(v_labels_addmeans,    c("-1.5", "-0.5", sprintf("0 (%s)", y_mean), "0.5", "1.5"))
    expect_equal(v_labels_no_addmeans, c(-1.5, -.5, 0, .5, 1.5))
})

test_that("sup-t bands are appropriately present or absent", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t",
                            controls = "x_r", post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_supt <- EventStudyPlot(estimates = estimates,
                             supt = .95)

    p_no_supt <- EventStudyPlot(estimates = estimates,
                                supt = NULL)

    expect_true(p_supt$labels$ymin    == "suptband_lower")
    expect_true(p_no_supt$labels$ymin != "suptband_lower")

    expect_true(p_supt$labels$ymax    == "suptband_upper")
    expect_true(p_no_supt$labels$ymax != "suptband_upper")
})

test_that("confidence intervals are appropriately present or absent", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t",
                            controls = "x_r", post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_ci <- EventStudyPlot(estimates = estimates,
                           conf_level = .95, supt = NULL)

    p_no_ci <- EventStudyPlot(estimates = estimates,
                              conf_level = NULL, supt = NULL)

    expect_equal(p_ci$labels$ymin, "ci_lower")
    expect_equal(p_ci$labels$ymax, "ci_upper")
    expect_null(p_no_ci$labels$ymin)
    expect_null(p_no_ci$labels$ymax)
})

test_that("Preevent Coeffs and Postevent Coeffs are appropriately present or absent", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                            post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p_pre_post_caption <- EventStudyPlot(estimates       = estimates,
                                         ybreaks         = c(-1.5, -.5, 0, .5, 1.5),
                                         pre_event_coeffs  = TRUE,
                                         post_event_coeffs = TRUE)$labels$caption

    p_pre_caption      <- EventStudyPlot(estimates       = estimates,
                                         ybreaks         = c(-1.5, -.5, 0, .5, 1.5),
                                         pre_event_coeffs  = TRUE,
                                         post_event_coeffs = FALSE)$labels$caption

    p_post_caption     <- EventStudyPlot(estimates       = estimates,
                                         ybreaks         = c(-1.5, -.5, 0, .5, 1.5),
                                         pre_event_coeffs  = FALSE,
                                         post_event_coeffs = TRUE)$labels$caption

    p_neither_caption   <- EventStudyPlot(estimates       = estimates,
                                          ybreaks         = c(-1.5, -.5, 0, .5, 1.5),
                                          pre_event_coeffs  = FALSE,
                                          post_event_coeffs = FALSE)$labels$caption

    regex_for_p_value <- "1\\.0*$|0\\.\\d+" # 1 followed by . and then zero or more 0's or 0 then . then any number
    regex_pretrends   <- "Pretrends p-value = "
    regex_posttrends  <- "Leveling off p-value = "

    expect_true(
        stringr::str_detect(p_pre_post_caption, regex_for_p_value) &
        stringr::str_detect(p_pre_post_caption, regex_pretrends)   &
        stringr::str_detect(p_pre_post_caption, regex_posttrends)
    )

    expect_true(
        stringr::str_detect(p_pre_caption, regex_for_p_value) &
        stringr::str_detect(p_pre_caption, regex_pretrends)
    )

    expect_false(
        stringr::str_detect(p_pre_caption, regex_for_p_value) &
        stringr::str_detect(p_pre_caption, regex_posttrends)
    )

    expect_false(
        stringr::str_detect(p_post_caption, regex_for_p_value) &
        stringr::str_detect(p_post_caption, regex_pretrends)
    )

    expect_true(
        stringr::str_detect(p_post_caption, regex_for_p_value) &
        stringr::str_detect(p_post_caption, regex_posttrends)
    )

    expect_null(p_neither_caption)
})

test_that("Sup-t bands are wider than confidence intervals", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                            post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p <- EventStudyPlot(estimates = estimates,
                        conf_level = .95,
                        supt = .95)

    ci_lower       <- na.omit(p$data$ci_lower)
    ci_upper       <- na.omit(p$data$ci_upper)
    suptband_lower <- na.omit(p$data$suptband_lower)
    suptband_upper <- na.omit(p$data$suptband_upper)
    num_terms      <- nrow(na.omit(p$data))

    v_lower_comparison <- (suptband_lower <= ci_lower)
    v_upper_comparison <- (suptband_upper >= ci_upper)

    expect_equal(num_terms, sum(v_lower_comparison))
    expect_equal(num_terms, sum(v_upper_comparison))
})

test_that("computed smoothest path for examples is within expectations", {

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_base",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                            post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = - 3)

    p <- EventStudyPlot(estimates = estimates,
                        smpath    = T)

    expect_equal(p$data$smoothest_path, matrix(rep(0, nrow(p$data))))

    estimates <- EventStudy(estimator = "OLS", data = example_data, outcomevar = "y_smooth_m",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r",
                            post = 3, pre = 2, overidpre = 4, overidpost = 5, normalize = -3)

    p <- EventStudyPlot(estimates = estimates,
                        smpath    = T)

    normalized_index  <- which(p$data$estimate == 0)
    normalized_smpath <- p$data$smoothest_path[normalized_index]

    # Expect normalized_smpath to be almost equal to zero
    expect_true(all(abs(normalized_smpath) < 1e-10))

    max_smpath <- max(p$data$smoothest_path)
    min_smpath <- min(p$data$smoothest_path)

    max_suptband <- max(p$data$suptband_upper, na.rm = T)
    min_suptband <- min(p$data$suptband_lower, na.rm = T)

    # Expect smpath to be contained in suptband
    expect_true(max_smpath < max_suptband)
    expect_true(min_smpath > min_suptband)
})

test_that("computed smoothest path for FHS has at least two coefficients almost equal to zero", {

    estimates <- EventStudy(estimator = "FHS", data = example_data, outcomevar = "y_jump_m",
                            policyvar = "z", idvar = "id", timevar = "t", controls = "x_r", proxy = "eta_r",
                            post = 3, pre = 0, overidpre = 3, overidpost = 1, normalize = -1, proxyIV = "z_fd_lead3")

    p <- EventStudyPlot(estimates = estimates,
                        smpath    = T)

    normalized_index  <- which(p$data$estimate == 0)
    normalized_smpath <- p$data$smoothest_path[normalized_index]

    expect_true(length(normalized_index) >= 2)
    expect_true(all(abs(normalized_smpath) < 1e-10))
})