S využitím databázy hotel_bookings.csv.

Pri ďalšej práci budeme používať knižnice

library(zoo)
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(lmtest)
library(sandwich)
library(car)
## Loading required package: carData
rm(list=ls())
udaje <- read.csv("Ekonometria/hotel_bookings.csv", header = TRUE, sep = ",", dec = ".")
udaje1 <- udaje[udaje$previous_cancellations > 0,]
udaje2 <- udaje1[udaje$arrival_date_year == 2016,]
udaje.new <- udaje2[udaje2$previous_bookings_not_canceled > 0, c("lead_time", "arrival_date_week_number", "arrival_date_day_of_month", "previous_cancellations", "previous_bookings_not_canceled")]

Pre účely tohoto cvičenia modelujeme z našej databázy vysvetľovanú premennú lead_time (počet dní medzi urobením rezervácie a pobytom) podľa vysvetľujúcich premenných arrival_date_week_number, arrival_date_day_of_month, previous_cancellations, previous_bookings_not_canceled.

Naša úvodná hypotéza tvrdí, že všetky premenné by mali mať štatisticky významný vplyv na predstih, v ktorom si ľudia vytvárajú rezervácie.

library(ggplot2)

# your regression model
model <- lm(
  lead_time ~ arrival_date_week_number + arrival_date_day_of_month +
    previous_cancellations + previous_bookings_not_canceled,
  data = udaje.new,
  na.action = na.exclude
)
summary(model)
## 
## Call:
## lm(formula = lead_time ~ arrival_date_week_number + arrival_date_day_of_month + 
##     previous_cancellations + previous_bookings_not_canceled, 
##     data = udaje.new, na.action = na.exclude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -85.607 -20.324  -6.394   4.273 291.476 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    -2.16990    6.13402  -0.354    0.724    
## arrival_date_week_number        0.61131    0.15463   3.953 9.01e-05 ***
## arrival_date_day_of_month      -0.07031    0.26307  -0.267    0.789    
## previous_cancellations          8.09211    0.75070  10.779  < 2e-16 ***
## previous_bookings_not_canceled -0.82653    0.15205  -5.436 9.16e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 45.06 on 430 degrees of freedom
##   (53961 observations deleted due to missingness)
## Multiple R-squared:  0.225,  Adjusted R-squared:  0.2178 
## F-statistic: 31.21 on 4 and 430 DF,  p-value: < 2.2e-16

Podľa výsledkov lineárnej regresie vidíme, že štatisticky významný vplyv na lead_time majú arrival_date_week_number, previous_cancellations a previous_bookings_not_canceled, kde previous_bookings_not_canceled má jediné záporný vplyv. Teda ľudia, ktorí rušia menej rezervácií, zvyknú rezervovať ubytovanie viac v predstihu. To znie rozumne, ide o fixné plány, ktoré sa väčšinou dohadujú viac vopred.

Premenná arrival_date_day_of_month nemá štatisticky významný vplyv na lead_time.

Autokorelácia reziduí

V tejto časti sa pozrieme na ďalší dôležitý predpoklad klasického lineárneho regresného modelu – nezávislosť rezíduí. V časových radoch sa často stáva, že chyba v čase \(t\) je systematicky spätá s chybou v čase \(t-1\), čo nazývame autokoreláciou rezíduí.

library(ggplot2)

udaje.new$fitted <- predict(model, newdata = udaje.new)

# scatterplot + regression line + spline smoother
ggplot(udaje.new, aes(x = arrival_date_week_number, y = lead_time)) +
  geom_point(color = "steelblue", linewidth = 2) +
  
  # regression fitted line
  geom_line(aes(y = fitted), color = "red", linewidth = 0.5) +
  

  labs(
    title = "Lead time: Empirical Data (blue) vs. Fitted Data (Red)",
    x = "Week of the year 2016",
    y = "Lead time"
  ) +
  theme_minimal()
## Warning in geom_point(color = "steelblue", linewidth = 2): Ignoring unknown
## parameters: `linewidth`
## Warning: Removed 53961 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 53961 rows containing missing values or values outside the scale range
## (`geom_line()`).

Empirické hodnoty lead time vykazujú veľký rozptyl a miestami extrémne vysoké hodnoty, ktoré výrazne vyčnievajú nad bežný priebeh. Vo viacerých týždňoch sú hodnoty koncentrované pri nule, zatiaľ čo v iných sa objavujú prudké nárasty, čo naznačuje výraznú variabilitu v správaní zákazníkov.

Vyrovnaná krivka fitted hodnôt zachytáva len všeobecný trend, no v mnohých úsekoch systematicky podhodnocuje alebo nadhodnocuje empirické dáta. Tieto kompaktné bloky s rovnakým znamienkom odchýlok môžu naznačovať prítomnosť autokorelácie v reziduách alebo nedostatočnú schopnosť lineárneho modelu vystihnúť extrémne hodnoty a sezónnosť v dátach.

# ulosime si rezidua z povodneho modelu - nazvaneho model
res <- residuals(model)

Autocorrelation function

acf(na.omit(res), lag.max = 4, main = "Autokorelačná funkcia reziduí")

ACF graf ukazuje, že pri posune Lag 1 sa nachádza výrazná a štatisticky významná kladná autokorelácia, ktorá presahuje hranice spoľahlivosti (modré čiarkované línie). To znamená, že reziduá v susedných obdobiach spolu systematicky súvisia, čo porušuje predpoklad nezávislosti náhodných zložiek v lineárnom modeli.