## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = FALSE ) ## ----load-packages------------------------------------------------------------ # library(EventStudy) # library(dplyr) # library(ggplot2) ## ----run-study---------------------------------------------------------------- # set.seed(42) # n <- 300 # dates <- format(seq(as.Date("2014-06-01"), by = "day", length.out = n), # "%d.%m.%Y") # # firms <- c("FIRM_A", "FIRM_B", "FIRM_C", "FIRM_D") # firm_tbl <- purrr::map_dfr(firms, function(sym) { # tibble( # symbol = sym, # date = dates, # adjusted = 100 * cumprod(1 + rnorm(n, 0.0003, 0.015)) # ) # }) # # index_tbl <- tibble( # symbol = "INDEX_1", # date = dates, # adjusted = 1000 * cumprod(1 + rnorm(n, 0.0002, 0.012)) # ) # # request_tbl <- tibble( # event_id = 1:4, # firm_symbol = firms, # index_symbol = rep("INDEX_1", 4), # event_date = rep(dates[200], 4), # group = c("Group_A", "Group_A", "Group_B", "Group_B"), # event_window_start = rep(-10L, 4), # event_window_end = rep(10L, 4), # shift_estimation_window = rep(-11L, 4), # estimation_window_length = rep(150L, 4) # ) # # task <- EventStudyTask$new(firm_tbl, index_tbl, request_tbl) # params <- ParameterSet$new() ## ----validate-basic----------------------------------------------------------- # validate_task(task) # #> Validation passed: no issues found across 4 event(s). ## ----validate-date------------------------------------------------------------ # # This would trigger a warning: # # [Event 1 / FIRM_A] Event date '32.02.2015' not found in data. ## ----validate-min-obs--------------------------------------------------------- # # Stricter requirement: at least 100 observations # validate_task(task, min_estimation_obs = 100) # # # Lenient: at least 20 # validate_task(task, min_estimation_obs = 20) ## ----validate-gaps------------------------------------------------------------ # # Warnings like: # # [Event 2 / FIRM_B] 1 gap(s) > 5 days found in time series. ## ----validate-overlap--------------------------------------------------------- # # Warnings like: # # [Event 3 / FIRM_C] Estimation and event windows overlap by 5 observation(s). ## ----validate-thin------------------------------------------------------------ # # Warnings like: # # [Event 4 / FIRM_D] 15.3% zero returns in estimation window (possible thin trading). ## ----validate-capture--------------------------------------------------------- # task <- prepare_event_study(task, params) # # warnings <- tryCatch( # withCallingHandlers( # validate_task(task), # warning = function(w) { # message("Issue: ", conditionMessage(w)) # invokeRestart("muffleWarning") # } # ) # ) ## ----diagnostics-run---------------------------------------------------------- # task <- fit_model(task, params) # # diag <- model_diagnostics(task) # diag # #> # A tibble: 4 x 9 # #> event_id firm_symbol is_fitted shapiro_p dw_stat ljung_box_p acf1 sigma r2 # #> # #> 1 1 FIRM_A TRUE 0.342 2.01 0.654 0.012 0.0149 0.032 # #> 2 2 FIRM_B TRUE 0.127 1.95 0.891 0.034 0.0162 0.028 # #> ... ## ----diagnostics-single------------------------------------------------------- # diag_event1 <- model_diagnostics(task, event_id = 1) # diag_event1 ## ----diagnostics-flag--------------------------------------------------------- # diag <- model_diagnostics(task) # # # Flag events with potential issues # diag %>% # mutate( # normality_ok = shapiro_p > 0.05, # no_autocorr = ljung_box_p > 0.05, # dw_ok = dw_stat > 1.5 & dw_stat < 2.5, # all_ok = normality_ok & no_autocorr & dw_ok # ) %>% # select(event_id, firm_symbol, normality_ok, no_autocorr, dw_ok, all_ok) ## ----plot-diagnostics, fig.width=8, fig.height=8------------------------------ # plot_diagnostics(task, event_id = 1) ## ----plot-diagnostics-loop, fig.width=8, fig.height=8------------------------- # # Visual diagnostics for all events # for (eid in task$data_tbl$event_id) { # plot_diagnostics(task, event_id = eid) # } ## ----pretrend-run------------------------------------------------------------- # task <- calculate_statistics(task, params) # # pretrend <- pretrend_test(task) # pretrend # #> # A tibble: 2 x 7 # #> group n_pre_periods n_events mean_pre_ar sd_pre_ar t_stat p_value # #> # #> Group_A 10 2 0.00012 0.0142 0.168 0.868 # #> Group_B 10 2 -0.00034 0.0155 -0.221 0.826 ## ----pretrend-group----------------------------------------------------------- # pretrend_a <- pretrend_test(task, group = "Group_A") # pretrend_b <- pretrend_test(task, group = "Group_B") ## ----full-workflow------------------------------------------------------------ # # 1. Create task # task <- EventStudyTask$new(firm_tbl, index_tbl, request_tbl) # # # 2. Validate data BEFORE estimation # validate_task(task) # # # 3. Prepare and fit # params <- ParameterSet$new(return_model = MarketModel$new()) # task <- prepare_event_study(task, params) # # # 4. Validate AFTER preparation (now windows are assigned) # validate_task(task) # # # 5. Fit models # task <- fit_model(task, params) # # # 6. Numerical diagnostics # diag <- model_diagnostics(task) # print(diag) # # # 7. Flag problematic events # problems <- diag %>% # filter(shapiro_p < 0.05 | ljung_box_p < 0.05 | dw_stat < 1.5 | dw_stat > 2.5) # # if (nrow(problems) > 0) { # cat("Events with diagnostic issues:\n") # print(problems %>% select(event_id, firm_symbol, shapiro_p, ljung_box_p, dw_stat)) # } else { # cat("All events pass diagnostic checks.\n") # } # # # 8. Visual diagnostics for flagged events (or all events) # events_to_check <- if (nrow(problems) > 0) problems$event_id else diag$event_id[1] # for (eid in events_to_check) { # plot_diagnostics(task, event_id = eid) # } # # # 9. Calculate statistics and test pre-trends # task <- calculate_statistics(task, params) # pretrend <- pretrend_test(task) # print(pretrend)