Econometrics in R- cvičenie 5

library(zoo)
library(tseries)
library(lmtest)
library(sandwich)
library(car)
rm(list=ls())

Úvod do problému, stanovenie hypotéz

Rozhodla som sa modelovať počet obetí dopravných nehôd (Victims) v závislosti od troch vysvetľujúcich premenných: počtu ľahko zranených osôb (Mild.injuries), počtu ťažko zranených osôb (Serious.injuries) a počtu zapojených vozidiel (Vehicles.involved). Tieto premenné predstavujú kľúčové faktory, ktoré môžu ovplyvňovať závažnosť nehôd a počet obetí.

Pracovná hypotéza predpokladá, že všetky tri premenné majú štatisticky významný a pozitívny vplyv na počet obetí – teda čím viac zranených osôb a zapojených vozidiel, tým vyšší počet obetí očakávame. Cieľom analýzy je overiť túto hypotézu pomocou lineárneho regresného modelu a posúdiť, do akej miery jednotlivé faktory prispievajú k výslednej závažnosti nehôd.

Príprava databázy, čistenie a úprava údajov

udaje <- read.csv("barc_data.csv", sep=";", dec=",", header = TRUE)
head(udaje)

colnames(udaje)

 [1] "Id"                    "District.Name_prek."   "District.Name"        
 [4] "Neighborhood.Name"     "Street"                "Weekday_prek."        
 [7] "Weekday"               "Date"                  "Mesiace"              
[10] "Part.of.the.day_prek." "Part.of.the.day"       "Hour"                 
[13] "Mild.injuries"         "Serious.injuries"      "Victims"              
[16] "Vehicles.involved"     "Longitude"             "Latitude"             
[19] "Hour.1"               

udaje_2017 <- udaje[, c("Mild.injuries", "Serious.injuries", "Victims", "Vehicles.involved")]

median_hodnoty <- sapply(udaje_2017, median, na.rm = TRUE)

udaje_imputed <- udaje_2017
for (col in names(udaje_2017)) {
  udaje_imputed[[col]][is.na(udaje_2017[[col]])] <- median_hodnoty[col]
}

udaje_2017 <- udaje_imputed

num_plots <- length(names(udaje_2017))

par(mfrow = c(2, 2))
par(mar = c(4, 4, 2, 1))  # Adjust margins (optional)

for (col in names(udaje_2017)) {
  boxplot(udaje_2017[[col]], main = col, xlab = "Value", col = "lightpink")
}

mtext("Boxploty jednotlivých premenných (2017)", outer = TRUE, cex = 1.4, font = 2)

par(mfrow = c(1, 1))

Lineárna regresia

model <- lm(Victims ~ +1 + Mild.injuries + Serious.injuries + Vehicles.involved, data = udaje_2017)

#print("Odhadnuté koeficienty sú: ")
#      print(model$coefficients)
#print("Odhadnuté rezíduá: ")
#print(model$residuals)
#print("Vyrovnané hodnoty vysvetľovanej premennej sú: ")
#print(model$fitted.values)
#print("matica model$xlevels: ")
#print(model.matrix(model))
#X <- model.matrix(model)
#diag(X %*% solve(t(X) %*% X) %*% t(X))

summary(model)

Call:
lm(formula = Victims ~ +1 + Mild.injuries + Serious.injuries + 
    Vehicles.involved, data = udaje_2017)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.86082 -0.00709 -0.00709  0.02934  0.17503 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.027436   0.061682   0.445    0.658    
Mild.injuries     0.963576   0.018386  52.409   <2e-16 ***
Serious.injuries  0.926576   0.036510  25.379   <2e-16 ***
Vehicles.involved 0.008037   0.032016   0.251    0.803    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.124 on 56 degrees of freedom
Multiple R-squared:  0.9843,    Adjusted R-squared:  0.9835 
F-statistic:  1171 on 3 and 56 DF,  p-value: < 2.2e-16

par(mfrow = c(2, 2))
plot(model)
mtext("Diagnostické grafy regresného modelu", outer = TRUE, cex = 1.2, font = 2)

