Pripravili: Soňa Dulíková, Lukáš Lafférs a Miroslav Štefánik ()
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 aktivačnú činnosť formou dobrovoľníckej služby

Tento automatizovaný report poskytuje informácie o jednom z nástrojov aktívnych opatrení na trhu práce (AOTP): Príspevok na aktivačnú činnosť formou dobrovoľníckej služby, ktorý bol implementovaný na Slovensku v roku 2017. Príspevok na aktivačnú činnosť formou dobrovoľníckej služby je poskytovaný na základe § 52 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 aktivačnú činnosť formou dobrovoľníckej služby je klasifikovaný ako “podpora tvorby pracovných miest”, so špecifickým kódom programu 6_SK24.

Cieľom programu Príspevok na aktivačnú činnosť formou dobrovoľníckej služby je: Forma aktivačnej činnosti uchádzača o zamestnanie, vykonávanie dobrovoľníckej činnosti s cieľom získať praktické skúseností pre potreby trhu práce.

Účastníci programu sú evidovaní uchádzači o zamestnanie.

Oprávnenými užívateľmi sú evidovaní uchádzači o zamestnanie.

Implementácia: § 52a (1) Dobrovoľnícka služba na účely tohto zákona je forma aktivácie uchádzača o zamestnanie vykonávaním dobrovoľníckej činnosti, ktorej cieľom je získanie praktických skúseností pre potreby trhu práce.

Dobrovoľnícku službu vykonáva uchádzač o zamestnanie v rozsahu 20 hodín týždenne nepretržite najviac počas 6 kalendárnych mesiacov u právnickej osoby alebo fyzickej osoby, ktorá svoju činnosť nevykonáva za účelom dosiahnutia zisku.

  1. Počas vykonávania dobrovoľníckej služby úrad poskytuje uchádzačovi o zamestnanie paušálny príspevok vo výške sumy životného minima poskytovaného jednej plnoletej fyzickej osobe podľa osobitného predpisu.

Príspevok na aktivačnú činnosť vykonávanú pri výkone dobrovoľníckej činnosti pozostáva z príspevku na náhradu časti výdavkov spojených s vykonávaním dobrovoľníckej služby a z časti celkovej ceny práce zamestnanca organizujúceho dobrovoľnícku službu.


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 aktivačnú činnosť formou dobrovoľníckej služby 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 aktivačnú činnosť formou dobrovoľníckej služby 5 063 jednotlivcov , čo predstavuje 2.62 %% z celkového počtu účastníkov na všetkých AOTP na Slovensku (typy LMP 2-7) a 3.83 %% z celkových výdavkov na tieto programy. Kategória Podpora tvorby pracovných miest predstavuje 5.93 %% z celkových nákladov na všetky AOTP na Slovenku (typy LMP 2-7) a 9.02 %% všetkých účastníkov na AOTP.


1.2 Príspevok na aktivačnú činnosť formou dobrovoľníckej služby v kontexte AOTP na Slovensku

Najskôr pomocou administratívnych údajov zobrazíme dôležitosť programu Príspevok na aktivačnú činnosť formou dobrovoľníckej služby 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 P52A, Príspevok na aktivačnú činnosť formou dobrovoľníckej služby.

