data <- read.csv("f1_dnf.csv")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.1     ✔ stringr   1.5.2
## ✔ ggplot2   4.0.0     ✔ tibble    3.3.0
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
f1 <- read_csv("f1_dnf.csv")
## Rows: 10000 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (16): milliseconds, fastestLap, rank, fastestLapTime, fastestLapSpeed, ...
## dbl  (13): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
glimpse(f1)  # len na kontrolu
## Rows: 10,000
## Columns: 31
## $ resultId        <dbl> 2460, 11565, 18661, 25121, 8863, 24317, 14518, 21966, …
## $ raceId          <dbl> 136, 483, 772, 1058, 383, 1015, 589, 892, 932, 746, 27…
## $ year            <dbl> 2002, 1981, 1958, 2021, 1988, 2019, 1975, 2013, 2015, …
## $ round           <dbl> 13, 1, 8, 8, 12, 6, 14, 12, 7, 1, 16, 16, 16, 1, 19, 1…
## $ grid            <dbl> 11, 23, 0, 19, 0, 5, 5, 16, 1, 2, 9, 15, 0, 14, 16, 18…
## $ positionOrder   <dbl> 4, 21, 26, 16, 30, 14, 18, 13, 1, 6, 3, 10, 31, 10, 14…
## $ points          <dbl> 3, 0, 0, 0, 0, 0, NA, NA, 25, 1, 4, 0, 0, 0, 0, 0, 0, …
## $ laps            <dbl> 77, 16, 0, 69, 0, 77, 9, 53, 70, 79, 81, 51, 0, 75, 55…
## $ milliseconds    <chr> NA, "\\N", "\\N", "\\N", "\\N", "\\N", "\\N", "4754232…
## $ fastestLap      <chr> "\\N", "\\N", "\\N", "57", "\\N", "61", "\\N", "53", "…
## $ rank            <chr> "\\N", "\\N", "\\N", "16", "\\N", "17", "\\N", "9", "3…
## $ fastestLapTime  <chr> "\\N", "\\N", "\\N", "1:10.005", "\\N", "1:16.992", "\…
## $ fastestLapSpeed <chr> "\\N", "\\N", "\\N", "222.052", "\\N", "156.031", "\\N…
## $ driverRef       <chr> "raikkonen", "watson", "ruttman", "mick_schumacher", "…
## $ surname         <chr> "Räikkönen", "Watson", "Ruttman", "Schumacher", "Moden…
## $ forename        <chr> "Kimi", "John", "Troy", "Mick", "Stefano", "Kevin", "M…
## $ dob             <date> 1979-10-17, 1946-05-04, 1930-03-11, 1999-03-22, 1963-…
## $ nationality_x   <chr> "Finnish", "British", "American", "German", "Italian",…
## $ constructorRef  <chr> "mclaren", "mclaren", "maserati", "haas", "eurobrun", …
## $ name            <chr> "Hungaroring", "Long Beach", "Nürburgring", "Red Bull …
## $ nationality_y   <chr> "British", "British", "Italian", "American", "Italian"…
## $ circuitRef      <chr> "hungaroring", "long_beach", "nurburgring", "red_bull_…
## $ circuitId       <dbl> 11, 43, 20, 70, 14, 6, 46, 14, 7, 25, 29, 22, 29, 33, …
## $ name_y          <chr> "McLaren", "McLaren", "Maserati", "Haas F1 Team", "Eur…
## $ location        <chr> "Budapest", "California", "Nürburg", "Spielberg", "Mon…
## $ country         <chr> "Hungary", "USA", "Germany", "Austria", "Italy", "Mona…
## $ lat             <dbl> 47.5789, 33.7651, 50.3356, 47.2197, 45.6156, 43.7347, …
## $ lng             <dbl> 19.248600, -118.189000, 6.947500, 14.764700, 9.281110,…
## $ alt             <dbl> 264, 12, 578, 678, 162, 7, 485, 162, 13, 8, 58, 45, 58…
## $ date            <date> 2002-08-18, 1981-03-15, 1958-08-03, 2021-06-27, 1988-…
## $ target_finish   <dbl> 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, …
unique(f1$target_finish)
## [1] 1 0
f1 %>%
  filter(target_finish == 0) %>%
  count(constructorRef, sort = TRUE) %>%
  top_n(10, n) %>%
  ggplot(aes(x = reorder(constructorRef, n), y = n, fill = n)) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  scale_fill_viridis_c(option = "magma") +
  labs(
    title = "TOP 10 tímov s najvyšším počtom DNF",
    x = "Tím",
    y = "Počet DNF"
  ) +
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

f1 <- f1 %>%
  distinct()
f1 <- f1 %>%
  select(-c(name_y, nationality_y), everything())
f1 <- f1 %>%
  mutate(
    year = as.integer(year),
    round = as.integer(round),
    grid = as.integer(grid),
    positionOrder = as.integer(positionOrder),
    points = as.numeric(points),
    laps = as.integer(laps),
    fastestLapSpeed = as.numeric(fastestLapSpeed),
    target_finish = as.integer(target_finish),
    date = ymd(date),
    dob = ymd(dob)
  )
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `fastestLapSpeed = as.numeric(fastestLapSpeed)`.
## Caused by warning:
## ! NAs introduced by coercion
f1 <- f1 %>%
  filter(!if_all(everything(), is.na))
f1 <- f1 %>%
  mutate(
    driverRef = str_trim(tolower(driverRef)),
    constructorRef = str_trim(tolower(constructorRef)),
    country = str_trim(country),
    location = str_trim(location)
  )
f1 <- f1 %>%
  filter(laps >= 0)
colSums(is.na(f1))
##        resultId          raceId            year           round            grid 
##               0               0               0               0               0 
##   positionOrder          points            laps    milliseconds      fastestLap 
##               0             867               0             912               0 
##            rank  fastestLapTime fastestLapSpeed       driverRef         surname 
##               0               0            6467               0               0 
##        forename             dob   nationality_x  constructorRef            name 
##               0               0               0               0               0 
##      circuitRef       circuitId        location         country             lat 
##               0               0               0               0               0 
##             lng             alt            date   target_finish   nationality_y 
##               0               0               0               0               0 
##          name_y 
##               0
write_csv(f1, "f1_dnf_clean.csv")
library(tidyverse)
f1 <- read_csv("f1_dnf_clean.csv")
## Rows: 9022 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (15): milliseconds, fastestLap, rank, fastestLapTime, driverRef, surnam...
## dbl  (14): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# 0/1 -> faktor pre prehľadnosť
f1 <- f1 %>%
  mutate(
    DNF = target_finish == 0,         # TRUE = nedokončil
    team = constructorRef,
    driver = driverRef
  )
library(tidyverse)

f1 <- read_csv("f1_dnf_clean.csv")
## Rows: 9022 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (15): milliseconds, fastestLap, rank, fastestLapTime, driverRef, surnam...
## dbl  (14): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Spočítam celkový počet DNF podľa tímu
top_teams <- f1 %>%
  filter(target_finish == 0) %>%      # berem len preteky, ktoré jazdci nedokončili
  count(constructorRef, sort = TRUE) %>%  # spočítam počet DNF pre každý tím
  slice_head(n = 15) %>%              # vezmem len 15 najčastejších tímov lepšie pre prehladnosť všetky by boli velmi chaoticke
  pull(constructorRef)                # extrahujem názvy tímov do vektora

# Heatmapa len pre top 15 tímov
f1 %>%
  filter(target_finish == 0, constructorRef %in% top_teams) %>%  # filtrujem len DNF a len top 15 tímov
  count(year, constructorRef) %>%      # spočítam DNF podľa roku a tímu
  ggplot(aes(x = year, y = fct_reorder(constructorRef, n, .fun = sum), fill = n)) +
  geom_tile(color = "white") +         # nakreslim „kocečky“ (každá bunka = tím + rok)
  scale_fill_viridis_c(option = "plasma", direction = -1) +  # farebná škála (žltá–fialová)
  labs(
    title = "Počet DNF podľa TOP 15 tímov a rokov",
    x = "Rok",
    y = "Tím",
    fill = "Počet DNF"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

f1 %>%
  filter(target_finish == 0, constructorRef == "ferrari") %>%  # filtrujem len Ferrari a DNF
  count(year) %>%                                               # spočítam DNF pre každý rok
  ggplot(aes(x = year, y = 1, fill = n)) +                     # y = 1 len ako vizuálna „čiara“
  geom_tile(color = "white") +
  scale_fill_viridis_c(option = "plasma") +
  labs(
    title = "🔥 Vývoj počtu DNF tímu Ferrari podľa rokov",
    x = "Rok",
    y = NULL,
    fill = "Počet DNF"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.y = element_blank(),         # y os zruším (nemá význam – len 1 riadok)
    axis.ticks.y = element_blank(),
    panel.grid = element_blank()           # čistejší dizajn
  )

library(tidyverse)
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
library(ggplot2)
library(corrplot)
## corrplot 0.95 loaded
# Načítaj vyčistené dáta
f1 <- read_csv("f1_dnf_clean.csv")
## Rows: 9022 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (15): milliseconds, fastestLap, rank, fastestLapTime, driverRef, surnam...
## dbl  (14): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Vyber len numerické stĺpce
f1_num <- f1 %>%
  select(where(is.numeric))

# Spočítaj korelačnú maticu (Pearson)
corr_matrix <- cor(f1_num, use = "complete.obs")

# Zmeníme formát pre ggplot (dlhý tvar)
corr_melt <- melt(corr_matrix)

# Heatmapa
ggplot(corr_melt, aes(Var1, Var2, fill = value)) +
  geom_tile(color = "white") +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0, limit = c(-1, 1)) +
  labs(
    title = " Korelačná matica numerických premenných – F1 dataset",
    x = NULL, y = NULL, fill = "Korelácia"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold", hjust = 0.5)
  )

