Práca s databázou - import údajov, grafy, štatistiky

knitr::opts_chunk$set(
    echo = TRUE,
    message = FALSE,
    warning = FALSE
)

Import a náhľad údaje

Dataset barc_data.csv z roku 2017 obsahuje informácie o dopravných nehodách v Barcelone.

udaje <- read.csv2("barc_data.csv",header=TRUE,sep=";",dec=".")
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"               

Grafy

library(dplyr)

barc_data <- udaje %>%
  filter(Date == 2017-04-19) %>%
  select(Weekday, Mild.injuries, Vehicles.involved, Longitude, Latitude)

Scatter plot

Graf znázorňuje vzťah medzi počtom vozidiel zapojených do nehôd a ich zemepisnou dĺžkou. Údaje sú rozdelené podľa časti dňa (ráno, popoludnie, noc), takže vidíme, kedy sa nehody s viacerými vozidlami vyskytujú častejšie. Farby bodov označujú dni v týždni, čo umožňuje porovnať, v ktoré dni a kde sa nehody najčastejšie stávajú.

Z grafu môžeme vidieť, že ráno a popoludní dochádza k viac nehodám s viacerými vozidlami, v noci je ich menej. Nehody sa vyskytujú v rôznych častiach mesta, pričom okolie zemepisnej dĺžky cca 2,15–2,18 má viac nehôd. V utorok a štvrtok vidíme v popoludňajších hodinách viac nehôd s viacerými vozidlami, čo môže súvisieť s hustou premávkou počas pracovného týždňa. Naopak, cez víkend je týchto prípadov menej, čo naznačuje pokojnejšiu dopravnú situáciu.

barc_data <- read.csv("barc_data.csv", sep = ";", stringsAsFactors = FALSE)

# Premenila som stĺpce na číselné hodnoty
barc_data$Vehicles.involved <- as.numeric(barc_data$Vehicles.involved)
barc_data$Longitude <- as.numeric(gsub(",", ".", barc_data$Longitude))
barc_data$Part.of.the.day <- factor(barc_data$Part.of.the.day)

library(ggplot2)
ggplot(barc_data, aes(x = Vehicles.involved, y = Longitude, color = Weekday)) +
  geom_point(size = 4, alpha = 0.8) +
  facet_wrap(~ Part.of.the.day) +
  theme_minimal() +
  labs(title = "Vzťah medzi počtom vozidiel a zemepisnou dĺžkou",
       subtitle = "Rozdelené podľa časti dňa",
       x = "Počet zapojených vozidiel",
       y = "Zemepisná dĺžka",
       color = "Deň v týždni")

Stĺpcový graf

Na grafe môžeme vidieť priemerný počet obetí dopravných nehôd za každý deň. Najvyššie hodnoty sú zaznamenané v sobotu, nasleduje streda a nedeľa. V pondelok, utorok, štvrtok a piatok je priemerný počet obetí nižší, pričom piatok vykazuje najnižšiu hodnotu zo všetkých dní.

library(ggplot2)
library(dplyr)

# Výpočet priemerného počtu obetí podľa dňa v týždni
obete_dni <- barc_data %>%
  group_by(Weekday) %>%
  summarise(mean_victims = mean(as.numeric(Victims), na.rm = TRUE))

obete_dni$Weekday <- factor(obete_dni$Weekday,
  levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
)

# Vykreslenie stĺpcového diagramu s farebným rozlíšením
ggplot(obete_dni, aes(x = Weekday, y = mean_victims, fill = Weekday)) +
  geom_col() +
  labs(
    title = "Priemerný počet obetí podľa dňa v týždni",
    x = "Deň v týždni",
    y = "Priemerný počet obetí"
  ) +
  theme_minimal() +
  theme(legend.position = "none") 

Základné štatistiky.

knitr - tabuľka

Tabuľka naznačuje, že v januári bol počet obetí najnižší, často sa objavila žiadna alebo iba jedna obeť. Vo februári a marci sa počet pohyboval medzi jednou a dvoma obetami. V apríli môžeme vidieť “najväčšiu” rozmanitosť – zaznamenali sa aj prípady s dvoma alebo tromi obeťami.

library(dplyr)
library(knitr)
library(kableExtra)