Graf 2: Príspevok na aktivačnú činnosť formou dobrovoľníckej služby 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
P053 Príspevok na dochádzanie za prácou
P054 Projekty a programy
P051 Príspevok na vykonávanie absolventskej praxe
P54O [Komponent] Projekty a programy - Samostatná zárobková činnosť
P060 Príspevok na úhradu prevádzkových nákladov chránenej dielne alebo chráneného pracoviska
P54K [Komponent] Projekty a programy - Projekty - Vzdelávanie a odborná príprava
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
P049 Príspevok na samostatnú zárobkovú činnosť
P50J Príspevok na podporu rozvoja miestnej a regionálnej zamestnanosti
P52A Príspevok na aktivačnú činnosť formou dobrovoľníckej služby
## 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
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
P054 Projekty a programy
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 395 328 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 443 969 krát počas obdobia 2014-2020. Z nich sa počas hodnoteného obdobia na opatrení Príspevok na aktivačnú činnosť formou dobrovoľníckej služby zúčastnilo 4 936 uchádzačov o zamestnanie. Zo vzorky bolo vymazaných 3 755 účastníkov na programe a 174 019 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 1 181 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 269 950 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í 1 181 269 950
Vek 40.5 36.5
Muži 21.42% 51.97%
Predošlé zamestnanie 5.84% 8.75%
Dĺžka nezamestnanosti 476.01 245.25
Deti v domácnosti 19.48% 11.42%
Stupeň vzdelania
Bez vzdelania 0.25% 0.69%
Základné 12.87% 13.87%
Nižšie sekundárne 25.83% 28.32%
Vyššie sekundárne 36.49% 35.73%
Terciárne 24.56% 21.4%
Štúdijný odbor
Poľnohospodársko-lesnícke a veterinárne vedy a náuky 4.23% 4.24%
Prírodné vedy 0.92% 0.7%
Spoločenské vedy, náuky a služby 33.1% 25.17%
Technické vedy a náuky 23.63% 30.38%
Vedy a náuky o kultúre a umení 0.67% 1.06%
Vojenské a bezpečnostné vedy a náuky 0.25% 0.34%
Všeobecné vedy a služby 35.14% 36.61%
Zdravotníctvo 2.02% 1.49%
Zručnosti
Cudzí jazyk 57.75% 62.43%
Počitačové zručnosti 51.48% 56.09%
Vodičský preukaz 40.56% 54.47%
Okres
Banskobystrický 15.75% 12%
Bratislavský 11.52% 11.63%
Košický 11.09% 14.26%
Nitriansky 12.02% 12.86%
Prešovský 15.58% 16.67%
Trenčiansky 11.18% 10.35%
Trnavský 6.94% 9.69%
Žilinský 15.92% 12.52%
Národnosť
Slovenská 91.45% 90.56%
Maďarská 7.79% 8.2%
Česká 0.51% 0.44%
Rómska 0% 0.16%
Ostatné 0.25% 0.65%
Prítok nezamestnaných
1Q.2017 26.25% 27.16%
2Q.2017 23.79% 25.52%
3Q.2017 23.45% 25.97%
4Q.2017 26.5% 21.35%
Odtok nezamestnaných
1Q.2017 4.65% 27.62%
2Q.2017 22.01% 28.67%
3Q.2017 33.71% 23.66%
4Q.2017 39.62% 20.06%

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 aktivačnú činnosť formou dobrovoľníckej služby 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 aktivačnú činnosť formou dobrovoľníckej služby

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 aktivačnú činnosť formou dobrovoľníckej služby 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 aktivačnú činnosť formou dobrovoľníckej služby 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.024 0.012
empl.3 -0.022 0.012 .
empl.2 -0.013 0.011
empl.1 -0.005 0.009
empl0 -0.163 0.013 ***
empl1 -0.184 0.017 ***
empl2 0.009 0.019
empl3 0.068 0.018 ***
empl4 0.049 0.017 **
empl5 0.027 0.016 .
empl6 0.008 0.014
empl7 -0.005 0.014
empl8 -0.012 0.015
empl9 -0.022 0.014
empl10 -0.004 0.014
empl11 0.003 0.014
empl12 0.011 0.014
firstempl -0.229 0.099
cumempl -0.215 0.122 .
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.024 0.012
-0.016 0.018 -0.020 0.030 -0.023 0.008 **
empl.3 -0.022 0.012 . 0.024 0.017 -0.165 0.034 *** -0.006 0.005
empl.2 -0.013 0.011 -0.002 0.020 -0.057 0.015 *** -0.004 0.004
empl.1 -0.005 0.009 -0.005 0.016 -0.005 0.005 0.000 0.000
empl0 -0.163 0.013 *** -0.158 0.019 *** -0.080 0.027 ** -0.222 0.028 ***
empl1 -0.184 0.017 *** -0.144 0.023 *** -0.112 0.039 ** -0.320 0.034 ***
empl2 0.009 0.019 0.078 0.026 ** 0.053 0.046 -0.176 0.040 ***
empl3 0.068 0.018 *** 0.133 0.024 *** 0.052 0.044 -0.063 0.041
empl4 0.049 0.017 ** 0.096 0.022 *** 0.077 0.039
-0.067 0.038 .
empl5 0.027 0.016 . 0.046 0.020
0.070 0.038 . -0.045 0.036
empl6 0.008 0.014 0.024 0.017 0.058 0.033 . -0.061 0.036 .
empl7 -0.005 0.014 0.008 0.017 0.014 0.028 -0.046 0.035
empl8 -0.012 0.015 -0.015 0.019 0.006 0.029 -0.018 0.034
empl9 -0.022 0.014 -0.008 0.019 -0.001 0.030 -0.072 0.030
empl10 -0.004 0.014 0.007 0.019 0.019 0.030 -0.050 0.031
empl11 0.003 0.014 0.020 0.018 0.013 0.029 -0.046 0.031
empl12 0.011 0.014 0.012 0.019 0.034 0.031 -0.022 0.030
firstempl -0.229 0.099
-0.462 0.121 *** -0.447 0.231 . 0.415 0.256
cumempl -0.215 0.122 . 0.099 0.149 0.202 0.278 -1.207 0.303 ***
1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1
2 Spolu: 2 366 pozorovaní 0-6 mesiacov: 1 284 pozorovaní 7-12 mesiacov: 495 pozorovaní 13+ mesiacov: 579 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.024 0.012
-0.022 0.012 . -0.019 0.032
empl.3 -0.022 0.012 . -0.023 0.014 . -0.007 0.027
empl.2 -0.013 0.011 -0.026 0.012
0.027 0.029
empl.1 -0.005 0.009 -0.014 0.010 0.034 0.019 .
empl0 -0.163 0.013 *** -0.155 0.015 *** -0.197 0.030 ***
empl1 -0.184 0.017 *** -0.181 0.019 *** -0.186 0.037 ***
empl2 0.009 0.019 0.019 0.023 -0.014 0.041
empl3 0.068 0.018 *** 0.077 0.021 *** 0.043 0.040
empl4 0.049 0.017 ** 0.063 0.020 ** -0.005 0.038
empl5 0.027 0.016 . 0.040 0.018
-0.029 0.037
empl6 0.008 0.014 0.022 0.016 -0.050 0.035
empl7 -0.005 0.014 -0.003 0.016 -0.020 0.029
empl8 -0.012 0.015 -0.011 0.018 -0.016 0.032
empl9 -0.022 0.014 -0.007 0.017 -0.066 0.032
empl10 -0.004 0.014 0.010 0.016 -0.050 0.032
empl11 0.003 0.014 0.010 0.016 -0.023 0.030
empl12 0.011 0.014 0.018 0.016 -0.010 0.033
firstempl -0.229 0.099
-0.387 0.118 *** 0.346 0.200 .
cumempl -0.215 0.122 . -0.097 0.146 -0.624 0.274
1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1
2 Spolu: 2 366 pozorovaní Ženy: 1 837 pozorovaní Muži: 529 pozorovaní

