Transition and Duration Models Project
Carla Ilardi and Lilie Timricht (M2 - Research)
Question 1 - What are the contributions of the study ?
When individuals become unemployed, governments provide unemployment benefits to compensate for their income loss, as they are worse off than when they were employed. According to job search theory, higher unemployment benefits increase the reservation wage, which reduces job-search effort, lowers the job-finding rate and prolongs the unemployment duration. This theoretical insight raises an important policy question : how to optimally design unemployment insurance to balance financial support and work incentives. This motivates Lalive et al. (2006) to study the effect of a more generous unemployment insurance affects the job-search behaviour of unemployed workers and, consequently, their unemployment duration.
To do so, they exploit a policy change introduced by the Austrian government in 1989 that modified these two key parameters of the unemployment insurance system. This reform presents an interesting case to study since it impacts groups of unemployed workers differently, based on their age, their earnings and their working experience: a first group experienced an increase in RR, a second group an extension of the PBD, a third group experienced both a higher RR and a longer PBD, and a fourth group experienced no change. This design allows Lalive et al. (2006) to study the effect of both parameters separately as well as their combined effects when they interact.
Previous U.S. studies have shown that a longer potential benefit duration (PBD) creates negative incentives, reducing job-search intensity and leading to a sharp increase in unemployment exit rates right before the benefits are exhausted (Grossman (1989), Moffitt (1985)). However, these findings are limited due to an endogenous policy bias. In fact, the increase in insurance generosity they analyse were often implemented in anticipation of deteriorating labour markets. Lalive et al. (2006) address this limitation by exploiting an Austrian reform that took place in a period of stable macroeconomic environment, thus minimizing the risk of policy endogeneity. As for the replacement rate (RR), earlier studies indicate that a lower RR boosts job search intensity, but the magnitude varies between studies : Carling, Holmlund, and Vejsiu (2001) find an elasticity of 1.7 while Carling, and Holmlund (2004) finds a lower elasticity of 0.6. A critical limitation of these studies is that they do not account for heterogeneous responses by age or work experience. Lalive et al. (2004) fill this gap by analyzing the impact of the reform across three distinct treatment groups defined by eligibility criteria such as age, income and work experience. Finally, while previous research has focused on the isolated effects of either RR or PBD, Lalive et al. (2006) not only separately estimate the effect of each parameter, but also investigate their joint effect when they interact (with the third treatment group).
Overall, Lalive et al. (2006) find that a more generous unemployment system significantly increases the duration of unemployment. The effect of changing the two key parameters takes place at different stages of the unemployment spell.
While most of the effect takes place early in the unemployment spell after an change in RR, the effects observed for an extension of PBD take place around the dates of expiration. Their sensitivity analysis shows heterogeneous impact of the policy in the treated populations : older workers react more strongly to PBD extension, and the combined effect of the simultaneous change in RR and PBD is larger for prime-age workers.
Data Preparation
library(foreign)## Warning: le package 'foreign' a été compilé avec la version R 4.3.3library(tidyverse)## Warning: le package 'ggplot2' a été compilé avec la version R 4.3.3## Warning: le package 'readr' a été compilé avec la version R 4.3.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(survival)## Warning: le package 'survival' a été compilé avec la version R 4.3.3library(dplyr)
library(tidyverse)
library(knitr)
library(kableExtra)## Warning: le package 'kableExtra' a été compilé avec la version R 4.3.3##
## Attachement du package : 'kableExtra'
##
## L'objet suivant est masqué depuis 'package:dplyr':
##
## group_rowslibrary(KernSmooth)## KernSmooth 2.23 chargé
## Copyright M. P. Wand 1997-2009udat <- read.dta("C:/Users/Lilie/MAG3/S2/Transition and Duration Models/Project/fi.dta")udat <- udat[,1:134]
udat <- as_tibble(udat)
dim(udat) ## [1] 225821 134glimpse(udat[,1:36])## Rows: 225,821
## Columns: 36
## $ beginn <dbl> 10412, 10169, 10624, 10343, 10654, 10101, 10652, 10338, 10705…
## $ ein_zus <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0…
## $ sfrau <dbl> 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0…
## $ age <dbl> 51.13758, 54.71595, 54.04791, 54.11636, 46.13005, 42.11909, 5…
## $ after <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ dur <dbl> 0.1428571, 0.1428571, 0.1428571, 0.1428571, 0.1428571, 0.1428…
## $ nwage_pj <dbl> 11282.729, 8577.623, 6828.051, 10071.884, 6342.333, 6094.196,…
## $ e3_5 <dbl> 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ bdur <dbl> 30, 30, 30, 20, 30, 30, 30, 20, 30, 30, 30, 30, 30, 30, 30, 3…
## $ y1988 <dbl> 1, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1…
## $ y1989 <dbl> 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0…
## $ y1990 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ y1991 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ med_educ <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ hi_educ <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ lehre <dbl> 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0…
## $ married <dbl> 1, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1…
## $ single <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ divorced <dbl> 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0…
## $ f_marr <dbl> 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0…
## $ f_single <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ f_divor <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ bc <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1…
## $ pnon_10 <dbl> 0.2651971579, 0.1003559679, 0.1081599146, 0.3736308813, 0.033…
## $ q2 <dbl> 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1…
## $ q3 <dbl> 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0…
## $ q4 <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0…
## $ seasonal <dbl> 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0…
## $ manuf <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0…
## $ ten72 <dbl> -3.47749186, -1.04384339, 0.23723496, -2.63423371, -2.5197806…
## $ type <fct> PBD and RR, PBD and RR, PBD and RR, PBD and RR, PBD and RR, P…
## $ uncc <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ lwage <dbl> 6.173206, 5.918063, 5.645761, 6.059680, 5.571968, 5.576242, 5…
## $ tr <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ t39 <dbl> 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0…
## $ t52 <dbl> 1, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1…table(udat$type)##
## PBD and RR PBD RR control
## 21174 99404 32470 72773# Computation of average spells when durations are truncated at 104 weeks
udat %>%
mutate(dur104 = dur,
dur104 = ifelse(dur104 > 104, 104, dur104)) ->
udatQuestion 2 (Difference in Differences) - Replicate Table 4
# Convert after to a factor
table4 <- udat %>%
group_by(type) %>%
summarise(
Before = mean(dur104[after == 0], na.rm = TRUE),
After = mean(dur104[after == 1], na.rm = TRUE),
N_before = sum(after == 0),
N_after = sum(after == 1),
se_before = sd(dur104[after == 0], na.rm = TRUE) / sqrt(N_before),
se_after = sd(dur104[after == 1], na.rm = TRUE) / sqrt(N_after),
diff = After - Before,
.groups = "drop"
)
control_diff <- table4 %>% filter(type == "control") %>% pull(diff)
table4 <- table4 %>%
mutate(DiD = diff - control_diff)
table4## # A tibble: 4 × 9
## type Before After N_before N_after se_before se_after diff DiD
## <fct> <dbl> <dbl> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 PBD and RR 18.5 22.7 11992 9182 0.162 0.233 4.25 3.08
## 2 PBD 15.8 18.1 48294 51110 0.0757 0.0912 2.25 1.08
## 3 RR 17.1 19.1 17160 15310 0.118 0.152 1.99 0.818
## 4 control 14.5 15.6 33815 38958 0.0782 0.0870 1.17 0Interpretation : this table reports the average unemployment spell duration in the different treatment groups and in the control group. In both before and after August 1989 periods, unemployment duration is longer for the treated groups, especially for the one receiving both treatments (PBD and RR). Moreover the comparison between before and after period (the diff column) shows that unemployment duration increases in all groups, especially in the PBD and the combined treatments groups. The last column provides the diff-in-diff estimates showing that the combined treatment (RR and PBD) led to an increase of 3.08 weeks in unemployment duration, displaying the strongest impact over the three treatment groups. For the PBD treatment, unemployment duration increases by 1.08 weeks, and the RR treatment shows the smallest increase, of 0.81 weeks.
Question 3 (Survival Functions) - Replicate Figure 1
# Question 3
# Set the plotting layout
par(mfrow = c(2, 2), mar = c(5, 4, 2, 1)) # Adjust margins if needed
# Survival function for PBD group
surv_obj_PBD <- with(udat %>% filter(type == "PBD"), Surv(dur104, uncc))
surv_fit_PBD <- survfit(surv_obj_PBD ~ after, data = udat %>% filter(type == "PBD"))
plot(surv_fit_PBD, col = c("black", "blue"), lty = c(2, 1),
xlab = "Time (weeks)", ylab = "Survival Probability",
main = "PBD", xlim = c(0, 104))
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1), bty = "n")
# Survival function for RR group
surv_obj_RR <- with(udat %>% filter(type == "RR"), Surv(dur104, uncc))
surv_fit_RR <- survfit(surv_obj_RR ~ after, data = udat %>% filter(type == "RR"))
plot(surv_fit_RR, col = c("black", "blue"), lty = c(2, 1),
xlab = "Time (weeks)", ylab = "Survival Probability",
main = "RR", xlim = c(0, 104))
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1), bty = "n")
# Survival function for PBD and RR group
surv_obj_PBD_RR <- with(udat %>% filter(type == "PBD and RR"), Surv(dur104, uncc))
surv_fit_PBD_RR <- survfit(surv_obj_PBD_RR ~ after, data = udat %>% filter(type == "PBD and RR"))
plot(surv_fit_PBD_RR, col = c("black", "blue"), lty = c(2, 1),
xlab = "Time (weeks)", ylab = "Survival Probability",
main = "PBD and RR", xlim = c(0, 104))
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1), bty = "n")
# Survival function for control group
surv_obj_control <- with(udat %>% filter(type == "control"), Surv(dur104, uncc))
surv_fit_control <- survfit(surv_obj_control ~ after, data = udat %>% filter(type == "control"))
plot(surv_fit_control, col = c("black", "blue"), lty = c(2, 1),
xlab = "Time (weeks)", ylab = "Survival Probability",
main = "Control", xlim = c(0, 104))
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1), bty = "n")
par(mfrow = c(1, 1))Interpretation : this figure displays the Kaplan-Meier survivor functions for the four groups, before and after the reform took place. At each week, the survival function allows to see the percentage of people that are still in unemployment.
The first information obtained from these graphs is that the after curve (in blue) is systematically higher than the before curve (in black) for the three treatment groups. It means that after the reform, for each given week, there is a higher share of people in unemployment, indicating that the reform reduced the exit rates.
For example, in the PBD and RR group, at week 40, before the reform, 10% of people were still unemployed. After the reform took place, making the unemployment benefit system more generous, almost 20% of the people were still unemployed at this point. For the three treatment groups, it seems that the increase in the survival curve occurs mostly around week 20. For the control group, as expected, there is no significant change in the survival curve.
Question 4 (KM Estimate Exit Rate) - Reproduce Figure 4
# PBD GROUP
# Before period with uncc == 1
surv_fit_PBD_before <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "PBD", after == 0, uncc == 1))
hazard_data_PBD_before <- data.frame(time = surv_fit_PBD_before$time, surv = surv_fit_PBD_before$surv)
hazard_data_PBD_before$t_diff <- c(NA, diff(hazard_data_PBD_before$time))
hazard_data_PBD_before$hz <- c(NA, (-diff(hazard_data_PBD_before$surv) / diff(hazard_data_PBD_before$time)) / hazard_data_PBD_before$surv[-1])
# After period with uncc == 1
surv_fit_PBD_after <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "PBD", after == 1, uncc == 1))
hazard_data_PBD_after <- data.frame(time = surv_fit_PBD_after$time, surv = surv_fit_PBD_after$surv)
hazard_data_PBD_after$t_diff <- c(NA, diff(hazard_data_PBD_after$time))
hazard_data_PBD_after$hz <- c(NA, (-diff(hazard_data_PBD_after$surv) / diff(hazard_data_PBD_after$time)) / hazard_data_PBD_after$surv[-1])
# Remove NA or Inf values
hazard_data_PBD_before <- hazard_data_PBD_before[!is.na(hazard_data_PBD_before$hz) & !is.infinite(hazard_data_PBD_before$hz), ]
hazard_data_PBD_after <- hazard_data_PBD_after[!is.na(hazard_data_PBD_after$hz) & !is.infinite(hazard_data_PBD_after$hz), ]
# Kernel smoothing
smoothed_PBD_before <- locpoly(hazard_data_PBD_before$time, hazard_data_PBD_before$hz, degree = 3, bandwidth = 3)
smoothed_PBD_after <- locpoly(hazard_data_PBD_after$time, hazard_data_PBD_after$hz, degree = 3, bandwidth = 3)
# RR GROUP
surv_fit_RR_before <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "RR", after == 0, uncc == 1))
hazard_data_RR_before <- data.frame(time = surv_fit_RR_before$time, surv = surv_fit_RR_before$surv)
hazard_data_RR_before$t_diff <- c(NA, diff(hazard_data_RR_before$time))
hazard_data_RR_before$hz <- c(NA, (-diff(hazard_data_RR_before$surv) / diff(hazard_data_RR_before$time)) / hazard_data_RR_before$surv[-1])
surv_fit_RR_after <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "RR", after == 1, uncc == 1))
hazard_data_RR_after <- data.frame(time = surv_fit_RR_after$time, surv = surv_fit_RR_after$surv)
hazard_data_RR_after$t_diff <- c(NA, diff(hazard_data_RR_after$time))
hazard_data_RR_after$hz <- c(NA, (-diff(hazard_data_RR_after$surv) / diff(hazard_data_RR_after$time)) / hazard_data_RR_after$surv[-1])
hazard_data_RR_before <- hazard_data_RR_before[!is.na(hazard_data_RR_before$hz) & !is.infinite(hazard_data_RR_before$hz), ]
hazard_data_RR_after <- hazard_data_RR_after[!is.na(hazard_data_RR_after$hz) & !is.infinite(hazard_data_RR_after$hz), ]
smoothed_RR_before <- locpoly(hazard_data_RR_before$time, hazard_data_RR_before$hz, degree = 3, bandwidth = 3)
smoothed_RR_after <- locpoly(hazard_data_RR_after$time, hazard_data_RR_after$hz, degree = 3, bandwidth = 3)
# PBD AND RR GROUP
surv_fit_PBD_RR_before <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "PBD and RR", after == 0, uncc == 1))
hazard_data_PBD_RR_before <- data.frame(time = surv_fit_PBD_RR_before$time, surv = surv_fit_PBD_RR_before$surv)
hazard_data_PBD_RR_before$t_diff <- c(NA, diff(hazard_data_PBD_RR_before$time))
hazard_data_PBD_RR_before$hz <- c(NA, (-diff(hazard_data_PBD_RR_before$surv) / diff(hazard_data_PBD_RR_before$time)) / hazard_data_PBD_RR_before$surv[-1])
surv_fit_PBD_RR_after <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "PBD and RR", after == 1, uncc == 1))
hazard_data_PBD_RR_after <- data.frame(time = surv_fit_PBD_RR_after$time, surv = surv_fit_PBD_RR_after$surv)
hazard_data_PBD_RR_after$t_diff <- c(NA, diff(hazard_data_PBD_RR_after$time))
hazard_data_PBD_RR_after$hz <- c(NA, (-diff(hazard_data_PBD_RR_after$surv) / diff(hazard_data_PBD_RR_after$time)) / hazard_data_PBD_RR_after$surv[-1])
hazard_data_PBD_RR_before <- hazard_data_PBD_RR_before[!is.na(hazard_data_PBD_RR_before$hz) & !is.infinite(hazard_data_PBD_RR_before$hz), ]
hazard_data_PBD_RR_after <- hazard_data_PBD_RR_after[!is.na(hazard_data_PBD_RR_after$hz) & !is.infinite(hazard_data_PBD_RR_after$hz), ]
smoothed_PBD_RR_before <- locpoly(hazard_data_PBD_RR_before$time, hazard_data_PBD_RR_before$hz, degree = 3, bandwidth = 3)
smoothed_PBD_RR_after <- locpoly(hazard_data_PBD_RR_after$time, hazard_data_PBD_RR_after$hz, degree = 3, bandwidth = 3)
# CONTROL GROUP
surv_fit_control_before <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "control", after == 0, uncc == 1))
hazard_data_control_before <- data.frame(time = surv_fit_control_before$time, surv = surv_fit_control_before$surv)
hazard_data_control_before$t_diff <- c(NA, diff(hazard_data_control_before$time))
hazard_data_control_before$hz <- c(NA, (-diff(hazard_data_control_before$surv) / diff(hazard_data_control_before$time)) / hazard_data_control_before$surv[-1])
surv_fit_control_after <- survfit(Surv(dur, uncc) ~ 1, data = udat %>% filter(type == "control", after == 1, uncc == 1))
hazard_data_control_after <- data.frame(time = surv_fit_control_after$time, surv = surv_fit_control_after$surv)
hazard_data_control_after$t_diff <- c(NA, diff(hazard_data_control_after$time))
hazard_data_control_after$hz <- c(NA, (-diff(hazard_data_control_after$surv) / diff(hazard_data_control_after$time)) / hazard_data_control_after$surv[-1])
hazard_data_control_before <- hazard_data_control_before[!is.na(hazard_data_control_before$hz) & !is.infinite(hazard_data_control_before$hz), ]
hazard_data_control_after <- hazard_data_control_after[!is.na(hazard_data_control_after$hz) & !is.infinite(hazard_data_control_after$hz), ]
smoothed_control_before <- locpoly(hazard_data_control_before$time, hazard_data_control_before$hz, degree = 3, bandwidth = 3)
smoothed_control_after <- locpoly(hazard_data_control_after$time, hazard_data_control_after$hz, degree = 3, bandwidth = 3)
# PLOT THE GRAPHS
par(mfrow = c(2, 2))
plot(c(0, 104), c(0, 0.15), xlab = "Time (weeks)", ylab = "Hazard Rate", type = "n",
main = "Hazard Rate for PBD Group", xlim = c(0, 104), ylim = c(0, 0.15))
lines(smoothed_PBD_before$x, smoothed_PBD_before$y, col = "black", lwd = 2, lty = 2)
lines(smoothed_PBD_after$x, smoothed_PBD_after$y, col = "blue", lwd = 2)
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1, 1, 1), lwd = 2, bty = "n")
plot(c(0, 104), c(0, 0.15), xlab = "Time (weeks)", ylab = "Hazard Rate", type = "n",
main = "Hazard Rate for RR Group", xlim = c(0, 104), ylim = c(0, 0.15))
lines(smoothed_RR_before$x, smoothed_RR_before$y, col = "black", lwd = 2, lty = 2)
lines(smoothed_RR_after$x, smoothed_RR_after$y, col = "blue", lwd = 2)
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1, 1, 1), lwd = 2, bty = "n")
plot(c(0, 104), c(0, 0.15), xlab = "Time (weeks)", ylab = "Hazard Rate", type = "n",
main = "Hazard Rate for PBD and RR Group", xlim = c(0, 104), ylim = c(0, 0.15))
lines(smoothed_PBD_RR_before$x, smoothed_PBD_RR_before$y, col = "black", lwd = 2, lty = 2)
lines(smoothed_PBD_RR_after$x, smoothed_PBD_RR_after$y, col = "blue", lwd = 2)
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1, 1, 1), lwd = 2, bty = "n")
plot(c(0, 104), c(0, 0.15), xlab = "Time (weeks)", ylab = "Hazard Rate", type = "n",
main = "Hazard Rate for Control Group", xlim = c(0, 104), ylim = c(0, 0.15))
lines(smoothed_control_before$x, smoothed_control_before$y, col = "black", lwd = 2, lty = 2)
lines(smoothed_control_after$x, smoothed_control_after$y, col = "blue", lwd = 2)
legend("topright", legend = c("Before", "After"),
col = c("black", "blue"), lty = c(2, 1, 1, 1), lwd = 2, bty = "n")
Interpretation : this figure reports the Kaplan-Meier estimates of the unemployment exit hazard for the treatments and control groups. The hazard rate indicates the instantaneous risk that a person exits the state (unemployment) within a given interval, conditional on having survived until there.
For all the treatment groups, the unemployment exit rate is lower after the reform took place, at the exception of the week 42 - week 60 period where the after-reform hazard rate is significantly higher in the PBD and the combined treatment groups.
Thus, more generous unemployment benefit system reduces the exit rates from unemployment, especially at the early stages of the unemployment spell.
Question 5 - Estimate the Causal Treatment Effect in a PH Model
# Split the data in order to estimate the PWE PH model
udat %>%
mutate(all = tr * (t39 + t52) ) ->
udat
breaks <- seq(from=3,to=59, by=4)
labels <- paste("(", c(0,breaks), ",", c(breaks,104), "]",sep="")
# The interval variable is the categorical variable that represents different time windows, which will allow to estimate how the hazard function changes at each of these intervals.
gux <- survSplit(Surv(dur104,uncc) ~., data=udat, cut = breaks,
end = "time", event="death", start="start", episode="interval")
gux %>%
mutate(exposure = time - start,
interval=factor(interval+1, labels = labels) ) ->
guxmodel <- glm(death ~ interval + offset(log(exposure)) + tr + t39 + t52 + all +
tr:interval + t39:interval + t52:interval + all:interval +
ein_zus + sfrau + age + nwage_pj + e3_5 +
y1988 + y1989 + y1990 + y1991 +
med_educ + hi_educ + lehre +
married + single + divorced +
f_marr + f_single + f_divor +
bc + pnon_10 +
q2 + q3 + q4 +
after1 + after2 + after3 + after4 + after5 + after6 +
after7 + after8 + after9 + after10 + after11 + after12 +
after13 + after14 + after15 +
seasonal + manuf + ten72 + lwage +
tr_a0 + t39_a0 + t52_a0 + t39tra0 + t52tra0 +
tr_a1 + t39_a1 + t52_a1 + t39tra1 + t52tra1 +
tr_a2 + t39_a2 + t52_a2 + t39tra2 + t52tra2 +
tr_a3 + t39_a3 + t52_a3 + t39tra3 + t52tra3 +
tr_a4 + t39_a4 + t52_a4 + t39tra4 + t52tra4 +
tr_a5 + t39_a5 + t52_a5 + t39tra5 + t52tra5 +
tr_a6 + t39_a6 + t52_a6 + t39tra6 + t52tra6 +
tr_a7 + t39_a7 + t52_a7 + t39tra7 + t52tra7 +
tr_a8 + t39_a8 + t52_a8 + t39tra8 + t52tra8 +
tr_a9 + t39_a9 + t52_a9 + t39tra9 + t52tra9 +
tr_a10 + t39_a10 + t52_a10 + t39tra10 + t52tra10 +
tr_a11 + t39_a11 + t52_a11 + t39tra11 + t52tra11 +
tr_a12 + t39_a12 + t52_a12 + t39tra12 + t52tra12 +
tr_a13 + t39_a13 + t52_a13 + t39tra13 + t52tra13 +
tr_a14 + t39_a14 + t52_a14 + t39tra14 + t52tra14 +
tr_a15 + t39_a15 + t52_a15 + t39tra15 + t52tra15,
family = poisson, data = gux)library(stargazer) ##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazersuppressWarnings(
stargazer(model,
dep.var.caption="", dep.var.labels="",
keep=1:15,
omit.table.layout = "n", star.cutoffs = NA,
keep.stat=c("n", "ll"), no.space=TRUE,
header=FALSE,
title="The PWE model", type="text"
)
)##
## The PWE model
## =============================
##
## -----------------------------
## interval(3,7] 0.646
## (0.015)
## interval(7,11] 1.164
## (0.015)
## interval(11,15] 1.403
## (0.016)
## interval(15,19] 1.338
## (0.018)
## interval(19,23] 1.471
## (0.019)
## interval(23,27] 1.208
## (0.023)
## interval(27,31] 1.254
## (0.025)
## interval(31,35] 1.090
## (0.031)
## interval(35,39] 0.791
## (0.039)
## interval(39,43] 0.628
## (0.045)
## interval(43,47] 0.443
## (0.053)
## interval(47,51] 0.255
## (0.061)
## interval(51,55] 0.224
## (0.065)
## interval(55,59] 0.131
## (0.072)
## interval(59,104] 0.292
## (0.029)
## -----------------------------
## Observations 1,057,906
## Log Likelihood -686,377.400
## =============================Interpretation : this table provides estimation results from a proportional hazard model specified as a piece wise constant function. In this model, the baseline hazard rates are constant within the time intervals, but can vary between intervals.
The coefficients displayed here indicate that the hazard of exiting unemployment increases until around week 31, then declines steadily. This pattern reflects an important dynamic on the labour market : when individuals remain unemployed for longer duration, they experience a loss of human capital (ex : skill depreciation). Consequently, their employability is lower and it reduces their probability of transitioning out of unemployment.