S využitím databázy hotel_booking.csv database. V databáze sa nachádzajú údaje o hotelových rezerváciach, počte hostí, pošte dní pobytu, časový interval medzi rezerváciou a pobytom…

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())

Úvod do problému, stanovenie hypotéz

Rozdhodli sme sa zamerať len na najzaujímavejšie číselné údaje spomedzi dostupných dát, a to is_canceled (či bola rezervácia zrušená), lead_time (počet dní medzi rezerváciou a pobytom), arrival_date_week_number (číslo týždňa pobytu v roku), stays_in_weekend_nights (počet víkondových dní pobytu), stays_in_week_nights (počet pracovných dní pobytu), previous_cancellations (počet predošlých zrušených rezervácií) a previous_bookings_not_canceled (počet nezrušených predošlých rezervácií).

udaje <- read.csv("Ekonometria/hotel_bookings.csv", header = TRUE, sep = ",", dec = ".")

udaje.new <- udaje[udaje$is_canceled == 1,
  c("lead_time","arrival_date_week_number","stays_in_weekend_nights",
    "stays_in_week_nights","previous_cancellations","previous_bookings_not_canceled")]

column_medians <- sapply(udaje.new, median, na.rm = TRUE)

udaje_imputed <- udaje.new
for (col in names(udaje.new)) {
  udaje_imputed[[col]][is.na(udaje_imputed[[col]])] <- column_medians[col]
}
udaje.new <- udaje_imputed

sapply(udaje.new, is.numeric)  # rýchla kontrola typov
##                      lead_time       arrival_date_week_number 
##                           TRUE                           TRUE 
##        stays_in_weekend_nights           stays_in_week_nights 
##                           TRUE                           TRUE 
##         previous_cancellations previous_bookings_not_canceled 
##                           TRUE                           TRUE

Teraz chceme vidieť tvar údajov.

head(udaje.new)
# Determine number of plots
num_plots <- length(names(udaje.new))
num_plots
## [1] 6
# Set the layout: 2 rows × 2 columns
par(mfrow = c(2, 3))
par(mar = c(4, 4, 2, 1))  # Adjust margins (optional)

# Loop through columns and plot each boxplot
for (col in names(udaje.new)) {
  boxplot(udaje.new[[col]], main = col, xlab = "Value", col = "lightblue")
}

# Add a global caption / title
mtext("Boxploty jednotlivých premenných", outer = TRUE, cex = 1.4, font = 2)

# Reset layout to default (1 plot per figure)
#par(mfrow = c(1, 1))

Boxploty krásne vykreslujú stav jednotlivých premenných. Najviac výrazné sú outliery, ľudia, ktorí príliš často rušia rezervácie, alebo využívajú hotel namiesto prenájmu apartmánu na dlhú dobu.

colnames(udaje.new)
## [1] "lead_time"                      "arrival_date_week_number"      
## [3] "stays_in_weekend_nights"        "stays_in_week_nights"          
## [5] "previous_cancellations"         "previous_bookings_not_canceled"
model <- lm(lead_time ~ +1 + arrival_date_week_number + stays_in_weekend_nights + stays_in_week_nights + previous_cancellations + previous_bookings_not_canceled, data=udaje.new)
model
## 
## Call:
## lm(formula = lead_time ~ +1 + arrival_date_week_number + stays_in_weekend_nights + 
##     stays_in_week_nights + previous_cancellations + previous_bookings_not_canceled, 
##     data = udaje.new)
## 
## Coefficients:
##                    (Intercept)        arrival_date_week_number  
##                        101.342                           1.498  
##        stays_in_weekend_nights            stays_in_week_nights  
##                         -8.162                           3.395  
##         previous_cancellations  previous_bookings_not_canceled  
##                          7.649                          -5.576

Objekt triedy lm() nám poskytuje niekoľko výsledkov:

  1. Vector odhadnutých koeficientov model$coefficients
  2. Vektor rezíduí model$ residuals
  3. Vektor vyrovnaných hodnôt vysvetľovanej veličiny model$fitted.values
  4. Maticu X model$x