library(corrplot)

corrplot(corr_matrix, method = "color",
         type = "upper",
         col = colorRampPalette(c("blue", "white", "red"))(200),
         tl.col = "black", tl.cex = 0.8,
         addCoef.col = "black", number.cex = 0.7,
         title = "Korelačná matica numerických veličín (F1)",
         mar = c(0,0,2,0))

# CVICENIE 5

library(tidyverse)
library(car)
## Loading required package: carData
## 
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following object is masked from 'package:purrr':
## 
##     some
library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(sandwich)
library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(patchwork)


f1 <- read_csv("f1_dnf_clean.csv")
## Rows: 9022 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (15): milliseconds, fastestLap, rank, fastestLapTime, driverRef, surnam...
## dbl  (14): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
f1_model <- f1 %>%
  select(points, grid, laps, fastestLapSpeed)

# Základná kontrola chýbajúcich hodnôt
colSums(is.na(f1_model))
##          points            grid            laps fastestLapSpeed 
##             867               0               0            6467
# Imputácia mediánom 
column_medians <- sapply(f1_model, median, na.rm = TRUE)
for (col in names(f1_model)) {
  f1_model[[col]][is.na(f1_model[[col]])] <- column_medians[col]
}

# Overenie, že žiadne hodnoty nechýbajú
colSums(is.na(f1_model))
##          points            grid            laps fastestLapSpeed 
##               0               0               0               0

Následne som načítal dataset f1_dnf_clean.csv, ktorý obsahuje údaje o pretekoch Formuly 1. Z celého datasetu som si vybral štyri premenné: points (počet bodov), grid (štartová pozícia), laps (počet odjazdených kôl) a fastestLapSpeed (maximálna rýchlosť jazdca).

Ďalej som overil, či v dátach nechýbajú hodnoty. Zistil som, že väčšina chýbajúcich údajov je v premennej laps, čo súvisí s jazdcami, ktorí preteky nedokončili. Chýbajúce hodnoty som nahradil mediánom danej premennej, aby som zachoval konzistentnosť a mohol ďalej pracovať s kompletným datasetom.

Po imputácii som skontroloval, že už žiadna premenná neobsahuje NA a dáta sú pripravené na vytvorenie regresného modelu.

par(mfrow = c(2, 2))
par(mar = c(4, 4, 2, 1))
for (col in names(f1_model)) {
  boxplot(f1_model[[col]], main = col, col = "lightblue")
}
mtext("Boxploty jednotlivých numerických premenných", outer = TRUE, cex = 1.2, font = 2)

par(mfrow = c(1, 1))

V tejto časti som si vizualizoval základné rozdelenie numerických premenných pomocou boxplotov. Grafy som zobrazil v rozložení 2 × 2, aby som mohol naraz porovnať všetky štyri premenné: points, grid, laps a fastestLapSpeed.

Z boxplotu pre points je vidieť, že väčšina jazdcov získava veľmi málo bodov, pričom sa objavuje viacero odľahlých hodnôt – to sú pretekári, ktorí skončili vysoko v poradí. Premenná grid má pomerne rovnomerné rozdelenie, bez výrazných extrémov. Pri laps sú viditeľné niektoré extrémy smerom nadol, čo predstavuje jazdcov, ktorí nedokončili preteky a odjazdili menej kôl. Premenná fastestLapSpeed má pomerne úzke rozdelenie bez odľahlých bodov, čo znamená, že maximálne rýchlosti jazdcov sú si navzájom podobné.

Boxploty mi pomohli získať prehľad o rozsahu hodnôt a prítomnosti extrémov v dátach, ktoré môžu ovplyvniť výsledky regresnej analýzy.

# Ekonometrický model: počet bodov ako funkcia štartovej pozície, počtu kôl a rýchlosti
model <- lm(points ~ grid + laps + fastestLapSpeed, data = f1_model)

summary(model)
## 
## Call:
## lm(formula = points ~ grid + laps + fastestLapSpeed, data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -9.5058 -2.2038 -0.7369  0.8420 26.3974 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -1.415646   0.735125  -1.926   0.0542 .  
## grid            -0.220036   0.005565 -39.537  < 2e-16 ***
## laps             0.035551   0.001348  26.368  < 2e-16 ***
## fastestLapSpeed  0.019687   0.003537   5.566 2.67e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.813 on 9018 degrees of freedom
## Multiple R-squared:  0.1961, Adjusted R-squared:  0.1959 
## F-statistic: 733.4 on 3 and 9018 DF,  p-value: < 2.2e-16

V tejto časti som odhadol lineárny regresný model, ktorý skúma, ako počet získaných bodov (points) závisí od troch faktorov: štartovej pozície (grid), počtu odjazdených kôl (laps) a maximálnej rýchlosti (fastestLapSpeed).

Z výsledkov vyplýva, že všetky tri premenné majú štatisticky významný vplyv na počet bodov (p < 0.001). Premenná grid má negatívny koeficient, čo znamená, že čím horšia štartovacia pozícia (vyššie číslo na štarte), tým menej bodov jazdec získa. Naopak, laps aj fastestLapSpeed majú pozitívne koeficienty – viac odjazdených kôl a vyššia rýchlosť zvyšujú šancu na lepší výsledok.

Hodnota R-squared = 0.1961 naznačuje, že model vysvetľuje približne 19,6 % variability v počte získaných bodov. Pri športových dátach, kde zohráva úlohu aj náhoda a veľa externých faktorov, je to pomerne dobrý výsledok. Celkový F-test (p < 2.2e-16) potvrdzuje, že model ako celok je štatisticky významný.

Celkovo teda platí, že model zachytáva logické a očakávané vzťahy: lepšia štartová pozícia, viac odjazdených kôl a vyššia rýchlosť vedú k vyššiemu počtu bodov.

par(mfrow = c(2, 2))
plot(model)

par(mfrow = c(1, 1))

V tejto časti som pomocou príkazu plot(model) zobrazil štyri diagnostické grafy, ktoré overujú správnosť predpokladov lineárneho modelu.

Residuals vs Fitted: Rezíduá sa nachádzajú približne okolo nulovej osi, čo naznačuje, že model nemá systematické chyby v predikcii. Červená hladká čiara je mierne zakrivená, čo môže naznačovať slabú nelinearitu, no celkovo sa rezíduá správajú náhodne – model teda dobre vystihuje vzťah medzi premennými.

Q-Q Plot: Väčšina bodov leží blízko priamky, takže rozdelenie rezíduí je približne normálne. Odchýlky na koncoch grafu môžu znamenať, že v dátach sú mierne extrémy, čo je bežné pri športových výsledkoch.

Scale-Location: Body sú rozložené pomerne rovnomerne, čo naznačuje, že rozptyl rezíduí je približne konštantný. Nevidno výrazný tvar lievika, takže predpoklad homoskedasticity je splnený.

Residuals vs Leverage: Väčšina pozorovaní má malý pákový efekt, teda žiadne jednotlivé hodnoty výrazne neovplyvňujú model. Žiadny bod neprekračuje hranicu Cookovej vzdialenosti, takže model nie je ovplyvnený extrémami.

Celkovo diagnostické grafy potvrdzujú, že model je stabilný, bez závažných porušení predpokladov, a je možné ho považovať za spoľahlivý.