Tabuľka 6: Účinnosť opatrenia podľa stupňa vzdelania

education
Vzdelanie
Spolu
Bez vzdelania
SŠ bez maturity
efekt se sig. efekt se sig. efekt se sig. efekt se sig. efekt se sig.
empl.4 -0.024 0.012
0.000 NaN -0.038 0.051 -0.036 0.028 0.011 0.022
empl.3 -0.022 0.012 . -0.250 NaN 0.031 0.046 -0.047 0.026 . 0.009 0.024
empl.2 -0.013 0.011 0.000 NaN 0.041 0.046 -0.021 0.026 -0.041 0.022 .
empl.1 -0.005 0.009 0.000 NaN -0.019 0.040 0.009 0.020 0.008 0.018
empl0 -0.163 0.013 *** 0.000 NaN -0.174 0.044 *** -0.201 0.027 *** -0.155 0.024 ***
empl1 -0.184 0.017 *** 0.000 NaN -0.221 0.057 *** -0.241 0.033 *** -0.177 0.030 ***
empl2 0.009 0.019 0.000 NaN -0.018 0.061 -0.041 0.038 0.029 0.033
empl3 0.068 0.018 *** 1.720 NaN 0.067 0.058 0.026 0.037 0.074 0.028 **
empl4 0.049 0.017 ** -0.928 NaN 0.013 0.058 0.027 0.035 0.026 0.027
empl5 0.027 0.016 . -0.720 NaN 0.067 0.055 -0.015 0.034 -0.002 0.024
empl6 0.008 0.014 -1.000 NaN 0.021 0.051 -0.041 0.031 0.005 0.022
empl7 -0.005 0.014 0.000 NaN 0.040 0.046 -0.010 0.031 -0.032 0.021
empl8 -0.012 0.015 0.000 NaN 0.037 0.047 0.010 0.030 -0.034 0.022
empl9 -0.022 0.014 0.000 NaN -0.020 0.048 -0.042 0.031 -0.004 0.021
empl10 -0.004 0.014 -0.720 NaN 0.022 0.046 -0.032 0.030 0.009 0.021
empl11 0.003 0.014 1.208 NaN 0.009 0.049 -0.025 0.031 0.011 0.021
empl12 0.011 0.014 1.928 NaN 0.110 0.052
-0.044 0.031 0.004 0.022
firstempl -0.229 0.099
-1.512 NaN -0.134 0.367 0.001 0.225 -0.150 0.127
cumempl -0.215 0.122 . 1.488 NaN -0.048 0.428 -0.628 0.267
-0.245 0.185
1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1
2 Spolu: 2 366 pozorovaní Bez vzdelania: 9 pozorovaní ZŠ: 277 pozorovaní SŠ bez maturity: 622 pozorovaní SŠ: 895 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.024 0.012
-0.029 0.014
-0.018 0.033
empl.3 -0.022 0.012 . -0.016 0.015 -0.047 0.031
empl.2 -0.013 0.011 -0.008 0.013 -0.029 0.030
empl.1 -0.005 0.009 -0.009 0.011 0.009 0.025
empl0 -0.163 0.013 *** -0.162 0.016 *** -0.157 0.029 ***
empl1 -0.184 0.017 *** -0.174 0.020 *** -0.211 0.037 ***
empl2 0.009 0.019 0.018 0.023 -0.018 0.041
empl3 0.068 0.018 *** 0.066 0.021 ** 0.074 0.040 .
empl4 0.049 0.017 ** 0.042 0.020
0.064 0.039
empl5 0.027 0.016 . 0.025 0.019 0.026 0.036
empl6 0.008 0.014 0.009 0.016 0.009 0.035
empl7 -0.005 0.014 -0.010 0.015 0.008 0.032
empl8 -0.012 0.015 -0.016 0.016 0.005 0.035
empl9 -0.022 0.014 -0.023 0.015 -0.014 0.035
empl10 -0.004 0.014 0.002 0.015 -0.029 0.034
empl11 0.003 0.014 0.008 0.016 -0.038 0.033
empl12 0.011 0.014 0.023 0.015 -0.044 0.034
firstempl -0.229 0.099
-0.210 0.113 . -0.239 0.260
cumempl -0.215 0.122 . -0.192 0.139 -0.325 0.301
1 Významnosť (sig.) 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1
2 Spolu: 2 366 pozorovaní 0-10%: 1 795 pozorovaní 10-100%: 571 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.024 0.012
-0.004 0.022 -0.037 0.019 .
empl.3 -0.022 0.012 . 0.002 0.021 -0.043 0.018
empl.2 -0.013 0.011 -0.013 0.020 -0.014 0.018
empl.1 -0.005 0.009 -0.001 0.015 -0.007 0.014
empl0 -0.163 0.013 *** -0.170 0.020 *** -0.154 0.019 ***
empl1 -0.184 0.017 *** -0.199 0.026 *** -0.168 0.024 ***
empl2 0.009 0.019 0.013 0.030 0.011 0.026
empl3 0.068 0.018 *** 0.066 0.029
0.070 0.024 **
empl4 0.049 0.017 ** 0.080 0.025 *** 0.022 0.023
empl5 0.027 0.016 . 0.039 0.024 0.017 0.022
empl6 0.008 0.014 0.003 0.023 0.011 0.020
empl7 -0.005 0.014 0.005 0.023 -0.019 0.019
empl8 -0.012 0.015 -0.015 0.024 -0.012 0.019
empl9 -0.022 0.014 -0.030 0.023 -0.013 0.019
empl10 -0.004 0.014 -0.013 0.023 0.003 0.019
empl11 0.003 0.014 0.002 0.023 0.007 0.018
empl12 0.011 0.014 0.004 0.022 0.020 0.019
firstempl -0.229 0.099
-0.120 0.175 -0.330 0.131
cumempl -0.215 0.122 . -0.217 0.207 -0.206 0.166
1 Významnosť (sig.): 0 " ** " 0.001 " * " 0.01 " * " 0.05 " . " 0.1 " " 1
2 Spolu: 2 366 pozorovaní Dedina: 1 102 pozorovaní Mesto: 1 264 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
Hodnotiace obdobie
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 443 969
Celkový počet oprávnených UoZ 0 395 328
Celkový počet účastí na hodnotenom opetrení 0 4 936
Celkový počet účastníkov hodnoteného opatrenia 0 4 825
Odstránení UoZ s participáciou na AOTP 2 roky pred hodnoteným obdobím
Odstránení oprávnení UoZ 56 701 387 268
Odstránení účastníci 2 131 2 805
Odstránení UoZ s participáciou na inom AOTP počas hodnoteného obdobia
Odstránení oprávnení UoZ 51 930 335 338
Odstránení účastníci 561 2 244
Odstránení účastníci s viacnásobnou účasťou v hodnotenom programe
Odstránení účastníci 64 2 180
Odstránení UoZ s účasťou na programe podporovaného zamestnávanie (AOTP) počas hodnoteného obdobia
Odstránení oprávnení UoZ 31 720 303 618
Odstránení účastníci 782 1 398
Odstránení účastníci s účasťou, ktorá sa nedeje počas obdobia nezamestnanosti
Nafúknutie účastníkov zlúčením tabuleik +292 1 487
Odstránení účastníci 292 1 195
Odstránení účastníci s extrémnymi hodnotami (1%) čakacej doby na účasť v hodnotenom opatrení
Odstránení účastníci 12 1 183
Odstránení UoZ s viacerými registráciami
Odstránení oprávnení UoZ 33 668 269 950
Odstránení účastníci 2 1 181
Celkový počet registrácií po čistení dát
Oprávnení 0 269 950
Účastníci 0 1 181

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 aktivačnú činnosť formou dobrovoľníckej služby 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.000 0.000
empl.2 0.000 0.000
empl.1 0.000 0.000
empl0 -0.179 0.017 ***
empl1 -0.162 0.025 ***
empl2 0.051 0.034
empl3 0.101 0.034 **
empl4 0.073 0.029
empl5 0.054 0.026
empl6 0.040 0.026
empl7 0.040 0.026
empl8 0.016 0.025
empl9 0.006 0.023
empl10 0.016 0.025
empl11 0.026 0.027
empl12 0.027 0.023
firstempl -0.619 0.169 ***
cumempl 0.108 0.240
1 Významnosť (sig.): 0 " *** " 0.001 " ** " 0.01 " * " 0.05 " . " 0.1 " " 1