Práca s databázou - World population

# Load data
udaje <- read.csv("world_population.csv", dec=".", sep=",", header = TRUE)

# Select relevant variables for prediction
udaje_pred <- udaje[, c("Country.Territory","X2020.Population", "X2015.Population",
                        "Growth.Rate", "Continent")]

# Median imputation for numeric variables
numeric_cols <- c("X2020.Population", "X2015.Population", "Growth.Rate")
column_medians <- sapply(udaje_pred[, numeric_cols], median, na.rm = TRUE)
for (col in numeric_cols) {
  udaje_pred[[col]][is.na(udaje_pred[[col]])] <- column_medians[col]
}

# Log-transform for modeling
udaje_pred$log_pop <- log(udaje_pred$X2020.Population)
udaje_pred$log_pop15 <- log(udaje_pred$X2015.Population)

# Dataset ready for predictive modeling
udaje <- udaje_pred

Čo skúmame:

• Pripravujeme dáta na predikciu budúcej populácie.

• Chýbajúce hodnoty dopĺňame mediánom, aby model fungoval správne.

• Log-transformácia populácie stabilizuje extrémne rozdiely medzi malými a veľkými krajinami.

# Pre budúcu populáciu nás najviac zaujíma historická populácia a rast
xvars <- udaje[, c("X2015.Population", "Growth.Rate")]
round(cor(xvars), 3)

                 X2015.Population Growth.Rate
X2015.Population            1.000      -0.032
Growth.Rate                -0.032       1.000

Teraz zisťujeme, ako sú medzi sebou prepojené historická populácia a ročný rast. Väčšinou historická populácia a Growth.Rate nie sú silne korelované → obe môžu byť použité ako prediktory pre budúcu populáciu.

pairs(xvars,
      main = "Scatterplotová matica – historická populácia a Growth Rate")

Vizualizujeme vzťah medzi historickou populáciou a rastom a pozrieme sa, či existujú extrémne hodnoty alebo netypické krajiny.

Ako môžme vidieť, väčšina krajín sa nachádza v stabilnom pásme rastu, niektoré majú extrémne hodnoty, ktoré môžu ovplyvniť predikciu.

library(car)
vif(model)

       Area..km.. Density..per.km..       Growth.Rate 
         1.004343          1.009057          1.005232 

X <- model.matrix(model)[, -1]
XtX <- t(X) %*% X
eig <- eigen(XtX)

condition_number <- sqrt(max(eig$values) / min(eig$values))
condition_number

[1] 1980890

Chceme zistiť, ako historická populácia, rast a kontinent vplývajú na populáciu 2020. Model nám zároveň slúži na overenie predikčnej schopnosti.

# Model predikcie populácie 2020
model_pred <- lm(log_pop ~ log_pop15 + Growth.Rate + Continent, data = udaje)
summary(model_pred)

Call:
lm(formula = log_pop ~ log_pop15 + Growth.Rate + Continent, data = udaje)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.228477 -0.018980  0.001669  0.020626  0.181035 

Coefficients:
                        Estimate Std. Error t value Pr(>|t|)    
(Intercept)            -2.274370   0.267180  -8.513 2.39e-15 ***
log_pop15               0.999371   0.001313 761.114  < 2e-16 ***
Growth.Rate             2.347058   0.262618   8.937  < 2e-16 ***
ContinentAsia          -0.021732   0.009384  -2.316 0.021465 *  
ContinentEurope        -0.057497   0.010139  -5.671 4.32e-08 ***
ContinentNorth America -0.041139   0.010860  -3.788 0.000195 ***
ContinentOceania       -0.048714   0.012870  -3.785 0.000197 ***
ContinentSouth America -0.024168   0.013950  -1.732 0.084559 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.04529 on 226 degrees of freedom
Multiple R-squared:  0.9997,    Adjusted R-squared:  0.9997 
F-statistic: 1.25e+05 on 7 and 226 DF,  p-value: < 2.2e-16

Historická populácia je najsilnejší prediktor.

Growth.Rate má pozitívny vplyv – krajiny s vyšším rastom budú väčšie.

Kontinent zachytáva regionálne rozdiely (napr. Európa má priemerne menšiu populáciu pri rovnakej historickej veľkosti).

# Spätná transformácia na počet obyvateľov
udaje$pred_pop2020 <- exp(predict(model_pred, newdata = udaje))

# Predikcia podľa Growth.Rate
udaje$pred_pop2025 <- udaje$X2020.Population * (1 + udaje$Growth.Rate)^5
udaje$pred_pop2030 <- udaje$X2020.Population * (1 + udaje$Growth.Rate)^10


# --- Výber konkrétnych krajín ---
vybrane_krajiny <- c("Slovakia", 
                     "Czech Republic", 
                     "Hungary", 
                     "Austria", 
                     "Ukraine", 
                     "Poland")

# Filtrovanie podľa názvu krajiny
udaje_vybrane <- udaje[udaje$Country.Territory %in% vybrane_krajiny, ]


# --- Zobrazenie výsledku ---
udaje_vybrane[, c("Country.Territory", 
                  "X2020.Population", 
                  "pred_pop2020", 
                  "pred_pop2025", 
                  "pred_pop2030")]

Predikujeme populáciu do budúcnosti (2025 a 2030) pomocou Growth.Rate. Umožňuje nám odhadnúť rast a porovnať ho medzi krajinami.

