A születésszám alakulása és az azt kísérő változások Magyarországon
Granát Marcell
2020-05-24
A jobb felhasználói élmény érdekében a tanulmány teljes szövege az alábbi oldalon érhető el: https://bookdown.org/MarcellGranat/fertility/absztrakt.html
A számítások kódjai pedig az alábbin: https://github.com/MarcellGranat/fertility
Absztrakt
A születendő gyermekek száma olyan téma, amely számos politikai vita központjába kerül napjainkban. A vitát indokolja, hogy egyik oldalon a Föld eltartó képességére hivatkozva, vannak, akik azt tartják helyesnek, ha a népesség csökkentését sürgetjük, azonban számos indok áll ezzel szemben. A bruttó nemzeti kibocsátás jelentős része származhat pusztán a demográfiai növekedésből. Ha a kibocsátás növekedése főként a lélekszám növekedéséből származik, abban az esetben ez nem vezet az életszínvonal emelkedéséhez, az egy főre jutó jövedelem nem nő a népesség számának növekedésével, azonban globális politikai súlyként szolgál a nagyobb kibocsátás. Fontos indok lehet mögötte a számos országban működő felosztó-kirovó nyugdíjrendszer fenntarthatósága. Az elsőként említett állásponton lévő országra kiváló példa Kína, aki az egy gyermek politika bevezetésével a népességének csökkentését kívánja kiváltani. A szemben álló oldalra sorolható akár Magyarország is. Nem is olyan régen jelent meg a hazai médiában, hogy a magyar miniszterelnök “alkut kíván kötni a magyar nőkkel”. Bármely oldalon is kíván egy ország vezetése helyet foglalni, az aktuális demográfiai folyamatokról szóló előrejelzések, illetőleg a folyamatot befolyásoló lehetséges eszközök ismerete elengedhetetlen.
Ezen tanulmány a születésszámra vonatkozó mutatók változásai mögött meghúzódó okozati tényezőket, illetőleg azok hatásait kívánja elemezni. A dolgozat során Magyarország 1960-tól számított mutatóin alapulva igyekszem feltárni a magyar gyermekvállalási tendenciák alakulását az elmúlt évtizedekben. Az elemzés fő eszközei közé tartozás a Granger-okság fennállásának vizsgálata, mely azt írja le, hogy az két idősor közül az egyikben végbemenő változás során következtethetünk-e arra, hogy a másik mutatóban is változás fog végbe menni. Vizsgálataim során ilyen jellegű kapcsolatot találtam szegénységi, munkaerőpiaci, illetőleg az ország pénzügyi szektorának helyzetét leíró egyes mutatók. Az idősor elemzés eszközeivel (Box-Jenkins eljárás, vektor-autoregresszív modellek, kointegráció) készített modellek eredményeiből a teljes termékenységi arányszámra ható változók, illetőleg a termékenységi arányszám által kifejtett hatásokat kívánom elemezni.
library(timeSeries)
library(tseries)
library(forecast)
library(ggplot2)
library(mFilter)
library(MTS)
library(readxl)
library(writexl)
library(vars)
library(rms)
library(car)
library(broom)
library(urca)
library(fUnitRoots)
library(knitr)
library(scales)
library(tidyr)
library(dplyr)
library(ggpmisc)
library(naniar)
library(tsDyn)
library(data.table)
library(formattable)
library(readxl)
library(DT)
library(rio)
library(sparkline)
library(viridis)
library(hrbrthemes)
library(plotly)
library(ggthemes)
library(kableExtra)
library(extrafont)
windowsFonts("Times New Roman" = windowsFont("Times New Roman"))
options(encoding = 'UTF-8')
load("C:/Users/user/Desktop/szakdolgozat/fertiliy/R files/Szakdolgozat/Thesis_Variables_2020.04.10.RData")MyTheme <- theme_economist() + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75))
)1 Magyarország születési indikátorainak ábrái
df=data.frame(LiveBirthAndFertility$Year, LiveBirthAndFertility$LiveBirthTotal/LiveBirthAndFertility$LiveBirthTotal[1], LiveBirthAndFertility$LiveBirthTo1000/LiveBirthAndFertility$LiveBirthTo1000[1], LiveBirthAndFertility$TotalFertility/LiveBirthAndFertility$TotalFertility[1])
names(df)=c("Year","Összes született gyermek", "Ezer nőre jutó született gyermekek száma", "Teljes termékenységi arány")
df=df %>% gather(key="variable", value = "value", -Year)
ggplot(df, aes(x = Year, y = value)) +
geom_line(aes(color = variable), size = 2) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1),expand=c(0,0),limits=c(0.5, 1.5)) +
scale_x_continuous(expand=c(0,0)) +
labs(title = "Születési mutatók bázisindexe", subtitle = "1960=100%") +
xlab("Év")+
ylab("Százalék") +
scale_color_economist() +
MyTheme
df=data.frame(LiveBirthAndFertility$Year, LiveBirthAndFertility$TotalFertility,rep(2.1,length(LiveBirthAndFertility$TotalFertility)))
names(df)=c("Year", "Teljes termékenységi arány","Az egyszerű reprodukciót jelentő érték")
df=df %>% gather(key="variable", value = "value", -Year)
ggplot(df, aes(x = Year, y = value)) +
geom_line(aes(color = variable,linetype=variable), size = 2) +
scale_y_continuous(expand=c(0.1,0.1)) +
scale_x_continuous(expand=c(0,0)) +
labs(title = "Magyarország termékenységi rátájának alakulása", subtitle="1960-2018") +
scale_color_manual(values = c("#e3120b","#244747")) +
scale_linetype_manual(values = c("longdash","solid"))+
ylab("Gyermek/anya")+
xlab("Év")+
MyTheme
2 ARIMA modellezés
df=data.frame(LiveBirthAndFertility$Year,
hpfilter(LiveBirthAndFertility$TotalFertility, freq = 100)$trend
,LiveBirthAndFertility$TotalFertility)
names(df)=c("Year", "HP","TFR")
ggplot(df, aes(x = Year)) +
geom_line(aes(y=TFR, color = "Magyarország teljes termékenységi arányszáma"),linetype="solid", size = 2) +
geom_line(aes(y=HP,color = "HP-szűrővel leválaszott trend"),linetype="longdash", size = 2) +
scale_y_continuous(expand=c(0,0), limits = c(0,2.5)) +
scale_x_continuous(expand=c(0,0)) +
labs(title = "Magyarország termékenységi rátájának alakulása és annak trendje", subtitle="1960-2018, Trend leválasztása Hodrick-Prescott szűrő segítségével (alfa=100)") +
scale_color_manual(values = c("Magyarország teljes termékenységi arányszáma"="#244747","HP-szűrővel leválaszott trend"="#e3120b")) +
ylab("Gyermek/anya")+
xlab("Év")+
MyTheme
df=data.frame(LiveBirthAndFertility$Year[-1],diff(LiveBirthAndFertility$TotalFertility))
names(df)=c("x","y")
ggplot(df, aes(x=x, y=y)) +
geom_hline(yintercept = 0, size=1.3, color="#4a4a4a") +
geom_line(size = 2, color="#e3120b") +
scale_y_continuous(expand=c(0,0), limits = c(-0.5, 0.5)) +
scale_x_continuous(expand=c(0,0)) +
labs(title = "Magyarország termékenységi rátájának növekménytagjai", subtitle="1961-2018, Differenciázás segítségével az eredeti idősor determinisztikus, illetve sztochasztikus trendje is eltávolítható") +
ylab("Gyermek/anya")+
xlab("Év")+
MyTheme
Myacf <- acf(diff(LiveBirthAndFertility$TotalFertility), plot = FALSE, lag.max = 20)
Myacf <- with(Myacf, data.frame(lag, acf))
Mypacf <- acf(diff(LiveBirthAndFertility$TotalFertility), plot = FALSE, type = "partial", lag.max = 20)
Mypacf <- with(Mypacf, data.frame(lag, acf))
df=data.frame(
0:20,
Myacf$acf,
c(1,Mypacf$acf)
)
names(df)=c("lag","acf","pacf")
df=df %>% gather("variable","value",-"lag")
variable_names = list("acf" = "Korrelogram (ACF)",
"pacf" = "Parciális korrelogram (PACF)")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
ggplot(df, aes(x=lag, y=value)) +
geom_hline(yintercept = 0, color="grey38", size=1) +
geom_line(size=1.2, color="#244747") +
geom_point(
shape=21, fill="#336666", color="#244747",size=3,stroke=1.5) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller) +
labs(title="Magyarország termékenységi rátájának növekménytagjainak korrelogramja",
subtitle="Autokorreláció és parciális autokorreláció függvény értékei egyes késleltetések mellett"
) +
scale_y_continuous(expand = c(0,0), limits = c(-1,1)) +
scale_x_continuous(expand = c(0,0)) +
xlab("Késleltetés száma") +
ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(2, "lines")
)
x=diff(LiveBirthAndFertility$TotalFertility)
x=head(x,-10)
auto.arima(x, ic = "aicc",trace = T, method ="CSS")##
## ARIMA(2,0,2) with non-zero mean : -242.8851
## ARIMA(0,0,0) with non-zero mean : -240.8491
## ARIMA(1,0,0) with non-zero mean : -245.8113
## ARIMA(0,0,1) with non-zero mean : -247.2505
## ARIMA(0,0,0) with zero mean : -241.4851
## ARIMA(1,0,1) with non-zero mean : -243.8007
## ARIMA(0,0,2) with non-zero mean : -244.9058
## ARIMA(1,0,2) with non-zero mean : -242.0471
## ARIMA(0,0,1) with zero mean : -248.6743
## ARIMA(1,0,1) with zero mean : -245.6434
## ARIMA(0,0,2) with zero mean : -246.473
## ARIMA(1,0,0) with zero mean : -247.6685
## ARIMA(1,0,2) with zero mean : -244.0502
##
## Best model: ARIMA(0,0,1) with zero mean## Series: x
## ARIMA(0,0,1) with zero mean
##
## Coefficients:
## ma1
## 0.4503
## s.e. 0.1269
##
## sigma^2 estimated as 0.005255: part log likelihood=58.36df=matrix(nrow = 12,ncol = 3)
df[1,3]=adf.test(LiveBirthAndFertility$LiveBirthTotal)$p.value
df[2,3]=adf.test(diff(LiveBirthAndFertility$LiveBirthTotal))$p.value
df[3,3]=adf.test(log(LiveBirthAndFertility$LiveBirthTotal))$p.value
df[4,3]=adf.test(diff(log(LiveBirthAndFertility$LiveBirthTotal)))$p.value
df[5,3]=adf.test(LiveBirthAndFertility$LiveBirthTo1000)$p.value
df[6,3]=adf.test(diff(LiveBirthAndFertility$LiveBirthTo1000))$p.value
df[7,3]=adf.test(log(LiveBirthAndFertility$LiveBirthTo1000))$p.value
df[8,3]=adf.test(diff(log(LiveBirthAndFertility$LiveBirthTo1000)))$p.value
df[9,3]=adf.test(LiveBirthAndFertility$TotalFertility)$p.value
df[10,3]=adf.test(diff(LiveBirthAndFertility$TotalFertility))$p.value
df[11,3]=adf.test(log(LiveBirthAndFertility$TotalFertility))$p.value
df[12,3]=adf.test(diff(log(LiveBirthAndFertility$TotalFertility)))$p.value
df=data.frame(df)
df[,3]=percent(df[,3],d=2)
df[,1]=c(rep("Összes születés",4),rep("Ezer főre eső születés",4),rep("TTA",4))
df[,2]=rep(c("x","diff(x)","log(x)","diff(log(x))"),3)
names(df)=c("Születési mutató","Transzformáció","ADF-teszthez tartozó p-érték")
kable(df,caption = "Megfontolásra kerülő modellek", align = c("l",rep("c",3))) %>%
kable_styling(bootstrap_options = "striped",full_width = T, fixed_thead = T)| Születési mutató | Transzformáció | ADF-teszthez tartozó p-érték |
|---|---|---|
| Összes születés | x | 24.93% |
| Összes születés | diff(x) | 4.06% |
| Összes születés | log(x) | 22.90% |
| Összes születés | diff(log(x)) | 4.85% |
| Ezer főre eső születés | x | 25.06% |
| Ezer főre eső születés | diff(x) | 3.36% |
| Ezer főre eső születés | log(x) | 22.92% |
| Ezer főre eső születés | diff(log(x)) | 4.49% |
| TTA | x | 44.80% |
| TTA | diff(x) | 2.72% |
| TTA | log(x) | 50.05% |
| TTA | diff(log(x)) | 5.68% |
Megjegyzés: A születési mutatók transzformációin lefutatott kiterjesztett Dickey-Fuller tesztek (trendszűréses tesztek) eredményei alapján megfontolásra kerül mind a három mutató differenciázott és logdifferenciázott idősorán az ARMA modellezés.
x1 = 1:12 #collector vectors
x2 = 1:12
x3 = 1:12
x4 = 1:12
x = ts(LiveBirthAndFertility$LiveBirthTotal)
MyArima = auto.arima(head(x,-10), ic = "aic", trace = F)
x1[1] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[1] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[1] = checkresiduals(MyArima, plot = F)$p.value
x4[1] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(head(x,-10),
ic = "aic",
trace = F,
method = "CSS")
x1[2] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[2] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[2] = checkresiduals(MyArima, plot = F)$p.value
x4[2] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(head(x,-10))), ic = "aic", trace = F)
x1[3] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[3] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[3] = checkresiduals(MyArima, plot = F)$p.value
x4[3] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(x)),
ic = "aic",
trace = F,
method = "CSS")
x1[4] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[4] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[4] = checkresiduals(MyArima, plot = F)$p.value
x4[4] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
x = ts(LiveBirthAndFertility$LiveBirthTo1000)
MyArima = auto.arima(head(x,-10), ic = "aic", trace = F)
x1[5] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[5] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[5] = checkresiduals(MyArima, plot = F)$p.value
x4[5] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(head(x,-10),
ic = "aic",
trace = F,
method = "CSS")
x1[6] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[6] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[6] = checkresiduals(MyArima, plot = F)$p.value
x4[6] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(head(x,-10))), ic = "aic", trace = F)
x1[7] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[7] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[7] = checkresiduals(MyArima, plot = F)$p.value
x4[7] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(x)),
ic = "aic",
trace = F,
method = "CSS")
x1[8] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[8] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[8] = checkresiduals(MyArima, plot = F)$p.value
x4[8] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
x = ts(LiveBirthAndFertility$TotalFertility)
MyArima = auto.arima(head(x,-10), ic = "aic", trace = F)
x1[9] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[9] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[9] = checkresiduals(MyArima, plot = F)$p.value
x4[9] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(head(x,-10),
ic = "aic",
trace = F,
method = "CSS")
x1[10] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[10] = sum(abs(tail(x, 10) - forecast(MyArima, 10)$mean) /
tail(x, 10) * 100) / 10
x3[10] = checkresiduals(MyArima, plot = F)$p.value
x4[10] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(head(x,-10))), ic = "aic", trace = F)
x1[11] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[11] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[11] = checkresiduals(MyArima, plot = F)$p.value
x4[11] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
MyArima = auto.arima(diff(log(x)),
ic = "aic",
trace = F,
method = "CSS")
x1[12] = paste("ARMA (", paste(MyArima$arma[1:2], collapse = ", "), ")", sep =
"")
x2[12] = sum(abs((tail(exp(
cumsum(c(
log(x[1]), MyArima$fitted, forecast(MyArima, 10)$mean
))
), 10) - tail(x, 10))) / tail(x, 10) * 100) / 10
x3[12] = checkresiduals(MyArima, plot = F)$p.value
x4[12] = jarque.bera.test(na.omit(MyArima$residuals))$p.value
df = matrix(ncol = 7, nrow = 12)
df = data.frame(
c(
rep("Összes születés", 4),
rep("Ezer főre eső születés", 4),
rep("TTA", 4)
),
rep(c(
"diff(x)", "diff(x)", "log(diff(x))", "log(diff(x))"
), 3),
x1,
rep(c("ML", "CSS"), 6),
percent(x2 / 100, d = 2),
percent(x3, d = 2),
percent(x4, d = 2)
)
names(df) = c(
"Születési mutató",
"Transzformáció",
"Illesztett modell",
"Becslés módszere",
"MAPE",
"Ljung-Box (p-érték)",
"Jarque-Bera (p-érték)"
)
rownames(df) = NULLkable(df,caption = "ARMA-modellekkel készített ex-post előrejelzések eredményei",align = c("l",rep("c",6))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),full_width = T, fixed_thead = F)| Születési mutató | Transzformáció | Illesztett modell | Becslés módszere | MAPE | Ljung-Box (p-érték) | Jarque-Bera (p-érték) |
|---|---|---|---|---|---|---|
| Összes születés | diff(x) | ARMA (1, 0) | ML | 10.24% | 90.39% | 0.00% |
| Összes születés | diff(x) | ARMA (0, 1) | CSS | 10.50% | 86.79% | 0.00% |
| Összes születés | log(diff(x)) | ARMA (1, 0) | ML | 33.17% | 97.35% | 0.00% |
| Összes születés | log(diff(x)) | ARMA (1, 0) | CSS | 22.27% | 95.40% | 0.00% |
| Ezer főre eső születés | diff(x) | ARMA (0, 1) | ML | 8.77% | 85.52% | 0.00% |
| Ezer főre eső születés | diff(x) | ARMA (0, 1) | CSS | 8.82% | 85.17% | 0.00% |
| Ezer főre eső születés | log(diff(x)) | ARMA (1, 0) | ML | 32.77% | 94.48% | 0.00% |
| Ezer főre eső születés | log(diff(x)) | ARMA (2, 0) | CSS | 20.27% | 93.08% | 0.00% |
| TTA | diff(x) | ARMA (0, 1) | ML | 6.16% | 94.02% | 0.00% |
| TTA | diff(x) | ARMA (0, 1) | CSS | 6.16% | 93.75% | 0.00% |
| TTA | log(diff(x)) | ARMA (0, 1) | ML | 30.75% | 97.68% | 0.00% |
| TTA | log(diff(x)) | ARMA (2, 0) | CSS | 20.76% | 97.53% | 0.00% |
x=auto.arima(head(ts(LiveBirthAndFertility$TotalFertility),-10),
ic = "aic",
trace = F)
#checkresiduals(x)
df=data.frame(x=x$residuals)
ggplot(data = df) +
stat_function(fun = dnorm, args = list(mean = mean(df$x), sd = sd(df$x)),aes(color="Azonos várható értékő és szórású normáleloszlás gyakorisággörbéje"),geom = "area",fill="#244747", size=0,alpha=0.5)+
geom_density(aes(x, color="Reziduumok gyakorisági görbéje"),fill="#e3120b",alpha=0.5,linetype="solid" ,position = "stack",size=1.2) +
scale_color_manual(values = c("Reziduumok gyakorisági görbéje" = "#e3120b","Azonos várható értékő és szórású normáleloszlás gyakorisággörbéje" = "#244747")) +
scale_x_continuous(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0,10)) +
labs(title="Reziduumok eloszlásának vizsgálata gyakorisági görbén",
subtitle = "A TTA-ra illesztett ARIMA(0,1,1) modell reziduumai a normál eloszlásnál csúcsosabb eloszlással rendelkeznek (Leptokurtikus)"
) +
xlab("") +
ylab("") +
MyTheme +
theme(
panel.grid.major = element_line(colour = "white",
size = rel(1)),
panel.grid.major.x = element_line(colour = "white",
size = rel(1)),
legend.title = element_blank(),
legend.position = "none",
)
Ex-post előrejelzéshez használt ARIMA(0,1,1) modell részletei
auto.arima(head(ts(LiveBirthAndFertility$TotalFertility),-10),
ic = "aic",
trace = F,
method = "CSS")## Series: head(ts(LiveBirthAndFertility$TotalFertility), -10)
## ARIMA(0,1,1)
##
## Coefficients:
## ma1
## 0.4503
## s.e. 0.1269
##
## sigma^2 estimated as 0.005255: part log likelihood=58.36
Ex-ante előrejelzéshez használt ARIMA(0,1,1) modell részletei
auto.arima(ts(LiveBirthAndFertility$TotalFertility), ic = "aic", trace = F, method = "CSS")## Series: ts(LiveBirthAndFertility$TotalFertility)
## ARIMA(0,1,1)
##
## Coefficients:
## ma1
## 0.4040
## s.e. 0.1121
##
## sigma^2 estimated as 0.004842: part log likelihood=72.79
x = ts(LiveBirthAndFertility$TotalFertility,
frequency = 1,
start = 1960)
h=10
MyArima=auto.arima(x,ic = "aic",trace = F,method = "CSS")
Myforecast=forecast(MyArima,level = c(95), h = h)
MyFrame=matrix(ncol = 5,nrow = length(x)+h)
MyFrame[,1]=c(1960:(1960+length(x)+h-1))
MyFrame[1:length(x),2]=x
MyFrame[1:length(x),3]=Myforecast$fitted
MyFrame[((length(x)+1):(length(x)+h)),3]=Myforecast$mean
MyFrame[((length(x)+1):(length(x)+h)),4]=Myforecast$lower
MyFrame[((length(x)+1):(length(x)+h)),5]=Myforecast$upper
x=c(1960:(1960+length(Myforecast$x)+h-1))
y1=c(1960:(1960+length(Myforecast$x)+h-1))
for (i in 1:(length(Myforecast$x)+h)) {
y1[i]=as.numeric( MyFrame[i,2])
}
y2=c(Myforecast$fitted,Myforecast$mean)
y3=c(1960:(1960+length(Myforecast$x)+h-1))
for (i in 1:(length(Myforecast$x)+h)) {
y3[i]=as.numeric( MyFrame[i,4])
}
y4=c(1960:(1960+length(Myforecast$x)+h-1))
for (i in 1:(length(Myforecast$x)+h)) {
y4[i]=as.numeric( MyFrame[i,5])
}
df=tbl_df(data.frame(x,y1,y2,y3,y4))
df1=df[1:3]
df2=data.frame(y3=c(rep(NA,lengths(df)[1]),df$y3),y4=c(rep(NA,lengths(df)[1]),df$y4))
df1=df1 %>% gather("variable","value",-"x")
df1["variable"]=ifelse(df1$variable=="y1","Eredeti idősor","Pontbecslés")
df2["x"]=df1["x"]
df2=na.exclude(df2)
ggplot(df) +
geom_ribbon(data=df2,aes(x=x,ymin=y3,ymax=y4,fill="95%-os konfidencia intervallum"), alpha = 0.3) +
geom_line(data=df1,
aes(x=x,y=value,color=variable),size=1.2) +
scale_x_continuous(expand=c(0,0)) +
coord_cartesian(ylim=c(0,2.5)) +
scale_color_manual(values=c("#e3120b","#336666")) +
scale_fill_manual(name = "", values = c("95%-os konfidencia intervallum" = "#336666")) +
ylab("Gyermek/anya")+
xlab("Év")+
labs(title = "Előrejelzés a teljes termékenységi arányszámra", subtitle = "ARIMA (0,1,1) modell, a következő 10 évre") +
MyTheme
3 Nemzetközi összehasonlítás
df=data.frame(c(ifelse(is.na(t(head(FertilityRates,1))),paste(names(FertilityRates),"*",sep=""),names(FertilityRates)),
ifelse(is.na(t(head(FertilityRates,1))),paste(names(FertilityRates),"*",sep=""),names(FertilityRates))),
c(rep("1960",length(FertilityRates)),rep("2017",length(FertilityRates))),
c(t(head(FertilityRates,1)),t(tail(FertilityRates,1))))
names(df)=c("Country","Year","Value")
df=subset(df,Country!="Year")
ggplot(df, aes(x=Country, y=Value,fill=Year)) +
geom_bar(stat="identity",position="dodge",color="black")+
ylab("Gyermek/nő")+
xlab("Ország")+
scale_y_continuous(expand=c(0,0)) +
coord_cartesian(ylim = c(0, 7.5))+
#scale_fill_manual(values=c("#336666", "#e3120b"))+
scale_color_economist() +
expand_limits(y=0) +
labs(title = "A teljes termékenységi arányszám alakulása globálisan",
subtitle ="Az OECD országok és az OECD partnerországainak adatai, 1960-ban és 2017-ben",
caption = "A *-gal jelölt országok esetében nem áll rendelkezésre 1960-as adat."
) +
MyTheme + theme(
axis.text.x = element_text(angle = 90, vjust = 0.45,size = 11),
)
Korreláció számítás a termékenységi ráták között
df = FertilityRates[-1]
df = df[, !names(df) %in% c("OAVG", "EU28")]
Tcor=0
Ncor=0
NNcor=0
Tn=0
Nn=0
NNn=0
for (i in 1:length(df)) {
for (j in 1:length(df)) {
if (i>j) {
x = df[i]
y = df[j]
xy=data.frame(x=x,y=y)
names(xy)=c("x","y")
xy=na.exclude(xy)
Mycor=cor(xy$x,xy$y)
Tcor=Tcor+Mycor
Tn=Tn+1
if (!is.na(NeighbourCountry[i,j])) {
Ncor=Ncor+Mycor
Nn=Nn+1
} else {
NNcor=NNcor+Mycor
NNn=NNn+1
}
}
}
}
cat(paste(
"Összes ország között a korrelációk átlaga: ",
percent(Tcor / Tn, digits = 0 , format = "d"),
"\n",
sep = ""
))
cat(paste(
"Szomszédos országok között a korrelációk átlaga: ",
percent(Ncor / Nn, digits = 0, format = "d"),
"\n",
sep = ""
))
cat(paste(
"Nem szomszédos országok között a korrelációk átlaga: ",
percent(NNcor / NNn, digits = 0, format = "d"),
sep = ""
))Összes ország között a korrelációk átlaga: 73%
Szomszédos országok között a korrelációk átlaga: 83%
Nem szomszédos országok között a korrelációk átlaga: 72%Ezen kalkuláció nyilvánvalóan számos ponton sért módszertani szempontokot, már csak abból a szempontból, hogy mikor két országot tenger határol el egymástól, ott annak megítélés, hogy szomszédosok-e igen szubjektív. Másik szempont, ami miatt a számítások elvégzése helytelen, hogy ezt pusztán olyan országok között tudtam elvégezni, amelyekről adatok elérhetőek az OECD honalpján.
4 Kointegráció tesztelése és hibakorrekciós modell
4.1 Kointegráció tesztelése
df=FertilityRates[-1]
NdiffFertilityRates=vector()
Years=vector()
Delta=vector()
for (i in 1:length(df)) {
x=df[i]
names(x)="x"
x=x$x
x=na.exclude(x)
Delta[i]=tail(x,1)-head(x,1)
x=ts(x)
NdiffFertilityRates[i]=ndiffs(
x,
alpha = 0.05,
test = "adf",
max.d = 10,
selectlags = "AIC",
type = "trend"
)
y=data.frame(y=FertilityRates$Year,x=df[i])
y=na.exclude(y)
Years[i]=paste(min(y$y),"-",max(y$y),sep = "")
}
V=sapply(df, sd,na.rm=T)/sapply(df, mean,na.rm=T)
df=data.frame(Years,Delta,percent(V,d=0),NdiffFertilityRates)
names(df)=c("Megfigyelt évek","Abszolút változás","Varibilitás","Idősor integráltságának rendje")
kable(df,caption="Teljes termékenységi arányszám nemzetközi összehasonlításban", align=c(rep("c",4))) %>%
column_spec(1, width = "1em", border_right = T) %>%
column_spec(5, width = "2em") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),full_width = F, fixed_thead = T)| Megfigyelt évek | Abszolút változás | Varibilitás | Idősor integráltságának rendje | |
|---|---|---|---|---|
| ARG | 1960-2017 | -0.83 | 12% | 0 |
| AUS | 1960-2017 | -1.71 | 24% | 1 |
| AUT | 1960-2017 | -1.17 | 28% | 1 |
| BEL | 1960-2017 | -0.90 | 19% | 2 |
| BGR | 1960-2017 | -0.75 | 22% | 1 |
| BRA | 1960-2017 | -4.36 | 42% | 3 |
| CAN | 1960-2017 | -2.40 | 34% | 0 |
| CHE | 1960-2017 | -0.92 | 23% | 1 |
| CHL | 1960-2017 | -3.33 | 36% | 0 |
| CHN | 1960-2017 | -4.12 | 58% | 0 |
| COL | 1960-2017 | -4.98 | 45% | 0 |
| CRI | 1960-2017 | -4.68 | 40% | 0 |
| CYP | 1982-2017 | -1.16 | 25% | 2 |
| CZE | 1960-2017 | -0.42 | 23% | 1 |
| DEU | 1960-2017 | -0.80 | 25% | 2 |
| DNK | 1960-2017 | -0.79 | 18% | 1 |
| ESP | 1960-2017 | -1.55 | 38% | 2 |
| EST | 1960-2017 | -0.39 | 17% | 2 |
| EU28 | 1960-2017 | -1.00 | 21% | 1 |
| FIN | 1960-2017 | -1.22 | 17% | 2 |
| FRA | 1960-2017 | -0.88 | 18% | 1 |
| GBR | 1960-2017 | -0.98 | 20% | 1 |
| GRC | 1960-2017 | -0.88 | 26% | 2 |
| HRV | 1960-2017 | -0.78 | 15% | 1 |
| HUN | 1960-2017 | -0.53 | 18% | 1 |
| IDN | 1960-2017 | -3.33 | 34% | 0 |
| IND | 1960-2017 | -3.61 | 29% | 2 |
| IRL | 1960-2017 | -1.88 | 31% | 1 |
| ISL | 1960-2017 | -2.55 | 26% | 1 |
| ISR | 1960-2017 | -0.84 | 12% | 1 |
| ITA | 1960-2017 | -1.09 | 30% | 2 |
| JPN | 1960-2017 | -0.57 | 18% | 1 |
| KOR | 1960-2017 | -4.95 | 61% | 1 |
| LTU | 1960-2017 | -0.77 | 21% | 1 |
| LUX | 1960-2017 | -0.89 | 17% | 1 |
| LVA | 1960-2017 | -0.25 | 19% | 2 |
| MEX | 1960-2017 | -4.62 | 42% | 0 |
| MLT | 1980-2017 | -0.73 | 18% | 1 |
| NLD | 1960-2017 | -1.50 | 28% | 2 |
| NOR | 1960-2017 | -1.29 | 21% | 2 |
| NZL | 1960-2017 | -2.43 | 29% | 1 |
| OAVG | 1960-2017 | -1.50 | 24% | 1 |
| PER | 1960-2017 | -4.60 | 37% | 1 |
| POL | 1960-2017 | -1.53 | 27% | 2 |
| PRT | 1960-2017 | -1.73 | 34% | 1 |
| ROU | 1975-2017 | -0.88 | 26% | 2 |
| RUS | 1960-2017 | -0.92 | 20% | 2 |
| SAU | 1960-2017 | -4.73 | 33% | 0 |
| SVK | 1960-2017 | -1.55 | 29% | 1 |
| SVN | 1960-2017 | -0.56 | 23% | 1 |
| SWE | 1960-2017 | -0.42 | 13% | 2 |
| TUR | 1960-2017 | -4.33 | 40% | 1 |
| USA | 1960-2017 | -1.88 | 22% | 0 |
| ZAF | 1960-2017 | -3.61 | 32% | 3 |
Megyjegyzés: Abszolút változás alatt értem, hogy az adott ország termékenységi rátája a megfigyelt időintervallumban a legkorábbi időponttól (néhány kivételtől eltekintve 1960) a legutolsó időpontig (2017) abszolút értékben hány egységgel csökkent. Varibilitás alatt itt a relatív szórást értem, mely definicíó szerint a szórás osztva az átlaggal. Az idősor integráltságának rendjeként pedig azt az ország teljes termékenységi arányszám idősorára vonatkozó számot értem, ami megadja, hogy hányszor került differenciázásra, hogy stacioner legyen.
4.2 Kointegráló országpárok keresése globálisan
df=FertilityRates[-1]
CointOutput = matrix(nrow = length(df),
ncol = length(df),
dimnames = list(names(df), names(df)))
for (i in 1:length(df)) {
for (j in 1:length(df)) {
CointOutput[i,j]=0
if (i!=j) {
if (NdiffFertilityRates[i]==NdiffFertilityRates[j] & NdiffFertilityRates[i]>0) {
Mylm=data.frame(y=df[i], x=df[j])
Mylm=na.exclude(Mylm)
names(Mylm)=c("y","x")
Mylm=lm(y~x,data=Mylm)
x=Mylm$residuals
x=ts(x)
x=ndiffs(
x,
alpha = 0.05,
test = "adf",
max.d = 10,
selectlags = "AIC",
type = "trend"
)
if ((NdiffFertilityRates[i]-1)==x) {
CointOutput[i,j]=2
} else {
CointOutput[i,j]=1
}
}
}
}
}
CointOutput=data.frame(CointOutput)df=data.frame(v=rownames(CointOutput),CointOutput)
df = df %>% gather(key = "variable", value = "Coint",-v)
names(df) = c("x", "y", "Coint")
df[,3]=ifelse(df[,3]==0,"A teszt nem elvégezhető",ifelse(df[,3]==1,"Nem kointegráltak","Kointegráltak"))
ggplot(df, aes(x, y, fill = factor(Coint))) +
geom_tile(color="black") +
labs(title = "Kointegrációs tesztek eredményei") +
scale_fill_manual(values=c("#acc8d4", "#244747", "#8abbd0")) +
xlab("OLS során függő változó")+
ylab("OLS során regresszor")+
MyTheme +
theme(
axis.text.x = element_text(angle = 90, vjust = 0.45,colour = "black", size = 11),
axis.ticks.y = element_line(colour = "black", size=0.6),
axis.ticks.length.y = unit(.2, "cm"),
axis.ticks.x = element_line(colour = "black", size=0.6),
axis.ticks.length.x = unit(.2, "cm"),
axis.line.x = element_blank()
)
df=CointOutput
df=df[-c(19,42),-c(19,42)]
df[,]=df[,]+1
cat(paste("Összes párosítás (OAVG és EU28 nélkül): ",sum(df==3)+sum(df==2)+sum(df==1)-length(df),"\n",sep = ""))
cat(paste("Összes elvégezhető teszt (OAVG és EU28 nélkül): ",sum(df==3)+sum(df==2),"\n",sep = ""))
cat(paste("Összes kointegrálás (OAVG és EU28 nélkül): ",sum(df==3),"\n",sep = ""))
df=(df*NeighbourCountry)
df[is.na(df)] <- 0
cat(paste("Összes szomszédos párosítás: ",sum(df==3)+sum(df==2)+sum(df==1),"\n",sep = ""))
cat(paste("Összes szomszédos elvégezhető teszt: ",sum(df==3)+sum(df==2),"\n",sep = ""))
cat(paste("Összes szomszédos kointegrálás: ",sum(df==3),sep = ""))Összes párosítás (OAVG és EU28 nélkül): 2652
Összes elvégezhető teszt (OAVG és EU28 nélkül): 794
Összes kointegrálás (OAVG és EU28 nélkül): 119
Összes szomszédos párosítás: 170
Összes szomszédos elvégezhető teszt: 72
Összes szomszédos kointegrálás: 19Magyaroszággal kointegráló országok listája
df=subset(CointOutput,select="HUN")
df=data.frame(names(CointOutput),df)
df=subset(df,HUN=="2")
cat(paste("Magyarországgal kointegráló országok (OLS során Magyarország a regresszor): ",paste((df[,1]),collapse = ", "), "\n"))
df=subset(t(CointOutput),select="HUN",HUN="2")
df=data.frame(names(CointOutput),df)
df=subset(df,HUN=="2")
cat(paste("Magyarországgal kointegráló országok (OLS során Magyarország a függő változó): ",paste((df[,1]),collapse = ", ")))Magyarországgal kointegráló országok (OLS során Magyarország a regresszor): CZE, SVK
Magyarországgal kointegráló országok (OLS során Magyarország a függő változó): CZE, SVK4.3 Hibakorrekciós modell (EU28 - Magyarország)
Miután a kointegrációs tesztek lefutattásakor kiderült, hogy Magyarország és az EU28 országának átlaga kointegrál egymással, így érdemes elkészíteni e két idősorból egy hibakorrekciós (VECM) modellt.
HUN <- ts(FertilityRates["HUN"], start = 1960)
CZE <- ts(FertilityRates["CZE"], start = 1960)
HUN_d1 = diff(HUN)
CZE_d1 <- diff(CZE)
MyLm <- lm(HUN ~ CZE)
MyRes <- MyLm$residuals
MyFitted = MyLm$fitted.values
df = matrix(nrow = length(HUN), ncol = 7)
df[, 1] = 1960:2017
df[, 2] = HUN
df[, 3] = CZE
df[, 4] = MyFitted
df[-1, 5] = HUN_d1
df[-1, 6] = CZE_d1
df[, 7] = MyRes
df = data.frame(df)
names(df) = c("Year", "HUN", "CZE", "MyFitted", "HUN_d1", "CZE_d1", "MyRes")
df = df %>% gather(key = "variable", value = "value", -Year)
y = data.frame(unique(df["variable"]), c(1, 1, 1, 2, 2, 3))
df = data.frame(df, MyFacet = plyr::join(df["variable"], y)[, 2])
y = data.frame(unique(df["variable"]),
c("HUN", "CZE", "OLS becslése (HUN)", "HUN", "CZE", "HUN"))
df = data.frame(df, MyCol = plyr::join(df["variable"], y)[, 2])
variable_names = list("1" = "Transzformálatlan idősorok",
"2" = "Differenciázott idősorok (d=1)",
"3" = "OLS maradéktagja")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
ggplot(df, aes(Year, value, color = MyCol)) +
geom_line(size = 2) +
scale_x_continuous(expand = c(0, 0)) +
facet_wrap(~ MyFacet,
scales = "free_y",
ncol = 1,
labeller = variable_labeller) +
labs(title = "A magyar és cseh TTA idősorok között fennálló kointegráció") +
xlab("Év") +
ylab("Gyermek/anya") +
scale_colour_economist() +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75))
)
HUN <- ts(FertilityRates["HUN"], start = 1960)
SVK <- ts(FertilityRates["SVK"], start = 1960)
HUN_d1 = diff(HUN)
SVK_d1 <- diff(SVK)
MyLm <- lm(HUN ~ SVK)
MyRes <- MyLm$residuals
MyFitted = MyLm$fitted.values
df = matrix(nrow = length(HUN), ncol = 7)
df[, 1] = 1960:2017
df[, 2] = HUN
df[, 3] = SVK
df[, 4] = MyFitted
df[-1, 5] = HUN_d1
df[-1, 6] = SVK_d1
df[, 7] = MyRes
df = data.frame(df)
names(df) = c("Year", "HUN", "SVK", "MyFitted", "HUN_d1", "SVK_d1", "MyRes")
df = df %>% gather(key = "variable", value = "value",-Year)
y = data.frame(unique(df["variable"]), c(1, 1, 1, 2, 2, 3))
df = data.frame(df, MyFacet = plyr::join(df["variable"], y)[, 2])
y = data.frame(unique(df["variable"]),
c("HUN", "SVK", "OLS becslése (HUN)", "HUN", "SVK", "HUN"))
df = data.frame(df, MyCol = plyr::join(df["variable"], y)[, 2])
variable_names = list("1" = "Transzformálatlan idősorok",
"2" = "Differenciázott idősorok (d=1)",
"3" = "OLS maradéktagja")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
ggplot(df, aes(Year, value, color = MyCol)) +
geom_line(size = 2) +
scale_x_continuous(expand = c(0, 0)) +
facet_wrap( ~ MyFacet,
scales = "free_y",
ncol = 1,
labeller = variable_labeller) +
labs(title = "A magyar és szlovák TTA idősorok között fennálló kointegráció") +
xlab("Év") +
ylab("Gyermek/anya") +
scale_colour_economist() +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75))
)
HUN <- ts(FertilityRates["HUN"], start = 1960)
CZE <- ts(FertilityRates["CZE"], start = 1960)
MyVECM=VECM(data.frame(HUN, CZE), lag = 1)
df=data.frame(summary(MyVECM)$coefMat)
df[,4]=percent(df[,4],d=2)
df[,1:3]=format(round(df[,1:3],4))
names(df)=c("b","st","t","p")
row.names(df) = c("HUN: Kointegráló vektor","HUN: Konstans","HUN: HUN (-1)","HUN: CZE (-1)",
"CZE: Kointegráló vektor", "CZE: Konstans","CZE: HUN (-1)", "CZE: CZE (-1)")
df %>% mutate(
Variable = row.names(.),
p = cell_spec(p, color = ifelse(p < 0.05, "red", "black"))
) %>%
select (Variable,b,st,t,p) %>%
kable(escape = F,caption = "Hibakorrekciós modell: CZE - HUN",align = c("l",rep("c",4)),
col.names=c("", "Béta","Standard hiba", "T-érték", "P-érték")) %>%
column_spec(1, border_right = T) %>%
kable_styling(bootstrap_options = c("striped", "hover", "responsive"), full_width = F)| Béta | Standard hiba | T-érték | P-érték | |
|---|---|---|---|---|
| HUN: Kointegráló vektor | -0.1184 | 0.0565 | -2.0967 | 4.09% |
| HUN: Konstans | -0.0008 | 0.0093 | -0.0849 | 93.27% |
| HUN: HUN (-1) | 0.3338 | 0.1246 | 2.6789 | 0.99% |
| HUN: CZE (-1) | 0.1400 | 0.1201 | 1.1660 | 24.90% |
| CZE: Kointegráló vektor | 0.1115 | 0.0568 | 1.9632 | 5.50% |
| CZE: Konstans | -0.0063 | 0.0093 | -0.6766 | 50.17% |
| CZE: HUN (-1) | -0.1883 | 0.1254 | -1.5023 | 13.91% |
| CZE: CZE (-1) | 0.7044 | 0.1208 | 5.8302 | 0.00% |
Miután a hibakorrekciós tag a Magyarországra felírt egyenletben szignifikáns, így arra a következtetésre jutunk, hogy Magyarország termékenységi rátája követi az EU28 országának átlagát. A hibakorrekciós tag pedig arra utal, hogy évenként az eltérés 11%-át dolgozza le.
HUN <- ts(FertilityRates["HUN"], start = 1960)
SVK <- ts(FertilityRates["SVK"], start = 1960)
MyVECM=VECM(data.frame(HUN, SVK), lag = 1)
df=data.frame(summary(MyVECM)$coefMat)
df[,4]=percent(df[,4],d=2)
df[,1:3]=format(round(df[,1:3],4))
names(df)=c("b","st","t","p")
row.names(df)=c("HUN: Kointegráló vektor","HUN: Konstans","HUN: HUN (-1)","HUN: SVK (-1)",
"SVK: Kointegráló vektor", "SVK: Konstans","SVK: HUN (-1)", "SVK: SVK (-1)")
df %>% mutate(
Variable = row.names(.),
p = cell_spec(p, color = ifelse(p < 0.05, "red", "black"))
) %>%
select (Variable,b,st,t,p) %>%
kable(escape = F,caption = "Hibakorrekciós modell: HUN - SVK",align = c("l",rep("c",4)),
col.names=c("", "Béta","Standard hiba", "T-érték", "P-érték")) %>%
column_spec(1, border_right = T) %>%
kable_styling(bootstrap_options = c("striped", "hover", "responsive"), full_width = F)| Béta | Standard hiba | T-érték | P-érték | |
|---|---|---|---|---|
| HUN: Kointegráló vektor | -0.0804 | 0.0391 | -2.0576 | 4.47% |
| HUN: Konstans | 0.0067 | 0.0105 | 0.6364 | 52.73% |
| HUN: HUN (-1) | 0.3795 | 0.1230 | 3.0853 | 0.33% |
| HUN: SVK (-1) | 0.2058 | 0.1364 | 1.5085 | 13.75% |
| SVK: Kointegráló vektor | 0.0575 | 0.0355 | 1.6189 | 11.15% |
| SVK: Konstans | -0.0184 | 0.0095 | -1.9375 | 5.81% |
| SVK: HUN (-1) | -0.1070 | 0.1118 | -0.9567 | 34.31% |
| SVK: SVK (-1) | 0.4253 | 0.1240 | 3.4304 | 0.12% |
5 Granger-okság
5.1 Vizsgálat alá vetett változók és azok transzformálása
df=Input[-1]
NdiffInput=vector()
for (i in 1:length(df)) {
x=df[i]
x=na.exclude(x)
x=ts(x)
NdiffInput[i]=ndiffs(x,test="adf",max.d = 5)
}
for (i in 1:length(df)) {
if (NdiffInput[i]>1) {
x=df[i]
x=na.exclude(x)
if (sum(x<0)==0) {
x=diff(log(x))
x=ts(x)
if (ndiffs(x,test="adf",max.d = 5)==0) {
NdiffInput[i]="ld"
}
}
}
}
df = data.frame(NdiffInput)
names(df) = "Alkalmazott differenciák száma"
rownames(df) = names(Input)[-1]
kable(df, caption = "Alkalmazott differenciák száma a magyar gazdasági-társadalmi változókon a satcionaritás biztosításának érdekében", align = "c") %>%
column_spec(2, width = "2em", border_left = T) %>%
column_spec(1, width = "3em") %>%
kable_styling(
bootstrap_options = c("striped", "condensed"),
full_width = F,
fixed_thead = T,
) %>%
footnote(general = "ld-vel jelöltem azokat az esetek, \namelyekben a változó logaritmusának \nvettem elsőrendű differenciáját.")| Alkalmazott differenciák száma | |
|---|---|
| Activs | ld |
| NominalWage | ld |
| RealIncome | 1 |
| Consumption | 1 |
| GDP1960 | 1 |
| GDPCAP1960 | 1 |
| Saving | 1 |
| HouseholdDebt | ld |
| PensionPublic | ld |
| FamilyBenefits | 1 |
| Marriage | 1 |
| UnemploymentM | ld |
| UnemploymentT | ld |
| UnemploymentW | ld |
| P90P10 | ld |
| PovertyRate017 | ld |
| PovertyRate66 | ld |
| PovertyRate1865 | ld |
| PovertyRateTot | ld |
| Gini | ld |
| MDeprivationT | 0 |
| MDeprivation018 | 0 |
| MDeprivation1865 | 0 |
| HousesTotal | 1 |
| HousesRate | 1 |
| CaesareanSections | ld |
| Crime | 1 |
| CriminalYoung | 1 |
| CriminalAdult | 1 |
| CriminalTotal | 1 |
| Note: | |
|
ld-vel jelöltem azokat az esetek, amelyekben a változó logaritmusának vettem elsőrendű differenciáját. |
5.2 Elvégzett Granger-oksági kapcsolatok feltárásának módszertani bemutatása
df = Input[-1]
d_input = matrix(nrow = lengths(df)[1], ncol = length(df))
for (i in 1:length(df)) {
d = NdiffInput[i]
x = data.frame(c(1:lengths(df)[1]), df[i])
x = na.exclude(x)
t = x[, 1]
x = x[, 2]
if (d == "ld") {
x = diff(log(x))
t = t[-1]
d_input[t, i] = x
} else {
d = as.numeric(d)
if (d > 0) {
t = t[-c(1:d)]
x = diff(x, diff = d)
d_input[t, i] = x
} else{
d_input[t, i] = x
}
}
}
d_input = data.frame(d_input)
names(d_input) = names(df)
rownames(d_input) = 1960:2017d_livebirthandfertility=data.frame(
LiveBirthTotal=c(NA,diff(LiveBirthAndFertility$LiveBirthTotal)),
LiveBirthTo1000=c(NA,diff(LiveBirthAndFertility$LiveBirthTo1000)),
TotalFertility=c(NA,diff(LiveBirthAndFertility$TotalFertility))
)
d_livebirthandfertility=head(d_livebirthandfertility,-1)y = c(NA, diff(head(
LiveBirthAndFertility$TotalFertility, -1
)))
Lags = vector()
x_AIC = vector()
y_AIC = vector()
x_cause = vector()
inst_cause = vector()
y_cause = vector()
x = data.frame(d_input$Marriage, y)
names(x) = c("x", "y")
x = na.exclude(x)
x = ts(x)
p = 0
Stop = 0
while (Stop == 0) {
p = p + 1
if (p > 1) {
remove(MyVar)
remove(MyVarSum)
}
try({
MyVar <- vars::VAR((x), p = p, type = "const")
MyVarSum <- summary(MyVar)
}
, silent = T)
if (exists("MyVarSum") == F) {
Stop = 1
} else {
Lags[p] = p
x_AIC[p] = sum(MyVar$varresult$x$residuals * MyVar$varresult$x$residuals) *
exp(2 * (MyVar$varresult$x$rank + 1) / MyVar$obs)
y_AIC[p] = sum(MyVar$varresult$y$residuals * MyVar$varresult$y$residuals) *
exp(2 * (MyVar$varresult$y$rank + 1) / MyVar$obs)
Mytest = causality(MyVar, cause = "x")
x_cause[p] = Mytest$Granger$p.value[1]
inst_cause[p] = Mytest$Instant$p.value[1]
Mytest = causality(MyVar, cause = "y")
y_cause[p] = Mytest$Granger$p.value[1]
}
}
df = data.frame(Lags, x_AIC, y_AIC, x_cause * 100, inst_cause * 100, y_cause *
100)
names(df) = c("Lags", 3, 1, 2, 5, 4)
df = df %>% gather(key = "variable", value = "value",-Lags)
variable_names = list(
"1" = "Modell alapján becsült TTA reziduumaiból számított AIC",
"2" = "Házasság kötések száma Granger-oka-e a TTA-nak : F-próba p-értéke (százalék)",
"3" = "Modell alapján becsült házasság kötések számának reziduumaiból számított AIC",
"4" = "TTA Granger-oka-e a házasságkötések alakulásának : F-próba p-értéke (százalék)",
"5" = "Fennáll-e egy idejű Granger-okság : próba p-értéke (százalék)"
)
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
df2=df
df2[3]=ifelse(df2[2]!=3 & df2[2]!=1, -Inf, NA)
df2["value2"]=ifelse(df2[2]!=3 & df2[2]!=1,5,NA)
names(df2)=c("Lags","variable","value","value2")
ggplot(data = df, aes(Lags, value)) +
geom_ribbon(data=df2,aes(x=Lags,ymin=value, ymax=value2, fill="5%-os szignifikanciaszint"), alpha=0.5) +
scale_fill_manual(values = c("5%-os szignifikanciaszint" = "#f8766d")) +
geom_line(size = 1.2, color="#244747") +
geom_point(
shape=21, fill="#336666", color="#244747",size=3,stroke=1.5) +
scale_x_continuous(expand = c(0, 0)) +
ylab("") +
labs(title = "Granger-oksági tesztek módszertani bemutatása",
subtitle= "A teljes termékenységi arányszám és a házasságkötések számából kapott VAR-modellek eredményei",
caption="A vízszintes tengelyen mindegyik esetben az alkalmazott késleltetések száma szerepel,\nmíg a függőleges tengely az összes esetben a vizsgált mutató szerint értelmezendő") +
xlab("Felhasznált késleltetések száma") +
facet_wrap( ~ variable,
ncol = 1,
scales = "free_y",
labeller = variable_labeller) +
theme_economist(dkpanel = T) + theme(
plot.title = element_text(margin = margin(t = 10, r = 10, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 10, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
legend.title = element_blank()
)
y = c(NA, diff(head(
LiveBirthAndFertility$TotalFertility, -1
)))
GrangerOutput = matrix(nrow = length(d_input), ncol = 4)
for (i in 1:length(d_input)) {
x = data.frame(d_input[i], y)
names(x) = c("x", "y")
x = na.exclude(x)
x = ts(x)
p = 0
Stop = 0
while (Stop == 0) {
p = p + 1
if (p > 1) {
remove(MyVar)
remove(MyVarSum)
}
try({
MyVar <- vars::VAR((x), p = p, type = "const")
MyVarSum <- summary(MyVar)
}
, silent = T)
if (exists("MyVarSum") == F) {
Stop = 1
} else {
ActualAICofx = sum(MyVar$varresult$x$residuals * MyVar$varresult$x$residuals) *
exp(2 * (MyVar$varresult$x$rank + 1) / MyVar$obs)
ActualAICofy = sum(MyVar$varresult$y$residuals * MyVar$varresult$y$residuals) *
exp(2 * (MyVar$varresult$y$rank + 1) / MyVar$obs)
if (p == 1) {
LstAICx = ActualAICofx
LstAICy = ActualAICofy
Cinst = ""
Cx = ""
Cy = ""
}
if (ActualAICofy <= LstAICy) {
LstAICy = ActualAICofy
Mytest = causality(MyVar, cause = "x")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cx == "") {
Cx = p
} else {
Cx = paste(Cx, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
if (ActualAICofx <= LstAICx) {
LstAICx = ActualAICofx
Mytest = causality(MyVar, cause = "y")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cy == "") {
Cy = p
} else {
Cy = paste(Cy, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
}
}
if (Cinst < 0.05) {
if (Cx=="" & Cy=="") {
GrangerOutput[i, 4] = ""
} else {
GrangerOutput[i, 4] = "van"
}
} else {
GrangerOutput[i, 4] = ""
}
GrangerOutput[i, 1] = p-1
GrangerOutput[i, 2] = Cx
GrangerOutput[i, 3] = Cy
}
GrangerOutput = data.frame(NdiffInput, GrangerOutput)
names(GrangerOutput) = c("d","max p","x->y", "x->y", "x-y")
rownames(GrangerOutput) = names(d_input)
kable(GrangerOutput, align =c("c","c","c","c"),caption = "A teljes termékenységi arányszám és a vizsgált gazdasági-társadalmi változók közötti Granger-okság feltárására irányuló próbák eredménye") %>%
kable_styling(bootstrap_options = "striped", full_width = T, fixed_thead = T)| d | max p | x->y | x->y | x-y | |
|---|---|---|---|---|---|
| Activs | ld | 18 | 3 | ||
| NominalWage | ld | 18 | |||
| RealIncome | 1 | 18 | |||
| Consumption | 1 | 18 | 14, 15, 16, 17 | van | |
| GDP1960 | 1 | 18 | |||
| GDPCAP1960 | 1 | 18 | 1, 14 | van | |
| Saving | 1 | 6 | |||
| HouseholdDebt | ld | 6 | 3, 4 | ||
| PensionPublic | ld | 4 | |||
| FamilyBenefits | 1 | 4 | 1 | ||
| Marriage | 1 | 18 | 1, 2 | ||
| UnemploymentM | ld | 5 | 3 | ||
| UnemploymentT | ld | 5 | 3, 5 | 3 | van |
| UnemploymentW | ld | 5 | |||
| P90P10 | ld | 2 | 2 | ||
| PovertyRate017 | ld | 2 | |||
| PovertyRate66 | ld | 2 | |||
| PovertyRate1865 | ld | 2 | |||
| PovertyRateTot | ld | 2 | 2 | ||
| Gini | ld | 2 | 2 | ||
| MDeprivationT | 0 | 3 | |||
| MDeprivation018 | 0 | 3 | 3 | ||
| MDeprivation1865 | 0 | 3 | |||
| HousesTotal | 1 | 18 | 13 | ||
| HousesRate | 1 | 18 | 13 | ||
| CaesareanSections | ld | 3 | |||
| Crime | 1 | 16 | 16 | van | |
| CriminalYoung | 1 | 16 | 11 | ||
| CriminalAdult | 1 | 16 | 9, 11, 12, 13, 15 | 16 | van |
| CriminalTotal | 1 | 16 | 9, 11, 12, 13, 15 | van |
y = c(NA, diff(head(
LiveBirthAndFertility$LiveBirthTo1000, -1
)))
GrangerOutput = matrix(nrow = length(d_input), ncol = 4)
for (i in 1:length(d_input)) {
x = data.frame(d_input[i], y)
names(x) = c("x", "y")
x = na.exclude(x)
x = ts(x)
p = 0
Stop = 0
while (Stop == 0) {
p = p + 1
if (p > 1) {
remove(MyVar)
remove(MyVarSum)
}
try({
MyVar <- vars::VAR((x), p = p, type = "const")
MyVarSum <- summary(MyVar)
}
, silent = T)
if (exists("MyVarSum") == F) {
Stop = 1
} else {
ActualAICofx = sum(MyVar$varresult$x$residuals * MyVar$varresult$x$residuals) *
exp(2 * (MyVar$varresult$x$rank + 1) / MyVar$obs)
ActualAICofy = sum(MyVar$varresult$y$residuals * MyVar$varresult$y$residuals) *
exp(2 * (MyVar$varresult$y$rank + 1) / MyVar$obs)
if (p == 1) {
LstAICx = ActualAICofx
LstAICy = ActualAICofy
Cinst = ""
Cx = ""
Cy = ""
}
if (ActualAICofy <= LstAICy) {
LstAICy = ActualAICofy
Mytest = causality(MyVar, cause = "x")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cx == "") {
Cx = p
} else {
Cx = paste(Cx, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
if (ActualAICofx <= LstAICx) {
LstAICx = ActualAICofx
Mytest = causality(MyVar, cause = "y")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cy == "") {
Cy = p
} else {
Cy = paste(Cy, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
}
}
if (Cinst < 0.05) {
if (Cx=="" & Cy=="") {
GrangerOutput[i, 4] = ""
} else {
GrangerOutput[i, 4] = "van"
}
} else {
GrangerOutput[i, 4] = ""
}
GrangerOutput[i, 1] = p-1
GrangerOutput[i, 2] = Cx
GrangerOutput[i, 3] = Cy
}
GrangerOutput = data.frame(NdiffInput, GrangerOutput)
names(GrangerOutput) = c("d","max p","x->y", "x->y", "x-y")
rownames(GrangerOutput) = names(d_input)
kable(GrangerOutput, align =c("c","c","c","c"),caption = "Az ezer főre jutó éves születésszám és a vizsgált gazdasági-társadalmi változók közötti Granger-okság feltárására irányuló próbák eredménye") %>%
kable_styling(bootstrap_options = "striped", full_width = T, fixed_thead = T)| d | max p | x->y | x->y | x-y | |
|---|---|---|---|---|---|
| Activs | ld | 18 | 18 | van | |
| NominalWage | ld | 18 | 15 | ||
| RealIncome | 1 | 18 | |||
| Consumption | 1 | 18 | 18 | ||
| GDP1960 | 1 | 18 | 17, 18 | van | |
| GDPCAP1960 | 1 | 18 | 17 | van | |
| Saving | 1 | 6 | 6 | van | |
| HouseholdDebt | ld | 6 | 4 | ||
| PensionPublic | ld | 4 | |||
| FamilyBenefits | 1 | 4 | 3, 4 | ||
| Marriage | 1 | 18 | 1, 2, 12, 17 | ||
| UnemploymentM | ld | 5 | 3 | ||
| UnemploymentT | ld | 5 | 3, 4, 5 | van | |
| UnemploymentW | ld | 5 | |||
| P90P10 | ld | 2 | 2 | ||
| PovertyRate017 | ld | 2 | |||
| PovertyRate66 | ld | 2 | |||
| PovertyRate1865 | ld | 2 | |||
| PovertyRateTot | ld | 2 | 2 | ||
| Gini | ld | 2 | 2 | ||
| MDeprivationT | 0 | 3 | |||
| MDeprivation018 | 0 | 3 | |||
| MDeprivation1865 | 0 | 3 | |||
| HousesTotal | 1 | 18 | 2, 6, 13 | 1, 2 | |
| HousesRate | 1 | 18 | 2, 6, 13 | 1, 2 | |
| CaesareanSections | ld | 3 | |||
| Crime | 1 | 16 | |||
| CriminalYoung | 1 | 16 | 11, 12, 16 | van | |
| CriminalAdult | 1 | 16 | 9, 10, 11, 12, 13, 14, 15, 16 | van | |
| CriminalTotal | 1 | 16 | 9, 10, 11, 12, 13, 14, 15 |
# Granger-tests / TotalFertility
y = c(NA, diff(head(
LiveBirthAndFertility$LiveBirthTotal, -1
)))
GrangerOutput = matrix(nrow = length(d_input), ncol = 4)
for (i in 1:length(d_input)) {
x = data.frame(d_input[i], y)
names(x) = c("x", "y")
x = na.exclude(x)
x = ts(x)
p = 0
Stop = 0
while (Stop == 0) {
p = p + 1
if (p > 1) {
remove(MyVar)
remove(MyVarSum)
}
try({
MyVar <- vars::VAR((x), p = p, type = "const")
MyVarSum <- summary(MyVar)
}
, silent = T)
if (exists("MyVarSum") == F) {
Stop = 1
} else {
ActualAICofx = sum(MyVar$varresult$x$residuals * MyVar$varresult$x$residuals) *
exp(2 * (MyVar$varresult$x$rank + 1) / MyVar$obs)
ActualAICofy = sum(MyVar$varresult$y$residuals * MyVar$varresult$y$residuals) *
exp(2 * (MyVar$varresult$y$rank + 1) / MyVar$obs)
if (p == 1) {
LstAICx = ActualAICofx
LstAICy = ActualAICofy
Cinst = ""
Cx = ""
Cy = ""
}
if (ActualAICofy <= LstAICy) {
LstAICy = ActualAICofy
Mytest = causality(MyVar, cause = "x")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cx == "") {
Cx = p
} else {
Cx = paste(Cx, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
if (ActualAICofx <= LstAICx) {
LstAICx = ActualAICofx
Mytest = causality(MyVar, cause = "y")
if (Mytest$Granger$p.value[1] < 0.05) {
if (Cy == "") {
Cy = p
} else {
Cy = paste(Cy, p, sep = ", ")
}
Cinst = Mytest$Instant$p.value[1]
}
}
}
}
if (Cinst < 0.05) {
if (Cx=="" & Cy=="") {
GrangerOutput[i, 4] = ""
} else {
GrangerOutput[i, 4] = "van"
}
} else {
GrangerOutput[i, 4] = ""
}
GrangerOutput[i, 1] = p-1
GrangerOutput[i, 2] = Cx
GrangerOutput[i, 3] = Cy
}
GrangerOutput = data.frame(NdiffInput, GrangerOutput)
names(GrangerOutput) = c("d","max p","x->y", "x->y", "x-y")
rownames(GrangerOutput) = names(d_input)
kable(GrangerOutput, align =c("c","c","c","c"),caption = "Az évenkénti születésszám és a vizsgált gazdasági-társadalmi változók közötti Granger-okság feltárására irányuló próbák eredménye") %>%
kable_styling(bootstrap_options = "striped", full_width = T, fixed_thead = T)| d | max p | x->y | x->y | x-y | |
|---|---|---|---|---|---|
| Activs | ld | 18 | 18 | van | |
| NominalWage | ld | 18 | 16 | ||
| RealIncome | 1 | 18 | |||
| Consumption | 1 | 18 | 17, 18 | ||
| GDP1960 | 1 | 18 | 18 | van | |
| GDPCAP1960 | 1 | 18 | 14 | van | |
| Saving | 1 | 6 | |||
| HouseholdDebt | ld | 6 | 3, 4 | ||
| PensionPublic | ld | 4 | |||
| FamilyBenefits | 1 | 4 | 3, 4 | ||
| Marriage | 1 | 18 | 1, 2, 12, 17 | 2 | |
| UnemploymentM | ld | 5 | 3 | ||
| UnemploymentT | ld | 5 | 3, 4, 5 | ||
| UnemploymentW | ld | 5 | 5 | ||
| P90P10 | ld | 2 | 2 | ||
| PovertyRate017 | ld | 2 | |||
| PovertyRate66 | ld | 2 | |||
| PovertyRate1865 | ld | 2 | |||
| PovertyRateTot | ld | 2 | 2 | ||
| Gini | ld | 2 | 2 | ||
| MDeprivationT | 0 | 3 | |||
| MDeprivation018 | 0 | 3 | |||
| MDeprivation1865 | 0 | 3 | |||
| HousesTotal | 1 | 18 | 2, 6, 13 | 1, 2 | |
| HousesRate | 1 | 18 | 2, 6, 13 | 1, 2 | |
| CaesareanSections | ld | 3 | |||
| Crime | 1 | 16 | |||
| CriminalYoung | 1 | 16 | 11, 12 | ||
| CriminalAdult | 1 | 16 | 9, 10, 11, 12, 13, 14, 15 | ||
| CriminalTotal | 1 | 16 | 9, 10, 11, 12, 13, 14, 15 | 15, 16 | van |
df=data.frame(d_input$Activs,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("Activs","LiveBirthTotal")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=18,type = "const")
p <- data.frame(0:18,irf(MyVar, impulse = "LiveBirthTotal", response = c("Activs","LiveBirthTotal"),
n.ahead = 18, ortho = TRUE)$irf)
names(p)=c("t","2","1")
variable_names = list("1" = "Évenkénti teljes születésszám (d=1)",
"2" = "Aktívak száma (d=ld)"
)
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:18)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller,scale="free") +
labs(title = "A teljes születésszámban bekövetkező sokk lecsapódása a gazdaságilag aktívak számában",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 18") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0), size = 13),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)
df=data.frame(d_input$Activs,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("Activs","LiveBirthTotal")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=18,type = "const")
df=select(data.frame(summary(MyVar)$varresult$Activs$coefficients),Estimate)
df=data.frame(df[seq(from=2, to=nrow(df), by=2),])
df["l"]=1:18
rownames(df)=NULL
df=df[c(2,1)]
names(df)=c("Késleltetések száma","Béta")
kable(df, align = c("c","c"),
caption="Az aktívak számából (d=ld) és a teljes születésszámból a VAR(18) modellben aktívak számára becsült egyenletben szereplő születésszám késleltetett értékeihez tartozó koefficiensek értéke"
)| Késleltetések száma | Béta |
|---|---|
| 1 | -4.1e-06 |
| 2 | -4.4e-06 |
| 3 | -5.0e-07 |
| 4 | -4.0e-06 |
| 5 | -1.8e-06 |
| 6 | -4.9e-06 |
| 7 | -6.0e-07 |
| 8 | -6.0e-07 |
| 9 | -1.6e-06 |
| 10 | -2.9e-06 |
| 11 | -7.0e-07 |
| 12 | -8.0e-07 |
| 13 | -1.7e-06 |
| 14 | -3.0e-06 |
| 15 | -6.0e-07 |
| 16 | -1.2e-06 |
| 17 | -2.0e-07 |
| 18 | -5.0e-06 |
df=data.frame(d_input$Consumption,d_livebirthandfertility$TotalFertility)
names(df)=c("Consumption","TotalFertility")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=17,type = "const")
p <- data.frame(0:17,irf(MyVar, impulse = "Consumption", response = c("Consumption","TotalFertility"),
n.ahead = 17, ortho = TRUE)$irf)
names(p)=c("t","1","2")
variable_names = list("2" = "Teljes termékenységi arányszám (d=1)",
"1" = "Egy főre eső fogyasztás bázisindex (1960=100%) (d=1)"
)
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:17)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller,scale="free") +
labs(title = "Az egy főre eső fogyasztásban bekövetkező sokk lecsapódása a teljes termékenységi arányszámban",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 17") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)
ggplot() +
geom_line(aes(y=diff(log(Input$Consumption)),x=1961:2017), color="#244747", size=2) +
labs(title="Az egy főre eső fogyasztás bázisindexének logdifferenciázott idősora",
caption="Kihasználva, hogy az egymást követő bázisviszonyszámok hányadosainak sorozata az erredeti idősor láncviszonyszámát eredményez,\nilletve, hogy a logdifferencia értéke közelítőleg megegyezik a százalékos változáshoz,\nígy az ábra tartalma az egy főre jutó fogyasztás évenkénti százalékos növekedéseként értelmezhető"
) + xlab("Év") + ylab("") +
scale_x_continuous(expand = c(0,0)) +
MyTheme
df=data.frame(d_input$Consumption,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("Consumption","LiveBirthTotal")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=18,type = "const")
df1 <- data.frame(0:18,irf(MyVar, impulse = "Consumption", response = c("Consumption","LiveBirthTotal"),
n.ahead = 18, ortho = TRUE)$irf)
names(df1)=c("Lags","Consumption","LiveBirthTotal")
df2 <- df1
for (i in 2:nrow(df2)) {
df2[i,2]= df1[i,2]+df2[i-1,2]
df2[i,3]= df1[i,3]+df2[i-1,3]
}
df1=data.frame(c(rep("IRF",nrow(df1)),rep("CIRF",nrow(df1))),
c(rep(df1$Lags,2)),
c(df1$Consumption,rep(NA,nrow(df1))),
c(df1$LiveBirthTotal,rep(NA,nrow(df1)))
)
names(df1)=c("place","Lags","Egy főre eső fogyasztás indexe (d=1)","Teljes születésszám (d=1)")
df1=gather(df1, key=variable, value=value, -c("Lags", "place"))
df1["valuemin"]=ifelse(as.numeric(df1$value)>=0,0,df1$value)
df1["valuemax"]=ifelse(as.numeric(df1$value)<=0,0,df1$value)
names(df2)=c("Lags","Egy főre eső fogyasztás indexe (d=1)","Teljes születésszám (d=1)")
df2["place"]=rep("CIRF",nrow(df2))
df2=gather(df2, key=variable, value=value, -c("Lags", "place"))
ggplot(data=filter(df1,place=="IRF"),aes(x=Lags)) +
geom_ribbon(aes(ymin=valuemin,ymax=valuemax, fill="IRF"), alpha = 0.4, color="#e3120b", size=1) +
scale_fill_manual(values = c("IRF"="#e3120b")) +
geom_line(data=df2, aes(x=Lags, y=value, color="CIRF"), size=2) +
scale_color_manual(values = c("CIRF"="#244747")) +
geom_hline(yintercept = 0) +
facet_wrap(.~variable, scales = "free_y") +
scale_x_continuous(expand = c(0,0)) +
ylab("") + xlab("Sokk óta eltelt évek száma") +
labs(title="A fogyasztás sokkjának születésszámban lecsapódó sokkja",
subtitle = "Impulzus és kumulált impulzus válaszfüggvény"
) +
MyTheme
df=data.frame(d_input$HouseholdDebt,d_livebirthandfertility$TotalFertility)
names(df)=c("HouseholdDebt","TotalFertility")
df=na.exclude(df)
df=ts(df)
MyVar=vars::VAR(df,p=4,type = "const")
p <- data.frame(0:5,irf(MyVar, impulse = "TotalFertility", response = c("HouseholdDebt","TotalFertility"),
n.ahead = 5, ortho = TRUE)$irf)
names(p)=c("t","2","1")
variable_names = list(
"2" = "Háztartások adósságállománya\nrendelkezésre álló jövedelmük \nszázalékában (d=ld)",
"1" = "Teljes termékenységi arányszám\n(d=1)"
)
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:5)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 2,labeller = variable_labeller,scale="free") +
labs(title = "A teljes termékenységi arányszámban bekövetkező sokk lecsapódása a háztartások adósságállományában",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 4") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)
df=data.frame(year=1960:2017,head(LiveBirthAndFertility$TotalFertility,-1),Input$HouseholdDebt)
names(df)=c("year","TTA","HHD")
df=na.exclude(df)
l=3
df$HHD=c(
rep(NA,l),
df$HHD[l:nrow(df)-3]
)
df=na.exclude(df)
ggplot(data=df) +
geom_hline(aes(yintercept = mean(df$HHD),linetype = "Átlag érték" ),size=1,color="black") +
scale_linetype_manual(values= c("Átlag érték" = "dashed")) +
geom_vline(xintercept = mean(df$TTA),linetype = "dashed",size=1,color="black") +
geom_point(aes(x=TTA, y=HHD),shape=21, fill="#8abbd0", color="#8abbd0",size=4,stroke=2, alpha = 0.7) +
geom_abline(aes(color = "Analitikus regressziófüggvény", slope=lm(HHD~TTA, data=df)$coefficients[2], intercept =lm(HHD~TTA, data=df)$coefficients[1]), size=2) +
annotate(
geom = 'segment',
y = Inf,
yend = Inf,
x = -Inf,
xend = Inf,
color="gray",
size= 1.5
) +
ylab("Háztartások adósságállománya 3 évvel később a rendelkezésre\nálló jövedelmük arányában (százalék)") +
xlab("Teljes termékenységi arányszám") +
labs(title = "A háztartások adósságállománya és a TTA közti kapcsolat",
subtitle="A függőleges tengelyen a háztatások jövedelmének 3 évvel későbbi értéke szerepel"
) +
scale_color_manual(values =c("Analitikus regressziófüggvény" = "#e3120b")) +
theme_economist_white(gray_bg = F) + theme(
axis.ticks.length = unit(5, "points"),
axis.ticks.y = element_line(colour = "gray", size=1.1),
axis.ticks.length.y = unit(.3, "cm"),
panel.grid.major = element_blank(),
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
legend.key.size = unit(3,"line")
)
df <- df %>% select(TTA, HHD)
df## # A tibble: 20 x 2
## TTA HHD
## <dbl> <dbl>
## 1 1.32 17.4
## 2 1.28 15.8
## 3 1.32 15.7
## 4 1.31 14.9
## 5 1.30 16.5
## 6 1.27 19.5
## 7 1.27 23.1
## 8 1.30 30.0
## 9 1.34 38.7
## 10 1.31 43.3
## 11 1.35 48.8
## 12 1.32 55.1
## 13 1.25 63.6
## 14 1.23 76.9
## 15 1.34 77.4
## 16 1.34 81.4
## 17 1.41 74.7
## 18 1.44 64.2
## 19 1.49 58.3
## 20 1.49 55.5cor(df)## TTA HHD
## TTA 1.0000000 0.3197472
## HHD 0.3197472 1.0000000lm(HHD~TTA, data=df)##
## Call:
## lm(formula = HHD ~ TTA, data = df)
##
## Coefficients:
## (Intercept) TTA
## -97.06 106.11df=data.frame(d_input$FamilyBenefits,d_livebirthandfertility$TotalFertility)
names(df)=c("FamilyBenefits","TTA")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=1,type = "const")
cat(paste("Családtámogatás előjele a modellben:" ,format(round(MyVar$varresult$TTA$coefficients[1], digits=2))))## Családtámogatás előjele a modellben: -0.16df=data.frame(d_input$Marriage,d_livebirthandfertility$LiveBirthTo1000)
names(df)=c("Marriage","TTA")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=17,type = "const")
p <- data.frame(0:18,irf(MyVar, impulse = "Marriage", response = c("Marriage","TTA"),
n.ahead = 18, ortho = TRUE)$irf)
names(p)=c("t","1","2")
variable_names = list("1" = "Házasságkötések száma (1000 főre eső db) (d=1)",
"2" = "Élveszületések száma (1000 főre eső db) (d=1)")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:18)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller,scale="free") +
labs(title = "Házasságkötések számában bekövetkező sokk lecsapódása",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 17") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)## Warning: The labeller API has been updated. Labellers taking `variable` and
## `value` arguments are now deprecated. See labellers documentation.
df=data.frame(head(LiveBirthAndFertility$LiveBirthTo1000,-1),Input$Marriage)
names(df)=c("y","x")
v=ts(lm(y~x,df)$residuals)
ndiffs(v)## [1] 0ggplot() +
geom_hline(yintercept = 0) +
geom_line(aes(x=1960:2017, y=v), color="#1167a6", size=2) +
scale_x_continuous(expand=c(0,0)) +
xlab("Év") + ylab("") + labs(
title="A születésszám az utóbbi években elmarad a házasságkötések számától",
subtitle="Az ezer főre eső születésszám az ezer főre eső házasságkötések számából számított egyensúlyi értéktől vett eltérése") +
MyTheme
df=data.frame(d_input$UnemploymentT,d_livebirthandfertility$TotalFertility)
names(df)=c("UnemploymentT","TTA")
df=ts(df,start = 1960)
df=na.exclude(df)
MyVar=vars::VAR(df,p=5,type = "const")
p <- data.frame(0:10,irf(MyVar, impulse = "UnemploymentT", response = c("UnemploymentT","TTA"),
n.ahead = 10, ortho = TRUE)$irf)
names(p)=c("t","1","2")
variable_names = list("1" = "Munkanélküliségi ráta (d=ld)",
"2" = "Teljes termékenységi arányszám (d=1)")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:10)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller,scale="free") +
labs(title = "Munkanélküliségben bekövetkező sokk lecsapódása",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 5") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)
df=data.frame(Input$Year,d_input$Gini,d_livebirthandfertility$TotalFertility)
names(df)=c("Year","Gini","TTA")
df=na.exclude(df)
df=gather(df,key = "variable",value="value",-Year )
ggplot(data=df) +
geom_line(aes(x=Year, y=value, color=variable), size=1.5) +
geom_point(aes(x=Year, y=value, color=variable), size=3)+
scale_color_economist() +
xlab("Év") + ylab("") + labs(title = "A Gini-mutató (d=ld) és a teljes termékenységi ráta (d=1) együttmozgása") + scale_x_continuous(expand=c(0,0)) +
MyTheme
df=data.frame(d_input$CriminalTotal,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("CriminalTotal","LiveBirthTotal")
df=na.exclude(df)
df=ts(df,start = 1965)
MyVar=vars::VAR(df,p=16,type = "const")
cat(
paste(
"A VAR(p=16) modell inverz gyökei:",
paste0(format(round(vars::roots(MyVar),2)),
collapse = ", "
)
)
)A VAR(p=16) modell inverz gyökei: 1.12, 1.12, 1.12, 1.07, 1.07, 1.04, 1.04, 1.01, 1.01, 0.99, 0.99, 0.99, 0.99, 0.95, 0.95, 0.94, 0.94, 0.93, 0.93, 0.93, 0.93, 0.93, 0.93, 0.93, 0.93, 0.91, 0.91, 0.86, 0.86, 0.78, 0.78, 0.62df=data.frame(d_input$CriminalTotal,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("CriminalTotal","LiveBirthTotal")
df=na.exclude(df)
df=ts(df,start = 1965)
MyVar=vars::VAR(df,p=12,type = "const")
cat(
paste(
"A VAR(p=12) modell inverz gyökei:",
paste0(format(round(vars::roots(MyVar),2)),
collapse = ", "
)
)
)A VAR(p=12) modell inverz gyökei: 0.97, 0.97, 0.94, 0.94, 0.94, 0.94, 0.93, 0.93, 0.92, 0.92, 0.92, 0.92, 0.92, 0.92, 0.89, 0.89, 0.82, 0.82, 0.71, 0.71, 0.70, 0.70, 0.51, 0.51df=data.frame(d_input$CriminalTotal,d_livebirthandfertility$LiveBirthTotal)
names(df)=c("CriminalTotal","LiveBirthTotal")
df=na.exclude(df)
df=ts(df,start = 1965)
MyVar=vars::VAR(df,p=12,type = "const")
p <- data.frame(0:17,irf(MyVar, impulse = "CriminalTotal", response = c("CriminalTotal","LiveBirthTotal"),
n.ahead = 17, ortho = TRUE)$irf)
names(p)=c("t","1","2")
variable_names = list("1" = "Bűnelkövetők száma (d=1)",
"2" = "Évenkénti összes születésszám (d=1)")
variable_labeller <- function(variable, value) {
return(variable_names[value])
}
p = p %>% gather(key = "variable", value = "value", -t)
ggplot(p, aes(t, value)) +
geom_hline(yintercept=0, color="#244747" ,size=1) +
geom_line(size = 1.5,color="#e3120b") +
scale_x_discrete(expand = c(0, -1),limits=c(0:17)) +
scale_y_continuous(expand = c(0.02,0.02)) +
facet_wrap(~ variable, ncol = 1,labeller = variable_labeller,scale="free") +
labs(title = "Bűnelkövetők számában bekövetkező sokk lecsapódása",subtitle ="Impulzus válasz-függvény",caption="A VAR-modellben szereplő késleltetések száma: 12") +
xlab("Sokkot követően eltelt évek száma") + ylab("") +
theme_economist(dkpanel = T) + theme(
legend.title = element_blank(),
plot.title = element_text(margin = margin(t = 0, r = 0, b = 10, l = 0)),
axis.title = element_text(margin = margin(t = 10, r = 10, b = 0, l = 0)),
axis.ticks.length = unit(5, "points"),
panel.grid.major = element_line(colour = "grey",
size = rel(1.75)),
panel.spacing = unit(3, "lines")
)
v=MyVar$varresult$LiveBirthTotal$coefficients
v=v[seq(from=1, to=length(v)-1, by=2)]
x=sum(v)
cat(
paste(
"A VAR(p=12) modellben a születések számára becsült egyenletben a bűnözők számának késleltetett értékeihez tartozó paraméterek összege:",
format(round(x,2))
)
)A VAR(p=12) modellben a születések számára becsült egyenletben a bűnözők számának késleltetett értékeihez tartozó paraméterek összege: -0.436 Függelék
6.1 Kiinduló adatok bemutatása
Magyarország születési mutatói
Forrás: KSH
LiveBirthAndFertility## # A tibble: 59 x 4
## Year LiveBirthTotal LiveBirthTo1000 TotalFertility
## <dbl> <dbl> <dbl> <dbl>
## 1 1960 146461 14.7 2.02
## 2 1961 140365 14 1.94
## 3 1962 130053 12.9 1.79
## 4 1963 132335 13.1 1.82
## 5 1964 132141 13.1 1.81
## 6 1965 133009 13.1 1.82
## 7 1966 138489 13.6 1.89
## 8 1967 148886 14.6 2.01
## 9 1968 154419 15.1 2.06
## 10 1969 154318 15 2.03
## # ... with 49 more rows
OECD honlapján elérhető termékenységi arányszámok világszerte
Forrás: OECD
FertilityRates## # A tibble: 58 x 55
## Year ARG AUS AUT BEL BGR BRA CAN CHE CHL CHN COL CRI
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1960 3.11 3.45 2.69 2.54 2.31 6.07 3.9 2.44 5.1 5.75 6.81 6.45
## 2 1961 3.1 3.55 2.78 2.63 2.29 6.05 3.84 2.53 5.05 5.92 6.8 6.41
## 3 1962 3.09 3.43 2.8 2.59 2.24 6 3.76 2.6 5 6.09 6.78 6.32
## 4 1963 3.08 3.34 2.82 2.68 2.21 5.94 3.67 2.67 4.93 6.24 6.74 6.2
## 5 1964 3.07 3.15 2.79 2.72 2.19 5.85 3.5 2.68 4.84 6.35 6.67 6.04
## 6 1965 3.06 2.97 2.7 2.62 2.09 5.73 3.15 2.61 4.75 6.4 6.57 5.85
## 7 1966 3.05 2.89 2.66 2.52 2.03 5.6 2.81 2.52 4.63 6.38 6.43 5.63
## 8 1967 3.05 2.85 2.62 2.41 2.02 5.45 2.6 2.41 4.5 6.29 6.25 5.38
## 9 1968 3.05 2.89 2.58 2.31 2.27 5.3 2.45 2.3 4.35 6.13 6.03 5.12
## 10 1969 3.06 2.89 2.49 2.28 2.27 5.15 2.4 2.19 4.19 5.92 5.8 4.86
## # ... with 48 more rows, and 42 more variables: CYP <dbl>, CZE <dbl>,
## # DEU <dbl>, DNK <dbl>, ESP <dbl>, EST <dbl>, EU28 <dbl>, FIN <dbl>,
## # FRA <dbl>, GBR <dbl>, GRC <dbl>, HRV <dbl>, HUN <dbl>, IDN <dbl>,
## # IND <dbl>, IRL <dbl>, ISL <dbl>, ISR <dbl>, ITA <dbl>, JPN <dbl>,
## # KOR <dbl>, LTU <dbl>, LUX <dbl>, LVA <dbl>, MEX <dbl>, MLT <dbl>,
## # NLD <dbl>, NOR <dbl>, NZL <dbl>, OAVG <dbl>, PER <dbl>, POL <dbl>,
## # PRT <dbl>, ROU <dbl>, RUS <dbl>, SAU <dbl>, SVK <dbl>, SVN <dbl>,
## # SWE <dbl>, TUR <dbl>, USA <dbl>, ZAF <dbl>
További mutatószámok Magyarországról, amelyeket a feldolgozott szakirodalom alapján helyeztem kutatásom fókuszába
Forrás: OECD/KSH/EUROSTAT
Input## # A tibble: 58 x 31
## Year Activs NominalWage RealIncome Consumption GDP1960 GDPCAP1960 Saving
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1960 4735 1575 100 100 100 100 NA
## 2 1961 4626 1599 100 101 105 94.5 NA
## 3 1962 4544 1638 102 104 111 95.3 NA
## 4 1963 4569 1702 106 109 117 92.3 NA
## 5 1964 4653 1757 109 114 123 90.5 NA
## 6 1965 4649 1766 109 115 124 92.3 NA
## 7 1966 4666 1856 112 121 133 98.1 NA
## 8 1967 4710 1915 116 128 143 104. NA
## 9 1968 4802 1928 118 134 150 109. NA
## 10 1969 4979 2012 123 140 161 116. NA
## # ... with 48 more rows, and 23 more variables: HouseholdDebt <dbl>,
## # PensionPublic <dbl>, FamilyBenefits <dbl>, Marriage <dbl>,
## # UnemploymentM <dbl>, UnemploymentT <dbl>, UnemploymentW <dbl>,
## # P90P10 <dbl>, PovertyRate017 <dbl>, PovertyRate66 <dbl>,
## # PovertyRate1865 <dbl>, PovertyRateTot <dbl>, Gini <dbl>,
## # MDeprivationT <dbl>, MDeprivation018 <dbl>, MDeprivation1865 <dbl>,
## # HousesTotal <dbl>, HousesRate <dbl>, CaesareanSections <dbl>, Crime <dbl>,
## # CriminalYoung <dbl>, CriminalAdult <dbl>, CriminalTotal <dbl># List of neighbours during the calculations --------------
df=matrix(nrow=length(NeighbourCountry),ncol = 2)
df[,1]=names(NeighbourCountry)
for (i in 1:length(NeighbourCountry)) {
v=ifelse(!is.na(NeighbourCountry[i,]),names(NeighbourCountry),"NA")
v=v[!v %in% "NA"]
df[i,2]=paste(v,collapse = ", ")
}
df=data.frame(df)
names(df)=c("Ország","Szomszédjának tekintett ország")
kable(df,caption = "Számítások során szomszédosnak tekintés",align = c("c","l")) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = F, fixed_thead = T) %>%
column_spec(1, width = "1em", border_right = T)| Ország | Szomszédjának tekintett ország |
|---|---|
| ARG | BRA, CHL |
| AUS | IDN, NZL |
| AUT | CHE, CZE, DEU, HUN, ITA, SVK, SVN |
| BEL | DEU, FRA, GBR, LUX, NLD |
| BGR | GRC, ROU, TUR |
| BRA | ARG, COL, PER |
| CAN | USA |
| CHE | AUT, DEU, FRA, ITA |
| CHL | ARG, PER |
| CHN | IND, KOR, RUS |
| COL | BRA, PER |
| CRI | |
| CYP | ISR, TUR |
| CZE | AUT, DEU, POL, SVK |
| DEU | AUT, BEL, CHE, CZE, DNK, FRA, LUX, NLD, POL, SWE |
| DNK | DEU, NLD, NOR, SWE |
| ESP | FRA, ITA, PRT |
| EST | FIN, LVA, RUS |
| FIN | EST, NOR, RUS, SWE |
| FRA | BEL, CHE, DEU, ESP, GBR, ITA, LUX |
| GBR | BEL, FRA, IRL, ISL, NLD, NOR |
| GRC | BGR, ITA, TUR |
| HRV | HUN, ITA, SVN |
| HUN | AUT, HRV, ROU, SVK, SVN |
| IDN | AUS, IND |
| IND | CHN, IDN |
| IRL | GBR, ISL |
| ISL | GBR, IRL, NOR |
| ISR | CYP, SAU |
| ITA | AUT, CHE, ESP, FRA, GRC, HRV, MLT, SVN |
| JPN | KOR, RUS |
| KOR | CHN, JPN |
| LTU | LVA, POL, SWE |
| LUX | BEL, DEU, FRA |
| LVA | EST, LTU, RUS |
| MEX | USA |
| MLT | ITA |
| NLD | BEL, DEU, DNK, GBR |
| NOR | DNK, FIN, GBR, ISL, RUS, SWE |
| NZL | AUS |
| PER | BRA, CHL, COL |
| POL | CZE, DEU, LTU, SVK, SWE |
| PRT | ESP |
| ROU | BGR, HUN |
| RUS | CHN, EST, FIN, JPN, LVA, NOR |
| SAU | ISR |
| SVK | AUT, CZE, HUN, POL |
| SVN | AUT, HRV, HUN, ITA |
| SWE | DEU, DNK, FIN, LTU, NOR, POL |
| TUR | BGR, CYP, GRC |
| USA | CAN, MEX |
| ZAF |
d_livebirthandfertility## # A tibble: 58 x 3
## LiveBirthTotal LiveBirthTo1000 TotalFertility
## <dbl> <dbl> <dbl>
## 1 NA NA NA
## 2 -6096 -0.700 -0.0853
## 3 -10312 -1.10 -0.145
## 4 2282 0.200 0.0284
## 5 -194 0 -0.00512
## 6 868 0 0.00664
## 7 5480 0.5 0.0649
## 8 10397 1 0.125
## 9 5533 0.5 0.0515
## 10 -101 -0.1000 -0.0305
## # ... with 48 more rowsd_input## # A tibble: 58 x 30
## Activs NominalWage RealIncome Consumption GDP1960 GDPCAP1960 Saving
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 NA NA NA NA NA NA NA
## 2 -2.33e-2 0.0151 0 1 5 -5.46 NA
## 3 -1.79e-2 0.0241 2 3 6 0.710 NA
## 4 5.49e-3 0.0383 4 5 6 -2.92 NA
## 5 1.82e-2 0.0318 3 5 6 -1.84 NA
## 6 -8.60e-4 0.00511 0 1 1 1.84 NA
## 7 3.65e-3 0.0497 3 6 9 5.76 NA
## 8 9.39e-3 0.0313 4 7 10 6.36 NA
## 9 1.93e-2 0.00677 2 6 7 4.19 NA
## 10 3.62e-2 0.0426 5 6 11 6.97 NA
## # ... with 48 more rows, and 23 more variables: HouseholdDebt <dbl>,
## # PensionPublic <dbl>, FamilyBenefits <dbl>, Marriage <dbl>,
## # UnemploymentM <dbl>, UnemploymentT <dbl>, UnemploymentW <dbl>,
## # P90P10 <dbl>, PovertyRate017 <dbl>, PovertyRate66 <dbl>,
## # PovertyRate1865 <dbl>, PovertyRateTot <dbl>, Gini <dbl>,
## # MDeprivationT <dbl>, MDeprivation018 <dbl>, MDeprivation1865 <dbl>,
## # HousesTotal <dbl>, HousesRate <dbl>, CaesareanSections <dbl>, Crime <dbl>,
## # CriminalYoung <dbl>, CriminalAdult <dbl>, CriminalTotal <dbl>