# Súhrnné štatistiky podľa mesiaca
nehody_stats <- barc_data %>%
  filter(Mesiace %in% c("Januar", "Februar", "Marec", "April")) %>%
  group_by(Mesiace) %>%
  summarise(
    n      = n(),
    mean   = mean(Victims, na.rm = TRUE),
    sd     = sd(Victims, na.rm = TRUE),
    min    = min(Victims, na.rm = TRUE),
    q25    = quantile(Victims, 0.25, na.rm = TRUE),
    median = median(Victims, na.rm = TRUE),
    q75    = quantile(Victims, 0.75, na.rm = TRUE),
    max    = max(Victims, na.rm = TRUE),
    .groups = "drop"
  )

# Štýlová tabuľka s oddelenými údajmi
nehody_stats %>%
  kable(digits = 2, caption = "Základné štatistiky počtu obetí (Január–Apríl)") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed")) %>%
  column_spec(1, bold = TRUE) %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2") %>%
  add_header_above(c(" " = 2, "Štatistiky obetí" = 7))

Základné štatistiky počtu obetí (Január–Apríl)

		Štatistiky obetí
Mesiace	n	mean	sd	min	q25	median	q75	max
April	5	1.6	0.89	1	1	1	2	3
Februar	5	1.4	0.55	1	1	1	2	2
Januar	5	0.8	0.45	0	1	1	1	1
Marec	5	1.2	0.45	1	1	1	1	2

Testovanie hypotéz

t-test: Rozdiel v počte obetí medzi januárom a májom

Výsledok t-testu naznačuje, že v máji bol priemerný počet obetí výrazne vyšší než v januári (1,6 oproti 0,8). Výsledok t-testu naznačuje, že tento rozdiel je štatisticky významný (p-hodnota ≈ 0,036). Interval spoľahlivosti neobsahuje nulu, čo potvrdzuje, že rozdiel medzi mesiacmi je reálny.

t.test.result <- t.test(
  barc_data$Victims[barc_data$Mesiace == "Januar"],
  barc_data$Victims[barc_data$Mesiace == "Maj"]
)

# Výsledok testu
print(t.test.result)

    Welch Two Sample t-test

data:  barc_data$Victims[barc_data$Mesiace == "Januar"] and barc_data$Victims[barc_data$Mesiace == "Maj"]
t = -2.5298, df = 7.6923, p-value = 0.03637
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -1.53433111 -0.06566889
sample estimates:
mean of x mean of y 
      0.8       1.6 

ANOVA: Porovnanie ľahkých zranení podľa mesiacov

Test ANOVA skúmal, či sa počet ľahkých zranení výrazne líši medzi jednotlivými mesiacmi. Výsledok ukazuje, že rozdiely nie sú štatisticky významné (p-hodnota = 0.809). To znamená, že počet ľahko zranených sa počas roka nemení výrazne a kolísanie medzi mesiacmi môže byť náhodné.

anova.result <- aov(Mild.injuries ~ Mesiace, data = barc_data)
summary(anova.result)

            Df Sum Sq Mean Sq F value Pr(>F)
Mesiace     11   5.78  0.5258   0.613  0.809
Residuals   48  41.20  0.8583               

Linear Regression: Vzťah medzi počtom vozidiel a počtom obetí

Analýza skúmala, či počet zúčastnených vozidiel ovplyvňuje počet obetí pri dopravných nehodách. Výsledky ukazujú, že medzi týmito premennými existuje mierne pozitívny vzťah (čím viac vozidiel, tým viac obetí), ale tento vzťah nie je štatisticky významný (p-hodnota ≈ 0.113).

model <- lm(Victims ~ Vehicles.involved, data = barc_data)
summary(model)

Call:
lm(formula = Victims ~ Vehicles.involved, data = barc_data)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.5080 -0.5080 -0.3147  0.4920  4.4920 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)
(Intercept)         0.7348     0.4616   1.592    0.117
Vehicles.involved   0.3866     0.2405   1.607    0.113

Residual standard error: 0.9515 on 58 degrees of freedom
Multiple R-squared:  0.04264,   Adjusted R-squared:  0.02613 
F-statistic: 2.583 on 1 and 58 DF,  p-value: 0.1134