Econometrics in R – Travel Cost Model

library(zoo)
library(tseries)
library(lmtest)
library(sandwich)
library(car)
library(ggplot2)
library(patchwork)

rm(list=ls())

Úvod do problému a stanovenie hypotéz

Cieľom je modelovať celkovú cenu cesty (Total trip cost) v závislosti od: -dĺžky trvania pobytu (Duration) -nákladov na ubytovanie (Accommodation cost) -nákladov na dopravu (Transportation cost)

Ekonomická logika predpokladá: Accommodation cost → pozitívny vplyv Transportation cost → pozitívny vplyv Duration môže byť problematická, keďže už je „zahrnutá“ v nákladoch — očakávam skôr slabší alebo nulový vplyv.

Hypotéza: H1: Accommodation cost a Transportation cost štatisticky významne zvyšujú Total trip cost. H2: Duration má slabý alebo nejasný vplyv na Total trip cost.

#Načítanie a úprava údajov

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

# sjednotíme názvy stĺpcov (medzery -> bodky atď.)
names(data) <- make.names(names(data))

# teraz už tieto názvy existujú určite
# "Accommodation cost" -> "Accommodation.cost"
# "Transportation cost" -> "Transportation.cost"
# "Duration (days)" -> "Duration..days."

# vytvorenie TotalCost
data$TotalCost <- data$Accommodation.cost + data$Transportation.cost

# príprava datasetu pre model
d <- data[, c("TotalCost", "Duration..days.", "Accommodation.cost", "Transportation.cost")]
names(d) <- c("TotalCost","Duration","AccommodationCost","TransportationCost")

# imputácia mediánmi
med <- sapply(d, median, na.rm = TRUE)
for (col in names(d)) {
  d[[col]][is.na(d[[col]])] <- med[col]
}

# model
model <- lm(TotalCost ~ Duration + AccommodationCost + TransportationCost, data = d)
summary(model)

Call:
lm(formula = TotalCost ~ Duration + AccommodationCost + TransportationCost, 
    data = d)

Residuals:
   Min     1Q Median     3Q    Max 
-23.31  -9.31  -5.30  -2.31 734.50 

Coefficients:
                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)        24.129732  28.131350   0.858    0.393    
Duration           -2.228253   3.521003  -0.633    0.528    
AccommodationCost   0.991250   0.006821 145.320   <2e-16 ***
TransportationCost  1.014255   0.015537  65.281   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 64.36 on 133 degrees of freedom
Multiple R-squared:  0.9988,    Adjusted R-squared:  0.9988 
F-statistic: 3.654e+04 on 3 and 133 DF,  p-value: < 2.2e-16

#Boxploty premenných

par(mfrow=c(2,2))
for (col in names(d)) {
boxplot(d[[col]], main=col, col="lightblue")
}
par(mfrow=c(1,1))

#Odhad lineárného modelu Interpretácia: AccommodationCost → veľmi silný a štatisticky významny pozitívny efekt TransportationCost → rovnako silný pozitívny efekt Duration → efekt môže byť slabší (často kolineárny s ubytovaním) R² bude extrémne vysoké, pretože TotalCost je súčet dvoch vysvetľujúcich premenných.

model <- lm(TotalCost ~ Duration + AccommodationCost + TransportationCost, data=d)
summary(model)

Call:
lm(formula = TotalCost ~ Duration + AccommodationCost + TransportationCost, 
    data = d)

Residuals:
   Min     1Q Median     3Q    Max 
-23.31  -9.31  -5.30  -2.31 734.50 

Coefficients:
                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)        24.129732  28.131350   0.858    0.393    
Duration           -2.228253   3.521003  -0.633    0.528    
AccommodationCost   0.991250   0.006821 145.320   <2e-16 ***
TransportationCost  1.014255   0.015537  65.281   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 64.36 on 133 degrees of freedom
Multiple R-squared:  0.9988,    Adjusted R-squared:  0.9988 
F-statistic: 3.654e+04 on 3 and 133 DF,  p-value: < 2.2e-16

#Diagnostické grafy Interpretácia diagnostických grafov 1. Residuals vs Fitted Reziduá sú rovnomerne rozptýlené okolo nuly → nepozorujeme nelinearitu Mierne zakrivenie môže byť dôsledkom striktnej lineárnej väzby medzi TotalCost a jeho zložkami

2. Q-Q plot Body takmer kopírujú priamku → reziduá sú približne normálne Odchýlky na koncoch sú minimálne

3. Scale-Location Takmer rovná LOESS krivka → žiadny výrazný problém heteroskedasticity

4. Residuals vs Leverage Žiadne extrémne Cookove vzdialenosti → žiadne mimoriadne vplyvné pozorovania

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

Jarque-Bera test (normalita rezíduí)

nterpretácia: p-value je < 0.05 → silne štatisticky významné

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

    Jarque Bera Test

data:  residuals(model)
X-squared = 97046, df = 2, p-value < 2.2e-16

Testovanie prítomnosti odľahlých hodnôt

dáta sú veľmi „upratané“, pretože ceny cestovania prirodzene rastú proporčne

outlierTest(model)

No Studentized residuals with Bonferroni p < 0.05
Largest |rstudent|:

Testovanie heteroskedasticity (Breusch–Pagan)

p-value > 0.05 → heteroskedasticita nie je prítomná dôvod: TotalCost je v podstate lineárna kombinácia dvoch vysvetľujúcich premenných

bptest(model)

    studentized Breusch-Pagan test

data:  model
BP = 1.8444, df = 3, p-value = 0.6053

Robustné (White-HC) štandardné chyby

coeftest(model, vcov = vcovHC(model))

t test of coefficients:

                     Estimate Std. Error  t value Pr(>|t|)    
(Intercept)        24.1297318 24.6267539   0.9798   0.3290    
Duration           -2.2282526  2.2998452  -0.9689   0.3344    
AccommodationCost   0.9912499  0.0091204 108.6855   <2e-16 ***
TransportationCost  1.0142552  0.0148015  68.5236   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Záver

Accommodation cost výrazne a spoľahlivo zvyšuje Total Trip Cost Transportation cost rovnako výrazne zvyšuje Total Trip Cost Duration má slabší alebo žiadny nezávislý vplyv – keďže náklady na ubytovanie už jeho efekt zachytávajú Normalita rezíduí je v poriadku Heteroskedasticita sa nepreukázala

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.

plot(cars)

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.