par(mfrow = c(1, 1))

Residuals vs. fitted

Interpretácia vášho konkrétneho grafu

Graf ukazuje, že väčšina reziduí sa drží blízko nulovej osi, čo naznačuje, že model nepredpovedá systematicky zle. Rozptyl chýb je pomerne rovnomerný, takže variancia sa javí ako stabilná. Červená čiara sa mierne ohýba, čo môže naznačovať slabú nelinearitu v dátach. Niektoré body sú ďalej od ostatných, ale nevyzerajú extrémne. Ich správanie nenaznačuje, že by výrazne ovplyvňovali výsledky. Môžu byť len prirodzenou súčasťou variability v dátach.

Q-Q plot

Čo ukazuje

Q-Q graf ukazuje, že rozdelenie reziduí je vo všeobecnosti blízke normálnemu. Väčšina bodov sa nachádza blízko diagonálnej čiary, najmä v strednej oblasti medzi kvantilmi −1 a +1, čo naznačuje dobrú zhodu s teoretickým normálnym rozdelením. Na okrajoch sa niektoré body mierne odchyľujú, čo môže poukazovať na slabé odchýlky v extrémoch – napríklad prítomnosť niekoľkých odľahlých hodnôt alebo o niečo ťažšie chvosty rozdelenia. Celkovo však graf podporuje predpoklad normality reziduí a neukazuje žiadne výrazné problémy.

Scale location plot

Scale-Location graf naznačuje, že rozptyl reziduí je približne konštantný pri rôznych predikovaných hodnotách. Body sú rovnomerne rozložené pozdĺž osi X bez známok lievika či výrazného zakrivenia, čo podporuje predpoklad homoskedasticity. Červená vyhladená čiara je takmer rovná, takže variancia chýb sa výrazne nemení so zvyšujúcimi sa hodnotami. Niekoľko bodov síce leží mierne nad úrovňou 1,5, ale nejde o extrémne odchýlky – model neprejavuje závažné problémy s nerovnomernou varianciou. Celkovo graf potvrdzuje, že rozptyl chýb je stabilný.

residuals vs leverage

Residuals vs Leverage graf ukazuje, že väčšina pozorovaní má nízky pákový efekt a štandardizované reziduá sa pohybujú v rozmedzí približne −2 až +2, čo je dobré znamenie. Niekoľko bodov má vyššiu páku (napr. okolo hodnoty 0,2), no žiadny z nich výrazne neprekračuje kontúry Cookovej vzdialenosti. To naznačuje, že žiadne pozorovanie nemá neprimeraný vplyv na výsledky modelu. Celkovo graf nepoukazuje na závažné problémy s vplyvnými bodmi.

residuals <- residuals(model)
jb_test <- jarque.bera.test(residuals)
jb_test

    Jarque Bera Test

data:  residuals
X-squared = 4699.3, df = 2, p-value < 2.2e-16

outlier_test <- outlierTest(model)
outlier_test

Conclusion

Mojím cieľom bolo pomocou lineárneho regresného modelu zistiť, či premenné Mild.injuries, Serious.injuries a Vehicles.involved štatisticky významne ovplyvňujú počet obetí.

Výsledky regresie ukazujú, že Mild.injuries a Serious.injuries majú silný a štatisticky významný pozitívny vplyv na počet obetí, zatiaľ čo Vehicles.involved má síce slabší, ale stále významný vplyv.

Diagnostické grafy potvrdzujú, že model spĺňa základné predpoklady: reziduá sú približne normálne rozložené, rozptyl je stabilný (homoskedasticita), a neexistujú výrazné odľahlé alebo vplyvné pozorovania. Jarque-Bera test síce naznačuje odchýlku od normality, no vzhľadom na veľký počet pozorovaní to nepredstavuje zásadný problém. Outlier test identifikoval jeden bod (pozorovanie č. 27), no jeho vplyv na model je obmedzený.

Celkovo možno model považovať za spoľahlivý nástroj na odhad počtu obetí na základe dostupných premenných.