Vyhodnotenie účinnosti nástrojov slovenskej aktívnej politiky trhu práce
Pripravili: Soňa Dulíková, Lukáš Lafférs a Miroslav Štefánik (miroslav.stefanik@savba.sk)
Ekonomický ústav Slovenskej akadémie vied
Túto prácu podporila Agentúrou na podporu výskumu a vývoja na základe zmluvy č. APVV-17-0329.
Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25)
Tento automatizovaný report poskytuje informácie o jednom z nástrojov aktívnych opatrení na trhu práce (AOTP): Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25), ktorý bol implementovaný na Slovensku v roku 2017. Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) je poskytovaný na základe § 51 Zákon o službách zamestnanosti č. 2004/5.
if(qualitative_data_condition) {
knitr::knit_exit()
}1. Opis programu
Na základe Labour Market Policy Database (LMP), databázy politíky trhu práce, ktorú spravuje Generálne riaditeľstvo Európskej komisie pre zamestnanosť, sociálne záležitosti a začlenenie, Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) je klasifikovaný ako “stimuly k zamestnávaniu”, so špecifickým kódom programu 41_SK42.
Cieľom programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) je: Motivácia zamestnávateľov k vytvoreniu nového pracovného miesta pre mladých uchádzačov o zamestnanie.
Účastníci programu sú uchádzači o zamestnanie do 25 rokov, ktorí sú evidovaní ako nezamestnaní minimálne 3 mesiace alebo uchádzači o zamestnanie do 29 rokov, ktorí sú evidovaní ako nezamestnaní minimálne 6 mesiacov.
Oprávnenými užívateľmi sú
Implementácia: § 51a (1) Úrad práce môže poskytnúť príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní zamestnávateľovi, ktorý na vytvorené pracovné miesto prijme do pracovného pomeru uchádzača o zamestnanie, ktorý je občanom mladším ako 25 rokov veku vedeným v evidencii uchádzačov o zamestnanie najmenej tri mesiace, alebo uchádzača o zamestnanie, ktorý je občanom mladším ako 29 rokov veku vedeným v evidencii uchádzačov o zamestnanie najmenej šesť mesiacov, a ktorí pred prijatím na vytvorené pracovné miesto nemali pravidelne platené zamestnanie, ak pracovný pomer je dohodnutý v rozsahu najmenej polovice ustanoveného týždenného pracovného času a ak zamestnávateľ o príspevok písomne požiada.
Príspevok sa poskytuje na základe písomnej dohody o poskytnutí príspevku uzatvorenej medzi úradom a zamestnávateľom najmenej počas 6 kalendárnych mesiacov a najviac počas 12 kalendárnych mesiacov. Výška príspevku zodpovedá pracovnému pomeru dohodnutému na ustanovený týždenný pracovný čas; ak je pracovný pomer dohodnutý na kratší pracovný čas, výška príspevku sa pomerne kráti.
Za vytvorenie pracovného miesta u zamestnávateľa sa považuje zvýšenie počtu pracovných miest, ktoré predstavuje v priemere za 12 kalendárnych mesiacov v porovnaní s rovnakým predchádzajúcim obdobím celkový nárast počtu jeho zamestnancov. Ak nedošlo k zvýšeniu počtu pracovných miest podľa prvej vety, zamestnávateľ je povinný preukázať, že k tomuto zvýšeniu nedošlo v dôsledku zrušenia pracovných miest z dôvodu nadbytočnosti.
Zamestnávateľ je povinný zachovať vytvorené pracovné miesto, na ktoré mu bol poskytnutý príspevok, najmenej v rozsahu zodpovedajúcom polovici dohodnutého obdobia poskytovania príspevku. Ak zamestnávateľ nesplnil povinnosť podľa prvej vety, je povinný vrátiť úradu pomernú časť poskytnutého príspevku zodpovedajúcu obdobiu, počas ktorého nezachoval vytvorené pracovné miesto.
1.1 Účastníci a výdavky
#Preparing of participants and expenditures tables
partSK <- subset(part, geo == 'SK' & year == format(as.Date(params$ep_start),"%Y") & age == 'TOTAL' & sex == 'T' & stk_flow == 'ENT' )
names(programesSK)[1] <- 'lmp_type'
partSK <- merge(partSK, programesSK, by = 'lmp_type', all = TRUE)
partSK <- subset(partSK, substr(Classification, 1, 1) == '2' | substr(Classification, 1, 1) == '4' | substr(Classification, 1, 1) == '5' | substr(Classification, 1, 1) == '6' | substr(Classification, 1, 1) == '7')
partSK_datapie <- subset(partSK, lmp_type == lmp_code | lmp_type == '2' | lmp_type == '4' | lmp_type == '5' | lmp_type == '6' | lmp_type == '7')
partSK_datapie$value <- ifelse(is.na(partSK_datapie$value), sum(partSK[substr(partSK$lmp_type, 1, 6) == substr(lmp_code, 1, 6) , 'value'], na.rm = TRUE), partSK_datapie$value)
expSK <- subset(exp, year == format(as.Date(params$ep_start),"%Y"))
expSK <- merge(expSK, programesSK, by = 'lmp_type', all = TRUE)
expSK <- subset(expSK, substr(Classification, 1, 1) == '2' | substr(Classification, 1, 1) == '4' | substr(Classification, 1, 1) == '5' | substr(Classification, 1, 1) == '6' | substr(Classification, 1, 1) == '7')
expSK_datapie <- subset(expSK, lmp_type == lmp_code | lmp_type == '2' | lmp_type == '4' | lmp_type == '5' | lmp_type == '6' | lmp_type == '7')
expSK_datapie$value <- ifelse(is.na(expSK_datapie$value), sum(expSK[substr(expSK$lmp_type, 1, 6) == substr(lmp_code, 1, 6) , 'value'], na.rm = TRUE), expSK_datapie$value)
#Share of expenditures and participants at programm
partSK_per <- partSK_datapie %>% select(lmp_type, value) %>%
subset(lmp_type != subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1]) %>%
mutate(per = paste(round(100 * value / sum(value),2),'%'))
expSK_per <- expSK_datapie %>% select(lmp_type, value) %>%
subset(lmp_type != subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1]) %>%
mutate(per = paste(round(100 * value / sum(value),2),'%'))
program_part <- data.frame(lmp_type = c('total', as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])),
participants = c(sum(partSK_per$value), subset(partSK_datapie, partSK_datapie$almp == params$measure)$value[1]),
per = c('100 %', paste(round(subset(partSK_datapie, partSK_datapie$almp == params$measure)$value[1] / sum(partSK_per$value) * 100,2),'%'))
)
program_exp <- data.frame(lmp_type = c('total', as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])),
expenditures = c(sum(expSK_per$value), subset(expSK_datapie, expSK_datapie$almp == params$measure)$value[1]),
per = c('100 %', paste(round(subset(expSK_datapie, expSK_datapie$almp == params$measure)$value[1] / sum(expSK_per$value) * 100,2),'%'))
)
type_share_par <- partSK_per$per[partSK_per$lmp_type == as.character(subset(qualitative, qualitative$almp == params$measure)$Classification[1])]
prog_share_par <- program_part$per[program_part$lmp_type == as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])]
prog_numb_par <- program_part$participants[program_part$lmp_type == as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])]
type_share_exp <- expSK_per$per[expSK_per$lmp_type == subset(qualitative, qualitative$almp == params$measure)$Classification[1]]
prog_share_exp <- program_exp$per[program_exp$lmp_type == as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])]
prog_numb_exp <- program_exp$expenditures[program_exp$lmp_type == as.character(subset(qualitative, qualitative$almp == params$measure)$lmp_type.x[1])]Koláčový graf Účastníci (vľavo) zobrazuje podiel účastníkov v programoch AOTP zoskupených podľa typov AOTP klasifikácie LMP. Podiely vychádzajú z údajov LMP Databázy za kalendárny rok 2017.
Koláčový graf Výdavky (vpravo) zobrazuje podiel výdavkov pomocou rovnakej klasifikácie LMP ako koláčový graf Účastníkov.
Porovnanie podieľov umožní rámcové vyhodnotenie rlatívnej nákladnosti programu. Ak je podiel na účastníkoch vyšší ako na nákladoch, ide o nadpriemerne nákladné opatrenie.
Graf 1: Zdroje programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) počas 2017
#Preparing data for Pie Chart
#PARTICIPANTS
piechart_P <- select(partSK_datapie, lmp_type, value)
piechart_P$lmp_type <- ifelse(piechart_P$lmp_type == '2' | piechart_P$lmp_type == '4' | piechart_P$lmp_type == '5' | piechart_P$lmp_type == '6' | piechart_P$lmp_type == '7',
qualitative$class_SK[match(piechart_P$lmp_type, qualitative$Classification)],
paste(qualitative$class_SK[match(piechart_P$lmp_type, qualitative$lmp_type.x)],
qualitative$Labour.market.services_SK[match(piechart_P$lmp_type, qualitative$lmp_type.x)],
sep =': ' ))
piechart_P <- filter(piechart_P, !duplicated(piechart_P$lmp_type))
piechart_P$lmp_type <- ifelse(piechart_P$lmp_type == 'Training: [Component] Projects and programmes - Projects - Education and training','Training: [Component] Projects and programmes - Projects - Education and training Repas',piechart_P$lmp_type)
piechart_P <- piechart_P[order(piechart_P$lmp_type),]
piechart_P$focus <- ifelse(
piechart_P$lmp_type == paste(
subset(qualitative, qualitative$almp == params$measure)$class_SK[1],
subset(qualitative, qualitative$almp == params$measure)$Labour.market.services_SK[1],
sep =': '),
0.05,
0)
#EXPENDITURES
piechart_E <- select(expSK_datapie, lmp_type, value)
piechart_E$lmp_type <- ifelse(piechart_E$lmp_type == '2' | piechart_E$lmp_type == '4' | piechart_E$lmp_type == '5' | piechart_E$lmp_type == '6' | piechart_E$lmp_type == '7',
qualitative$class_SK[match(piechart_E$lmp_type, qualitative$Classification)],
paste(qualitative$class_SK[match(piechart_E$lmp_type, qualitative$lmp_type.x)],
qualitative$Labour.market.services_SK[match(piechart_E$lmp_type, qualitative$lmp_type.x)],
sep =': ' ))
piechart_E <- filter(piechart_E, !duplicated(piechart_E$lmp_type))
piechart_E$lmp_type <- ifelse(piechart_E$lmp_type == 'Training: [Component] Projects and programmes - Projects - Education and training','Training: [Component] Projects and programmes - Projects - Education and training Repas',piechart_E$lmp_type)
piechart_E <- piechart_E[order(piechart_E$lmp_type),]
piechart_E$focus <- ifelse(
piechart_E$lmp_type == paste(
subset(qualitative, qualitative$almp == params$measure)$class_SK[1],
subset(qualitative, qualitative$almp == params$measure)$Labour.market.services_SK[1],
sep =': '),
0.05,
0)
## PIE CHART
#PARTICIPANTS
piechart_P$lmp_type <- gsub("(.{25,}?)\\s", "\\1\n", piechart_P$lmp_type)
ev_measure <- gsub("(.{25,}?)\\s", "\\1\n",
paste(subset(qualitative, qualitative$almp == params$measure)$class_SK[1],
subset(qualitative, qualitative$almp == params$measure)$Labour.market.services_SK[1],
sep =': '))
ev_type <- gsub("(.{25,}?)\\s", "\\1\n",
subset(qualitative, qualitative$almp == params$measure)$class_SK[1])
piechart_P$value <- ifelse(piechart_P$lmp_type == ev_type, piechart_P$value - piechart_P[piechart_P$lmp_type == ev_measure,"value"], piechart_P$value)
piechart_P <- piechart_P %>%
mutate(per = paste0(round(100 * value / sum(value),2), "%", by = ""),
total = sum(value),
end_angle = 2*pi*cumsum(value)/total,
start_angle = lag(end_angle, default = 0),
mid_angle = 0.5*(start_angle + end_angle))
rpie <- 1
rlabel <- 0.6 * rpie
plot_piechart_P <- ggplot(piechart_P) +
theme_no_axes() +
theme_void() +
coord_fixed()+
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0, r = 1, amount = value,
fill = lmp_type, explode = focus),
data = piechart_P, stat = 'pie',color='white')+
ggtitle('Účastníci') +
geom_text(aes(x = rlabel*sin(mid_angle), y = rlabel*cos(mid_angle), label = ifelse(lmp_type == ev_type | lmp_type == ev_measure, per,"")),
size = 4, position=position_jitter(width=0,height=0.3))+
theme(plot.title = element_text(color="black", size=18, face="bold.italic"),
legend.title = element_text(size=15, face="bold"),
legend.text = element_text(size=12),
legend.key.height=unit(1.1, "cm")) +
guides(fill=guide_legend(title="Klasifikácia LMP\n a nástrojov")) +
scale_fill_manual(values=c(ifelse(piechart_P$value != 0 & piechart_P$lmp_type == ev_measure,
"steelblue3",
ifelse(piechart_P$lmp_type == ev_type,
"steelblue1",
gray.colors(6, start = 0.8)))))
#EXPENDITURES
piechart_E$lmp_type <- gsub("(.{25,}?)\\s", "\\1\n", piechart_E$lmp_type)
piechart_E$value <- ifelse(piechart_E$lmp_type == ev_type, piechart_E$value - piechart_E[piechart_E$lmp_type == ev_measure,"value"], piechart_E$value)
piechart_E <- piechart_E %>%
mutate(per = paste0(round(100 * value / sum(value),2), "%", by = ""),
total = sum(value),
end_angle = 2*pi*cumsum(value)/total,
start_angle = lag(end_angle, default = 0),
mid_angle = 0.5*(start_angle + end_angle))
rpie <- 1
rlabel <- 0.6 * rpie
plot_piechart_E <- ggplot(piechart_E) +
theme_no_axes() +
theme_void() +
coord_fixed()+
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0, r = 1, amount = value,
fill = lmp_type, explode = focus),
data = piechart_E, stat = 'pie',color='white')+
ggtitle('Výdavky') +
geom_text(aes(x = rlabel*sin(mid_angle), y = rlabel*cos(mid_angle), label = ifelse(lmp_type == ev_type | lmp_type == ev_measure, per,"")),
size = 4, position=position_jitter(width=0,height=0.3))+
theme(plot.title = element_text(color="black", size=18, face="bold.italic"),
legend.title = element_text(size=15, face="bold"),
legend.text = element_text(size=12),
legend.key.height=unit(1.1, "cm")) +
guides(fill=guide_legend(title="Klasifikácia LMP\n a nástrojov")) +
scale_fill_manual(values=c(ifelse(piechart_E$value != 0 & piechart_E$lmp_type == ev_measure,
"steelblue3",
ifelse(piechart_E$lmp_type == ev_type,
"steelblue1",
gray.colors(6, start = 0.8)))))
Na základe databázy LMP sa počas roku 2017 zúčastnilo na programe Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) 1 998 jednotlivcov , čo predstavuje 1.03 %% z celkového počtu účastníkov na všetkých AOTP na Slovensku (typy LMP 2-7) a 6.22 %% z celkových výdavkov na tieto programy. Kategória Stimuly k zamestnávaniu predstavuje 60.68 %% z celkových nákladov na všetky AOTP na Slovenku (typy LMP 2-7) a 61.68 %% všetkých účastníkov na AOTP.
1.2 Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) v kontexte AOTP na Slovensku
Najskôr pomocou administratívnych údajov zobrazíme dôležitosť programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) v kontexte AOTP na Slovensku. Nasledujúci vývojový diagram zobrazuje toky uchádzačov o zamestnanie evidovaných v databáze nezamestnanosti v roku 2017. Toky reprezentujú pohyb jednotlivcov počas dvoch rokov od ich registrácie. Toto obdobie je rozdelené na čiastkové, 6-mesačné obdobia (0/6/12/18/24). Počas týchto čiastkových období sledujeme toky registrovaných uchádzačov o zamestnanie do zamestnania, alebo ich vyradenia z databázy nezamestnaných z iných dôvodov. Uchádzači o zamestnanie sa taktiež môžu presunúť do jedného z programov AOTP. Zvýraznená, červená čiara predstavuje tok uchádzačov o zamestnanie do opatrenia P51A2, Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25).
Graf 2: Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) v štruktúre tokov uchádzačov o zamestnanie registrovaných v roku 2017
Nasledujúca tabuľka zobrazuje skratky a názvy nástrojov/programov AOTP, ktoré boli uvedené v grafe vyššie.
Tabuľka 1.1: Vysvetľujúca tabuľka ku grafu 2
Sankey_description <- select(qualitative, almp, Labour.market.services, Labour.market.services_SK)
Sankey_description[32,1] <- 'P054'
Sankey_description<- rbind(Sankey_description, Sankey_description[32,])
Sankey_description[nrow(Sankey_description),1] <- 'P54O'
Sankey_description[28,1] <- 'P54D'
Sankey_tabel1 <- data.frame(Measures = c(setdiff(nastroj_kod, c("iný dôvod vyradenia", "zamestnaní"))))
Sankey_tabel1$'programme' <- Sankey_description$Labour.market.services_SK[match(Sankey_tabel1$Measures, Sankey_description$almp)]
colnames(Sankey_tabel1) <- c('Skratka programu', 'Názov programu')
Sankey_tabel1 %>% kbl(format = 'html', booktabs = TRUE , align = 'c', row.names = FALSE)%>%
kable_classic('hover', full_width = FALSE)%>%
column_spec(1, border_right = TRUE) | Skratka programu | Názov programu |
|---|---|
| Vyradenie z iného dôvodu | NA |
| Nástup do zamestnania | NA |
| P54R | [Komponent] Projekty a programy - Projekty - Vzdelávanie a odborná príprava |
| P051 | Príspevok na vykonávanie absolventskej praxe |
| P054 | Projekty a programy |
| P54K | [Komponent] Projekty a programy - Projekty - Vzdelávanie a odborná príprava |
| P053 | Príspevok na dochádzanie za prácou |
| P54O | [Komponent] Projekty a programy - Samostatná zárobková činnosť |
| P052 | Príspevok na aktivačnú činnosť formou menších obecných služieb pre obec alebo formou menších služieb pre samosprávny kraj |
| P52A | Príspevok na aktivačnú činnosť formou dobrovoľníckej služby |
| P049 | Príspevok na samostatnú zárobkovú činnosť |
| P060 | Príspevok na úhradu prevádzkových nákladov chránenej dielne alebo chráneného pracoviska |
| P51A2 | Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) |
## Preparing of df
# we observe only young people under XX (age) which inflow in XXXX (entry year)
df_r <- subset(df, age <= age_group_max)
df_r <- subset(df_r, format(as.Date(df_r$entry),"%Y")== format(as.Date(params$ep_start),"%Y"))
#df_r <- df_r %>% mutate_all(na_if,"") #if cells are empty -> change it to NAs
df_r <- subset(df_r, healthy < 3)
# DOVOD VYRADENIA
dovod_vyradenia = c('V01','V02','V03','V1','V12','V15') #zamestnali sa
# Opatrenie P032 vyhodiť (ak sa budú meniť aj iné opatrenia ako napr. 54R a 54Rp tak tu sa to opraví (%in% c()))
delete <- setdiff(c('P032','P54P','P54D'),params$measure)
Salmps <- subset(almps, !nastroj %in% delete)
## Spojenie DF a ALMPS
df_almps <- merge(Salmps, df_r, by = 'klient_id')
## Vyfiltruj iba tie klient_id. pri ktorých nástroj je params$measure
partic_measure <- df_almps[df_almps$nastroj == params$measure, 'klient_id']
df_almps <- filter(df_almps, klient_id %in% partic_measure) #tu su tí, ktorí boli na aj na params$measure ale aj na iných opatreniach
# Podmienka prieniku času pri databáze nezamestnaných a v zúčastnili sa evaluated measure
df_almps_measure <- subset(df_almps, entry <= entrya & exita <= (exit +7) & nastroj == params$measure) # tu su tí, ktorí išli v skúmanom čase do opatrenia params$measure
##### toto je moja základňa môj prvý stĺpec
##### Podmienka prieniku času pri databáze nezamestnaných a iných programoch ako evaluated measue ale zároveň sú to tí, ktorí už niekedy na evaluated measure už boli
df_almps_other <- subset(df_almps, entry <= entrya & exita <= (exit +7) & nastroj != params$measure)
# upravíme si dáta ktoré budeme používať pri grafe
df_almps_measure <- select(df_almps_measure, klient_id, entry, exit, entrya, exita, nastroj, dovod_vyradenia_kod)
df_almps_other <- select(df_almps_other, klient_id, entry, exit, entrya, exita, nastroj, dovod_vyradenia_kod)
#smojím iba tých ktorí boli aj v evaluated measure aj v iných opatreniach, all.x = T lebo chceme aj tých ktorý boli iba na evaluated measure (nemuseli sa zúčastniť aj iných programov)
flow <- merge(df_almps_measure, df_almps_other, by = 'klient_id', all.x = TRUE)
#dni od začatia opatrenia entrya.x po začatie iného opatrenia entrya.y alebo po zamestnanie/odchod z iného dôvodu exit.x
flow$days <- ifelse(is.na(flow$nastroj.y),
as.numeric(difftime(flow$exit.x, flow$entrya.x, units = 'days')),
as.numeric(difftime(flow$entrya.y, flow$entrya.x, units = 'days')))
#ak je dovod vyradenia NA ale zúčastnili sa na opatrení
flow$dovod_vyradenia_kod.y <- ifelse(is.na(flow$dovod_vyradenia_kod.y) & !is.na(flow$nastroj.y), 'V01', flow$dovod_vyradenia_kod.y)
#vyfiltruj tých ktorý boli aj na evaluated measure aj na inom opatrení alebo sa zamestnali a days nie je záporné
#podmienka -> entrya do ďalšieho projektu musí byť väčšie ako entrya do evaluated measure
#flow$days nemôže byť záporné
flow <- filter(flow, days >= 0)
#nastroj -> ak dovod vyradenia sa rovna nejakému prvku z vektoru dovodov vyradenia tak -> employed inak another reason
flow <- flow %>%
mutate(nastroj.y = case_when(is.na(flow$nastroj.y) & flow$dovod_vyradenia_kod.x %in% dovod_vyradenia ~ 'zamestnaní',
is.na(flow$nastroj.y) & !flow$dovod_vyradenia_kod.x %in% dovod_vyradenia ~ 'iný dôvod vyradenia',
!is.na(flow$nastroj.y) ~ flow$nastroj.y)
)
#dataframe, ktorý budem používať pri tvorbe grafu
Sankey_measure <- flow %>% select(nastroj.x, nastroj.y, days) %>%
mutate(month = ceiling(days/30.417))
Sankey_measure <- Sankey_measure %>%mutate(
time = case_when(
Sankey_measure$month %in% seq(0,6,1) ~ 6,
Sankey_measure$month %in% seq(7,12,1) ~ 12,
Sankey_measure$month %in% seq(13,18,1) ~ 18,
Sankey_measure$month %in% seq(19,100,1) ~ 24,
)
)
Sankey_measure$sources <- ifelse(Sankey_measure$time == 6 | Sankey_measure$time == 12 |
Sankey_measure$time == 18 | Sankey_measure$time == 24,
Sankey_measure$time - 6,
Sankey_measure$time)
#zosumarizuj, koľký mladí išli do ktorého opatrenia, zamestnali sa alebo odišli z registra z iných dôvodov
San_measure <- Sankey_measure %>% select(nastroj.y, time, sources) %>%
group_by(nastroj.y, time, sources) %>% summarise(num = n(), .groups = 'drop') %>%
rename(nastroj = nastroj.y)
# rozdeľ opatrenia, na tie ostatné almps - OTHER ALMPS
nastroj_kod <- c('iný dôvod vyradenia','zamestnaní')
NastrojKod <- San_measure[!San_measure$nastroj %in% nastroj_kod,] %>% group_by(nastroj) %>% summarise(num = sum(num), .groups = 'drop') %>%
mutate(perc = num*100 / sum(num),
cut = case_when(perc >= 5 ~ 1,
perc < 5 ~ 0))
nastroj_kod <- c(nastroj_kod, NastrojKod$nastroj[NastrojKod$cut == '1'])
San_aplmps <- subset(San_measure, nastroj %in% nastroj_kod | nastroj == params$measure)
San_other_aplmps <- subset(San_measure, !nastroj %in% nastroj_kod & !nastroj == params$measure)
San_other_aplmps <- San_other_aplmps %>% group_by(sources , time) %>% summarise(num = sum(num), .groups = 'drop')
San_other_aplmps$nastroj <- 'ostatné AOTP'
San_other_aplmps <- relocate(San_other_aplmps, c(nastroj, time), .before = sources,)
San_measure <- rbind(San_aplmps, San_other_aplmps)
remove(San_aplmps, San_other_aplmps)
# uzly grafu (jedinečné), musia tu byť všetky opatrenia
node_m <- data.frame(
name=c(as.character(San_measure$nastroj), as.character(San_measure$sources))%>% unique()
)
# definovanie koľko registrovaných bude medzi tými rokmi
velky_df <- data.frame()
for (i in seq(6,24,6)){
pocet <- San_measure %>% group_by('sources' = sources >= i) %>% summarise(num = sum(num), .groups = 'drop')
pocet <- subset(pocet, sources == TRUE)
pocet$sources <- i
velky_df <- rbind(velky_df, pocet)
}
# musím si velky_df prisposobiť tak, aby roky boli ako nodes aby som to mohla spojiť s dataframe San s ktorým potom budem ďalej robiť graf
# preto sources budu ako nastroj -> aby som spravila nodes, years su sources ale sources su years -1 v skutočnosti (v san grafe)
colnames(velky_df) <- c('nastroj', 'num')
velky_df$time <- velky_df$nastroj
velky_df$sources <- San_measure$sources[match(velky_df$time, San_measure$time)]
velky_df <- relocate(velky_df, num, .after = sources)
San_measure <- rbind(San_measure, velky_df)
#urobím IDsources a ID target podľa uzlov aby garf vedel ten flow medzi jednotlivími uzlami
San_measure$IDsource <- match(San_measure$sources, node_m$name)-1
San_measure$IDtarget <- match(San_measure$nastroj, node_m$name)-1
#Color
time <- seq(0,24,6)
NOALMP <- c('iný dôvod vyradenia', 'zamestnaní')
node_m <- node_m %>% mutate(group = case_when(node_m$name %in% NOALMP ~ 'A',
!node_m$name %in% NOALMP & !node_m$name %in% time ~ 'B',
node_m$name %in% time ~ 'C'
)
)
San_measure$group <- 'type_a'
my_color <- 'd3.scaleOrdinal() .domain(["type_a", "A","B", "C"]) .range(["lightgray", "darkseagreen", "thistle", "rosybrown", "red"])'
San_measure <- as.data.frame(San_measure)
Sankey_ev.measure <- sankeyNetwork(Links = San_measure, Nodes = node_m,
Source = "IDsource", Target = "IDtarget",
Value = "num", NodeID = "name",
sinksRight=FALSE, fontSize = 14,
fontFamily = "sans-serif",
width = 900,
colourScale=my_color, LinkGroup="group", NodeGroup="group",
nodePadding=10)
condition_for_Sankeyplot <- length(unique(San_measure$IDsource))>=1 && length(unique(San_measure$IDtarget))>=1 && !any(is.na(San_measure$IDsource)) && !any(is.na(San_measure$IDtarget))Druhý vývojový diagram zobrazuje ďalšie toky účastníkov hodnoteného programu po jeho absolvovaní (ďalšie vetvenie červenej čiary v grafe 2). Po účasti v programe môžu byť účastníci zamestnaní, alebo môžu byť vyradení z evidencie UoZ na zákalde iného dôvodu. Môžu sa tiež zúčastniť aj ďalších programov AOTP. Toto správanie sme pozorovali v období dvoch rokov po ich účasti. Obdobie je rozdelené na štyri 6-mesačné čiastkové obdobia (0/6/12/18).
Graf 2.2: Toky účastníkov hodnoteného programu.
if(condition_for_Sankeyplot){
Sankey_ev.measure
}cond_for_table <- FALSE
if(condition_for_Sankeyplot){
Sankey_tabel2 <- data.frame(Measures = c(setdiff(nastroj_kod, c("iný dôvod vyradenia", "zamestnaní"))))
Sankey_tabel2$'programme' <- Sankey_description$Labour.market.services_SK[match(Sankey_tabel2$Measures, Sankey_description$almp)]
colnames(Sankey_tabel2) <- c('Skratka programu', 'Názov programu')
cond_for_table <- nrow(Sankey_tabel2) >=1
}Nasledujúca tabuľka zobrazuje skratky a názvy programov, ktoré boli uvedené v grafe vyššie.
Tabuľka 1.2: Vysvetľujúca tabuľka ku grafu 2.2
if (cond_for_table){
Sankey_tabel2 %>% kbl(format = 'html', booktabs = TRUE , align = 'c', row.names = FALSE)%>%
kable_classic('hover', full_width = FALSE)%>%
column_spec(1, border_right = TRUE)
}| Skratka programu | Názov programu |
|---|---|
| P053 | Príspevok na dochádzanie za prácou |
| P54O | [Komponent] Projekty a programy - Samostatná zárobková činnosť |
| P54R | [Komponent] Projekty a programy - Projekty - Vzdelávanie a odborná príprava |
2. Dáta a opis vzorky použitej na hodnotenie
Tento evaluačný report využíva administratívne údaje z registra nezamestnaných uchádzačov o zamestnanie (UoZ) na Slovensku, ktoré sú prepojiteľné s databázou účastníkov na opatreniach AOTP. Export dát zabezpečilo Ústredie práce, sociálnych vecí a rodiny Slovenskej republiky (ÚPSVR) na začiatku roka 2021 a pokrýva obdobie od januára 2014 do decembra 2020. Pôvodné údaje boli spracované pomocou skriptu na prípravu údajov, ktorý je k dispozícií na vyžiadanie od autorov.
Tabuľka “df” pokrýva všetky obdobia nezamestnanosti uchádzačov o zamestnanie s atribútami, ktoré boli zozbierané v čase ich registrácie ako nezamestnaných uchádzačov o zamestnanie (prihlasovací formulár)
### DEFINE THE EVALUATION PERIOD #
ep_start <- as.Date(params$ep_start)
ep_end <- as.Date(params$ep_end)
un_spell <- spell
measure <- params$measure
########################################x
## SELECTING THE EVALUATION SAMPLE #
########################################x,
treated<-filter(almps, nastroj==toString(params$measure))
#Sub-groups to be dropped:
# - those with ALMP participation 2 years before the EP
IDalmps_before<-unique(almps$klient_id[almps$entrya<ep_start & almps$entrya>=ep_start-730])
# - those with ALMP participation in other ALMP during the EP
IDalmps_during_ep<-unique(almps$klient_id[(almps$entrya<=ep_end & almps$entrya>=ep_start) & almps$nastroj!=toString(params$measure)])
###DEFINE THE ELIGIBILITY CRITERIA
#the EC are measure specific, in the case of looping over multiple measures EC need to be elaborated t a form of table or a list and added to the parameters
#SUBSETTING THE BASE EVALUATION DATASET OF ELIGIBLE
cond0<-as.logical(df$entry<=ep_end & df$exit>=ep_start) # Being on the register of unemployed during the evaluation period
cond1<-as.logical(df$age < age_group_max)
cond2<-as.logical((df$exit-df$entry)>=un_spell) #LENGTH OF PREVIOUS UNEMPLOYMENT SPELL
cond3<-as.logical(df$entry>=ep_start-730) # Dropping old unemployment spells (cases inflowing more than 730 days before the start of the evaluation period)
dfe<-df[cond0 & cond1 & cond2 & cond3,]
n1 <- dim(dfe)[1]
sampleIDs<-unique(df$klient_id[cond0 & cond1 & cond2 & cond3])
n2 <- length(sampleIDs)
###
#### ONLY KEEP THE SPELLS OF PARTICIPANTS DURING WHICH THEY PARTICIPATED
#### Creating dataframe of participants in the evaluated programme during the evaluation period.
dfa<-filter(treated, entrya<=ep_end & entrya>=ep_start)
npart0<-length(unique(dfa$klient_id))
npart1<-dim(dfa)[1]
#Drop other ALMP participations from the group of participants as well as the eligible non-participants
n3 <- nrow(filter(dfa, klient_id %in% IDalmps_before))
n4 <- nrow(filter(dfe, klient_id %in% IDalmps_before))
dfa<-filter(dfa, !klient_id %in% IDalmps_before)
dfe<-filter(dfe, !klient_id %in% IDalmps_before)
n5 <- nrow(filter(dfa, klient_id %in% IDalmps_during_ep))
n6 <- nrow(filter(dfe, klient_id %in% IDalmps_during_ep))
dfa<-filter(dfa, !klient_id %in% IDalmps_during_ep)
dfe<-filter(dfe, !klient_id %in% IDalmps_during_ep)
#### Only participants with one participation during the evaluation period are sampled.
#### JS with multiple participations are droped from the sample
dfa<-dfa %>%
group_by(klient_id) %>%
mutate(rep=n()) # rep is the number of participations of one JS repeating during 2014
n7 <- nrow(filter(dfa, rep!=1))
dfa<-filter(dfa, rep==1)
npart2<-dim(dfa)[1] # Number of participants after cleaning with multiple ALMP participations
###Participants who also participated in other ALMP measures (§54) are dropped
progOUT<- setdiff(c("P050", "P50A", "P50C","P50J", "P50K" ,"P51A", "P054", "P54D", "P54E", "P54O", "P54P", "P54U"),params$measure)
outIDs<-unique(almps$klient_id[(almps$entrya>=as.Date(params$ep_start) & almps$entrya<=as.Date(params$ep_end)+730) & as.logical(almps$nastroj %in% progOUT)])
n8 <- nrow(filter(dfa, klient_id %in% outIDs))
n9 <- nrow(filter(dfe, klient_id %in% outIDs))
dfa<-(filter(dfa, !klient_id %in% outIDs))
dfe<-(filter(dfe, !klient_id %in% outIDs))
npart3<-length(unique(dfa$klient_id)) # The number of participants after we drop participations in supported employment during the outcome observation period
#MERGING PARTICIPATIONS AND UNEMPLOYMENT SPELLS
#First we add the date of the entry and exit from the registration into the table of participations in measure (evaluated measure params$measure). We only import entry dates for the individuals in the evaluation sample.
dfa<-merge(dfa, select(dfe, klient_id, entry, exit), by="klient_id", all.x = TRUE)
nrowdfa <- nrow(dfa)
#Second we filter only the registrations of members of the evaluation sample during which the programme participation took place.
dfa<-filter(dfa, dfa$exit+30>=dfa$entrya & dfa$entrya<=ep_end & entrya >= entry) # Keeping only the participations happening during an unemployment spell
n10 <- nrowdfa-dim(dfa)[1]
npart4<-dim(dfa)[1] # Number of participants after cleaning participations outside an unemployment spell (data quality issue)
## Participants #
particIDs<-unique(dfa$klient_id)
## Eligible #
# nonpartIDs<-sampleIDs[!(sampleIDs %in% particIDs)]
nonpart<-filter(dfe, !(klient_id %in% particIDs))
###Out of the participants only one-time participations happening during an unemployment spell are used
partic<-merge(dfe, dfa, by = c("klient_id", "entry"), all.x = FALSE)
#LL: sanity check
#nonpart$klient_id
#partic$klient_id
#intersect(nonpart$klient_id,partic$klient_id)
#this should be empty. OK
### Cleaning and renaming #
partic$exit.y<-NULL
partic<-partic %>% rename(exit=exit.x)
nonpart$entrya<-NA
nonpart$exita<-NA
nonpart$nastroj<-NA
nonpart$naklady<-NA
nonpart$projekt<-NA
partic$rep<-NULL
#Filter extreme values (1%) of the waiting time until participation in the evaluated measure
wte<-quantile(as.numeric(partic$entrya)-as.numeric(partic$entry),na.rm=TRUE, probs=0.99)
n11 <- nrow(filter(filter(partic, as.numeric(entrya)-as.numeric(entry)>wte)))
partic<-filter(partic, as.numeric(entrya)-as.numeric(entry)<=wte)
esample<-rbind(nonpart, partic)
esample$treated<-!is.na(esample$entrya)
#Filter extreme values of the waiting time until participation in the evaluated measure
#LL:
#summary(esample$treated)
###Unemployment spells ending with LM placements
#esample<-filter(esample, dovod_vyradenia_kod == 'V01' | dovod_vyradenia_kod == 'V02' | dovod_vyradenia_kod == 'V03' | dovod_vyradenia_kod == 'V1' | dovod_vyradenia_kod == 'V12' | dovod_vyradenia_kod == 'V15')
########################################x
## GENERATING EXPLANATORY VARIABLES #
########################################x,
esample$ent <- as.numeric(as.Date(ep_start))-as.numeric(as.Date(esample$entry))
#LL: quantile(esample$ent)
#niektore unemployment spells boli
# negativne (JS zacal byt nezamestnany po 1-1-2017),
# niektore pozitivne (JS zacal byt nezamestnany pred 1-1-2017)
########AGEG
esample$ageg <- cut_interval(esample$age, 5, labels=FALSE)
esample$ageg <- as.factor(esample$ageg)
####Extra columns for dummy variables go into the esample_est for further testing
esample <- dummy_cols(esample, select_columns = c("ageg"), remove_first_dummy = TRUE)
ageg_dummies<-colnames(esample)[grepl("ageg_", colnames(esample))]
#######Regional Unemployment rate during the implementation period
esample[, "UR_region"] <- esample[, paste0("UR_region_",year(ep_start), "")]
esample[,grepl("UR_region_", colnames(esample))]<-NULL
esample$UR_region <- as.numeric(gsub(",", ".", gsub("\\.", "", esample$UR_region)))
##########Difference between entry into unemployment register and started of participation in measure
esample$diff_entry <- ceiling(as.integer(as.Date(esample$entrya) - as.Date(esample$entry))/30.417)
#Cleaning
#nonpart<-NULL
#partic<-NULL
# Share of repeated unemployment after participation in ALMP
# Merge esample, history table
h_esample <- merge(select(esample, klient_id, entry, exit, dovod_vyradenia_kod, entrya, exita, nastroj, treated), dfh, by = 'klient_id', all.x = TRUE, all.y = FALSE)
# as.Date
entry <- paste('entry', seq(1:11), sep = '')
exit <- paste('exit', seq(1:11), sep = '')
for (e in entry){
h_esample[ ,e] <- as.Date(h_esample[ ,e], origin = '1970-01-01')
}
for (x in exit){
h_esample[ ,x] <- as.Date(h_esample[ ,x], origin = '1970-01-01')
}
h_esample$exita <- as.Date(h_esample$exita, origin = '1970-01-01')
#Dropping cases with over than 15 unemployment spells
#h_esample<-filter(h_esample, is.na(entry16)) #subset (klient_id) jobseekers who became unemployment only 15 times
#esample <- subset(esample, klient_id %in% h_esample$klient_id)
#remove entry16+ and exit16+ columns
#h_esample<-select(h_esample, -entry16, -entry17, -entry18, -entry19, -entry20, -exit16, -exit17, -exit18, -exit19, -exit20)
esample_condition <- (mean(esample$treated) < 0.00001)if(esample_condition) {
knitr::knit_exit()
}2.1 Opis účastníkov na opatrení a oprávnených uchádzačov o zamestnanie
Dátová vzorka použitá na hodnotenie pozostáva z 98 288 oprávnených jednotlivcov, registrovaných ako uchádzačov o zamestnanie počas hodnotiaceho obdobia od 2017-01-01 do 2017-12-31. Títo UoZ boli registrovaní v databáze nezamestnaných celkovo 103 612 krát počas obdobia 2014-2020. Z nich sa počas hodnoteného obdobia na opatrení Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) zúčastnilo 1 920 uchádzačov o zamestnanie. Zo vzorky bolo vymazaných 1 104 účastníkov na programe a 54 438 oprávnených UoZ z dôvodu viacnásobnej účasti v hodnotenom programe (alebo iných relevantných APTP) počas hodnoteného obdobia alebo dva roky po hodnotenom období. Po vyčistení údajov sme získali 816 uchádzačov o zamestnanie s jednou participáciou počas hodnoteného obdobia. Súčasne počas roku 2017 bolo v databáze nezamestnaných 49 174 oprávnených, nezúčastnených uchádzačov o zamestnanie.
Skupiny účastníkov a oprávnených vykazujú rozdiely v množstve pozorovaných charakteristík. Tabuľka 2 zobrazuje prehľad týchto rozdielov vybraných charakteristík.
Tabuľka 2: Popisné štatistiky účastníkov a oprávnených uchádzačov o zamestnanie (vybrané charakteristiky)
####
## number of participants and eligible
####
#separate table dfe with participants in ALMP and eligible
elig <- distinct_at(nonpart,vars(klient_id),.keep_all = TRUE)
part <- distinct_at(partic,vars(klient_id),.keep_all = TRUE)
#BASIC DESCRIPTIVE TABLE
# The number of participants and eligible in the sample'
#tab1<-cbind(sum(!is.na(dfe$entrya)),sum(is.na(dfe$entrya)))
tab1 <- cbind(format(length(unique(esample$klient_id[esample$treated==TRUE])), big.mark=" ", scientific=FALSE), format(length(unique(esample$klient_id[esample$treated==FALSE])), big.mark=" ", scientific=FALSE))
colnames(tab1) <- c('Účastníci', 'Oprávnení')
tab1 <- data.frame(cbind(Description = 'Počet pozorovaní', tab1))
####
## Age distribution
####
age_par <- part %>% select(age) %>% group_by(age) %>% dplyr::summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%"))
age_elig <- elig %>% select(age) %>% group_by(age) %>% dplyr::summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
age <- merge(age_par, age_elig, by='age', all = TRUE)
age$Participants_percent <- ifelse(is.na(age$Participants_percent), paste(0,'%'), age$Participants_percent)
age$Participants_total <- ifelse(is.na(age$Participants_total), 0, age$Participants_total)
mean_age_par <- round(mean(part$age),1)
mean_age_elig <- round(mean(elig$age),1)
##### MEAN
mean_age<-data.frame(mean_age_par,mean_age_elig)
mean_age <- cbind(Description = 'Vek', mean_age)
mean_age <- rename(mean_age, 'Účastníci' = mean_age_par, 'Oprávnení' = mean_age_elig)
####
age_elig$desc <- 'Oprávnení'
age_par$desc <- 'Účastníci'
age_elig <- age_elig %>% rename(total = Eligible_total, percent = Eligible_percent)
age_par <- age_par %>% rename(total = Participants_total, percent = Participants_percent)
age_r <- rbind(age_par,age_elig)
age_plot <- ggplot(age_r, aes(x = age, y = total, group= desc)) +
geom_point(aes(color = desc), size = 1.5)+
geom_line(aes(color = desc), size = 1) +
ylim(0,23000) +
theme_light() +
geom_text(aes(label = paste(percent, '\n\n' )), col ='black', size = 3, fontface ='italic')+
labs(
title = "Compare of age distribution (%)",
x = "Age",
y = "Total Count"
)
####
## Gender distribution
####
gender_par <- part %>% select(male) %>% group_by(male) %>% dplyr::summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%"))
gender_elig <- elig %>% select(male) %>% group_by(male) %>% dplyr::summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
gender <- merge(gender_par, gender_elig, by='male', all = TRUE)
####
male <- data.frame(gender_par[2,3], gender_elig[2,3])
male <- cbind(Description = 'Muži', male)
male <- rename(male, 'Účastníci' = Participants_percent, 'Oprávnení'=Eligible_percent)
####
## Education distribution
####
education_par <- part %>% select(noedu, primary, lsec, usec, tertiary) %>%
group_by(noedu, primary, lsec, usec, tertiary) %>% dplyr::summarise(Participants_total = n(), .groups = 'drop') %>%
mutate(Participants = round(100 * Participants_total / sum(Participants_total),2))
education_par <- education_par[!(is.na(education_par$noedu)),]
education_par <- reshape2::melt(education_par, measure.vars = c('noedu', 'primary', 'lsec', 'usec', 'tertiary'))
education_par <- education_par[education_par$value == 1,]
education_par <- select(education_par, -value)
education_elig <- elig %>% select(noedu, primary, lsec, usec, tertiary) %>%
group_by(noedu, primary, lsec, usec, tertiary) %>% dplyr::summarise(Eligible_total = n(), .groups = 'drop') %>%
mutate(Eligible = round(100 * Eligible_total / sum(Eligible_total),2))
education_elig <- education_elig[!(is.na(education_elig$noedu)),]
education_elig <- reshape2::melt(education_elig, measure.vars = c('noedu', 'primary', 'lsec', 'usec', 'tertiary'))
education_elig <- education_elig[education_elig$value == 1,]
education_elig <- select(education_elig, -value)
education <- merge(education_par, education_elig, by='variable', all = TRUE)
education <- select(education, variable, Participants, Eligible)
education <- rename(education, Popis = variable)
education <- education%>%mutate(
Popis = case_when(
education$Popis == 'noedu' ~ 'Bez vzdelania',
education$Popis == 'primary' ~ 'Základné',
education$Popis == 'lsec' ~ 'Nižšie sekundárne',
education$Popis == 'usec' ~ 'Vyššie sekundárne',
education$Popis == 'tertiary' ~ 'Terciárne',
TRUE~as.character(education$Popis)
)
)
education <- education %>% group_by(Popis) %>%
dplyr::summarise('Účastníci' = paste0(sum(Participants), "%"), 'Oprávnení' = paste0(sum(Eligible), "%"))
x <- c('Bez vzdelania','Základné','Nižšie sekundárne', 'Vyššie sekundárne', 'Terciárne')
education <- education[match(x, education$Popis),]
####
## skills
####
l_skills_par <- part %>% select(flang) %>%
mutate(flang = case_when(part$flang == 1 ~ 'Cudzí jazyk')) %>%
group_by(flang) %>% summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%")) %>%
rename(Description = flang) %>% filter(row_number() == 1L)
l_skills_elig <- elig %>% select(flang) %>%
mutate(flang = case_when(elig$flang == 1 ~ 'Cudzí jazyk')) %>%
group_by(flang) %>% summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%")) %>%
rename(Description = flang) %>% filter(row_number() == 1L)
PC_skills_par <- part %>% select(pc) %>%
mutate(pc = case_when(part$pc == 1 ~ 'Počitačové zručnosti')) %>%
group_by(pc) %>% summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%")) %>%
rename(Description = pc) %>% filter(row_number() == 1L)
PC_skills_elig <- elig %>% select(pc) %>%
mutate(pc = case_when(elig$pc == 1 ~ 'Počitačové zručnosti')) %>%
group_by(pc) %>% summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%")) %>%
rename(Description = pc) %>% filter(row_number() == 1L)
d_skills_par <- part %>% select(drive) %>%
mutate(drive = case_when(part$drive == 1 ~ 'Vodičský preukaz')) %>%
group_by(drive) %>% summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%")) %>%
rename(Description = drive) %>% filter(row_number() == 1L)
d_skills_elig <- elig %>% select(drive) %>%
mutate(drive = case_when(elig$drive == 1 ~ 'Vodičský preukaz')) %>%
group_by(drive) %>% summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%")) %>%
rename(Description = drive) %>% filter(row_number() == 1L)
l_skills <- merge(l_skills_par, l_skills_elig, by='Description', all = TRUE)
PC_skills <- merge(PC_skills_par, PC_skills_elig, by='Description', all = TRUE)
d_skills <- merge(d_skills_par, d_skills_elig, by='Description', all = TRUE)
skills <- rbind(l_skills, PC_skills, d_skills)
skills <- select(skills, Description, Participants_percent, Eligible_percent)
skills <- rename(skills, Popis = Description, 'Účastníci' = Participants_percent, 'Oprávnení'=Eligible_percent)
####
## region
####
part <- part %>% mutate(
okres = case_when(
grepl('SK010',okres) ~ 'Bratislavský',
grepl('SK021',okres) ~ 'Trnavský',
grepl('SK022',okres) ~ 'Trenčiansky',
grepl('SK023',okres) ~ 'Nitriansky',
grepl('SK031',okres) ~ 'Žilinský',
grepl('SK032',okres) ~ 'Banskobystrický',
grepl('SK041',okres) ~ 'Prešovský',
grepl('SK042',okres) ~ 'Košický',
TRUE~as.character(okres)
)
)
elig <- elig %>% mutate(
okres = case_when(
grepl('SK010',okres) ~ 'Bratislavský',
grepl('SK021',okres) ~ 'Trnavský',
grepl('SK022',okres) ~ 'Trenčiansky',
grepl('SK023',okres) ~ 'Nitriansky',
grepl('SK031',okres) ~ 'Žilinský',
grepl('SK032',okres) ~ 'Banskobystrický',
grepl('SK041',okres) ~ 'Prešovský',
grepl('SK042',okres) ~ 'Košický',
TRUE~as.character(okres)
)
)
okres_par <- part %>% select(okres) %>% group_by(okres) %>% dplyr::summarise(Participants_total = n()) %>%
mutate('Účastníci' = paste0(round(100 * Participants_total / sum(Participants_total),2), "%"))
okres_elig <- elig %>% select(okres) %>% group_by(okres) %>% dplyr::summarise(Eligible_total = n()) %>%
mutate('Oprávnení' = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
okres <- merge(okres_par, okres_elig, by='okres', all = TRUE)
okres <- select(okres, okres, 'Účastníci', 'Oprávnení')
okres <- rename(okres, Description = okres)
okres <- okres[okres$Description != 'N/A',]
####
## Previous employment
####
prev_emp_part <- part %>% select(empl) %>% group_by(empl) %>% summarise(Participants_total = n()) %>%
mutate(Participants_percent = paste0(round(100 * Participants_total / sum(Participants_total),2), "%")) %>%
rename(Popis = empl, 'Účastníci' = Participants_percent)
prev_emp_elig <- elig %>% select(empl) %>% group_by(empl) %>% summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%")) %>%
rename(Popis = empl, 'Oprávnení' = Eligible_percent)
prev_emp <- merge(prev_emp_part, prev_emp_elig, by='Popis', all = TRUE)
prev_emp <- select(prev_emp, Popis, 'Účastníci', 'Oprávnení')
prev_emp <- prev_emp[prev_emp$Popis == 1,]
prev_emp$Popis[prev_emp$Popis == 1 ] <- 'Predošlé zamestnanie'
####
## Nationality
####
nat_part <- part %>% select(slovak, hungarian, roma, czech, othern) %>%
group_by(slovak, hungarian, roma, czech, othern) %>% summarise(Participants_total = n(), .groups = 'drop') %>%
mutate('Účastníci' = paste0(round(100 * Participants_total / sum(Participants_total),2),'%'))
nat_part$othern <- ifelse(nat_part$othern == 'TRUE', 1,0)
nat_part <- reshape2::melt(nat_part, measure.vars = c('slovak', 'hungarian', 'roma', 'czech', 'othern'))
nat_part <- nat_part[nat_part$value == 1,]
nat_part <- select(nat_part, -value)
nat_elig <- elig %>% select(slovak, hungarian, roma, czech, othern) %>%
group_by(slovak, hungarian, roma, czech, othern) %>% summarise(Eligible_total = n(), .groups = 'drop') %>%
mutate('Oprávnení' = paste0(round(100 * Eligible_total / sum(Eligible_total),2),'%'))
nat_elig$othern <- ifelse(nat_elig$othern == 'TRUE', 1,0)
nat_elig <- reshape2::melt(nat_elig, measure.vars = c('slovak', 'hungarian', 'roma', 'czech', 'othern'))
nat_elig <- nat_elig[nat_elig$value == 1,]
nat_elig <- select(nat_elig, -value)
nat <- merge(nat_part, nat_elig, by='variable', all = TRUE)
nat <- select(nat, variable, 'Účastníci', 'Oprávnení')
nat <- rename(nat, Popis = variable)
nat <- nat %>%mutate(
Popis = case_when(
nat$Popis == 'slovak' ~ 'Slovenská',
nat$Popis == 'hungarian' ~ 'Maďarská',
nat$Popis == 'czech'~ 'Česká',
nat$Popis == 'roma' ~ 'Rómska',
nat$Popis == 'othern'~ 'Ostatné',
)
)
x <- c('Slovenská','Maďarská', 'Česká','Rómska','Ostatné')
nat <-nat[match(x, nat$Popis),]
####
## Length of the unemployment spell
####
part$un_spell <- as.integer(part$exit - part$entry)
elig$un_spell <- as.integer(elig$exit - elig$entry)
un_spell <- cbind(round(mean(part$un_spell),2), round(mean(elig$un_spell),2))
un_spell <- data.frame(cbind(Description = 'Dĺžka nezamestnanosti ', un_spell))
un_spell <- rename(un_spell, 'Účastníci'= V2, 'Oprávnení'=V3)
####
## Length of spell between unemployment and participation
####
#Rozdiel medzi evidenciou nezamestnanosti a nastúpenia do AOTP
part$spell_b <- as.integer(part$entrya - part$entry)
spell_bup <- part %>% select(spell_b) %>%
mutate(month = ceiling(spell_b/30.417)) #roundup -> ceiling
spell_bup_p <- ggplot(data=spell_bup, aes(month)) +
geom_histogram(binwidth=1, fill="grey", color="black", alpha=0.9) +
theme_light() +
theme(legend.position = "none")+
labs(
title = "Prítoky nezamestnaných uchádzačov o zamestnanie\ndo programu v mesiacoch od začiatku nezamestnanosti",
x = "Mesiace",
y = "Celkový počet nezamestnaných"
) +
scale_x_continuous()
####
## Length of AOTP
####
part$spell_aotp <- as.integer(part$exita - part$entrya)
spell_aotp <- part %>% select(spell_aotp) %>%
mutate(month = ceiling(spell_aotp/30.417)) #roundup -> ceiling
spell_aotp_p <- ggplot(data=spell_aotp, aes(month)) +
geom_histogram(binwidth=1, fill="grey", color="black", alpha=0.9) +
theme_light() +
theme(legend.position = "none") +
labs(
title = "Dĺžka účasti na programe\n (v mesiacoch)",
x = "Mesiace",
y = "Celkový počet nezamestnaných"
) +
scale_x_continuous(breaks = scales::breaks_extended(length(unique(spell_aotp$month))))
####
## Compare of length spell
####
spell_p <- ggarrange(spell_bup_p, spell_aotp_p)
####
## In flow
####
a <- format(seq(as.Date(ep_start),length=3,by="1 month"),"%Y-%m")
b <- format(seq((ymd(as.Date(ep_start)) %m+% months(3)),length=3,by="1 month"),"%Y-%m")
c <- format(seq((ymd(as.Date(ep_start)) %m+% months(6)),length=3,by="1 month"),"%Y-%m")
d <- format(seq((ymd(as.Date(ep_start)) %m+% months(9)),length=3,by="1 month"),"%Y-%m")
#vstúpili do programu
in_part <- part %>% select(entrya) %>% group_by(format(as.Date(entrya),"%Y-%m")) %>%
summarise(Participants_total = n()) %>%
mutate(Participants_percent = round(100 * Participants_total / sum(Participants_total),2))
colnames(in_part)[1] <- 'Popis'
in_part <- filter(in_part, str_detect(in_part$Popis, (format(as.Date(ep_start),"%Y"))))
in_part <- in_part%>%mutate(
Popis = case_when(
in_part$Popis %in% a ~ paste0('1Q.', (format(as.Date(ep_start),"%Y"))),
in_part$Popis %in% b ~ paste0('2Q.', (format(as.Date(ep_start),"%Y"))),
in_part$Popis %in% c ~ paste0('3Q.', (format(as.Date(ep_start),"%Y"))),
in_part$Popis %in% d ~ paste0('4Q.', (format(as.Date(ep_start),"%Y"))),
)
)
in_part <- in_part %>% select(Popis, Participants_total) %>% group_by(Popis) %>%
summarise(Participants_total = sum(Participants_total)) %>%
mutate('Účastníci' = paste0(round(100 * Participants_total / sum(Participants_total),2),'%'))
#sa stali nezamestnaný
in_elig <- elig %>% select(entry) %>% group_by(format(as.Date(entry),"%Y-%m")) %>%
summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
colnames(in_elig)[1] <- 'Popis'
in_elig <- filter(in_elig, str_detect(in_elig$Popis, (format(as.Date(ep_start),"%Y"))))
in_elig <- in_elig%>%mutate(
Popis = case_when(
in_elig$Popis %in% a ~ paste0('1Q.', (format(as.Date(ep_start),"%Y"))),
in_elig$Popis %in% b ~ paste0('2Q.', (format(as.Date(ep_start),"%Y"))),
in_elig$Popis %in% c ~ paste0('3Q.', (format(as.Date(ep_start),"%Y"))),
in_elig$Popis %in% d ~ paste0('4Q.', (format(as.Date(ep_start),"%Y"))),
)
)
in_elig <- in_elig %>% select(Popis, Eligible_total) %>% group_by(Popis) %>%
summarise(Eligible_total = sum(Eligible_total)) %>%
mutate('Oprávnení' = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
inflow <- merge(in_part, in_elig, by='Popis', all = FALSE)
inflow <- select(inflow, Popis, 'Účastníci', 'Oprávnení')
####
## Outflow
####
#vystúpili z programu
out_part <- part %>% select(exita) %>% group_by(format(as.Date(exita),"%Y-%m")) %>%
summarise(Participants_total = n()) %>%
mutate(Participants_percent = round(100 * Participants_total / sum(Participants_total),2))
colnames(out_part)[1] <- 'Popis'
out_part <- filter(out_part, str_detect(out_part$Popis, (format(as.Date(ep_start),"%Y"))))
out_part <- out_part%>%mutate(
Popis = case_when(
out_part$Popis %in% a ~ paste0('1Q.', (format(as.Date(ep_start),"%Y"))),
out_part$Popis %in% b ~ paste0('2Q.', (format(as.Date(ep_start),"%Y"))),
out_part$Popis %in% c ~ paste0('3Q.', (format(as.Date(ep_start),"%Y"))),
out_part$Popis %in% d ~ paste0('4Q.', (format(as.Date(ep_start),"%Y"))),
)
)
out_part <- out_part %>% select(Popis, Participants_total) %>% group_by(Popis) %>%
summarise(Participants_total = sum(Participants_total)) %>%
mutate('Účastníci' = paste0(round(100 * Participants_total / sum(Participants_total),2),'%'))
#vystúpili z evidencie -> zamestnali sa
out_elig <- elig %>% select(exit) %>% group_by(format(as.Date(exit),"%Y-%m")) %>%
summarise(Eligible_total = n()) %>%
mutate(Eligible_percent = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
colnames(out_elig)[1] <- 'Popis'
out_elig <- filter(out_elig, str_detect(out_elig$Popis, (format(as.Date(ep_start),"%Y"))))
out_elig <- out_elig%>%mutate(
Popis = case_when(
out_elig$Popis %in% a ~ paste0('1Q.', (format(as.Date(ep_start),"%Y"))),
out_elig$Popis %in% b ~ paste0('2Q.', (format(as.Date(ep_start),"%Y"))),
out_elig$Popis %in% c ~ paste0('3Q.', (format(as.Date(ep_start),"%Y"))),
out_elig$Popis %in% d ~ paste0('4Q.', (format(as.Date(ep_start),"%Y"))),
)
)
out_elig <- out_elig %>% select(Popis, Eligible_total) %>% group_by(Popis) %>%
summarise(Eligible_total = sum(Eligible_total)) %>%
mutate('Oprávnení' = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%"))
outflow <- merge(out_part, out_elig, by='Popis', all = FALSE)
outflow <- select(outflow, Popis, 'Účastníci', 'Oprávnení')
####
## Children in the household
####
child_part <- part %>% select(kids) %>% group_by(kids) %>% summarise(Participants_total = n()) %>%
mutate('Účastníci' = paste0(round(100 * Participants_total / sum(Participants_total),2), "%")) %>%
rename(Popis = kids)
child_elig <- elig %>% select(kids) %>% group_by(kids) %>% summarise(Eligible_total = n()) %>%
mutate('Oprávnení' = paste0(round(100 * Eligible_total / sum(Eligible_total),2), "%")) %>%
rename(Popis = kids)
child <- merge(child_part, child_elig, by='Popis', all = TRUE)
child <- select(child, Popis, 'Účastníci', 'Oprávnení')
child <- child[child$Popis == 1,]
child$Popis[child$Popis == 1] <- 'Deti v domácnosti'
####
## Fields of study
####
study_part <- part %>% select(odbor) %>% group_by(odbor) %>%
summarise(Participants_total = n()) %>%
mutate(Participants = round(100 * Participants_total / sum(Participants_total),2))
study_elig <- elig %>% select(odbor) %>% group_by(odbor) %>%
summarise(Eligible_total = n()) %>%
mutate(Eligible = round(100 * Eligible_total / sum(Eligible_total),2))
study <- merge(study_part, study_elig, by='odbor', all = TRUE)
study <- select(study, odbor, Participants, Eligible)
study$Participants <- ifelse(is.na(study$Participants), 0, study$Participants)
a <- as.character(c(seq(11,19,1)))
b <- as.character(c(seq(21,39,1)))
c <- as.character(c(seq(41,49,1)))
d <- as.character(c(seq(51,59,1)))
e <- as.character(c(seq(61,79,1)))
f <- as.character(c(seq(81,89,1)))
g <- as.character(c(seq(91,98,1)))
study <- study%>%mutate(
odbor = case_when(
study$odbor %in% a ~ 'Prírodné vedy',
study$odbor %in% b ~ 'Technické vedy a náuky ',
study$odbor %in% c ~ 'Poľnohospodársko-lesnícke a veterinárne vedy a náuky',
study$odbor %in% d ~ 'Zdravotníctvo',
study$odbor %in% e ~ 'Spoločenské vedy, náuky a služby',
study$odbor %in% f ~ 'Vedy a náuky o kultúre a umení',
study$odbor %in% g ~ 'Vojenské a bezpečnostné vedy a náuky',
study$odbor == 99 || study$odbor == 0 || study$odbor == 10 ~ 'Všeobecné vedy a služby',
TRUE~as.character(study$odbor)
)
)
study <- study %>% select(odbor, Participants, Eligible) %>%
group_by(odbor) %>%
summarise('Účastníci' = paste0(sum(Participants), "%"), 'Oprávnení' =paste0(sum(Eligible), "%"))
study <- rename(study, Popis = odbor)
####
## SUMMARIZE ####
####
colnames(tab1)<-c("Popis", "Účastníci ", "Oprávnení")
colnames(mean_age)<-c("Popis", "Účastníci ", "Oprávnení")
colnames(male)<-c("Popis", "Účastníci ", "Oprávnení")
colnames(prev_emp)<-c("Popis", "Účastníci ", "Oprávnení")
colnames(un_spell)<-c("Popis", "Účastníci ", "Oprávnení")
colnames(child)<-c("Popis", "Účastníci ", "Oprávnení")
tables <- c('tab1', 'mean_age', 'male', 'prev_emp', 'un_spell', 'child')
basics <- data.frame()
for (name in tables){
table <- get(name)
table <- mutate(table, across(everything(), as.factor))
basics <- bind_rows(basics, table)
}
tables <- c('basics', 'education', 'study', 'skills', 'okres', 'nat', 'inflow', 'outflow')
for (name in tables){
table <- get(name)
table <- add_column(table, Variable = name, .after = "Oprávnení")
colnames(table) <- c("Popis", "Účastníci ", "Oprávnení", "Variable")
assign(name, table)
}
sum_table <- rbind(basics, education, study, skills, okres, nat, inflow, outflow)
sum_table <- sum_table %>% relocate(Variable, .before = Popis) %>%mutate(
Variable = case_when(
sum_table$Variable == 'basics' ~ 'Základné štatistiky',
sum_table$Variable == 'education' ~ 'Stupeň vzdelania',
sum_table$Variable == 'study' ~ 'Štúdijný odbor',
sum_table$Variable == 'skills' ~ 'Zručnosti',
sum_table$Variable == 'okres' ~ 'Okres',
sum_table$Variable == 'nat' ~ 'Národnosť',
sum_table$Variable == 'inflow' ~ 'Prítok nezamestnaných',
sum_table$Variable == 'outflow' ~ 'Odtok nezamestnaných',
TRUE ~ as.character(sum_table$Variable)
)
)
sum_table$`Účastníci ` <- ifelse(is.na(sum_table$`Účastníci `) | gsub('\\D','', sum_table$`Účastníci `) == "",
ifelse(is.na(sum_table$`Účastníci `) | gsub('\\D','', sum_table$`Účastníci `) == "",
ifelse(str_detect(as.character(sum_table$Oprávnení), regex("%")), '0%',0),
as.character(sum_table$`Účastníci `)),
as.character(sum_table$`Účastníci `))
sum_table[,2:4] %>% kbl(format = 'html', booktabs = TRUE , align = 'c', row.names = FALSE) %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE) %>%
pack_rows(index = table(fct_inorder(sum_table$Variable)))| Popis | Účastníci | Oprávnení |
|---|---|---|
| Základné štatistiky | ||
| Počet pozorovaní | 816 | 49 174 |
| Vek | 22.3 | 23.3 |
| Muži | 51.96% | 54.21% |
| Predošlé zamestnanie | 2.57% | 6.19% |
| Dĺžka nezamestnanosti | 650.59 | 279.82 |
| Deti v domácnosti | 8.09% | 10.53% |
| Stupeň vzdelania | ||
| Bez vzdelania | 0.74% | 1.5% |
| Základné | 8.46% | 21.56% |
| Nižšie sekundárne | 13.85% | 16.08% |
| Vyššie sekundárne | 55.39% | 40.95% |
| Terciárne | 21.57% | 19.91% |
| Štúdijný odbor | ||
| Poľnohospodársko-lesnícke a veterinárne vedy a náuky | 1.6% | 1.98% |
| Prírodné vedy | 0.98% | 0.55% |
| Spoločenské vedy, náuky a služby | 23.41% | 24.8% |
| Technické vedy a náuky | 14.12% | 17.84% |
| Vedy a náuky o kultúre a umení | 1.59% | 1.45% |
| Vojenské a bezpečnostné vedy a náuky | 0.37% | 0.24% |
| Všeobecné vedy a služby | 56.62% | 52% |
| Zdravotníctvo | 1.35% | 1.14% |
| Zručnosti | ||
| Cudzí jazyk | 84.56% | 70.45% |
| Počitačové zručnosti | 81.13% | 67.57% |
| Vodičský preukaz | 62.38% | 49.42% |
| Okres | ||
| Banskobystrický | 15.69% | 12.7% |
| Bratislavský | 0% | 10.25% |
| Košický | 17.65% | 16.75% |
| Nitriansky | 11.15% | 9.84% |
| Prešovský | 30.76% | 22.89% |
| Trenčiansky | 8.33% | 8.4% |
| Trnavský | 5.02% | 6.81% |
| Žilinský | 11.4% | 12.35% |
| Národnosť | ||
| Slovenská | 92.4% | 91.72% |
| Maďarská | 7.11% | 7.5% |
| Česká | 0.37% | 0.22% |
| Rómska | 0.12% | 0.23% |
| Ostatné | 0% | 0.33% |
| Prítok nezamestnaných | ||
| 1Q.2017 | 30.27% | 26.79% |
| 2Q.2017 | 41.18% | 26.59% |
| 3Q.2017 | 16.3% | 25.13% |
| 4Q.2017 | 12.25% | 21.48% |
| Odtok nezamestnaných | ||
| 1Q.2017 | 7.66% | 31.31% |
| 2Q.2017 | 22.49% | 30.44% |
| 3Q.2017 | 30.62% | 21.36% |
| 4Q.2017 | 39.23% | 16.88% |
Graf 3 (vľavo) zobrazuje podiely účastníkov programu podľa toho, koľko mesiacov ubehlo od začiatku ich nezamestnanosti do ich zaradenia do programu. Na pravej strane je vidieť podiely účastníkov podľa dĺžky ich účasti v programe, meranej v mesiacoch.
Graf 3: Časovanie prítoku (vľavo) a dĺžka účasti (vpravo) na Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) počas 2017
require(gridExtra)
if (nrow(spell_bup) > 5){
mx <- max(spell_bup$month)
mn <- min(spell_bup$month)
plot1 <- ggplot(data=spell_bup, aes(month)) +
geom_histogram(binwidth=3, bins=30, breaks=seq(mn, mx, by=0.5), alpha=0.8,col="white", fill="steelblue3") +
theme_minimal()+
ggtitle("Prítok do programu v mesiacoch\nod začiatku nezamestnanosti") +
xlab("Mesiac") +
ylab("Počet")+
scale_x_continuous(breaks= pretty_breaks())
}
if (nrow(spell_aotp) > 5){
mx <- max(spell_aotp$month)
mn <- min(spell_aotp$month)
plot2 <- ggplot(data=spell_aotp, aes(month)) +
geom_histogram(binwidth=3, bins=30, breaks=seq(mn, mx, by=0.5), alpha=0.8,col="white", fill="steelblue3") +
theme_minimal()+
ggtitle("Dĺžka účasti v programe \n (v mesiacoch)") +
xlab("Mesiac") +
ylab("Počet")+
scale_x_continuous(breaks= pretty_breaks())
}
grid.arrange(plot1, plot2, ncol=2)
3. Vyhodnotenie účinnosti programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25)
Vyhodnotenie účinnosti (dopadu) pomoci poskytovanej UoZ je založené na sledovaní správania sa účastníkov, ktoré je porovnávané so správaním sa oprávnených UoZ. Dostupné údaje nám umožňujú sledovať výlučne prítomnosť jednotlivcov v evidencií UoZ. Na základe tejto informácie sme zostrojili tri indikátory sledovaného výsledku:
- Miera prítomnosti v evidencií UoZ (proxy pre mieru zamestnanosti)
- Dĺžka obdobia od účasti do prvého opustenia evidencie UoZ
- Kumulatívny počet období (štvrťrokov/mesiacov) mimo evidenciu UoZ
Jednoduché porovnanie hodnôt zvolených indikátorov výsledku by bolo skreslené rozdielnym zložením skupiny účastn↨íkov a oprávnených UoZ. Z toho dôvodu vyberáme spomedzi oprávnených UoZ kontrolnú skupinu metódou jedného najbližšieho suseda. Takýmto spôsobom odhadneme účinok účasti na opatrení APTP na sledované výsledky populácie účastníkov programu.
#Estimation parameters
#LL: there will be four different samples according to how long have JSs been unemployed prior to receiving the training
Ssamples <- seq(1,4)
# Month of participation since the start of the evaluation period
participation_month<-((year(as.Date(esample$entrya))-min(year(ep_start)))*12)+month(as.Date(esample$entrya))
#LL: participation quarter, if JS was treated on 3 Feb, pcpQ == 1
pcpQ<-ceiling(participation_month/3)
max_pcpQ<-max(pcpQ, na.rm = TRUE)
#LL: create an object that will store data
Mdata<-c()
#LL: these are the periods that we will look at
# the negative values correspond to "placebo" effects. We should not see any effect there, or only a small one.
OQm <- seq(-12,36,3)
OQ <- -4:12
O_vars <- c(paste("empl",OQ, sep=""), "firstempl", "cumempl")
O_vars<-str_replace(O_vars, "-", ".")
#LL: O_vars stores outcome variables
# empl.2 means employment 2 quarters before the start of the evaluation period.
# empl0 will correspond to the last quarter of the year before the start of the eval. period
# empl1 will correspond to the first quarter of the start year of the eval. period
#LL: This is a list of baseline covariates that will be used throughout the analysis
# they correspond to a reasonable minimum of information that should be controlled for
# in order to have a meaningful comparison
list_vars <- c('ent', 'male', 'married','kids',
'slovak', 'noedu','primary', 'lsec', 'usec',
'flang', 'drive', 'pc',
'unpast', 'min_urad', 'min_BA',
'UR_region', 'roma_share', 'population', 'age')
#LL: In order to have a credible comparison groups. We need to look how similar the groups are, how balanced they are.
# we compare the mean differences BEFORE adjustment and AFTER adjustment
Balance_vars <- list_vars
#LL: We allocate objects that will store the results
#LL: number of treated units
N<-nrow(esample[esample$treated==TRUE,])
#LL: number of treated units in a particular esample
N_sp <- matrix(NA, nrow=length(Ssamples)) # S x P x Q2
#LL: results array ATT. We are interested in the average treatment effect on the TREATED subpopulation.
# in this particular case, most LM programs are intended for a specific subpopulation.
# it is therefore of less interest to look at the whole population of JSs (ATE)
resultsArray_ATT <- array(NA, dim=c(length(O_vars),length(Ssamples))) # S x P x Q2
dimnames(resultsArray_ATT)[[1]] <- c(O_vars)
#LL: we also store standard errors that quantify STATISTICAL uncertainty of our estimates
resultsArray_se <- array(NA, dim=c(length(O_vars),length(Ssamples))) # S x P x Q2
dimnames(resultsArray_se)[[1]] <- c(O_vars)
results <- array(NA, dim=c(length(O_vars),2))
### 1. Counting of ATTs
Sesample <- esample
###Four sub-samples based on the waiting time until participation in the evaluated measure (cutoffs p25, p50, p75):
#LL: these will make 4 (roughly equally sized) different groups according to how long JSs have been unemployed
# this is an important determinant of the effect and it is important to control for it
wtc25<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.25)
wtc50<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.50)
wtc75<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.75)
minToP<-min(as.numeric(Sesample$entrya)-as.numeric(Sesample$entry), na.rm = TRUE)
partic<-Sesample[Sesample$treated==TRUE,]
nonpart<-Sesample[Sesample$treated==FALSE,]
#NonPart majú iba spodné kritérium minimálnej dĺžky nezamestnanosti
#LL: Nonparticipants have only criterium of minimal length of unemployment
# (thus one non-participant can be used multiple times)
esample1<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>minToP,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc25,])
esample2<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc25,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc25 &
as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc50,])
esample3<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc50,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc50 &
as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc75,])
esample4<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc75,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc75,])
#LL: We loop over 4 different lenghts of the prior unemployments
for (s in Ssamples) {
esampleS <- get(paste0('esample', s, by = ''))
# we count how many participants are there in a particular group.
N_sp[s,] <- nrow(esampleS[esampleS$treated==TRUE,])
if (mean(esampleS$treated) > 0.0001){
#LL: we pick a particular subsample of variables.
esampleS <-esampleS[,c("treated", "klient_id",
"entry", "exit", "entrya",
list_vars)]
# Month of participation since the start of the evaluation period
esampleS$participation_month<-((year(as.Date(esampleS$entrya))-year(ep_start))*12)+
month(as.Date(esampleS$entrya))
#LL: maybe simplify it to
#month(as.Date(esampleS$entrya))
#?
# we can use this with current specification of esample ( participants in the evaluated programme during the evaluation period (ep -> one year) + eligible unemployed at the same period)
# if we change specification of esample (i.e. What happened with those ones who became unemployed in a specific year (2017) and they can enter into the program after 3 months since they become unemployed (but they can enter into program 24 months since they become unemployed too))
# Participation quarter
esampleS$pcpQ<-ceiling(esampleS$participation_month/3)
#LL: instead, we could have just
#esampleS$pcpQ<-quarter(as.Date(esampleS$entrya))
# without the need to define participation_month
# Month of the start of the unemployment since the start of the evaluation period
esampleS$Ustart_month<-((year(as.Date(esampleS$entry))-min(year(ep_start)))*12)+
month(as.Date(esampleS$entry))
#LL: notice that this is a relative number, thus it can be negative(!)
# Inflow quarter
esampleS$infQ<-ceiling(esampleS$Ustart_month/3)
#LL: infQ = 0 means that this JS entered the register in Q4 of 2016 (if ep_start=="2017-01-01")
# Outflow quarter
esampleS$Uend_month<-((year(as.Date(esampleS$exit))-min(year(ep_start)))*12)+
month(as.Date(esampleS$exit))
esampleS$outQ<-ceiling(esampleS$Uend_month/3)
##Difference between entry into unemployment register and started of participation in measure
esampleS$diff_entry <- ceiling(as.integer(as.Date(esampleS$entrya) - as.Date(esampleS$entry))/30.417)
#LL: NOTEL why 30.417?
# table(ceiling(difftime(as.Date(esampleS$entrya), as.Date(esampleS$entry), units = "days")/30.417))
# parameters of difftime units = c("auto", "secs", "mins", "hours", "days", "weeks")
# haven't "months" unit
#Adding unemployment history
#LL: previous unemployment history is an important predictor of both the treatment and outcomes
# it is important to control for it.
esampleS<-merge(esampleS,
h_esample[,c("klient_id", "entry",
paste0("entry", seq(1:11), sep=""),
paste0("exit", seq(1:11), sep=""))],
by=c("klient_id", "entry"), all.y = FALSE)
#Imputing the start of the unemployment spell
#LL: wait, isn't it
# #Imputing the start of the programme ? YES
#LL: we wish to make a meaningful comparison.
# But we're facing a problem because for the non-participants, we don't have date of entry to the course
# well simply because they did not participate(!)
# what we do is the following.
# for every suitable non-participant we chose one particular quarter at random from the evaluation year that is "feasible"
# "feasible" means that the non-participant _could_have_ potentially participated in that quarter
# given that we have a large donor pool, this randomness will not impact our estimates much.
#LL: In Pmatrix, we will store for every non-participant, the feasible quarters.
# e.g. if it is [0 1 1 1], it means that with prob. 1/3 we pick quarter 2,3 or 4
Pmatrix <- matrix(NA, nrow = nrow(esampleS[esampleS$treated==FALSE,]), ncol=max_pcpQ)
#LL: we loop through the participation quarters
for (p in 1:max_pcpQ){
#LL: NOTE!!!!
# we restrict ourselves to only non-participants who are at the (beginning of the) particular pcpQ unemployed
ind <- (esampleS$outQ[esampleS$treated==FALSE]>=p)
# Quarter of inflow to unemployment of participants entering the programme in quarter P
PinfQ<-unique(esampleS$infQ[esampleS$treated==TRUE & esampleS$pcpQ==p])
# Only allowing non-participants inflowing to unemployment during the quarters when participants in this sub-sample were inflowing
#D<-esampleS[as.logical(esampleS$treated==T & esampleS$pcpQ == p) |
# as.logical(esampleS$treated==F & esampleS$infQ %in% PinfQ),]
#LL: NOTE: what is this last commented bit?
Pmatrix[ind,p]<-as.numeric((esampleS$infQ[esampleS$treated==FALSE])[ind] %in% PinfQ)
Pmatrix[!ind,p] <- 0
#LL: does, for this particular quarter of inflow, exists anyone from the list of participants?
# in other words
# can we, in a given sample for a given quarter match it to at least one participant?
}
hh <- function(j){
sample(which(j==1),1)
}
sumIsZero <- as.logical(apply(Pmatrix, 1, FUN=sum)==0)
sumIsNonZero <- as.logical(apply(Pmatrix, 1, FUN=sum)!=0)
esampleS[esampleS$treated == FALSE,]$pcpQ[sumIsZero] <- 0
#LL: for every non-participant, for whose inflow we cannot match to ANY participant
# for any of the four quarters, we assign zero
esampleS[esampleS$treated == FALSE,]$pcpQ[sumIsNonZero] <- apply(Pmatrix[sumIsNonZero,],1,hh)
#LL: for every non-participant we pick one of the feasible quarters RANDOMLY for given esampleS (we have four of these)
# (remember: feasible means that there exists at least one participant for inflow)
#LL: NOTE: did we fix the seed?? if not, we should.
#LL: loop across different time periods
for (q in OQm) {
cond <- FALSE
#LL: we add variables whether someone is in the register.
# we consider at most 11 unemployment spells.
for (n in 1:11) {
entry_n <- esampleS[ ,paste0('entry', n, '')]
exit_n <- esampleS[, paste0('exit', n, '')]
cond <- cond | isInRegister(p = esampleS$pcpQ, q, entry_n, exit_n)
}
esampleS[ ,paste0('empl',ceiling(q/3), '')] <- ifelse(cond, 0,1)
}
#LL: NOTE: can't this be in the same loop (?)
for(q in OQm){
esampleS <- esampleS[!is.na(esampleS[ ,paste0('empl',ceiling(q/3), '')]),]
}
#Pre-estimation data preparation
#Additional outcome variables
esampleS[ ,"cumempl"] <- rowSums(esampleS[, paste0("empl", seq(0,12,1), sep="")])
esampleS[ ,"firstempl"] <- ceiling(as.numeric((as.Date(esampleS$exit)-
(as.Date(ep_start) + months(esampleS$pcpQ*3)))/93))
#LL: NOTE: here persons with multiple unempl spell WITHIN the studied year could create problems
# Cleaning the Xs
y <- data.frame(treated = esampleS[ ,'treated'])
D <- data.frame(esampleS) #D - su tvoje data ako data.frame()
spec <- as.formula(cbind(y,D[,c(list_vars,
paste0("empl.", seq(1,4,1), sep=""))]))
#je tvoja specifikacia modelu, je to object as.formula()
colTh <- 0.8
#Treshold for the acceptable correlation between vars ( je maximalne tolerovana korelacia medzi dvoma premennymi)
dumTh <- 0.0001
#Treshold for the acceptable concentration of dummy variables (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
TdumTh <- 0.005
#Treshold for the acceptable concentration of dummy variables in the sub-group of participants (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
TdumThN <- 5
#Treshold for the minimal number of observations of a dummy variables in the sub-group of participants (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
result <- DatPrep(D = D, spec = spec, colTh = colTh, dumTh = dumTh, TdumTh = TdumTh, TdumThN = TdumThN)
for (col in colnames(result$D)){
D <- D[!is.na(D[,col]),]
}
# ESTIMATION:
m.1 <- matchit(as.formula(paste(result$spec[2], '~', result$spec[3] , sep = ' ')),
data = D,
method = "nearest",
exact = c("infQ"),
distance = "glm", link = "probit")
#plot(summary(m.1))
m.data1 <- match.data(m.1)
match.matrix <- data.frame("untreated" = m.1$match.matrix[,1] ,
"treated" = rownames(m.1$match.matrix))
m.data1[as.character(match.matrix[, 'untreated']), 'entrya'] <- m.data1[as.character(match.matrix[, 'treated']),'entrya']
m.data1$diff_entry <- ceiling(as.integer(as.Date(m.data1$entrya) - as.Date(m.data1$entry))/30.417)
assign(paste("Mdata",s, sep=""), m.data1)
Mdata <- bind_rows(Mdata, m.data1)
assign(paste0('balancegraph',s, by=''),summary(m.1, subclass = TRUE))
#distance in m.data1 is Propensity score
#trim = 0.005
#m.data1 <- m.data1[!(m.data1$distance <= trim | m.data1$distance >= (1-trim)),]
for (iQ in O_vars){
fit <- lm(as.formula(paste(iQ , '~', result$spec[2], '+' , result$spec[3], by = ' ')),
data = m.data1,
weights = weights)
res <- coeftest(fit, vcov. = vcovCL, cluster = ~subclass)
att <- res[2,1]
se <- res[2,2]
resultsArray_ATT[iQ,s] <- att
resultsArray_se[iQ,s] <- se
}
}
}
for (iQ in 1:length(O_vars)){
results[iQ,1] <- sum((resultsArray_ATT[iQ,]*(N_sp/N)))
results[iQ,2] <- sum((resultsArray_se[iQ,]*(N_sp/N)))
#results[iQ,2] <- sum((resultsArray_se[iQ,]^2*(N_sp/N)))
}
# LL: sanity check
#plot(resultsArray_ATT[1:17,1])
#lines(resultsArray_ATT[1:17,2])
#lines(resultsArray_ATT[1:17,3])
#lines(resultsArray_ATT[1:17,4])
results<-cbind(O_vars, results)
#Mdata<-rbind(Mdata1, Mdata2, Mdata3, Mdata4)
resultsPSM <- matrix(NA, nrow=length(O_vars), ncol = 2)
for (iQ in 1:length(O_vars)){
fit <- lm(as.formula(paste(O_vars[iQ] , '~', result$spec[2], '+' , result$spec[3], by = ' ')),
data = Mdata,
weights = weights)
res <- coeftest(fit, vcov. = vcovCL, cluster = ~subclass)
#LL: source of clustering?
att <- res[2,1]
se <- res[2,2]
resultsPSM[iQ,1] <- att
resultsPSM[iQ,2] <- se
}
resultsPSM<-cbind(O_vars, resultsPSM)
#LL: why do results and results PSM give different values?
# I see, it is the standard errors. They are effectively cut in half
# that is in line with square-root convergence, because the sample size is quadrupled.Kľúčovým predpokladom v pozadí kvantifikácie účinnosti, či dopadu účasti v opatrení na sledovaný výsledok je, že porovnávané skupiny sú si čo najviac podobné. Podobnosť účastníkov so skupinou opravených ale nepodporovaných je v našom prípade dosahovaná párovaním jedného účastníka k jemu čo najpodobnejším, oprávneným nezúčastneným UoZ. Párovaním tak vytvoríme kontrolnú skupinu, ktorá by sa minimálne pri porovnaní stredných hodnôt (priemerov), nemala zásadne odlišovať od účastníkov. Ako vidieť z Grafu 4, párovanie podstatne zvýšilo podobnosť kontrolnej skupiny a účastníkov programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) počas roka 2017.
Graf 4: Graf stredných hodnôt charakteristík účastníkov a oprávnených UoZ pred a po párovaní
match.vars <- c('distance',list_vars,paste0("empl.", seq(1,4,1), sep=""),'infQ')
balance_g <- array(NA, dim=c(length(match.vars),2,length(Ssamples)))
dimnames(balance_g)[[1]] <-match.vars
dimnames(balance_g)[[2]] <- c('Balance_for_All_Data','Balance_for_Matched_Data')
for(i in 1:length(Ssamples)){
if(exists(paste0('balancegraph', i, by = ''))){
x <- get(paste0('balancegraph', i, by = ''))
balance_g[,1,i] <- abs(x$sum.all[,3][match(rownames(balance_g), names(x$sum.all[,3]))])
balance_g[,2,i] <- abs(x$sum.matched[,3][match(rownames(balance_g), names(x$sum.matched[,3]))])
}
}
balance_f <- array(NA, dim=c(length(match.vars),2))
dimnames(balance_f)[[1]] <-match.vars
dimnames(balance_f)[[2]] <- c('Balance_for_All_Data','Balance_for_Matched_Data')
for (iQ in 1:length(match.vars)){
balance_f[iQ,1] <- sum(sum((as.numeric(balance_g[iQ,1,])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
balance_f[iQ,2] <-sum(sum((as.numeric(balance_g[iQ,2,])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
}
balance_fg <- data.frame(balance = c(balance_f[,1], balance_f[,2]),
Zhoda = c(rep("pred párovaním",length(match.vars)),rep("po párovaním",length(match.vars))),
names = c(match.vars,match.vars) )
p <- balance_fg %>%
mutate(names = fct_reorder(names, balance)) %>%
ggplot(aes(x=balance, y=names,col=Zhoda)) +
geom_vline(xintercept = 0.05, linetype="dotted", color = 'darkgrey') +
geom_vline(xintercept = 0.0, color = 'darkgrey')+
geom_vline(xintercept = 0.1, color = 'darkgrey')+
geom_point()+
theme_minimal()+
ylab('Premenné')+
xlab('Absolútne štandardizované rozdiely')+
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
labs(caption="Zdroj: ÚPSVaR")
p
3.1 Sledované výsledky účastníkov programu a členov kontrolnej skupiny
Prítomnosť v evidencií UoZ sledujeme v štvrťročnej periodicite, vždy ku začiatku štvrťroka. Graf 5 porovnáva podiel osôb mimo evidencie UoZ samostatne pre účastníkov a oprávnených ex-post vybraných do kontrolnej skupiny. Prítomnosť je zisťovaná na začiatku štvrťroka. Počas štvrťroku 0 došlo k účasti v opatrení. Graf zobrazuje podiel účastníkov a kontrolnej skupiny v evidencií UoZ počas jedného roka pred účasťou a troch rokov po účasti v opatrení.
Graf 5: Podiel účastníkov a kontrolnej skupiny mimo evidencie nezamestnaných UoZ (proxy pre mieru zamestnanosti)
graph <- matrix(NA, nrow=length(O_vars[1:17]), ncol = 2)
rownames(graph) <- O_vars[1:17]
for(o in O_vars[1:17]){
graph[o,1] <- apply(Mdata[Mdata$treated == TRUE,o,drop = FALSE], 2, mean, na.rm = TRUE)
graph[o,2] <- apply(Mdata[Mdata$treated == FALSE,o,drop = FALSE], 2, mean, na.rm = TRUE)
}
graph <- data.frame(cbind(O_vars[1:17],graph))
colnames(graph) <- c('O_vars','treated', 'untreated')
graph$treated <- as.numeric(as.character(graph$treated))
graph$untreated <- as.numeric(as.character(graph$untreated))
graph$O_vars <- factor(graph$O_vars, levels=c(O_vars[1:17]))
graph$Q<-seq(-4,12,1)
graphER<- ggplot(data=graph) +
geom_line(aes(x=Q, y=treated, colour="Účastníci"), size = 1 , group = 1) +
geom_line(aes(x=Q, y=untreated, colour="Kontrolná skupina"), size = 1 , group = 1) +
scale_x_continuous(breaks=seq(-4,12,1))+
theme_minimal()+
labs(
y = "Podiel",
x = "Štvrťroky od účasti na opatrení (0)",
colour = "Skupina",
caption="Zdroj: ÚPSVaR") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")
graphER
Okrem podielu (miery) účastníkov v registri nezamestnaných zisťovaného k určitému dátumu, sledujeme aj ďalšie dva doplňujúce indikátory výsledku. Prvým je dĺžka evidencie od začiatku účasti na opatrení po prvé opustenie evidencie UoZ (firstempl). Tento indikátor zachytáva príspevok účasti v opatrení ku skráteniu nezamestnanosti účastníkov. Dĺžka je meraná v štvrťrokoch. Hodnoty tohto indikátora pre kontrolnú skupinu a účastníkov zobrazuje nasledujúci Graf 6.
Graf 6: Počet štvrťrokov od začiatku účasti do prvého opustenia databázy UoZ
#### THE NUMBER OF MONTHS UNTIL THE FIRST EXIT
########## Months until the first exit
#how many months after the entrya JS got a job
firstempl_P <- data.frame('quarter' = Mdata[Mdata$treated==TRUE, 'firstempl']) %>%
group_by(quarter) %>%
summarise(total = n(), .groups = 'drop') %>%
mutate(percent = round( total / sum(total), 4),
Group = "Účastníci")
firstempl_E <- data.frame('quarter' = Mdata[Mdata$treated==FALSE, 'firstempl']) %>%
group_by(quarter) %>%
summarise(total = n(), .groups = 'drop') %>%
mutate(percent = round( total / sum(total), 4),
Group = "Oprávnení")
firstempl <- rbind(firstempl_P, firstempl_E)
ggplot(firstempl, aes(fill=Group, y=percent, x=quarter)) +
geom_bar(position="dodge", stat="identity") +
facet_wrap(~Group) +
theme_minimal() +
scale_fill_manual(values=c('grey', 'steelblue3')) +
scale_x_continuous(breaks=seq(0,16,1)) +
theme(legend.position="none") +
xlab("Štvrťroky po začiatku účasti (0)") +
ylab("") +
labs(caption="Zdroj: COLSAF")+
scale_y_continuous(labels = percent)
Zároveň sledujeme kumulatívny počet štvrťrokov, počas ktorých sa jednotlivci nachádzali mimo evidenciu UoZ. Účastníkov a členov kontrolnej skupiny sledujeme minimálne počas trinástich štvrťrokov. Graf 7 zobrazuje hodnoty tohto indikátora pre kontrolnú skupinu a účastníkov programu.
Graf 7: Kumulatívny počet štvrťrokov mimo evidencie nezamestnaných od začiatku účasti
## Plotting the number of months in cumulative employment
###### Participants
empl36m_P <- data.frame('quarter' = Mdata[Mdata$treated==TRUE, 'cumempl']) %>%
group_by(quarter) %>%
summarise(total = n(), .groups = 'drop') %>%
mutate(percent = round( total / sum(total), 4),
Group = "Účastníci")
empl36m_E <- data.frame('quarter' = Mdata[Mdata$treated==FALSE, 'cumempl']) %>%
group_by(quarter) %>%
summarise(total = n(), .groups = 'drop') %>%
mutate(percent = round( total / sum(total), 4),
Group = "Oprávnení")
empl36m <- rbind(empl36m_P, empl36m_E)
ggplot(empl36m, aes(fill=Group, y=percent, x=quarter)) +
geom_bar(position="dodge", stat="identity") +
facet_wrap(~Group) +
theme_minimal() +
scale_fill_manual(values=c('grey', 'steelblue3')) +
scale_x_continuous(breaks=seq(0,16,1)) +
theme(legend.position="none") +
xlab("Štvrťroky po začiatku účasti (0)") +
ylab("") +
labs(caption="Zdroj: COLSAF")+
scale_y_continuous(labels = percent)
3.2 Odhad priemernej účinnosti účasti na opatrení (ATT)
Rozdiel v hodnotách indikátorov sledovaných pre kontrolnú skupinu a podporených predstavuje efekt opatrenia. Negatívny efekt na prítomnosť v evidencii pozorovaný v období tesne po účasti je v literatúre opísaný ako tzv. efekt uzavretia (lock-in effect) v opatrení, kedy v dôsledku samotnej účasti alebo poklesu úsilia v hľadaní si práce, účastníci vykazujú relatívne vyššiu prítomnosť v evidencií UoZ (rovnaký efekt zvykne byť pozorovaný aj pri miere zamestnanosti).
Graf 8: Priemerná účinnosť opatrenia (ATT) na prítomnosť v registri nezamestnaných UoZ pre účastníkov programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) počas roka 2017
graphATT
3.3 Štatistická významnosť a heterogénnosť odhadovanej účinnosti
V nasledujúcich tabuľkách, okrem odhadov na mieru prítomnosti v registry nezamestnaných UoZ, reportujeme aj odhady pre: - Počet štvrťrokov od ukončenia účasti do prvého opustenia registra UoZ (firstempl) - Kumulatívny počet štvrťrokov mimo registra UoZ (cumempl)
Tabuľka 3: Priemerná účinnosť účasti na opatrení (ATT)
resultsDF <- select(resultsDF, -pval)
colnames(resultsDF) <- c("", "efekt", "se", "sig.")
resultsDF %>% kbl(format = 'html', booktabs = TRUE , align = 'c') %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE) %>%
row_spec(1:nrow(resultsDF), font_size = '1cm') %>%
column_spec(1:ncol(resultsDF),width = "1.1cm") %>%
kableExtra::footnote(number = paste('Významnosť (sig.):', 0.0000, ' " *** " ', 0.001, ' " ** " ', 0.01, ' " * " ', 0.05, ' " . " ', 0.1, '" "', 1))| efekt | se | sig. | |
|---|---|---|---|
| empl.4 | -0.006 | 0.016 | |
| empl.3 | -0.011 | 0.016 | |
| empl.2 | 0.012 | 0.014 | |
| empl.1 | 0.000 | 0.002 | |
| empl0 | -0.107 | 0.012 | *** |
| empl1 | -0.098 | 0.014 | *** |
| empl2 | -0.093 | 0.016 | *** |
| empl3 | -0.071 | 0.019 | *** |
| empl4 | -0.049 | 0.018 | ** |
| empl5 | 0.035 | 0.020 | . |
| empl6 | 0.244 | 0.016 | *** |
| empl7 | 0.211 | 0.016 | *** |
| empl8 | 0.153 | 0.017 | *** |
| empl9 | 0.147 | 0.018 | *** |
| empl10 | 0.135 | 0.019 | *** |
| empl11 | 0.130 | 0.018 | *** |
| empl12 | 0.128 | 0.019 | *** |
| firstempl | -0.665 | 0.116 | *** |
| cumempl | 0.765 | 0.126 | *** |
| 1 Významnosť (sig.): 0 " *** " 0.001 " ** " 0.01 " * " 0.05 " . " 0.1 " " 1 |
Hodnoty priemerných efektov odhadnutých pre celú populáciu účastníkov sa môžu výrazne líšiť pre jednotlivé podskupiny účastníkov. Z toho dôvodu reportujeme výsledky v podskupinách podľa:
- dĺžky nezamestnanosti do účasti na opatrení (do 6 mesiacov, 6-12 mesiacov, 12+ mesiacov),
- pohlavia,
- stupňa vzdelania,
- podielu rómov v obci trvalého bydliska (do a nad 10%),
- veľkosti obce trvalého bydliska (do a nad 4000 obyvateľov).
Tabuľka 4: Účinnosť opatrenia podľa dĺžky nezamestnanosti do účasti na opatrení
diff_entry|
Dĺžka predchádzajúcej nezamestnanosti
|
||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
|
Spolu
|
0-6 mesiacov
|
7-12 mesiacov
|
13+ mesiacov
|
|||||||||
| efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | |
| empl.4 | -0.006 | 0.016 | 0.001 | 0.025 | 0.055 | 0.030 | . | -0.110 | 0.023 | *** | ||
| empl.3 | -0.011 | 0.016 | 0.158 | 0.027 | *** | -0.173 | 0.026 | *** | -0.002 | 0.002 | ||
| empl.2 | 0.012 | 0.014 | 0.118 | 0.034 | *** | -0.059 | 0.013 | *** | -0.002 | 0.002 | ||
| empl.1 | 0.000 | 0.002 | -0.002 | 0.006 | 0.000 | 0.000 | 0.000 | 0.000 | ||||
| empl0 | -0.107 | 0.012 | *** | -0.187 | 0.025 | *** | -0.086 | 0.022 | *** | -0.017 | 0.017 | |
| empl1 | -0.098 | 0.014 | *** | -0.187 | 0.028 | *** | -0.044 | 0.024 | . | -0.042 | 0.026 | |
| empl2 | -0.093 | 0.016 | *** | -0.137 | 0.028 | *** | -0.054 | 0.028 | . | -0.093 | 0.038 |
|
| empl3 | -0.071 | 0.019 | *** | -0.072 | 0.032 |
|
-0.058 | 0.029 |
|
-0.116 | 0.051 |
|
| empl4 | -0.049 | 0.018 | ** | -0.026 | 0.033 | -0.024 | 0.030 | -0.170 | 0.050 | *** | ||
| empl5 | 0.035 | 0.020 | . | 0.052 | 0.030 | . | 0.101 | 0.035 | ** | -0.140 | 0.055 |
|
| empl6 | 0.244 | 0.016 | *** | 0.159 | 0.021 | *** | 0.324 | 0.032 | *** | 0.248 | 0.035 | *** |
| empl7 | 0.211 | 0.016 | *** | 0.141 | 0.023 | *** | 0.287 | 0.029 | *** | 0.185 | 0.037 | *** |
| empl8 | 0.153 | 0.017 | *** | 0.086 | 0.027 | *** | 0.192 | 0.030 | *** | 0.178 | 0.040 | *** |
| empl9 | 0.147 | 0.018 | *** | 0.096 | 0.026 | *** | 0.210 | 0.029 | *** | 0.142 | 0.040 | *** |
| empl10 | 0.135 | 0.019 | *** | 0.071 | 0.026 | ** | 0.205 | 0.031 | *** | 0.137 | 0.039 | *** |
| empl11 | 0.130 | 0.018 | *** | 0.107 | 0.024 | *** | 0.142 | 0.031 | *** | 0.155 | 0.041 | *** |
| empl12 | 0.128 | 0.019 | *** | 0.092 | 0.026 | *** | 0.161 | 0.032 | *** | 0.136 | 0.039 | *** |
| firstempl | -0.665 | 0.116 | *** | -0.043 | 0.158 | -1.352 | 0.232 | *** | -0.299 | 0.293 | ||
| cumempl | 0.765 | 0.126 | *** | 0.193 | 0.176 | 1.356 | 0.219 | *** | 0.602 | 0.326 | . | |
| 1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1 | ||||||||||||
| 2 Spolu: 1 632 pozorovaní 0-6 mesiacov: 604 pozorovaní 7-12 mesiacov: 655 pozorovaní 13+ mesiacov: 372 pozorovaní | ||||||||||||
Tabuľka 5: Účinnosť opatrenia podľa pohlavia
gender|
Pohlavie
|
|||||||||
|---|---|---|---|---|---|---|---|---|---|
|
Spolu
|
Ženy
|
Muži
|
|||||||
| efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | |
| empl.4 | -0.006 | 0.016 | 0.007 | 0.027 | -0.010 | 0.023 | |||
| empl.3 | -0.011 | 0.016 | -0.017 | 0.024 | -0.018 | 0.024 | |||
| empl.2 | 0.012 | 0.014 | 0.017 | 0.022 | 0.010 | 0.018 | |||
| empl.1 | 0.000 | 0.002 | 0.001 | 0.001 | 0.000 | 0.003 | |||
| empl0 | -0.107 | 0.012 | *** | -0.096 | 0.020 | *** | -0.119 | 0.021 | *** |
| empl1 | -0.098 | 0.014 | *** | -0.078 | 0.026 | ** | -0.114 | 0.022 | *** |
| empl2 | -0.093 | 0.016 | *** | -0.064 | 0.030 |
|
-0.113 | 0.027 | *** |
| empl3 | -0.071 | 0.019 | *** | -0.038 | 0.034 | -0.113 | 0.029 | *** | |
| empl4 | -0.049 | 0.018 | ** | -0.032 | 0.033 | -0.085 | 0.029 | ** | |
| empl5 | 0.035 | 0.020 | . | 0.028 | 0.035 | 0.031 | 0.028 | ||
| empl6 | 0.244 | 0.016 | *** | 0.238 | 0.026 | *** | 0.234 | 0.023 | *** |
| empl7 | 0.211 | 0.016 | *** | 0.193 | 0.026 | *** | 0.204 | 0.025 | *** |
| empl8 | 0.153 | 0.017 | *** | 0.145 | 0.025 | *** | 0.143 | 0.024 | *** |
| empl9 | 0.147 | 0.018 | *** | 0.136 | 0.025 | *** | 0.143 | 0.024 | *** |
| empl10 | 0.135 | 0.019 | *** | 0.124 | 0.024 | *** | 0.137 | 0.025 | *** |
| empl11 | 0.130 | 0.018 | *** | 0.134 | 0.027 | *** | 0.118 | 0.025 | *** |
| empl12 | 0.128 | 0.019 | *** | 0.124 | 0.029 | *** | 0.123 | 0.024 | *** |
| firstempl | -0.665 | 0.116 | *** | -0.823 | 0.231 | *** | -0.353 | 0.178 |
|
| cumempl | 0.765 | 0.126 | *** | 0.814 | 0.230 | *** | 0.589 | 0.189 | ** |
| 1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1 | |||||||||
| 2 Spolu: 1 632 pozorovaní Ženy: 776 pozorovaní Muži: 856 pozorovaní | |||||||||
Tabuľka 6: Účinnosť opatrenia podľa stupňa vzdelania
education|
Vzdelanie
|
|||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
|
Spolu
|
Bez vzdelania
|
ZŠ
|
SŠ bez maturity
|
SŠ
|
|||||||||||
| efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | |
| empl.4 | -0.006 | 0.016 | 0.000 | NaN | -0.017 | 0.064 | -0.005 | 0.050 | 0.007 | 0.026 | |||||
| empl.3 | -0.011 | 0.016 | 0.925 | NaN | -0.004 | 0.054 | -0.090 | 0.052 | . | -0.021 | 0.025 | ||||
| empl.2 | 0.012 | 0.014 | 0.000 | NaN | -0.021 | 0.051 | -0.023 | 0.038 | 0.035 | 0.020 | . | ||||
| empl.1 | 0.000 | 0.002 | 0.000 | NaN | -0.010 | 0.010 | 0.000 | 0.000 | 0.000 | 0.004 | |||||
| empl0 | -0.107 | 0.012 | *** | 0.379 | NaN | 0.019 | 0.048 | -0.168 | 0.046 | *** | -0.144 | 0.019 | *** | ||
| empl1 | -0.098 | 0.014 | *** | -0.878 | NaN | 0.032 | 0.061 | -0.105 | 0.058 | . | -0.150 | 0.025 | *** | ||
| empl2 | -0.093 | 0.016 | *** | 0.332 | NaN | 0.070 | 0.069 | -0.007 | 0.069 | -0.156 | 0.029 | *** | |||
| empl3 | -0.071 | 0.019 | *** | 0.166 | NaN | 0.110 | 0.079 | -0.041 | 0.071 | -0.136 | 0.028 | *** | |||
| empl4 | -0.049 | 0.018 | ** | -1.091 | NaN | 0.280 | 0.079 | *** | -0.063 | 0.070 | -0.128 | 0.031 | *** | ||
| empl5 | 0.035 | 0.020 | . | 3.209 | NaN | 0.301 | 0.078 | *** | 0.047 | 0.071 | -0.073 | 0.034 |
|
||
| empl6 | 0.244 | 0.016 | *** | -2.134 | NaN | 0.343 | 0.065 | *** | 0.290 | 0.049 | *** | 0.158 | 0.023 | *** | |
| empl7 | 0.211 | 0.016 | *** | -2.134 | NaN | 0.309 | 0.069 | *** | 0.222 | 0.049 | *** | 0.122 | 0.019 | *** | |
| empl8 | 0.153 | 0.017 | *** | -2.134 | NaN | 0.265 | 0.065 | *** | 0.151 | 0.052 | ** | 0.086 | 0.020 | *** | |
| empl9 | 0.147 | 0.018 | *** | -3.043 | NaN | 0.201 | 0.062 | *** | 0.129 | 0.055 |
|
0.083 | 0.020 | *** | |
| empl10 | 0.135 | 0.019 | *** | -1.877 | NaN | 0.189 | 0.063 | ** | 0.090 | 0.057 | 0.093 | 0.022 | *** | ||
| empl11 | 0.130 | 0.018 | *** | -2.043 | NaN | 0.190 | 0.064 | ** | 0.110 | 0.056 |
|
0.080 | 0.021 | *** | |
| empl12 | 0.128 | 0.019 | *** | -2.043 | NaN | 0.118 | 0.069 | . | 0.157 | 0.054 | ** | 0.087 | 0.023 | *** | |
| firstempl | -0.665 | 0.116 | *** | -1.844 | NaN | -2.194 | 0.475 | *** | -0.912 | 0.486 | . | 0.199 | 0.178 | ||
| cumempl | 0.765 | 0.126 | *** | -13.291 | NaN | 2.426 | 0.483 | *** | 0.812 | 0.455 | . | -0.076 | 0.181 | ||
| 1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1 | |||||||||||||||
| 2 Spolu: 1 632 pozorovaní Bez vzdelania: 13 pozorovaní ZŠ: 184 pozorovaní SŠ bez maturity: 233 pozorovaní SŠ: 855 pozorovaní | |||||||||||||||
Tabuľka 7: Účinnosť opatrenia podľa podielu rómov v obci trvalého bydliska
romas|
Podiel Rómov v mieste trvalého bydliska
|
|||||||||
|---|---|---|---|---|---|---|---|---|---|
|
Spolu
|
0-10%
|
10-100%
|
|||||||
| efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | |
| empl.4 | -0.006 | 0.016 | 0.027 | 0.023 | -0.078 | 0.035 |
|
||
| empl.3 | -0.011 | 0.016 | -0.059 | 0.019 | ** | 0.082 | 0.032 | ** | |
| empl.2 | 0.012 | 0.014 | -0.005 | 0.017 | 0.054 | 0.025 |
|
||
| empl.1 | 0.000 | 0.002 | -0.001 | 0.003 | -0.003 | 0.007 | |||
| empl0 | -0.107 | 0.012 | *** | -0.141 | 0.017 | *** | -0.037 | 0.023 | |
| empl1 | -0.098 | 0.014 | *** | -0.148 | 0.019 | *** | -0.001 | 0.032 | |
| empl2 | -0.093 | 0.016 | *** | -0.152 | 0.022 | *** | 0.016 | 0.039 | |
| empl3 | -0.071 | 0.019 | *** | -0.125 | 0.025 | *** | 0.024 | 0.044 | |
| empl4 | -0.049 | 0.018 | ** | -0.145 | 0.024 | *** | 0.116 | 0.046 |
|
| empl5 | 0.035 | 0.020 | . | -0.027 | 0.026 | 0.116 | 0.047 |
|
|
| empl6 | 0.244 | 0.016 | *** | 0.219 | 0.020 | *** | 0.274 | 0.035 | *** |
| empl7 | 0.211 | 0.016 | *** | 0.175 | 0.017 | *** | 0.238 | 0.037 | *** |
| empl8 | 0.153 | 0.017 | *** | 0.114 | 0.018 | *** | 0.193 | 0.036 | *** |
| empl9 | 0.147 | 0.018 | *** | 0.114 | 0.017 | *** | 0.199 | 0.040 | *** |
| empl10 | 0.135 | 0.019 | *** | 0.112 | 0.020 | *** | 0.160 | 0.038 | *** |
| empl11 | 0.130 | 0.018 | *** | 0.105 | 0.019 | *** | 0.179 | 0.037 | *** |
| empl12 | 0.128 | 0.019 | *** | 0.096 | 0.021 | *** | 0.195 | 0.037 | *** |
| firstempl | -0.665 | 0.116 | *** | -0.060 | 0.146 | -1.496 | 0.278 | *** | |
| cumempl | 0.765 | 0.126 | *** | 0.199 | 0.153 | 1.671 | 0.298 | *** | |
| 1 Významnosť (sig.) 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1 | |||||||||
| 2 Spolu: 1 632 pozorovaní 0-10%: 1 143 pozorovaní 10-100%: 489 pozorovaní | |||||||||
Tabuľka 8: Účinnosť opatrenia podľa veľkosti sídla trvalého bydliska
City|
Typ miesta bydliska
|
|||||||||
|---|---|---|---|---|---|---|---|---|---|
|
Spolu
|
Dedina
|
Mesto
|
|||||||
| efekt | se | sig. | efekt | se | sig. | efekt | se | sig. | |
| empl.4 | -0.006 | 0.016 | -0.009 | 0.025 | 0.006 | 0.026 | |||
| empl.3 | -0.011 | 0.016 | -0.020 | 0.025 | -0.005 | 0.024 | |||
| empl.2 | 0.012 | 0.014 | 0.017 | 0.021 | 0.002 | 0.021 | |||
| empl.1 | 0.000 | 0.002 | -0.003 | 0.003 | 0.002 | 0.005 | |||
| empl0 | -0.107 | 0.012 | *** | -0.109 | 0.018 | *** | -0.104 | 0.019 | *** |
| empl1 | -0.098 | 0.014 | *** | -0.138 | 0.024 | *** | -0.068 | 0.024 | ** |
| empl2 | -0.093 | 0.016 | *** | -0.125 | 0.028 | *** | -0.072 | 0.028 | ** |
| empl3 | -0.071 | 0.019 | *** | -0.105 | 0.031 | *** | -0.045 | 0.031 | |
| empl4 | -0.049 | 0.018 | ** | -0.037 | 0.030 | -0.074 | 0.034 |
|
|
| empl5 | 0.035 | 0.020 | . | 0.025 | 0.032 | 0.034 | 0.032 | ||
| empl6 | 0.244 | 0.016 | *** | 0.251 | 0.023 | *** | 0.231 | 0.024 | *** |
| empl7 | 0.211 | 0.016 | *** | 0.240 | 0.024 | *** | 0.176 | 0.022 | *** |
| empl8 | 0.153 | 0.017 | *** | 0.186 | 0.025 | *** | 0.114 | 0.022 | *** |
| empl9 | 0.147 | 0.018 | *** | 0.178 | 0.025 | *** | 0.114 | 0.023 | *** |
| empl10 | 0.135 | 0.019 | *** | 0.152 | 0.027 | *** | 0.116 | 0.025 | *** |
| empl11 | 0.130 | 0.018 | *** | 0.152 | 0.025 | *** | 0.103 | 0.025 | *** |
| empl12 | 0.128 | 0.019 | *** | 0.141 | 0.025 | *** | 0.106 | 0.028 | *** |
| firstempl | -0.665 | 0.116 | *** | -0.633 | 0.194 | *** | -0.593 | 0.194 | ** |
| cumempl | 0.765 | 0.126 | *** | 0.812 | 0.197 | *** | 0.631 | 0.206 | ** |
| 1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1 | |||||||||
| 2 Spolu: 1 632 pozorovaní Dedina: 812 pozorovaní Mesto: 820 pozorovaní | |||||||||
4. Technická príloha
Dodatočné detaily týkajúce sa použitej metodiky a opisu vzorky je možné nájsť v technickej prílohe.
4.1 Detaily výber vzorky
info_table <- data.frame(matrix(ncol=2,nrow=0, dimnames=list(NULL, c("Popis", "Hodnota"))))
info_table[1,] <- c('Začiatok hodnotiaceho obdobia', paste(ep_start))
info_table[2,] <- c('Koniec hodnotiaceho obdobia', paste(ep_end))
info_table <-
info_table[,-3] %>% kbl(format = 'html', booktabs = TRUE, align = 'c', caption = 'Hodnotiace obdobie', row.names = FALSE) %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE)
sample_selection <- data.frame(matrix(ncol=3,nrow=0, dimnames=list(NULL, c("Popis", "Odstránených","Spolu"))))
sample_selection[1,] <- c('Celkový počet registrácií', 0,format(n1, big.mark=" ", scientific=FALSE))
sample_selection[2,] <- c('Celkový počet oprávnených UoZ', 0,format(n2, big.mark=" ", scientific=FALSE))
sample_selection[3,] <- c('Celkový počet účastí na hodnotenom opetrení', 0,format(npart1, big.mark=" ", scientific=FALSE))
sample_selection[4,] <- c('Celkový počet účastníkov hodnoteného opatrenia', 0 ,format(npart0, big.mark=" ", scientific=FALSE))
x<-n1-n4
y<-npart1-n3
sample_selection[5,] <- c('Odstránení oprávnení UoZ', format(n4, big.mark=" ", scientific=FALSE), format(x, big.mark=" ", scientific=FALSE))
sample_selection[6,] <- c('Odstránení účastníci', format(n3, big.mark=" ", scientific=FALSE), format(y, big.mark=" ", scientific=FALSE))
x<-x-n6
y<-y-n5
sample_selection[7,] <- c('Odstránení oprávnení UoZ', format(n6, big.mark=" ", scientific=FALSE),format(x, big.mark=" ", scientific=FALSE))
sample_selection[8,] <- c('Odstránení účastníci', format(n5, big.mark=" ", scientific=FALSE),format(y, big.mark=" ", scientific=FALSE))
y<-y-n7
sample_selection[9,] <- c('Odstránení účastníci', format(n7, big.mark=" ", scientific=FALSE),format(y, big.mark=" ", scientific=FALSE))
x<-x-n9
y<-y-n8
sample_selection[10,] <- c('Odstránení oprávnení UoZ', format(n9, big.mark=" ", scientific=FALSE),format(x, big.mark=" ", scientific=FALSE))
sample_selection[11,] <- c('Odstránení účastníci', format(n8, big.mark=" ", scientific=FALSE),format(y, big.mark=" ", scientific=FALSE))
y<-nrowdfa-n10
sample_selection[12,] <- c('Nafúknutie účastníkov zlúčením tabuleik', paste0('+',format(nrowdfa-y, big.mark=" ", scientific=FALSE), by = ""),format(nrowdfa, big.mark=" ", scientific=FALSE))
sample_selection[13,] <- c('Odstránení účastníci', format(n10, big.mark=" ", scientific=FALSE),format(y, big.mark=" ", scientific=FALSE))
y<-y-n11
sample_selection[14,] <- c('Odstránení účastníci', format(n11, big.mark=" ", scientific=FALSE),format(y, big.mark=" ", scientific=FALSE))
sample_selection[15,] <- c('Odstránení oprávnení UoZ', format(x-(length(unique(esample$klient_id[esample$treated==FALSE]))), big.mark=" ", scientific=FALSE), format(length(unique(esample$klient_id[esample$treated==FALSE])), big.mark=" ", scientific=FALSE))
sample_selection[16,] <- c('Odstránení účastníci', format(y-length(unique(esample$klient_id[esample$treated==TRUE])), big.mark=" ", scientific=FALSE), format(length(unique(esample$klient_id[esample$treated==TRUE])), big.mark=" ", scientific=FALSE))
sample_selection[17,] <- c('Oprávnení', 0, format(length(unique(esample$klient_id[esample$treated==FALSE])), big.mark=" ", scientific=FALSE))
sample_selection[18,] <- c('Účastníci', 0, format(length(unique(esample$klient_id[esample$treated==TRUE])), big.mark=" ", scientific=FALSE))
sample_selection$Variable <- c('Všetky registrácie (pred čistením dát)', 'Všetky registrácie (pred čistením dát)', 'Všetky registrácie (pred čistením dát)','Všetky registrácie (pred čistením dát)',
'Odstránení UoZ s participáciou na AOTP 2 roky pred hodnoteným obdobím', 'Odstránení UoZ s participáciou na AOTP 2 roky pred hodnoteným obdobím',
'Odstránení UoZ s participáciou na inom AOTP počas hodnoteného obdobia', 'Odstránení UoZ s participáciou na inom AOTP počas hodnoteného obdobia',
'Odstránení účastníci s viacnásobnou účasťou v hodnotenom programe ',
'Odstránení UoZ s účasťou na programe podporovaného zamestnávanie (AOTP) počas hodnoteného obdobia', 'Odstránení UoZ s účasťou na programe podporovaného zamestnávanie (AOTP) počas hodnoteného obdobia',
'Odstránení účastníci s účasťou, ktorá sa nedeje počas obdobia nezamestnanosti','Odstránení účastníci s účasťou, ktorá sa nedeje počas obdobia nezamestnanosti',
'Odstránení účastníci s extrémnymi hodnotami (1%) čakacej doby na účasť v hodnotenom opatrení',
'Odstránení UoZ s viacerými registráciami', 'Odstránení UoZ s viacerými registráciami',
'Celkový počet registrácií po čistení dát', 'Celkový počet registrácií po čistení dát'
)
sample_selection <-sample_selection[,-4] %>% kbl(format = 'html', booktabs = TRUE , align = 'c', row.names = FALSE) %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE)%>%
pack_rows(index = table(fct_inorder(sample_selection$Variable)))Tabuľka 9: Informačná tabuľka začatia a ukončenia hodnotiaceho obdobia
info_table| Popis | Hodnota |
|---|---|
| Začiatok hodnotiaceho obdobia | 2017-01-01 |
| Koniec hodnotiaceho obdobia | 2017-12-31 |
Tabuľka 10: Dokumentácia očistenia dát
sample_selection| Popis | Odstránených | Spolu |
|---|---|---|
| Všetky registrácie (pred čistením dát) | ||
| Celkový počet registrácií | 0 | 103 612 |
| Celkový počet oprávnených UoZ | 0 | 98 288 |
| Celkový počet účastí na hodnotenom opetrení | 0 | 1 920 |
| Celkový počet účastníkov hodnoteného opatrenia | 0 | 1 916 |
| Odstránení UoZ s participáciou na AOTP 2 roky pred hodnoteným obdobím | ||
| Odstránení oprávnení UoZ | 17 876 | 85 736 |
| Odstránení účastníci | 590 | 1 330 |
| Odstránení UoZ s participáciou na inom AOTP počas hodnoteného obdobia | ||
| Odstránení oprávnení UoZ | 22 997 | 62 739 |
| Odstránení účastníci | 275 | 1 055 |
| Odstránení účastníci s viacnásobnou účasťou v hodnotenom programe | ||
| Odstránení účastníci | 4 | 1 051 |
| Odstránení UoZ s účasťou na programe podporovaného zamestnávanie (AOTP) počas hodnoteného obdobia | ||
| Odstránení oprávnení UoZ | 10 603 | 52 136 |
| Odstránení účastníci | 113 | 938 |
| Odstránení účastníci s účasťou, ktorá sa nedeje počas obdobia nezamestnanosti | ||
| Nafúknutie účastníkov zlúčením tabuleik | +132 | 957 |
| Odstránení účastníci | 132 | 825 |
| Odstránení účastníci s extrémnymi hodnotami (1%) čakacej doby na účasť v hodnotenom opatrení | ||
| Odstránení účastníci | 9 | 816 |
| Odstránení UoZ s viacerými registráciami | ||
| Odstránení oprávnení UoZ | 2 962 | 49 174 |
| Odstránení účastníci | 0 | 816 |
| Celkový počet registrácií po čistení dát | ||
| Oprávnení | 0 | 49 174 |
| Účastníci | 0 | 816 |
4.2 Opis použitých vysvetľujúcich premenných (sledovaných charakteristík)
Nasledujúca tabuľka obsahuje zoznam premenných, ktoré boli použité vo finálnej špecifikácií modelu použitého pri odhade účinnosti opatrenia (ATT). Ide o premenné, ktorých stredné hodnoty zobrazujeme v Grafe 4 (resp. v prílohe Graf 10).
Tabuľka 11: Zoznam a opis premenných použitých pri odhade
list_vars_table <- data.frame("Premenné" = list_vars,
Popis = c("čas (v dňoch) medzi zaradením do evidencie\n nezamestnaných a začiatkom hodnoteného obdobia", "pohlavie (1: muž, 0: žena)", "Rodinný stav: ženatý", "deti do 10 rokov", "národnosť: slovenská", "stupeň vzdelania: žiadne vzdelanie", "stupeň vzdelania: základné", "stupeň vzdelania: nižšie stredné","stupeň vzdelania: vyššie stredné", 'znalosť cudzieho jazyka (1: áno, 0: nie)', "držiteľ vodičského preukazu (1: áno, 0: nie)", "počítačové zručnosti (1: áno, 0: nie)", "evidovaný občan v minulosti (1: áno, 0: nie), v minulosti nezamestnaný", "časová vzdialenosť na najbližší úrad práce (v minútach)", "časová vzdialenosť do hlavného mesta - Bratislavy (v minútach)", "miera nezamestnanosti v regióne","podiel rómov v mieste bydliska", "počet obyvateľov v mieste bydliska", "vek"))
list_vars_table[,-3] %>% kbl(format = 'html', booktabs = TRUE , align = 'l', row.names = FALSE) %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE) | Premenné | Popis |
|---|---|
| ent | čas (v dňoch) medzi zaradením do evidencie nezamestnaných a začiatkom hodnoteného obdobia |
| male | pohlavie (1: muž, 0: žena) |
| married | Rodinný stav: ženatý |
| kids | deti do 10 rokov |
| slovak | národnosť: slovenská |
| noedu | stupeň vzdelania: žiadne vzdelanie |
| primary | stupeň vzdelania: základné |
| lsec | stupeň vzdelania: nižšie stredné |
| usec | stupeň vzdelania: vyššie stredné |
| flang | znalosť cudzieho jazyka (1: áno, 0: nie) |
| drive | držiteľ vodičského preukazu (1: áno, 0: nie) |
| pc | počítačové zručnosti (1: áno, 0: nie) |
| unpast | evidovaný občan v minulosti (1: áno, 0: nie), v minulosti nezamestnaný |
| min_urad | časová vzdialenosť na najbližší úrad práce (v minútach) |
| min_BA | časová vzdialenosť do hlavného mesta - Bratislavy (v minútach) |
| UR_region | miera nezamestnanosti v regióne |
| roma_share | podiel rómov v mieste bydliska |
| population | počet obyvateľov v mieste bydliska |
| age | vek |
4.3 Alternatívny model odhadu (inverse probability weighting)
V tejto časti ukazujeme, ako sa zmenia výsledné odhady, ak by sme použili alternatívnu metódu odhadu účinnosti opatrenia ATT. Vyššie uvádzané odhady sú založené na výbere kontrolnej skupiny metódou propensity score matching, algoritmom výberu jedného najbližšieho suseda. Ako alternatívny metódu odhadu používame metódu inverzného váženia pozorovaní. Pri finálnej kvantifikácií ATT tak neberieme iba pozorovanie jedného najbližšieho suseda, ale všetkých UoZ, ktorý sa v danom čase nachádzali v databáze UoZ a boli oprávnení pre daný typ podpory. Tieto pozorovania sú však vážené na základe ich podobnosti s podporenými účastníkmi.
#Estimation parameters
Ssamples <- seq(1,4)
participation_month<-((year(as.Date(esample$entrya))-min(year(ep_start)))*12)+month(as.Date(esample$entrya)) # Month of participation since the start of the evaluation period
pcpQ<-ceiling(participation_month/3)
max_pcpQ<-max(pcpQ, na.rm = TRUE)
OQm <- seq(-12,36,3)
OQ <- -4:12
O_vars <- c(paste("empl",OQ, sep=""), "firstempl", "cumempl")
O_vars<-str_replace(O_vars, "-", ".")
list_vars <- c('ent', 'male', 'married','kids',
'slovak', 'noedu','primary', 'lsec', 'usec',
'flang', 'drive', 'pc',
'unpast', 'min_urad', 'min_BA',
'UR_region', 'roma_share', 'population', 'age')
# # All potentially useful explanatory variables (Xs)
# list_vars <- c('ent', 'male', 'single', 'married','kids',
# 'slovak', 'hungarian', 'roma',
# 'noedu','primary', 'lsec', 'usec', 'tertiary'
# , 'zaujem_vzdel',
# 'flang', 'drive', 'pc',
# 'healthy', 'barrier', 'graduate', 'ziad_undn_sp', 'cvyhl_poisteu',
# 'empl', 'unpast', 'employee', 'selfempl', 'zaujem_szco',
# 'look_ptime', 'commute', 'relocate', 'zaujem_zam_zahr',
# 'min_kraj', 'min_urad', 'min_BA',
# 'UR_region', 'roma_share', 'population',
# ageg_dummies,
# # paste0("urad_",seq(from=1, to=46), sep=""),
# paste0("isco1_",seq(from=1, to=3), sep=""),
# paste0("odbor1_",seq(from=1, to=5), sep=""))
# # paste0(colnames(df)[grepl("nace1_",colnames(df))], sep=""))
Balance_vars <- list_vars
# Result Matrixes
N<-nrow(esample[esample$treated==TRUE,])
N_sp <- matrix(NA, nrow=length(Ssamples))
resultsArray_ATT <- array(NA, dim=c(length(O_vars),7,length(Ssamples)))
dimnames(resultsArray_ATT)[[1]] <- c(O_vars)
dimnames(resultsArray_ATT)[[2]] <- c('ATT', 'se', 'pval', 'Y1', 'Y0', 'SampleSize', 'Sign.')
results <- array(NA, dim=c(length(O_vars),4))
balance_matrix_w <- array(NA, dim=c(length(list_vars),length(Ssamples))) # S x P x Q2
dimnames(balance_matrix_w)[[1]] <- c(list_vars)
results_bv_W <- array(NA, dim=c(1,length(list_vars)))
balance_matrix_un <- array(NA, dim=c(length(list_vars),length(Ssamples))) # S x P x Q2
dimnames(balance_matrix_un)[[1]] <- c(list_vars)
results_bv_un <- array(NA, dim=c(1,length(list_vars)))
### 1. Counting of ATTs
Sesample <- esample
###Four sub-samples based on the waiting time until participation in the evaluated measure (cutoffs p25, p50, p75):
wtc25<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.25)
wtc50<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.50)
wtc75<-quantile(as.numeric(Sesample$exita)-as.numeric(Sesample$entry),na.rm=TRUE, probs=0.75)
minToP<-min(as.numeric(Sesample$entrya)-as.numeric(Sesample$entry), na.rm = TRUE)
partic<-Sesample[Sesample$treated==TRUE,]
nonpart<-Sesample[Sesample$treated==FALSE,]
#NonPart majú iba spodné kritérium minimálnej dĺžky nezamestnanosti
esample1<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>minToP,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc25,])
esample2<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc25,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc25 &
as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc50,])
esample3<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc50,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc50 &
as.numeric(partic$exita)-as.numeric(partic$entry)<=wtc75,])
esample4<-rbind(nonpart[as.numeric(nonpart$exit)-as.numeric(nonpart$entry)>=wtc75,],
partic[as.numeric(partic$exita)-as.numeric(partic$entry)>wtc75,])
DataSample <- c()
for (s in Ssamples) {
esampleS <- get(paste0('esample', s, by = ''))
N_sp[s,] <- nrow(esampleS[esampleS$treated==TRUE,])
if (mean(esampleS$treated) > 0.0001){
esampleS <-esampleS[,c("treated", "klient_id",
"entry", "exit", "entrya",
list_vars)]
# Month of participation since the start of the evaluation period
esampleS$participation_month<-((year(as.Date(esampleS$entrya))-year(ep_start))*12)+
month(as.Date(esampleS$entrya))
# Participation quarter
esampleS$pcpQ<-ceiling(esampleS$participation_month/3)
# Month of the start of the unemployment since the start of the evaluation period
esampleS$Ustart_month<-((year(as.Date(esampleS$entry))-min(year(ep_start)))*12)+
month(as.Date(esampleS$entry))
# Inflow quarter
esampleS$infQ<-ceiling(esampleS$Ustart_month/3)
#Adding unemployment history
esampleS<-merge(esampleS,
h_esample[,c("klient_id", "entry",
paste0("entry", seq(1:11), sep=""),
paste0("exit", seq(1:11), sep=""))],
by=c("klient_id", "entry"), all.y = FALSE)
#Imputing the start of the unemployment spell
Pmatrix <- matrix(NA, nrow = nrow(esampleS[esampleS$treated==FALSE,]), ncol=max_pcpQ)
for (p in 1:max_pcpQ){
# Quarter of inflow to unemployment of participants entering the programme in quarter P
PinfQ<-unique(esampleS$infQ
[esampleS$treated==TRUE & esampleS$pcpQ==p])
# Only allowing non-participants inflowing to unemployment during the quarters when participants in this sub-sample were inflowing
#D<-esampleS[as.logical(esampleS$treated==T & esampleS$pcpQ == p) |
# as.logical(esampleS$treated==F & esampleS$infQ %in% PinfQ),]
Pmatrix[,p]<-as.numeric(esampleS$infQ[esampleS$treated==FALSE] %in% PinfQ)
}
hh <- function(j){
sample(which(j==1),1)
}
esampleS$pcpQ[as.logical(apply(Pmatrix, 1, FUN=sum)==0) & esampleS$treated == FALSE] <- 0
Pmatrix<-Pmatrix[as.logical(apply(Pmatrix, 1, FUN=sum)>0),]
esampleS$pcpQ[as.logical(apply(Pmatrix, 1, FUN=sum)>0) & esampleS$treated == FALSE] <- apply(Pmatrix,1,hh)
for (q in OQm) {
cond <- FALSE
for (n in 1:11) {
entry_n <- esampleS[ ,paste0('entry', n, '')]
exit_n <- esampleS[, paste0('exit', n, '')]
cond <- cond | isInRegister(p = esampleS$pcpQ, q, entry_n, exit_n)
}
esampleS[ ,paste0('empl',ceiling(q/3), '')] <- ifelse(cond, 0,1)
}
for(q in OQm){
esampleS <- esampleS[!is.na(esampleS[ ,paste0('empl',ceiling(q/3), '')]),]
}
#Pre-estimation data preparation
#Additional outcome variables
esampleS[ ,"cumempl"] <- rowSums(esampleS[, paste0("empl", seq(0,12,1), sep="")])
esampleS[ ,"firstempl"] <- ceiling(as.numeric((as.Date(esampleS$exit)-
(as.Date(ep_start) + months(esampleS$pcpQ*3)))/90))
# Cleaning the Xs
y <- data.frame(treated = esampleS[ ,'treated'])
D <- data.frame(esampleS) #D - su tvoje data ako data.frame()
spec <- as.formula(cbind(y,D[,c(list_vars,
paste0("empl.", seq(1,4,1), sep=""))]))
#je tvoja specifikacia modelu, je to object as.formula()
colTh <- 0.8
#Treshold for the acceptable correlation between vars ( je maximalne tolerovana korelacia medzi dvoma premennymi)
dumTh <- 0.0001
#Treshold for the acceptable concentration of dummy variables (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
TdumTh <- 0.005
#Treshold for the acceptable concentration of dummy variables in the sub-group of participants (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
TdumThN <- 5
#Treshold for the minimal number of observations of a dummy variables in the sub-group of participants (hovori kolko (100[%] x dumTh) percent je minimalny vyskyt hodnot 1 alebo 0 pri dummy premennych. Ak je dumTh = 0.005, tak aspon pol-percent pozorovani musi mat 1 alebo 0.)
result <- DatPrep(D = D, spec = spec, colTh = colTh, dumTh = dumTh, TdumTh = TdumTh, TdumThN = TdumThN)
for (col in colnames(result$D)){
D <- D[!is.na(D[,col]),]
}
# ESTIMATION:
d = D$treated*1
x = as.matrix(D[,c(list_vars, paste0("empl.", seq(1,4,1), sep=""))])
y_mat <- D[,c(paste0("empl.", seq(1,4,1), sep=""),
paste0("empl", seq(0,12,1), sep=""),
'firstempl', 'cumempl')]
att <- treatweight_pmp(y = y_mat, d, x, s = NULL, z = NULL, selpop = FALSE, trim = 0.05, ATET = TRUE, logit = TRUE, boot = 10)
#att <- treatselDML(y = y_mat, d, x, s = d, z=x, selected=1)
resultsArray_ATT[,1,s] <- round(att$effect,3)
resultsArray_ATT[,2,s] <- round(att$se,3)
resultsArray_ATT[,3,s] <- round(att$pval,3)
resultsArray_ATT[,4,s] <- round(att$y1,3)
resultsArray_ATT[,5,s] <- round(att$y0,3)
resultsArray_ATT[,6,s] <- format(length(d)-att$ntrimmed, big.mark=" ", scientific=FALSE)
resultsArray_ATT[,7,s] <- stars.pval(att$pval)
DataSample <- bind_rows(DataSample, D)
#Balance
#Generating the propensity score variable
PSmodel<-glm(result$spec, family=binomial(link = "logit"), data=D)
#print(summary(PSmodel))
D$PSvar<-as.numeric(PSmodel$fitted.values)
#LL: old weights INCORRECT
#w_ATE <- D$treated/D$PSvar + (1-D$treated)/(1-D$PSvar)
#LL: new weights CORRECT
w_ATE <- D$treated + (1-D$treated)*D$PSvar/(1-D$PSvar)
#Balance_vars <- colnames(result$D)[colnames(result$D) %in% list_vars]
for (bv in Balance_vars){
if (apply(D[,bv,drop = FALSE] ,2,function(x) { all(x %in% c(0:1)) }) ) {
#unweighted discrete
p_treat <- apply(D[D$treated==1,bv,drop = FALSE],2,mean)
p_contr <- apply(D[D$treated==0,bv,drop = FALSE],2,mean)
balance_matrix_un[bv,s] <- abs( 100*(p_treat - p_contr )/sqrt( (p_treat*(1-p_treat) + p_contr*(1-p_contr))/2 ) )
#weighted discrete
p_treat <- t(w_ATE[D$treated==1]) %*% D[D$treated==1,bv] / sum(w_ATE[D$treated==1], na.rm = TRUE)
p_contr <- t(w_ATE[D$treated==0]) %*% D[D$treated==0,bv] / sum(w_ATE[D$treated==0], na.rm = TRUE)
balance_matrix_w[bv,s] <- abs( 100*(p_treat - p_contr )/sqrt( (p_treat*(1-p_treat) + p_contr*(1-p_contr))/2 ) )
} else {
#unweighted continuous
balance_matrix_un[bv,s] <- abs( 100*(apply(D[D$treated==1,bv,drop = FALSE],2,mean) - apply(D[D$treated==0,bv,drop = FALSE],2,mean))/
sqrt( (apply(D[D$treated==1,bv,drop = FALSE],2,sd)^2 + apply(D[D$treated==0,bv,drop = FALSE],2,sd)^2)/2 ) )
#weighted continuous
p_treat <- t(w_ATE[D$treated==1]) %*% D[D$treated==1,bv] / sum(w_ATE[D$treated==1], na.rm = TRUE)
p_contr <- t(w_ATE[D$treated==0]) %*% D[D$treated==0,bv] / sum(w_ATE[D$treated==0], na.rm = TRUE)
p_treat_var <- ( sum(w_ATE[D$treated==1]) / (sum(w_ATE[D$treated==1])^2 - sum(w_ATE[D$treated==1]^2)) )*
t(w_ATE[D$treated==1]) %*% ((D[D$treated==1,bv] - c(p_treat))^2)
p_contr_var <- ( sum(w_ATE[D$treated==0]) / (sum(w_ATE[D$treated==0])^2 - sum(w_ATE[D$treated==0]^2)) ) *
t(w_ATE[D$treated==0]) %*% ((D[D$treated==0,bv] - c(p_contr))^2)
balance_matrix_w[bv,s] <- abs(100* (p_treat - p_contr ) /
sqrt( (p_treat_var + p_contr_var )/2 ) )
}
}
}
}
for (iQ in 1:length(O_vars)){
results[iQ,1] <- sum(sum((as.numeric(resultsArray_ATT[iQ,'ATT',])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
results[iQ,2] <-sum(sum((as.numeric(resultsArray_ATT[iQ,'se',])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
results[iQ,3] <-sum(sum((as.numeric(resultsArray_ATT[iQ,'Y1',])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
results[iQ,4] <-sum(sum((as.numeric(resultsArray_ATT[iQ,'Y0',])*(N_sp/N)), na.rm = TRUE), na.rm = TRUE)
}
results<-cbind(O_vars, results)
colnames(results) <- c('O_vars', 'ATT', 'se','Y1', 'Y0')
results_bv <- array(NA, dim=c(length(list_vars),2))
dimnames(results_bv)[[1]] <- c(list_vars)
dimnames(results_bv)[[2]] <- c("unweighted", "weighted")
for (bVar in 1:length(list_vars)){
results_bv[bVar,1] <- abs(sum(sum((balance_matrix_w[bVar,]*(N_sp/N)), na.rm=TRUE), na.rm=TRUE))
results_bv[bVar,2] <- abs(sum(sum((balance_matrix_un[bVar,]*(N_sp/N)), na.rm=TRUE), na.rm=TRUE))
}Zaujíma nás nakoľko sa zmenia výsledné odhady ATT, ak zmeníme metódu ich odhadu. Pokiaľ zmena nie je zásadná, môžeme konštatovať že naše výsledky nie sú citlivé na zmenu metódy odhadu.
Graf 10: Graf stredných hodnôt charakteristík účastníkov a oprávnených pred a po párovaní
BVDF <- data.frame(balance_vars = c(rownames(results_bv),rownames(results_bv)),
balance = c(results_bv[,1], results_bv[,2]),
Balans = c(rep("pred vážením",nrow(results_bv)),rep("po vážení",nrow(results_bv))))
BVDF %>% subset(!is.na(balance)) %>%
mutate(balance_vars = fct_reorder(balance_vars, balance)) %>%
ggplot(aes(x=balance, y=balance_vars,col=Balans)) +
geom_point() +
ylab('Premenné')+
xlab('Absolútne štandardizované rozdiely')+
theme_minimal()+
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
labs(caption="Zdroj: ÚPSVaR")+
geom_vline(xintercept = 0.0, color = 'darkgrey')
Taktiež sa môžeme pozrieť na podiel účastníkov a kontrolnej skupiny mimo evidencie nezamestnaných UoZ.
Graf 11: Podiel účastníkov a kontrolnej skupiny mimo evidencie nezamestnaných UoZ (proxy pre mieru zamestnanosti)
graph <- matrix(NA, nrow=length(O_vars[1:17]), ncol = 2)
rownames(graph) <- O_vars[1:17]
for(o in O_vars[1:17]){
graph[o,1] <- apply(DataSample[DataSample$treated == TRUE,o,drop = FALSE], 2, mean, na.rm = TRUE)
graph[o,2] <- apply(DataSample[DataSample$treated == FALSE,o,drop = FALSE], 2, mean, na.rm = TRUE)
}
graph <- data.frame(cbind(O_vars[1:17],graph))
colnames(graph) <- c('O_vars','treated', 'untreated')
graph$treated <- as.numeric(as.character(graph$treated))
graph$untreated <- as.numeric(as.character(graph$untreated))
graph$O_vars <- factor(graph$O_vars, levels=c(O_vars[1:17]))
graph$Q<-seq(-4,12,1)
graphER<- ggplot(data=graph) +
geom_line(aes(x=Q, y=treated, colour="Účastníci"), size = 1 , group = 1) +
geom_line(aes(x=Q, y=untreated, colour="Kontrolná skupina"), size = 1 , group = 1) +
scale_x_continuous(breaks=seq(-4,12,1))+
theme_minimal()+
labs(
y = "Podiel",
x = "Štvrťroky od účasti na opatrení (0)",
colour = "Skupina",
caption="Zdroj: ÚPSVaR") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")
graphER
Graf 9: Priemerná účinnosť opatrenia (ATT) na prítomnosť v registri nezamestnaných UoZ pre účastníkov programu Príspevok na podporu vytvorenia pracovného miesta v prvom pravidelne platenom zamestnaní (<25) počas roka 2017
graphATT
Nakoniec zobrazíme priemernú účinnosť účasti na opatrení v tabuľke, ktorú sme získali alternatívnym výpočtom pomocou inverzného váženia pravdepodobnosti.
Tabuľka 12: Priemerná účinnosť účasti na opatrení (ATT)
resultsDF %>% kbl(format = 'html', booktabs = TRUE , align = 'c') %>%
column_spec(1, border_right = TRUE) %>%
kable_classic('hover', full_width = FALSE) %>%
row_spec(1:nrow(resultsDF), font_size = '1cm') %>%
column_spec(1:ncol(resultsDF),width = "1.1cm") %>%
kableExtra::footnote(number = paste('Významnosť (sig.):', 0.0000, ' " *** " ', 0.001, ' " ** " ', 0.01, ' " * " ', 0.05, ' " . " ', 0.1, '" "', 1))| efekt | se | sig. | |
|---|---|---|---|
| empl.4 | 0.000 | 0.000 | |
| empl.3 | -0.002 | 0.006 | |
| empl.2 | 0.017 | 0.010 | . |
| empl.1 | 0.010 | 0.014 | |
| empl0 | -0.131 | 0.024 | *** |
| empl1 | -0.137 | 0.042 | *** |
| empl2 | -0.095 | 0.032 | ** |
| empl3 | -0.030 | 0.022 | |
| empl4 | -0.015 | 0.030 | |
| empl5 | 0.085 | 0.032 | ** |
| empl6 | 0.295 | 0.037 | *** |
| empl7 | 0.243 | 0.038 | *** |
| empl8 | 0.164 | 0.040 | *** |
| empl9 | 0.142 | 0.039 | *** |
| empl10 | 0.129 | 0.036 | *** |
| empl11 | 0.136 | 0.040 | *** |
| empl12 | 0.145 | 0.048 | ** |
| firstempl | -0.867 | 0.302 | ** |
| cumempl | 0.932 | 0.231 | *** |
| 1 Významnosť (sig.): 0 " *** " 0.001 " ** " 0.01 " * " 0.05 " . " 0.1 " " 1 |