# Test normality rezíduí (Jarque-Bera)
jb_test <- jarque.bera.test(residuals(model))
jb_test
## 
##  Jarque Bera Test
## 
## data:  residuals(model)
## X-squared = 59492, df = 2, p-value < 2.2e-16
# Test heteroskedasticity (Breusch–Pagan)
bptest(model)
## 
##  studentized Breusch-Pagan test
## 
## data:  model
## BP = 712.13, df = 3, p-value < 2.2e-16
# Test multikolinearity (VIF)
vif(model)
##            grid            laps fastestLapSpeed 
##        1.008185        1.004137        1.005003
# Outlier test (Bonferroni)
outlierTest(model)
##      rstudent unadjusted p-value Bonferroni p
## 439  6.942039         4.1318e-12   3.7277e-08
## 774  6.068786         1.3408e-09   1.2096e-05
## 2446 5.976672         2.3638e-09   2.1326e-05
## 3697 5.864856         4.6535e-09   4.1984e-05
## 6073 5.816946         6.1975e-09   5.5914e-05
## 2131 5.791884         7.1933e-09   6.4898e-05
## 4365 5.759462         8.7148e-09   7.8625e-05
## 5865 5.742714         9.6190e-09   8.6782e-05
## 5239 5.741110         9.7102e-09   8.7605e-05
## 916  5.724587         1.0700e-08   9.6539e-05

V tejto časti som vykonal niekoľko testov, ktoré overujú základné predpoklady lineárnej regresie: normalitu rezíduí, homoskedasticitu, multikolinearitu a prítomnosť odľahlých hodnôt.

1 Jarque–Bera test (normalita rezíduí) Výsledok testu (p-hodnota < 2.2e-16) ukazuje, že rezíduá nie sú dokonale normálne rozdelené. To znamená, že v dátach sa vyskytujú určité odchýlky, pravdepodobne spôsobené extrémnymi hodnotami. Keďže však ide o veľký dataset s viac ako 9000 pozorovaniami, táto odchýlka nie je zásadným problémom a model možno považovať za spoľahlivý.

2️ Breusch–Pagan test (homoskedasticita) Aj v tomto prípade je p-hodnota < 2.2e-16, čo znamená, že sa môže vyskytovať heteroskedasticita, teda nerovnaký rozptyl rezíduí. Pri reálnych dátach z pretekov je to bežné, keďže výkony jazdcov nie sú rovnomerné. Ak by bolo potrebné model upraviť, mohol by som použiť robustné štandardné chyby (z balíka sandwich) alebo transformáciu premenných.

3️ VIF test (multikolinearita) Hodnoty Variance Inflation Factor sú veľmi blízke 1 (grid = 1.00, laps = 1.00, fastestLapSpeed = 1.00), čo znamená, že medzi vysvetľujúcimi premennými nie je žiadna výrazná korelácia. Model teda netrpí problémom multikolinearity a všetky premenné prinášajú samostatné informácie.

4️ Outlier test (odľahlé hodnoty – Bonferroni) Výsledky ukázali niekoľko pozorovaní s nízkymi p-hodnotami (napr. < 0.001), čo znamená, že v dátach existuje pár extrémnych hodnôt s väčším vplyvom na model. Tieto prípady pravdepodobne predstavujú jazdcov, ktorí dosiahli extrémne výkony alebo naopak veľmi slabé výsledky. Takéto odľahlé hodnoty sú v športe prirodzené a ich počet nie je vysoký, takže nie je nutné ich z modelu odstraňovať.

summary(f1_model)
##      points            grid            laps        fastestLapSpeed
##  Min.   : 0.000   Min.   : 0.00   Min.   :  0.00   Min.   :100.6  
##  1st Qu.: 0.000   1st Qu.: 5.00   1st Qu.: 23.25   1st Qu.:204.8  
##  Median : 0.000   Median :11.00   Median : 53.00   Median :204.8  
##  Mean   : 1.817   Mean   :11.17   Mean   : 46.76   Mean   :204.6  
##  3rd Qu.: 1.000   3rd Qu.:17.00   3rd Qu.: 67.00   3rd Qu.:204.8  
##  Max.   :30.000   Max.   :34.00   Max.   :200.00   Max.   :257.3
colSums(is.na(f1_model))
##          points            grid            laps fastestLapSpeed 
##               0               0               0               0
sapply(f1_model, function(x) sum(is.infinite(x)))
##          points            grid            laps fastestLapSpeed 
##               0               0               0               0
summary(f1_model$laps)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   23.25   53.00   46.76   67.00  200.00
f1_model <- f1_model %>%
  filter(!is.na(points), !is.na(laps), !is.na(fastestLapSpeed)) %>%  # odstráň NA
  filter(laps > 0, fastestLapSpeed > 0)                              # log() potrebuje kladné hodnoty
model2 <- lm(points ~ log(laps) + fastestLapSpeed, data = f1_model)
summary(model2)
## 
## Call:
## lm(formula = points ~ log(laps) + fastestLapSpeed, data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6662 -2.3545 -1.5840  0.4014 28.0928 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -7.23131    0.84017  -8.607  < 2e-16 ***
## log(laps)        1.04500    0.05501  18.997  < 2e-16 ***
## fastestLapSpeed  0.02618    0.00399   6.561 5.67e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.313 on 8205 degrees of freedom
## Multiple R-squared:  0.04729,    Adjusted R-squared:  0.04706 
## F-statistic: 203.6 on 2 and 8205 DF,  p-value: < 2.2e-16

V tejto časti som vytvoril nový model model2, v ktorom som nahradil premennú laps jej logaritmickou transformáciou. Cieľom bolo znížiť vplyv extrémnych hodnôt a zlepšiť splnenie predpokladu normality rezíduí.

Z výsledkov vyplýva, že obidve premenné – log(laps) aj fastestLapSpeed – sú štatisticky vysoko významné (p < 0.001). Koeficient pri log(laps) má kladné znamienko, čo znamená, že čím viac kôl jazdec odjazdí (alebo čím menší rozdiel v počte kôl oproti víťazovi), tým viac bodov získa. Podobne aj vyššia maximálna rýchlosť má pozitívny vplyv na počet bodov.

Konštanta (intercept) je záporná, čo je logické – jazdec, ktorý neodjazdí žiadne kolá a nedosiahne rýchlosť, nezíska žiadne body.

Hodnota R-squared = 0.047, teda model vysvetľuje približne 4,7 % variability výsledkov. Je to menej ako pri pôvodnom modeli, no po transformácii sme dosiahli lepšie splnenie štatistických predpokladov a model je stabilnejší voči extrémnym hodnotám.

Celkovo možno povedať, že aj po úprave sa potvrdzuje pozitívny vzťah medzi výkonom jazdca (počas pretekov) a počtom získaných bodov, pričom log-transformácia pomáha lepšie zachytiť reálne vzťahy v dátach.

1 Cvicenie 6

model  <- lm(points ~ grid + laps + fastestLapSpeed, data = f1_model)
model2 <- lm(points ~ log(laps) + fastestLapSpeed, data = f1_model)

summary(model)
## 
## Call:
## lm(formula = points ~ grid + laps + fastestLapSpeed, data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.5423 -2.1779 -0.6523  0.9362 25.8075 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      0.431588   0.759912   0.568     0.57    
## grid            -0.270884   0.006270 -43.205  < 2e-16 ***
## laps             0.024417   0.001591  15.343  < 2e-16 ***
## fastestLapSpeed  0.017083   0.003626   4.711 2.51e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.907 on 8204 degrees of freedom
## Multiple R-squared:  0.218,  Adjusted R-squared:  0.2177 
## F-statistic: 762.4 on 3 and 8204 DF,  p-value: < 2.2e-16
summary(model2)
## 
## Call:
## lm(formula = points ~ log(laps) + fastestLapSpeed, data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6662 -2.3545 -1.5840  0.4014 28.0928 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -7.23131    0.84017  -8.607  < 2e-16 ***
## log(laps)        1.04500    0.05501  18.997  < 2e-16 ***
## fastestLapSpeed  0.02618    0.00399   6.561 5.67e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.313 on 8205 degrees of freedom
## Multiple R-squared:  0.04729,    Adjusted R-squared:  0.04706 
## F-statistic: 203.6 on 2 and 8205 DF,  p-value: < 2.2e-16
p1 <- ggplot(f1_model, aes(x = grid, y = resid(model)^2)) +
  geom_point(alpha = 0.35) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "grid (štartová pozícia)", y = "štvorce rezíduí", title = "model: resid^2 ~ grid") +
  theme_minimal()

p2 <- ggplot(f1_model, aes(x = laps, y = resid(model)^2)) +
  geom_point(alpha = 0.35) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "laps (počet kôl)", y = "štvorce rezíduí", title = "model: resid^2 ~ laps") +
  theme_minimal()

p3 <- ggplot(f1_model, aes(x = fastestLapSpeed, y = resid(model)^2)) +
  geom_point(alpha = 0.35) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "fastestLapSpeed", y = "štvorce rezíduí", title = "model: resid^2 ~ fastestLapSpeed") +
  theme_minimal()

(p1 | p2) / p3
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