summary(model)
## 
## Call:
## lm(formula = lead_time ~ +1 + arrival_date_week_number + stays_in_weekend_nights + 
##     stays_in_week_nights + previous_cancellations + previous_bookings_not_canceled, 
##     data = udaje.new)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -265.77  -89.10  -24.55   68.37  504.79 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    101.34182    1.50034  67.546  < 2e-16 ***
## arrival_date_week_number         1.49792    0.04234  35.375  < 2e-16 ***
## stays_in_weekend_nights         -8.16160    0.62500 -13.059  < 2e-16 ***
## stays_in_week_nights             3.39482    0.33535  10.123  < 2e-16 ***
## previous_cancellations           7.64900    0.41774  18.310  < 2e-16 ***
## previous_bookings_not_canceled  -5.57589    0.81776  -6.818 9.32e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 116.2 on 44218 degrees of freedom
## Multiple R-squared:  0.04101,    Adjusted R-squared:  0.0409 
## F-statistic: 378.2 on 5 and 44218 DF,  p-value: < 2.2e-16

Podľa výsledku lineárnej regresie vidíme, že všetky nami vybrané údaje štatisticky významné pre sledovanie počtu dní medzi rezerváciou a pobytom.

# Nastaviť rozloženie 2 x 2
par(mfrow = c(2, 2))

# Vykresliť všetky 4 diagnostické grafy modelu
plot(model)
Diagnostické grafy regresného modelu

Diagnostické grafy regresného modelu 

# (Voliteľné) pridať spoločný nadpis
#mtext("Diagnostické grafy regresného modelu", outer = TRUE, cex = 1.2, font = 2)

# Resetovať layout
par(mfrow = c(1, 1))

1. Residuals vs Fitted

  • Účel: overenie linearity a konštantného rozptylu reziduí
  • Body by mali byť náhodne rozptýlené okolo červenej čiary
  • V tomto prípade vidno zhlukovanie a mierny trend, čo naznačuje porušenie linearity a možnú nehomoskedasticitu (rozptyl reziduí nie je konštantný).

2. Normal Q-Q

  • Účel: kontrola, či majú reziduá približne normálne rozdelenie
  • Ak sú body na grafe v blízkosti priamky, predpoklad normality je splnený
  • Tu pozorujeme odchýlky v chvostoch grafu, čo poukazuje na narušenie normality reziduí

3. Scale-Location (Spread-Location)

  • Účel: overenie, či je rozptyl reziduí rovnaký pre všetky predikované hodnoty
  • Červená čiara by mala byť približne vodorovná
  • V našom prípade má červená čiara stúpajúci trend, čo signalizuje heteroskedasticitu.

4. Residuals vs Leverage

  • Účel: identifikovať vplyvné pozorovania, ktoré môžu výrazne ovplyvniť odhad parametrov
  • Body s vysokým „leverage“ a veľkou Cookovou vzdialenosťou (nad 0.5 alebo 1) sú potenciálne problematické
  • V našom prípade sa v grafe nachádza niekoľko takýchto bodov, čo znamená, že model je citlivý na niektoré pozorovania

Zhrnutie

Na základe diagnostických grafov možno konštatovať, že: - predpoklady lineárneho modelu nie sú úplne splnené - reziduá nevykazujú konštantný rozptyl - rozdelenie reziduí sa odchyľuje od normálneho
- niektoré pozorovania majú výrazný vplyv na výsledky

Čo ďalej?

Podľa výsledku lm modelu sú všetky naše dáta relevantné, ale grafy nám nevychádzajú až tak pekne, ako by sme si želali. Preto si upravíme outliery.

# normality tests
residuals <- residuals(model)
jb_test <- jarque.bera.test(residuals)
jb_test
## 
##  Jarque Bera Test
## 
## data:  residuals
## X-squared = 9237.4, df = 2, p-value < 2.2e-16
# outlier test (see p-value for Bonferroni correction)
outlier_test <- outlierTest(model)
outlier_test
## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
##       rstudent unadjusted p-value Bonferroni p
## 65232 4.346172         1.3884e-05      0.61402