Keď sa pozrieme na naše výsledky, vidíme, že východiskové hodnoty populácie v roku 2020 zodpovedajú reálnym počtom obyvateľov v jednotlivých krajinách. Model však pri dlhodobej predikcii (najmä smerom k roku 2030) generuje extrémne vysoké čísla. Toto sa deje preto, že sme použili jednoduchý výpočet založený na exponenciálnom raste, ktorý pri dlhšom období veľmi preháňa výsledky.

V krátkodobom horizonte (do roku 2025) sú predpovede ešte relatívne podobné realite – populácia sa mení len mierne. V dlhodobom horizonte (rok 2030) už model predpovedá nereálne vysoký nárast, takže tieto čísla nevnímame ako skutočnú predpoveď, ale skôr ako ukážku toho, ako rýchlo vie populácia narásť, keď necháme v modeli pôsobiť rastovú mieru bez obmedzenia.

Krajinám môžeme pripísať tieto trendy:

Slovensko, Česko, Rakúsko, Maďarsko a Poľsko – krátkodobo stabilné, bez veľkých zmien.

Ukrajina – krátkodobo skôr pokles, čo zodpovedá realite.

Dlhodobé výsledky – sú enormné vo všetkých krajinách, čo znamená, že exponenciálny model nie je vhodný na dlhé časové obdobie.

X <- model.matrix(model_centered)[, -1]
XtX <- t(X) %*% X
eig <- eigen(XtX)

condition_number <- sqrt(max(eig$values) / min(eig$values))
condition_number

[1] 1.09998

udaje$GrowthRate_c <- scale(udaje$Growth.Rate, center=TRUE, scale=TRUE)
model_centered <- lm(log_pop ~ log_pop15 + GrowthRate_c + Continent, data = udaje)
summary(model_centered)

Call:
lm(formula = log_pop ~ log_pop15 + GrowthRate_c + Continent, 
    data = udaje)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.228477 -0.018980  0.001669  0.020626  0.181035 

Coefficients:
                        Estimate Std. Error t value Pr(>|t|)    
(Intercept)             0.095167   0.021598   4.406 1.62e-05 ***
log_pop15               0.999371   0.001313 761.114  < 2e-16 ***
GrowthRate_c            0.031415   0.003515   8.937  < 2e-16 ***
ContinentAsia          -0.021732   0.009384  -2.316 0.021465 *  
ContinentEurope        -0.057497   0.010139  -5.671 4.32e-08 ***
ContinentNorth America -0.041139   0.010860  -3.788 0.000195 ***
ContinentOceania       -0.048714   0.012870  -3.785 0.000197 ***
ContinentSouth America -0.024168   0.013950  -1.732 0.084559 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.04529 on 226 degrees of freedom
Multiple R-squared:  0.9997,    Adjusted R-squared:  0.9997 
F-statistic: 1.25e+05 on 7 and 226 DF,  p-value: < 2.2e-16

library(MASS)

# Matrix-based analysis for predictive variables
X <- as.matrix(udaje[, c("log_pop15", "Growth.Rate")])  # historická populácia a rast
y <- udaje$log_pop  # log-populácia 2020

lambda <- 0.01  # regularizačný parameter pre Ridge (môžeš upraviť)
A <- t(X) %*% X
AInv <- solve(A)
Alam <- t(X) %*% X + lambda * diag(ncol(X))
AlamInv <- solve(Alam)

cat("lambda =", lambda, "\n")

lambda = 0.01 

cat("Matrix A:\n"); print(A)

Matrix A:
            log_pop15 Growth.Rate
log_pop15   53207.913   3504.1094
Growth.Rate  3504.109    238.5454

cat("Matrix Alam (regularized):\n"); print(Alam)

Matrix Alam (regularized):
            log_pop15 Growth.Rate
log_pop15   53207.923   3504.1094
Growth.Rate  3504.109    238.5554

cat("Inverse of A:\n"); print(AInv)

Inverse of A:
                log_pop15 Growth.Rate
log_pop15    0.0005765852 -0.00846974
Growth.Rate -0.0084697403  0.12860820

cat("Inverse of Alam:\n"); print(AlamInv)

Inverse of Alam:
                log_pop15  Growth.Rate
log_pop15    0.0005758655 -0.008458813
Growth.Rate -0.0084588128  0.128442299

cat("Eigenvalues of A:\n"); print(eigen(A)$values)

Eigenvalues of A:
[1] 53438.716800     7.741971

cat("Eigenvalues of Alam:\n"); print(eigen(Alam)$values)

Eigenvalues of Alam:
[1] 53438.726800     7.751971

Celkové zistenie:

Historická populácia je najsilnejším prediktorom budúcej populácie.

Growth.Rate umožňuje predikciu rastu do budúcnosti (2025, 2030).

Kontinent zachytáva regionálne rozdiely.

Model umožňuje praktickú predikciu budúcej populácie pre všetky krajiny a jej porovnanie medzi regiónmi.

Na základe našej analýzy môžeme povedať, že model funguje dobre na krátkodobú projekciu, ale pri dlhšom časovom horizonte dochádza k výraznému nadhodnocovaniu populácie. Preto tieto výsledky skôr ukazujú, ako veľmi dokáže model reagovať na rastovú mieru, než to, ako bude populácia v skutočnosti vyzerať.