Na obrázku sú zobrazené vzťahy medzi štvorcami rezíduí a jednotlivými vysvetľujúcimi premennými – štartová pozícia (grid), počet odjazdených kôl (laps) a maximálna rýchlosť (fastestLapSpeed). Cieľom je vizuálne overiť, či sa rozptyl rezíduí mení s hodnotou týchto premenných – teda či sa v modeli vyskytuje heteroskedasticita.

model: resid² ~ grid Krivka má mierne klesajúci priebeh na začiatku, no celkovo je pomerne plochá. Rozptyl rezíduí sa výrazne nemení s rastúcim číslom štartovej pozície, takže podľa tejto premennej sa heteroskedasticita nezdá byť výrazná.

model: resid² ~ laps V grafe vidno väčšiu koncentráciu bodov pri nižších hodnotách laps (jazdci, ktorí nedokončili preteky). Červená krivka sa tam mierne dvíha, čo naznačuje, že rozptyl rezíduí je väčší práve pri menšom počte kôl. Tento efekt môže súvisieť s tým, že DNF jazdci majú nepredvídateľné výsledky. Pri väčšom počte kôl sa krivka vyrovnáva – rozptyl sa stabilizuje.

model: resid² ~ fastestLapSpeed Krivka má mierne stúpajúci trend, čo naznačuje, že pri vyšších rýchlostiach sa rozptyl rezíduí mierne zvyšuje. Tento efekt však nie je výrazný, takže ide len o slabý náznak heteroskedasticity.

Celkovo možno povedať, že rozptyl rezíduí nie je konštantný úplne ideálne – pri nižších hodnotách laps (jazdci, ktorí nedokončili preteky) je vidieť väčšiu variabilitu. V ďalšom kroku preto použijem transformáciu log(laps), aby som znížil vplyv týchto extrémov a stabilizoval rozptyl.

q1 <- ggplot(f1_model, aes(x = log(laps), y = resid(model2)^2)) +
  geom_point(alpha = 0.35) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "log(laps)", y = "štvorce rezíduí", title = "model2: resid^2 ~ log(laps)") +
  theme_minimal()

q2 <- ggplot(f1_model, aes(x = fastestLapSpeed, y = resid(model2)^2)) +
  geom_point(alpha = 0.35) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "fastestLapSpeed", y = "štvorce rezíduí", title = "model2: resid^2 ~ fastestLapSpeed") +
  theme_minimal()

q1 | q2
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

Na grafoch je zobrazená závislosť štvorcov rezíduí od vysvetľujúcich premenných po logaritmickej transformácii počtu kôl (log(laps)). Cieľom je posúdiť, či sa heteroskedasticita znížila oproti pôvodnému modelu.

model2: resid² ~ log(laps) Po log-transformácii je červená LOESS krivka takmer vodorovná, čo naznačuje, že rozptyl rezíduí sa už nemení s hodnotou premennej. Väčšina bodov je koncentrovaná okolo nízkych hodnôt rezíduí, a nepozorujem výrazné zhluky ani rastúci trend ako v pôvodnom modeli. To znamená, že transformácia log(laps) účinne znížila heteroskedasticitu, najmä pri extrémne malých počtoch odjazdených kôl.

model2: resid² ~ fastestLapSpeed Krivka má len veľmi mierne stúpajúci priebeh, ale vo všeobecnosti zostáva plochá – rozptyl rezíduí je približne rovnaký naprieč rôznymi hodnotami rýchlosti. Na rozdiel od pôvodného modelu už nevidno systematický rast rozptylu.

Celkovo teda môžem povedať, že logaritmická transformácia premenných pomohla odstrániť alebo aspoň výrazne znížiť heteroskedasticitu. Rezíduá sú teraz rozložené rovnomernejšie a model má stabilnejší rozptyl chýb.

bp1 <- bptest(model)
bp2 <- bptest(model2)
bp1; bp2
## 
##  studentized Breusch-Pagan test
## 
## data:  model
## BP = 737.13, df = 3, p-value < 2.2e-16
## 
##  studentized Breusch-Pagan test
## 
## data:  model2
## BP = 116.51, df = 2, p-value < 2.2e-16

Na základe výstupu z Breusch–Pagan testu porovnávam pôvodný model (model) a model po logaritmickej transformácii (model2).

Model: Hodnota testovej štatistiky je BP = 737.13, p-hodnota < 2.2e-16. Keďže p-hodnota je výrazne menšia ako 0.05, zamietam nulovú hypotézu o homoskedasticite. To znamená, že v pôvodnom modeli sa nachádza heteroskedasticita – rozptyl rezíduí nie je konštantný.

Model2 (po log-transformácii laps): Tu je hodnota BP = 116.51, p-hodnota rovnako < 2.2e-16. Hoci test stále indikuje prítomnosť heteroskedasticity, hodnota testovej štatistiky sa výrazne znížila (z 737 na 116), čo naznačuje, že transformácia premenných výrazne znížila intenzitu heteroskedasticity.

Celkovo možno povedať, že po aplikácii logaritmickej transformácie sa variabilita rezíduí stabilizovala, aj keď úplne nezmizla. Model2 je teda štrukturálne lepší a štatisticky stabilnejší ako pôvodný model, čo potvrdzuje aj vizuálna analýza z predchádzajúcich grafov.

coeftest(model,  vcov = vcovHC(model,  type = "HC1"))
## 
## t test of coefficients:
## 
##                   Estimate Std. Error  t value  Pr(>|t|)    
## (Intercept)      0.4315882  1.0933250   0.3947  0.693039    
## grid            -0.2708842  0.0076115 -35.5886 < 2.2e-16 ***
## laps             0.0244175  0.0013033  18.7356 < 2.2e-16 ***
## fastestLapSpeed  0.0170828  0.0053152   3.2139  0.001314 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coeftest(model2, vcov = vcovHC(model2, type = "HC1"))
## 
## t test of coefficients:
## 
##                   Estimate Std. Error t value  Pr(>|t|)    
## (Intercept)     -7.2313080  1.2283323 -5.8871 4.085e-09 ***
## log(laps)        1.0449962  0.0326292 32.0264 < 2.2e-16 ***
## fastestLapSpeed  0.0261796  0.0060558  4.3230 1.557e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

V tejto časti som použil tzv. White heteroskedasticity-consistent odhad rozptylov pomocou funkcie coeftest(model, vcov = vcovHC(model)). Táto metóda upravuje štandardné chyby koeficientov tak, aby boli spoľahlivé aj v prípade, že v dátach pretrváva heteroskedasticita.

Prvý výstup (model): Po zohľadnení robustných chýb ostávajú všetky premenné – grid, laps aj fastestLapSpeed – štatisticky významné (p < 0.01). Koeficient pri grid je negatívny, čo potvrdzuje, že horšia štartovacia pozícia znižuje počet získaných bodov. Premenné laps a fastestLapSpeed majú pozitívne koeficienty, teda viac odjazdených kôl a vyššia rýchlosť vedú k lepším výsledkom. Intercept (konštanta) nie je štatisticky významný, čo je bežné – jeho hodnota nie je pre interpretáciu podstatná.

Druhý výstup (model2 – po logaritmickej transformácii): Po transformácii log(laps) sa všetky koeficienty stávajú vysoko štatisticky významné (p < 0.001). Logaritmická premena zlepšila stabilitu modelu a potlačila vplyv odľahlých hodnôt. Interpretácia ostáva rovnaká – vyšší počet odjazdených kôl (v logaritmickej forme) aj vyššia rýchlosť pozitívne ovplyvňujú počet bodov.

Celkovo môžem povedať, že robustné štandardné chyby potvrdili stabilitu modelu a zároveň eliminovali vplyv heteroskedasticity na testovanie významnosti koeficientov. Výsledky oboch modelov sú konzistentné a ich interpretácia sa nemení – model2 však dosahuje lepšie vlastnosti z pohľadu štatistickej spoľahlivosti.

2 Cvicenie 7

library(tidyverse)
library(car)        # crPlots, vif
library(lmtest)     # resettest, bptest
library(sandwich)   # robustné chyby
library(MASS)       # boxcox
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:patchwork':
## 
##     area
## The following object is masked from 'package:dplyr':
## 
##     select
resettest(model)   # pôvodný
## 
##  RESET test
## 
## data:  model
## RESET = 310.38, df1 = 2, df2 = 8202, p-value < 2.2e-16
resettest(model2)  # s log(laps)
## 
##  RESET test
## 
## data:  model2
## RESET = 45.839, df1 = 2, df2 = 8203, p-value < 2.2e-16

``` r
crPlots(model)   # pre grid, laps, fastestLapSpeed

RESET test pri pôvodnom modeli ukazuje, že lineárna špecifikácia nie je vhodná. P-hodnota je prakticky nulová, čo znamená, že model v aktuálnej podobe nedokáže zachytiť všetky vzťahy medzi premenými a v dátach ostáva nelineárna štruktúra, ktorú model nepopisuje. Po aplikovaní logaritmickej transformácie na premennú laps sa hodnota testovej štatistiky výrazne znížila, čo potvrdzuje, že úprava zlepšila celkovú špecifikáciu modelu. Aj tu však p-hodnota zostáva veľmi nízka, takže ani transformovaný model nedokáže úplne odstrániť problém nesprávnej funkčnej formy. Výsledok treba chápať tak, že model2 je síce lepší než pôvodný, no stále nepostačuje na úplné vystihnutie variability bodov v závislosti od zvolených vysvetľujúcich premenných.

Component + Residual grafy ukazujú, ako sa jednotlivé vysvetľujúce premenné správajú po tom, čo odfiltrujeme vplyv ostatných premenných. Pri premennej grid je viditeľné zakrivenie, ktoré naznačuje, že vzťah medzi štartovou pozíciou a počtom bodov nie je priamo lineárny. Pri premennej laps je nelinearita ešte výraznejšia, najmä pri nízkych hodnotách počtu odjazdených kôl, kde vzniká veľké množstvo extrémnych pozorovaní súvisiacich s jazdcami, ktorí preteky nedokončili. Táto premenná je najproblematickejšia a práve preto logaritmická transformácia výrazne pomohla. Premenná fastestLapSpeed vykazuje iba veľmi miernu nelinearitu a jej vplyv je v zásade stabilný; lineárny tvar je tu prijateľný. Z týchto grafov vyplýva, že najväčšiu pozornosť si vyžaduje premená laps a prípadne aj grid, zatiaľ čo fastestLapSpeed je v modeli najstabilnejšia.

model_poly <- lm(points ~ grid + laps + fastestLapSpeed +
                   I(grid^2) + I(laps^2) + I(fastestLapSpeed^2),
                 data = f1_model)
summary(model_poly)
## 
## Call:
## lm(formula = points ~ grid + laps + fastestLapSpeed + I(grid^2) + 
##     I(laps^2) + I(fastestLapSpeed^2), data = f1_model)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -13.0072  -1.6482  -0.4248   0.9372  24.8734 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           5.172e+01  3.689e+00   14.02   <2e-16 ***
## grid                 -8.085e-01  2.154e-02  -37.54   <2e-16 ***
## laps                  5.793e-02  3.167e-03   18.29   <2e-16 ***
## fastestLapSpeed      -4.860e-01  3.671e-02  -13.24   <2e-16 ***
## I(grid^2)             2.201e-02  8.297e-04   26.53   <2e-16 ***
## I(laps^2)            -2.696e-04  2.071e-05  -13.02   <2e-16 ***
## I(fastestLapSpeed^2)  1.263e-03  9.208e-05   13.72   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.69 on 8201 degrees of freedom
## Multiple R-squared:  0.3029, Adjusted R-squared:  0.3024 
## F-statistic:   594 on 6 and 8201 DF,  p-value: < 2.2e-16
anova(model, model_poly)        # zlepšil sa model?
resettest(model_poly)           # je špecifikácia lepšia?
## 
##  RESET test
## 
## data:  model_poly
## RESET = 312.03, df1 = 2, df2 = 8199, p-value < 2.2e-16
model2_poly <- lm(points ~ log(laps) + fastestLapSpeed +
                    I(log(laps)^2) + I(fastestLapSpeed^2),
                  data = f1_model)
summary(model2_poly)
## 
## Call:
## lm(formula = points ~ log(laps) + fastestLapSpeed + I(log(laps)^2) + 
##     I(fastestLapSpeed^2), data = f1_model)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.2513  -2.2273  -1.2994   0.2873  28.2911 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          49.9625221  4.2561401  11.739  < 2e-16 ***
## log(laps)            -0.7459682  0.2309072  -3.231  0.00124 ** 
## fastestLapSpeed      -0.5328207  0.0422149 -12.622  < 2e-16 ***
## I(log(laps)^2)        0.3122674  0.0398659   7.833 5.36e-15 ***
## I(fastestLapSpeed^2)  0.0014116  0.0001059  13.335  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.253 on 8203 degrees of freedom
## Multiple R-squared:  0.07367,    Adjusted R-squared:  0.07322 
## F-statistic: 163.1 on 4 and 8203 DF,  p-value: < 2.2e-16
anova(model2, model2_poly)
resettest(model2_poly)
## 
##  RESET test
## 
## data:  model2_poly
## RESET = 14.086, df1 = 2, df2 = 8201, p-value = 7.818e-07

Model, v ktorom som spojil logaritmickú transformáciu premennej laps a kvadratické členy, priniesol ďalšie zlepšenie oproti predchádzajúcim verziám. Všetky zahrnuté premenné aj ich kvadráty vyšli vysoko štatisticky významné, čo znamená, že model zachytáva nelineárne vzťahy medzi rýchlosťou, počtom kôl a počtom získaných bodov výrazne lepšie než lineárna špecifikácia. Upravený koeficient determinácie sa zvýšil približne na 0.073, čo je síce len mierne zlepšenie, ale stále ide o posun k presnejšiemu zachyteniu vzťahov v dátach. Aj reziduálna smerodajná odchýlka sa znížila a ANOVA test potvrdzuje, že rozšírený model poskytuje štatisticky významne lepšie výsledky než model bez kvadratických členov.

RESET test však ukazuje, že ani táto upravená špecifikácia nie je úplne bezchybná. Testová štatistika je síce výrazne nižšia než pri pôvodnom modeli, ale p-hodnota zostáva veľmi malá, takže problém nesprávnej špecifikácie sa nepodarilo odstrániť úplne. V praxi to znamená, že model síce reaguje lepšie na nelineárne vzťahy, no s najväčšou pravdepodobnosťou mu stále chýbajú ďalšie vysvetľujúce premenné alebo vhodnejšia transformácia. Model teda možno považovať za zlepšený, ale nie definitívne správne špecifikovaný.

f1_model <- f1_model %>% mutate(D_TOP10 = if_else(grid <= 10, 1, 0))

# a) zlom v konštante (posun)
m_break_const <- lm(points ~ D_TOP10 + grid + log(laps) + fastestLapSpeed, data = f1_model)
summary(m_break_const)
## 
## Call:
## lm(formula = points ~ D_TOP10 + grid + log(laps) + fastestLapSpeed, 
##     data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.1160 -2.1026 -0.6351  0.9117 25.6323 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -1.587749   0.793175  -2.002 0.045343 *  
## D_TOP10          0.587440   0.161232   3.643 0.000271 ***
## grid            -0.232372   0.011624 -19.991  < 2e-16 ***
## log(laps)        0.814672   0.050008  16.291  < 2e-16 ***
## fastestLapSpeed  0.014808   0.003616   4.095 4.26e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.898 on 8203 degrees of freedom
## Multiple R-squared:  0.222,  Adjusted R-squared:  0.2216 
## F-statistic: 585.1 on 4 and 8203 DF,  p-value: < 2.2e-16
# b) zlom v sklone podľa grid (interakcia)
m_break_slope <- lm(points ~ grid + I(D_TOP10*grid) + log(laps) + fastestLapSpeed, data = f1_model)
summary(m_break_slope)
## 
## Call:
## lm(formula = points ~ grid + I(D_TOP10 * grid) + log(laps) + 
##     fastestLapSpeed, data = f1_model)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.8904 -2.1106 -0.7189  0.9452 25.3738 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       -0.125830   0.770692  -0.163     0.87    
## grid              -0.311325   0.007219 -43.125  < 2e-16 ***
## I(D_TOP10 * grid) -0.176404   0.014928 -11.817  < 2e-16 ***
## log(laps)          0.807068   0.049631  16.261  < 2e-16 ***
## fastestLapSpeed    0.015763   0.003589   4.392 1.13e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.868 on 8203 degrees of freedom
## Multiple R-squared:  0.2338, Adjusted R-squared:  0.2334 
## F-statistic: 625.6 on 4 and 8203 DF,  p-value: < 2.2e-16
# porovnanie s „bez zlomu“
anova(model2, m_break_const, m_break_slope)

Pri analýze zlomu podľa štartovej pozície som vytvoril dummy premennú, ktorá rozdeľuje jazdcov na tých, ktorí štartujú v TOP10, a ostatných. Model so zlomom v konštante ukázal, že TOP10 jazdci majú odlišnú základnú úroveň bodov, ale zlepšenie modelu bolo len mierne. Naopak, model so zlomom v sklone potvrdil, že vplyv štartovej pozície na počet bodov je pre jazdcov v TOP10 výrazne odlišný. Interakčný člen je vysoko štatisticky významný a upravené R² sa zvýšilo viac než pri modeli s posunom.

ANOVA test jasne ukazuje, že oba modely so zlomom sú lepšie ako model bez zlomu, pričom zlom v sklone poskytuje najväčšie zlepšenie. To znamená, že rozdiel vplyvu štartovej pozície na výsledok je v TOP10 oveľa výraznejší než v zvyšku poľa a model s interakciou tento efekt zachytáva najlepšie.

bc <- boxcox(lm(I(points+1) ~ grid + laps + fastestLapSpeed, data = f1_model), plotit = FALSE)
lambda <- bc$x[which.max(bc$y)]
lambda
## [1] -1.4
# transformujem Y podľa λ
y_bc <- if (abs(lambda) < 1e-8) log(f1_model$points + 1) else ((f1_model$points + 1)^lambda - 1) / lambda
m_bc <- lm(y_bc ~ grid + laps + fastestLapSpeed, data = f1_model)
summary(m_bc)
## 
## Call:
## lm(formula = y_bc ~ grid + laps + fastestLapSpeed, data = f1_model)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.80521 -0.18496 -0.05073  0.22827  0.74219 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      4.424e-03  4.735e-02   0.093    0.926    
## grid            -1.878e-02  3.907e-04 -48.067  < 2e-16 ***
## laps             2.781e-03  9.916e-05  28.047  < 2e-16 ***
## fastestLapSpeed  1.286e-03  2.260e-04   5.692  1.3e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2435 on 8204 degrees of freedom
## Multiple R-squared:  0.2944, Adjusted R-squared:  0.2941 
## F-statistic:  1141 on 3 and 8204 DF,  p-value: < 2.2e-16
resettest(m_bc)
## 
##  RESET test
## 
## data:  m_bc
## RESET = 235.31, df1 = 2, df2 = 8202, p-value < 2.2e-16

Box-Coxov test mi odporučil transformovať závislú premennú points (po posune o 1 kvôli nulám) približne s parametrom λ ≈ –1,4, teda pomocou transformácie blízkej recipročnej. Na základe tejto hodnoty som vytvoril novú premennú a znovu odhadol model so štartovou pozíciou, počtom kôl a maximálnou rýchlosťou ako vysvetľujúcimi premennými. Všetky tri premenné ostali štatisticky vysoko významné a upravené R² sa zvýšilo približne na 0,29, čo je citeľné zlepšenie oproti pôvodnému modelu s netransformovanými bodmi. Znížila sa aj reziduálna smerodajná odchýlka, takže model lepšie vystihuje variabilitu transformovaných výsledkov.

RESET test však ukazuje, že ani po Box-Coxovej transformácii nie je špecifikácia modelu úplne v poriadku, keďže p-hodnota zostáva veľmi malá a nulovú hypotézu správnej funkčnej formy musíme stále zamietnuť. Transformácia teda síce zlepšila prispôsobenie modelu a štatistické vlastnosti, ale neodstránila problém nesprávnej špecifikácie úplne a zároveň zhoršila intuitívnosť interpretácie výsledkov, pretože koeficienty sa už vzťahujú na transformovanú mieru bodov, nie na pôvodný počet bodov.

coeftest(model_poly,  vcov = vcovHC(model_poly,  type = "HC1"))
## 
## t test of coefficients:
## 
##                         Estimate  Std. Error  t value  Pr(>|t|)    
## (Intercept)           5.1718e+01  5.8156e+00   8.8930 < 2.2e-16 ***
## grid                 -8.0845e-01  3.0301e-02 -26.6806 < 2.2e-16 ***
## laps                  5.7926e-02  2.2034e-03  26.2891 < 2.2e-16 ***
## fastestLapSpeed      -4.8601e-01  5.7808e-02  -8.4074 < 2.2e-16 ***
## I(grid^2)             2.2015e-02  9.8607e-04  22.3257 < 2.2e-16 ***
## I(laps^2)            -2.6961e-04  1.4667e-05 -18.3816 < 2.2e-16 ***
## I(fastestLapSpeed^2)  1.2632e-03  1.4557e-04   8.6774 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coeftest(model2_poly, vcov = vcovHC(model2_poly, type = "HC1"))
## 
## t test of coefficients:
## 
##                         Estimate  Std. Error t value  Pr(>|t|)    
## (Intercept)          49.96252212  6.22567129  8.0252 1.154e-15 ***
## log(laps)            -0.74596819  0.11596098 -6.4329 1.322e-10 ***
## fastestLapSpeed      -0.53282075  0.06269597 -8.4985 < 2.2e-16 ***
## I(log(laps)^2)        0.31226742  0.02322585 13.4448 < 2.2e-16 ***
## I(fastestLapSpeed^2)  0.00141161  0.00015921  8.8662 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coeftest(m_break_slope, vcov = vcovHC(m_break_slope, type = "HC1"))
## 
## t test of coefficients:
## 
##                     Estimate Std. Error  t value  Pr(>|t|)    
## (Intercept)       -0.1258303  1.0767464  -0.1169  0.906973    
## grid              -0.3113246  0.0102996 -30.2268 < 2.2e-16 ***
## I(D_TOP10 * grid) -0.1764035  0.0164018 -10.7551 < 2.2e-16 ***
## log(laps)          0.8070682  0.0316774  25.4777 < 2.2e-16 ***
## fastestLapSpeed    0.0157631  0.0052476   3.0039  0.002674 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coeftest(m_bc,         vcov = vcovHC(m_bc,         type = "HC1"))
## 
## t test of coefficients:
## 
##                    Estimate  Std. Error  t value  Pr(>|t|)    
## (Intercept)      0.00442388  0.05069822   0.0873    0.9305    
## grid            -0.01877821  0.00038046 -49.3566 < 2.2e-16 ***
## laps             0.00278111  0.00011923  23.3252 < 2.2e-16 ***
## fastestLapSpeed  0.00128606  0.00024269   5.2993 1.193e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Po doplnení robustných (Whiteových) štandardných chýb sa potvrdilo, že všetky dôležité výsledky našich modelov ostávajú stabilné a nemenia sa ani po zohľadnení heteroskedasticity. V polynomiálnych modeloch zostávajú všetky lineárne aj kvadratické členy výrazne štatisticky významné, čo znamená, že aj po úprave štandardných chýb sú nelineárne vzťahy medzi premennými skutočné a nie sú len dôsledkom skreslených odhadov rozptylu. Rovnako aj model s logaritmickou transformáciou laps vykazuje stabilné a jednoznačne významné koeficienty.

Model so zlomom v sklone podľa štartovej pozície si tiež zachováva významnosť všetkých kľúčových koeficientov vrátane interakčného člena. To potvrdzuje, že rozdielny vplyv štartovej pozície pre jazdcov v TOP10 je robustný a nie je výsledkom štatistického šumu. Aj model po Box–Coxovej transformácii bodov si zachováva významnosť všetkých vysvetľujúcich premenných.

Z pohľadu ekonometrickej interpretácie to znamená, že hlavné štruktúry, ktoré modely odhalili — nelinearita vo vzťahu laps, zakrivenie vplyvu grid, rozdiely medzi TOP10 jazdcami a ostatnými, či vplyv transformácie výsledkov — sú potvrdené aj po korekcii heteroskedasticity. Nič zásadné sa nemení, takže výsledky sú spoľahlivé a odolné voči porušeniu predpokladu konštantného rozptylu rezíduí.

3 Cvicenie 9

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

Zameral som sa na jeden tím, konkrétne Ferrari, a vytvoril som časový rad na úrovni rokov. Pre každý rok som spočítal celkový počet bodov, ktoré tím získal, a zároveň som si pripravil vysvetľujúce premenné založené na priemerných hodnotách v danom roku. Cieľom je modelovať závislosť počtu bodov v sezóne od priemernej štartovej pozície, priemerného počtu odjazdených kôl a priemernej maximálnej rýchlosti.

f1 <- read_csv("f1_dnf_clean.csv")
## Rows: 9022 Columns: 31
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (15): milliseconds, fastestLap, rank, fastestLapTime, driverRef, surnam...
## dbl  (14): resultId, raceId, year, round, grid, positionOrder, points, laps,...
## date  (2): dob, date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
constructor_name <- "ferrari"

f1_team <- f1 %>%
  filter(constructorRef == constructor_name) %>%
  group_by(year) %>%
  summarise(
    points_season = sum(points, na.rm = TRUE),
    avg_grid      = mean(grid, na.rm = TRUE),
    avg_laps      = mean(laps, na.rm = TRUE),
    avg_speed     = mean(fastestLapSpeed, na.rm = TRUE)
  ) %>%
  arrange(year)

f1_team <- f1_team %>% filter(year >= 2000)

rownames(f1_team) <- f1_team$year
## Warning: Setting row names on a tibble is deprecated.
f1_team

V tejto časti odhadujem základný lineárny model, v ktorom je vysvetľovanou premennou celkový počet bodov tímu Ferrari v sezóne a vysvetľujúcimi premennými sú priemerná štartová pozícia, priemerný počet odjazdených kôl a priemerná maximálna rýchlosť v danej sezóne.

model <- lm(points_season ~ avg_grid + avg_laps + avg_speed, data = f1_team)
summary(model)
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_laps + avg_speed, 
##     data = f1_team)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -73.287 -29.775  -8.704  33.973 120.361 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  515.999    299.018   1.726   0.1025  
## avg_grid     -11.363      4.608  -2.466   0.0246 *
## avg_laps      -2.126      2.654  -0.801   0.4343  
## avg_speed     -1.042      1.235  -0.843   0.4107  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.98 on 17 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.3132, Adjusted R-squared:  0.192 
## F-statistic: 2.584 on 3 and 17 DF,  p-value: 0.08716

Najskôr vizuálne porovnávam empirické hodnoty počtu bodov v sezóne so zodpovedajúcimi vyrovnanými (fitted) hodnotami z regresného modelu. Sledovanie kompaktných úsekov, kde sú rezíduá systematicky kladné alebo záporné, môže naznačovať prítomnosť autokorelácie.

library(ggplot2)

f1_team <- f1_team %>% drop_na()

model <- lm(points_season ~ avg_grid + avg_laps + avg_speed, data = f1_team)

f1_team$fitted <- fitted(model)
ggplot(f1_team, aes(x = year, y = points_season)) +
  geom_point(color = "steelblue", size = 2) +
  geom_line(aes(y = fitted), color = "red", linewidth = 1) +
  labs(
    title = "Body Ferrari podľa sezón: empirické hodnoty (modrá) vs. vyrovnané hodnoty (červená)",
    x = "Rok",
    y = "Body v sezóne"
  ) +
  theme_minimal()

Graf porovnáva skutočné bodové zisky Ferrari (modré body) s hodnotami predpovedanými lineárnym modelom (červená čiara). Vidno, že model zachytáva celkový trend, no nedokáže presne vystihnúť prudké výkyvy medzi jednotlivými sezónami. V niektorých rokoch Ferrari získalo výrazne viac alebo menej bodov, než model predpokladal, čo naznačuje, že výsledky tímu ovplyvňujú aj faktory, ktoré v modeli nie sú zahrnuté. Model teda vystihuje len časť variability výkonu tímu v čase.

res <- residuals(model)

acf(res, lag.max = 4, main = "Autokorelačná funkcia rezíduí – Ferrari")

ACF graf ukazuje, či sú rezíduá z modelu navzájom korelované v čase. V grafe vidno, že autokorelačný koeficient pre lag 1 je výrazne mimo hraníc 95 % intervalu spoľahlivosti (modré čiary), čo znamená, že rezíduá v čase t sú silno závislé od rezíduí v čase t−1. Autokorelácia pri vyšších posunoch je už slabšia, no stále nie úplne zanedbateľná. Celkovo to signalizuje, že rezíduá nie sú nezávislé a model trpí pozitívnou autokoreláciou, čo je pri časových radoch podobného typu bežné.

dwtest(model)
## 
##  Durbin-Watson test
## 
## data:  model
## DW = 1.6309, p-value = 0.1447
## alternative hypothesis: true autocorrelation is greater than 0
bgtest(model, order = 1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  model
## LM test = 0.32749, df = 1, p-value = 0.5671

Durbin–Watsonov test aj Breusch–Godfreyho test ukazujú, že v modeli niet štatisticky významnej autokorelácie rezíduí. Durbin–Watsonova štatistika má hodnotu približne 1.64, čo je síce mierne pod hodnotou 2, ale p-hodnota je vyššia ako 0.05, takže nulovú hypotézu o neprítomnosti autokorelácie nezamietame. Podobne aj BG test má p-hodnotu okolo 0.57, čo znamená, že oneskorené rezíduá neovplyvňujú súčasné rezíduá a sériová korelácia prvého rádu sa štatisticky nepotvrdila. Oba testy teda naznačujú, že rezíduá modelu sú v čase nezávislé.

Teraz potrebujeme Koyckovu rovnicu: pridáme lag vysvetľovanej premennej. Keďže ide o časový rad výkonu jedného tímu, prirodzené je predpokladať, že počet bodov v aktuálnej sezóne môže závisieť aj od výkonu v predchádzajúcej sezóne. Tento efekt zachytíme pomocou Koyckovho modelu, kde medzi regresory zaradíme aj oneskorenú vysvetľovanú premennú.

library(dplyr)

f1_team <- f1_team %>%
  arrange(year) %>%
  mutate(points_season_lag1 = lag(points_season))


model_koyck <- lm(points_season ~ avg_grid + avg_laps + avg_speed + points_season_lag1,
                  data = f1_team)

summary(model_koyck)
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_laps + avg_speed + 
##     points_season_lag1, data = f1_team)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -71.600 -37.975  -7.852  31.251 111.665 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)  
## (Intercept)        464.1657   330.7356   1.403   0.1808  
## avg_grid           -11.8292     4.8913  -2.418   0.0288 *
## avg_laps            -1.5484     2.9585  -0.523   0.6083  
## avg_speed           -0.9928     1.3295  -0.747   0.4668  
## points_season_lag1   0.1310     0.2242   0.584   0.5676  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 54.41 on 15 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.3288, Adjusted R-squared:  0.1498 
## F-statistic: 1.837 on 4 and 15 DF,  p-value: 0.1743
dwtest(model_koyck)
## 
##  Durbin-Watson test
## 
## data:  model_koyck
## DW = 1.9496, p-value = 0.3364
## alternative hypothesis: true autocorrelation is greater than 0
bgtest(model_koyck, order = 1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  model_koyck
## LM test = 0.072216, df = 1, p-value = 0.7881

Tento dynamický (Koyckov) model pridáva do regresie oneskorené body tímu z predchádzajúcej sezóny, aby zachytil prípadnú zotrvačnosť výkonu Ferrari. Výsledky však ukazujú, že oneskorená premenná points_season_lag1 nie je štatisticky významná (p-hodnota ≈ 0.57), takže výkon z minulého roka nemá výrazný vplyv na body v aktuálnej sezóne. Rovnako žiadny z ostatných regresorov nevychádza ako štatisticky významný. Hodnota upraveného R² sa dokonca znížila v porovnaní s pôvodným modelom, čo znamená, že pridanie dynamiky model nezlepšilo. Celkovo možno povedať, že Koyckova transformácia v tomto prípade nepomáha a pôvodný statický model je vhodnejší.

coeftest(model,       vcov = NeweyWest(model))
## 
## t test of coefficients:
## 
##              Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 515.99934  180.03882  2.8660  0.01071 *
## avg_grid    -11.36324    4.94117 -2.2997  0.03441 *
## avg_laps     -2.12578    2.69202 -0.7897  0.44060  
## avg_speed    -1.04153    0.54701 -1.9040  0.07397 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coeftest(model_koyck, vcov = NeweyWest(model_koyck))
## 
## t test of coefficients:
## 
##                     Estimate Std. Error t value Pr(>|t|)  
## (Intercept)        464.16570  219.12596  2.1183  0.05126 .
## avg_grid           -11.82925    5.67168 -2.0857  0.05450 .
## avg_laps            -1.54844    4.03303 -0.3839  0.70641  
## avg_speed           -0.99284    0.35114 -2.8275  0.01273 *
## points_season_lag1   0.13101    0.19891  0.6586  0.52012  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Durbin–Watson aj Breusch–Godfrey test pre dynamický model (Koyck) Oba testy ukazujú, že v Koyckovom modeli neexistuje štatisticky významná autokorelácia rezíduí.

Durbin–Watson ≈ 1.95 (blízko neutrálnej hodnoty 2)

p-hodnota ≈ 0.33 → autokorelácia sa nepotvrdila

BG test p-hodnota ≈ 0.79 → takisto žiadna sériová korelácia

To znamená, že po pridaní oneskorenej premennej zmizla aj slabá autokorelácia, ktorú bolo možné pozorovať graficky.

Newey–West robustné štandardné chyby – pôvodný model

Po použití robustnej kovariančnej matice Newey–West vidíme, že:

avg_grid (štartová pozícia) zostáva štatisticky významná

rýchlosť a počet kôl významné nie sú

výsledky sú stabilné → model nie je citlivý na autokoreláciu či heteroskedasticitu

Newey–West pre Koyckov model

Pri dynamickom modeli s oneskorenými bodmi:

nijaký regresor nie je štatisticky významný, dokonca ani avg_grid

lagovaná premenná points_season_lag1 nevysvetľuje výsledky (p ≈ 0.52)

robustné štandardné chyby tento záver nemenia

4 Cvicenie 10

V tomto cvičení skúmam, ako súvisia sezónne výsledky tímu Ferrari (počet získaných bodov) s ukazovateľmi výkonnosti monopostu – priemernou štartovou pozíciou, počtom odjazdených kôl a priemernou rýchlosťou. Model bol odhadnutý pomocou viacnásobnej lineárnej regresie.

library(tidyverse)
library(car)

f1_team <- f1_team %>% drop_na()

model <- lm(points_season ~ avg_grid + avg_laps + avg_speed, data = f1_team)
summary(model)
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_laps + avg_speed, 
##     data = f1_team)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -76.309 -32.361  -8.477  32.777 116.523 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 471.9376   323.5969   1.458   0.1641  
## avg_grid    -11.6830     4.7833  -2.442   0.0266 *
## avg_laps     -1.7218     2.8823  -0.597   0.5586  
## avg_speed    -0.9226     1.2965  -0.712   0.4870  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 53.28 on 16 degrees of freedom
## Multiple R-squared:  0.3135, Adjusted R-squared:  0.1847 
## F-statistic: 2.435 on 3 and 16 DF,  p-value: 0.1025

Z výsledkov vyplýva, že jedinou štatisticky významnou premennou je priemerná štartovacia pozícia – horšie štarty vedú k nižšiemu bodovému zisku. Avg_laps a avg_speed významné nie sú, čo môže naznačovať multikolinearitu, keďže obe premenné popisujú podobné vlastnosti auta.

Hodnota Adjusted R² ≈ 0.18 ukazuje, že model vysvetľuje len menšiu časť variability výkonov, čo je vo Formule 1 prirodzené, pretože výsledky ovplyvňujú aj faktory, ktoré v modeli nie sú zahrnuté.

Model teda zachytáva základné väzby, no naznačuje potrebu bližšie preskúmať vzťahy medzi technickými premennými.

cor(f1_team[, c("avg_grid", "avg_laps", "avg_speed")])
##              avg_grid   avg_laps    avg_speed
## avg_grid  1.000000000  0.1366905  0.002609522
## avg_laps  0.136690470  1.0000000 -0.077769303
## avg_speed 0.002609522 -0.0777693  1.000000000

Korelačná matica ukazuje, že medzi vysvetľujúcimi premennými neexistujú silné korelácie. Všetky vzťahy sú veľmi slabé (v absolútnej hodnote pod 0.15). To znamená, že premenné avg_grid, avg_laps a avg_speed sa navzájom výrazne neovplyvňujú a neposkytujú rovnakú informáciu.

Na základe tohto výsledku sa nepotvrdzuje výraznejší problém multikolinearity, aspoň nie v zmysle jednoduchých párových korelácií. Ak sa neskôr objaví problém s nestabilnými koeficientmi, je potrebné overiť multikolinearitu pomocou VIF, ale samotná korelačná štruktúra v tomto prípade problém neodhalila.

Hlavný diagnostický nástroj:

VIF = 1 → žiadna multikolinearita

VIF = 5 → stredná

VIF > 10 → vážny problém

vif(model)
##  avg_grid  avg_laps avg_speed 
##  1.019223  1.025418  1.006266

Hodnoty VIF sú veľmi nízke (okolo 1), čo znamená, že medzi vysvetľujúcimi premennými neexistuje žiadna multikolinearita. Premenné avg_grid, avg_laps a avg_speed sa navzájom takmer vôbec neprekrývajú v informácii, ktorú prinášajú modelu.

V praxi sa multikolinearita začína považovať za problém pri VIF > 5 (mierna) alebo VIF > 10 (vážna), takže výsledky jasne ukazujú, že model z hľadiska multikolinearity spĺňa všetky predpoklady OLS.

summary(model)
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_laps + avg_speed, 
##     data = f1_team)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -76.309 -32.361  -8.477  32.777 116.523 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 471.9376   323.5969   1.458   0.1641  
## avg_grid    -11.6830     4.7833  -2.442   0.0266 *
## avg_laps     -1.7218     2.8823  -0.597   0.5586  
## avg_speed    -0.9226     1.2965  -0.712   0.4870  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 53.28 on 16 degrees of freedom
## Multiple R-squared:  0.3135, Adjusted R-squared:  0.1847 
## F-statistic: 2.435 on 3 and 16 DF,  p-value: 0.1025

Z regresného výstupu vyplýva, že jediným štatisticky významným vysvetľujúcim regresorom je priemerná štartovacia pozícia (avg_grid). Jej koeficient je negatívny, čo potvrdzuje intuitívny vzťah – čím horšie Ferrari štartovalo, tým menej bodov získalo.

Premenné avg_laps a avg_speed vychádzajú ako štatisticky nevýznamné. V tomto prípade to však nie je dôsledok multikolinearity (keďže VIF hodnoty sú nízke), ale skôr toho, že tieto premenné samostatne nedokážu dobre vysvetliť bodový zisk v jednotlivých sezónach.

Hodnota Adjusted R² ≈ 0.18 znamená, že model zachytáva približne 18 % variability počtu bodov, čo je vo Formule 1 prirodzené – výkon tímu ovplyvňuje množstvo ďalších faktorov (nehody, technické problémy, vývoj auta, stratégia).

Celkovo model poskytuje rozumný základ, pričom najlepším prediktorom bodového zisku zostáva štartovacia pozícia, zatiaľ čo ostatné premenné majú slabý samostatný vplyv

model_reduced <- lm(points_season ~ avg_grid + avg_speed, data = f1_team)
summary(model_reduced)
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_speed, data = f1_team)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -84.87 -35.71  -5.53  34.87 108.41 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 366.6364   266.1892   1.377   0.1863  
## avg_grid    -12.0754     4.6475  -2.598   0.0187 *
## avg_speed    -0.8615     1.2678  -0.680   0.5060  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 52.26 on 17 degrees of freedom
## Multiple R-squared:  0.2982, Adjusted R-squared:  0.2156 
## F-statistic: 3.611 on 2 and 17 DF,  p-value: 0.04932
vif(model_reduced)
##  avg_grid avg_speed 
##  1.000007  1.000007

V redukovanom modeli som odstránil premennú avg_laps, ktorá bola nevýznamná a jej prínos do modelu bol minimálny. Po zjednodušení modelu vidíme, že:

avg_grid zostáva štatisticky významným prediktorom (p ≈ 0.0187), čo opäť potvrdzuje, že horšia štartovacia pozícia vedie k nižšiemu bodovému zisku.

premenná avg_speed je stále nevýznamná.

Z hľadiska kvality modelu si redukovaná verzia mierne polepšila: Adjusted R² vzrástlo z 0.1847 na 0.2156, čo znamená, že dvojpremenný model vysvetľuje variabilitu lepšie než pôvodný trojpremenný.

Zároveň je celý model podľa F-testu štatisticky významný (p ≈ 0.049), čo pri pôvodnom modeli neplatilo.

Celkovo redukovaný model pôsobí stabilnejšie a lepšie spĺňa požiadavky na interpretovateľnosť bez straty informačnej hodnoty.

f1_norm <- f1_team %>%
  mutate(across(c(avg_grid, avg_laps, avg_speed), scale))

lm(points_season ~ avg_grid + avg_laps + avg_speed, data = f1_norm) |> summary()
## 
## Call:
## lm(formula = points_season ~ avg_grid + avg_laps + avg_speed, 
##     data = f1_norm)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -76.309 -32.361  -8.477  32.777 116.523 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  110.450     11.914   9.270  7.8e-08 ***
## avg_grid     -30.141     12.341  -2.442   0.0266 *  
## avg_laps      -7.394     12.378  -0.597   0.5586    
## avg_speed     -8.725     12.262  -0.712   0.4870    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 53.28 on 16 degrees of freedom
## Multiple R-squared:  0.3135, Adjusted R-squared:  0.1847 
## F-statistic: 2.435 on 3 and 16 DF,  p-value: 0.1025

Normalizácia (z-skórovanie) vysvetľujúcich premenných nemení vzťahy v modeli, ale upravuje mierku, aby boli všetky premenné porovnateľné. Po škálovaní zostali výsledky prakticky rovnaké ako v pôvodnom modeli:

avg_grid je naďalej jediná štatisticky významná premenná (p ≈ 0.0266).

avg_laps a avg_speed zostávajú nevýznamné, čo potvrdzuje, že problém nevzniká z rozdielnej škály premenných, ale z ich nízkej vysvetľovacej sily.

Hodnoty R² aj Adjusted R² sa vôbec nezmenili, keďže štandardizácia nemení schopnosť modelu vysvetľovať dáta.

Z toho vyplýva, že model netrpí multikolinearitou a problém nízkej významnosti premenných nie je spôsobený mierkou údajov, ale ich skutočným slabým vzťahom k bodovému zisku Ferrari.