Analiza i przewidywanie anulowania rezerwacji hotelowych

Autor

Patrycja Mazur, ——– ————

Internetowe kanały rezerwacji hotelowych całkowicie zmieniły sposób dokonywania rezerwacji oraz zachowania klientów. Duża część rezerwacji jest anulowana lub kończy się tzw. no-show, czyli niepojawieniem się gościa w hotelu. Najczęstsze powody anulowania to zmiana planów, kolizje w terminarzu lub inne nieprzewidziane okoliczności.

Często ułatwieniem jest możliwość bezpłatnego lub taniego anulowania rezerwacji, co z punktu widzenia gościa jest wygodne i korzystne. Dla hoteli jednak stanowi to wyzwanie, ponieważ negatywnie wpływa na przychody i utrudnia efektywne zarządzanie dostępnością pokoi.

1 Cel projektu

Celem projektu jest zbudowanie modelu klasyfikacyjnego, który będzie przewidywał, czy dana rezerwacja w hotelu zostanie anulowana.

2 Zbiór danych

dt <- read.csv("Hotel Reservations.csv") 
#head(dt)

datatable(dt, options = list(scrollX = TRUE))

2.1 Opis zbioru

Źródło: https://www.kaggle.com/datasets/ahsan81/hotel-reservations-classification-dataset

Zbiór danych zawiera informacje o 36 275 rezerwacjach hotelowych. Każdy rekord reprezentuje pojedynczą rezerwację. Zmienną docelową (target) jest booking_status, która przyjmuje wartości “Canceled” (anulowana) lub “Not_Canceled” (nieanulowana).

Zbiór zawiera 19 zmiennych:

Opis zmiennych
Zmienna Opis Typ Zakres Uwagi
Booking_ID Unikalny identyfikator każdej rezerwacji character INN00001-INN36275 -
no_of_adults Liczba dorosłych numeric 0 - 4 -
no_of_children Liczba dzieci numeric 0 – 10 -
no_of_weekend_nights Liczba nocy weekendowych (sobota lub niedziela), w których gość zatrzymał się lub zarezerwował pobyt w hotelu numeric 0-7 -
no_of_week_nights Liczba nocy w tygodniu (od poniedziałku do piątku), w których gość zatrzymał się lub zarezerwował pobyt w hotelu numeric 0 - 17 -
type_of_meal_plan Rodzaj planu posiłków zarezerwowanego przez klienta factor Meal Plan 1, Meal Plan 2, Meal Plan 3, Not Selected 4 poziomy
required_car_parking_space Czy klient potrzebuje miejsca parkingowego? factor 0, 1 0 = Nie, 1 = Tak
room_type_reserved Rodzaj pokoju zarezerwowanego przez klienta. Wartości są szyfrowane (kodowane) przez INN Hotels. factor Room_Type 1, Room_Type 2, Room_Type 3, Room_Type 4, Room_Type 5, Room_Type 6, Room_Type 7 7 poziomów
lead_time Liczba dni między datą rezerwacji a datą przyjazdu numeric 0–460 -
arrival_year Rok daty przyjazdu factor 2017, 2018 2 poziomy
arrival_month Miesiąc daty przyjazdu factor 1-12 1-styczeń, 2-luty, 3-marzec, 4-kwiecień, 5-maj, 6-czerwiec, 7-lipiec, 8-sierpień, 9-wrzesień, 10-październik, 11-listopad, 12-grudzień
arrival_date Dzień miesiąca daty przyjazdu numeric 1-31 -
market_segment_type Oznaczenie segmentu rynku factor Aviation Complementary, Corporate, Offline, Online 5 poziomów
repeated_guest Czy klient jest powracającym gościem factor 0, 1 0 = Nie, 1 = Tak
no_of_previous_cancellations Liczba poprzednich rezerwacji, które zostały anulowane przez klienta przed obecną rezerwacją numeric 0–13 -
no_of_previous_bookings _not_canceled Liczba poprzednich rezerwacji, które nie zostały anulowane przez klienta przed obecną rezerwacją numeric 0 - 60 -
avg_price_per_room Średnia cena rezerwacji za dzień; ceny pokoi są dynamiczne. (w euro) numeric 0 - 550 -
no_of_special_requests Całkowita liczba specjalnych próśb złożonych przez klienta (np. wysokie piętro, widok z pokoju itp.) numeric 0 - 5 -
booking_status Zmienna docelowa wskazująca, czy rezerwacja została anulowana, czy nie factor Not_Canceled, Cancelled Not_Canceled = rezerwacja nieanulowana, Cancelled = rezerwacja anulowana

2.2 Braki danych

invisible(suppressMessages(mice::md.pattern(dt, rotate.names = TRUE)))
 /\     /\
{  `---'  }
{  O   O  }
==>  V <==  No need for mice. This data set is completely observed.
 \  \|/  /
  `-----'

W zbiorze danych nie występują braki — każda zmienna została w pełni zaobserwowana. Dane są gotowe do analizy bez dodatkowego czyszczenia.

2.3 Analiza zbioru danych

Zanim przystąpimy do budowy modeli, przyjrzymy się bliżej danym. Sprawdzimy m.in. jak wygląda rozkład statusu rezerwacji oraz jakie zależności występują między zmiennymi. Taka analiza pozwoli nam lepiej zrozumieć dane i przygotować je do dalszych etapów pracy.

2.3.1 Procentowy rozkład zmiennej booking_status

library(dplyr)
dt %>%
  count(booking_status) %>%
  mutate(percent = n / sum(n) * 100) %>%
  ggplot(aes(x = booking_status, y = percent, fill = booking_status)) +
  geom_col() +
  geom_text(aes(label = sprintf("%.1f%%", percent)), vjust = -0.5, size = 5) +
  scale_fill_manual(values = c("Canceled" = "salmon", "Not_Canceled" = "lightgreen")) + 
  scale_y_continuous(limits = c(0, 75)) +
  labs(
    #title = "Procentowy rozkład zmiennej booking_status", 
       x = "Status rezerwacji", 
       y = "Procent (%)") +
  theme_minimal()

Na podstawie wykresu możemy zauważyć, że zmienna docelowa booking_status jest niezbalansowana. Większość obserwacji – 67,2% – dotyczy rezerwacji zrealizowanych (nieanulowanych), natomiast 32,8% stanowią rezerwacje anulowane. Taka dysproporcja klas może mieć istotny wpływ na skuteczność modeli klasyfikacyjnych i wymaga odpowiednich technik balansowania danych, takich jak np. oversampling.

2.3.2 Lead time a status rezerwacji hotelowej

Lead time to odstęp (w dniach) między rezerwacją a przyjazdem.

ggplot(dt, aes(x = booking_status, y = lead_time, fill = booking_status)) +
  geom_boxplot() +
  labs(
    #title = "Odstęp (w dniach) między rezerwacją a przyjazdem w podziale na status rezerwacji",
       x = "Status rezerwacji",
       y = "Liczba dni od rezerwacji do przyjazdu",
       fill = "Status rezerwacji") +
  theme_minimal() +
  scale_fill_manual(values = c("Canceled" = "salmon", "Not_Canceled" = "lightgreen"))

Anulowane rezerwacje (Cancelled) są zwykle dokonywane z większym wyprzedzeniem - mediana wynosi ponad 100 dni, podczas gdy nieanulowane (Not_Cancelled) – znacznie później (bliżej przyjazdu) - mediana wynosi ponieżej 50 dni, z wieloma wartościami odstającymi.

2.3.3 Liczba rezerwacji względem dorosłych i dzieci

dt %>% 
  group_by(no_of_adults, no_of_children) %>% 
  summarize(count = n(), .groups = "drop") %>%
  ggplot(aes(x = factor(no_of_adults), y = factor(no_of_children), fill = count)) +
  geom_tile(color = "white") +
  geom_text(aes(label = count), size = 4) +
  scale_fill_gradient(low = "seashell", high = "rosybrown") +
  labs(
    #title = "Liczba rezerwacji względem liczby dorosłych i dzieci",
    x = "Liczba dorosłych",
    y = "Liczba dzieci",
    fill = "Liczba\nrezerwacji"
  ) +
  theme_minimal()

Najwięcej rezerwacji dotyczyło dwóch dorosłych i brak dzieci - 23 719 rezerwacji, co wskazuje na najczęstszy profil gości – pary dorosłych bez dzieci. Drugi najczęstszy układ to jedna osoba dorosła bez dzieci. (7551 rezerwacji). Rezerwacje z dziećmi są znacznie rzadsze.

2.3.4 Korelacja zmiennych liczbowych:

# Zmienne liczbowe
numeric_vars <- dt[sapply(dt, is.numeric)]

# Oblicza korelacje
corr_matrix <- cor(numeric_vars, use = "complete.obs")


dt %>% 
  select(where(is.numeric)) %>% 
        cor() %>% 
       corrplot::corrplot(method = "color",
                          type = "upper",
                          tl.srt = 45, 
                          number.cex = 0.7, 
                          tl.cex = 0.7, 
                          tl.col = "black", 
                          addCoef.col = "black",
                          col = colorRampPalette(c("midnightblue", "white", "maroon"))(100))

no_of_previous_cancellations (liczba wcześniejszych anulowanych rezerwacji) i no_of_previous_bookings_not_canceled: (liczba wcześniejszych nieanulowanych rezerwacji) są najmocniej skorelowane (ale nie silnie). Oznacza to, że klienci, którzy mają więcej wcześniejszych rezerwacji (ogółem), mają też zwykle zarówno więcej anulowanych, jak i nieanulowanych rezerwacji.

Istnieje słaba, dodatnia korelacja między ceną rezerwacji za dzień (avg_price_per_room), a liczbą osób w rezerwacji (no_of_adults 0.3, no_of_children - 0.34). Ceny rosną wraz z liczbą gości, co jest dość logiczne.

2.3.5 Liczba rezerwacji w czasie

p <- dt %>% 
  mutate(year_month = make_date(as.numeric(as.character(arrival_year)), as.numeric(as.character(arrival_month)), arrival_date))

monthly_counts <- p %>%
  count(year_month)

w <- monthly_counts %>%
  ggplot(aes(x = year_month, y = n)) +
    geom_area(fill = "maroon", alpha = 0.5) +
    geom_line(color = "maroon") +
    labs(
      x = "Miesiąc",
      y = "Liczba rezerwacji"
      #title = "Liczba rezerwacji"
    ) +
    theme_ipsum()

ggplotly(w)

Na wykresie przedstawiono liczbę rezerwacji dokonanych w okresie od 1 lipca 2017 roku do końca 2018 roku. Zauważalny jest lekki spadek liczby rezerwacji w miesiącach zimowych, na przełomie 2017 i 2018 roku.

Największe natężenie rezerwacji odnotowano 13 października 2018 roku, kiedy to zarejestrowano aż 254 rezerwacje w ciągu jednego dnia. Może to być związane z okresem wzmożonego ruchu turystycznego lub wydarzeniami sezonowymi.

2.3.6 Rozkłady zmiennych numerycznych

# Kolumny numeryczne
num_cols <- c("no_of_children", "no_of_adults", "no_of_week_nights", 
              "no_of_weekend_nights", "arrival_date", "lead_time", 
              "no_of_previous_cancellations", "no_of_previous_bookings_not_canceled", 
              "no_of_special_requests", "avg_price_per_room")

# Wykresy
plots <- lapply(num_cols, function(col) {
  ggplot(dt, aes_string(x = col)) +
    geom_histogram(bins = 30, fill = "skyblue", color = "white") +
    ggtitle(col) +
    theme_minimal()
    
})

# Wyświetlenie ich razem 
wrap_plots(plots, ncol = 3)

Dane są mocno skośne w przypadku wielu zmiennych – co może wpływać na wyniki modeli predykcyjnych.

Typowy klient to nowy gość, bez dzieci, dwoje dorosłych, pobyt 1–3 noce, bez specjalnych życzeń.

Część zmiennych może wymagać transformacji lub standaryzacji przed modelowaniem (np. lead_time, avg_price_per_room).

3 Metoda analizy

W celu zbudowania modelu klasyfikacyjnego, który przewiduje, czy dana rezerwacja zostanie anulowana, wykorzystamy pięć popularnych algorytmów uczenia maszynowego, różniących się założeniami, mechanizmami działania oraz odpornością na złożoność danych.

3.1 Regresja logistyczna (Logistic Regression)

Regresja logistyczna to liniowy model klasyfikacyjny, który estymuje prawdopodobieństwo przynależności do jednej z dwóch klas. Jest łatwa do interpretacji i często używana jako punkt odniesienia.

3.2 Drzewo decyzyjne (Decision Tree)

Model oparty na strukturze drzewa, który dokonuje podziałów zbioru danych na podstawie wartości predyktorów. Łatwy do interpretacji i wizualizacji, choć podatny na przeuczenie (overfitting).

3.3 Las losowy (Random Forest)

To model składający się z wielu drzew decyzyjnych, budowanych na losowych podzbiorach danych i zmiennych. Dzięki uśrednianiu wyników poszczególnych drzew model ten uzyskuje wysoką stabilość i dokładność, a także zmniejsza ryzyko przeuczenia. Jest to jeden z najczęściej stosowanych modeli klasyfikacyjnych.

3.4 Naive Bayes

Model probabilistyczny bazujący na twierdzeniu Bayesa i założeniu niezależności między predyktorami. Mimo swojej prostoty, często daje zaskakująco dobre wyniki w klasyfikacji, szczególnie przy dużych zbiorach danych i niezrównoważonych klasach.

3.5 XGBoost (Extreme Gradient Boosting)

Zaawansowany model oparty na boostingowaniu drzew decyzyjnych. Buduje kolejne drzewa na podstawie błędów poprzednich. Jest bardzo skuteczny, zwłaszcza przy dużych i złożonych zbiorach danych, ale mniej interpretowalny niż prostsze modele.

4 Modelowanie klasyfikacyjne

4.1 Podział na zbiór uczący i testowy

Proces modelowania rozpoczynamy od podziału danych na zbiór uczący i testowy. Zbiór treningowy stanowi 2/3 całkowitej liczby obserwacji, a testowy pozostałą 1/3.

Analiza rozkładu zmiennej docelowej (booking_status) ujawniła znaczną nierównowagę klas — około 67,2% obserwacji to rezerwacje nieanulowane (Not_Canceled), a 32,8% to rezerwacje anulowane (Canceled). Taka dysproporcja może prowadzić do uprzywilejowania klasy dominującej i zaniżenia skuteczności klasyfikacji dla mniejszościowej klasy.

Aby zniwelować ten problem, zastosujemy technikę oversamplingu na zbiorze treningowym. Polega ona na sztucznym zwiększeniu liczby przykładów należących do klasy mniejszościowej poprzez ich losowe powielanie. Dzięki temu model uczy się na bardziej zbalansowanym zbiorze.

Dodatkowo, aby uzyskać rzetelną ocenę wydajności modelu, zastosowano walidację krzyżową (cross-validation). Dane uczące podzielone zostały na 5 części (tzw. foldy) przy użyciu 5-krotnej walidacji krzyżowej ze stratyfikacją względem zmiennej booking_status, co zapewnia zachowanie proporcji klas w każdym foldzie.

set.seed(2025)

# Sprawdzenie zmiennych o zerowej lub bliskiej zeru wariancji
##nzv <- nearZeroVar(dt, saveMetrics = TRUE)
##nzv #brak
##dt <- dt[, !nzv$zeroVar] 


dt <- dt[, -1] #usuwamy kolumnę id



# Podział na zbiór uczący i testowy
split <- initial_split(dt, prop = 2/3, strata = booking_status)
train <- training(split)
test <- testing(split)




## Oversamplig 
train <- ovun.sample(booking_status ~ ., data = train, method = "over", N = 33000)$data
#method = "over" – stosujemy oversampling, czyli zwiększamy liczbę przykładów klasy mniejszościowej przez kopiowanie
#N = 1000 – nowy zbiór danych ma mieć łącznie 1000 obserwacji




# Dla Decision Tree i Random FOrest
rec <- recipe(booking_status ~ ., data = train)

# Dla LR, XGBoost, Naive Bayes
rec_dummy <- recipe(booking_status ~ ., data = train) %>%
  step_dummy(all_nominal_predictors()) %>%
  step_zv(all_predictors())  


dt_folds <- vfold_cv(data = train, v = 5, strata = booking_status) #v = 5 – 5-krotna walidacja krzyżowa (podzielenie danych na 5 części)


control <- trainControl(method = "repeatedcv", 
                        number = 5, 
                        #repeats = 5,
                        summaryFunction = twoClassSummary,
                        classProbs = TRUE) # 5-krotna walidacja
# Logistic Regression, Decision Tree, Random Forest, Gradient Boosting, XGBoost

# 1. Logistic Regression
lr <- logistic_reg(mode = "classification") %>%
  set_engine("glm")

# 2. Decision Tree
dt <- decision_tree(mode = "classification") %>%
  set_engine("rpart")

# 3. Random Forest
rf <- rand_forest(mode = "classification") %>%
  set_engine("ranger", importance = "impurity")

# 4. Naive Bayes
nb <- naive_Bayes(mode = "classification") %>%
  set_engine("naivebayes") 

# 5. XGBoost (identycznie, ale możesz ustawić inne parametry)
xgb <- boost_tree(mode = "classification") %>%
  set_engine("xgboost")



classification_models <- workflow_set(
  preproc = list(
    rec_d = rec_dummy,
    rec = rec,
    rec = rec,
    rec_d = rec_dummy,
    rec_d = rec_dummy),
  models = list(
    lr = lr,
    dt = dt,
    rf = rf,
    nb = nb,
    xgb = xgb
  ),
  cross = FALSE
)
keep_pred <- control_resamples(save_pred = TRUE, save_workflow = TRUE)
#Tworzy obiekt kontrolny do funkcji fit_resamples():
  # save_pred = TRUE – zapisz przewidywania (predykcje) dla każdej obserwacji w walidacji krzyżowej,
  # save_workflow = TRUE – zapisz cały workflow razem z wynikami

#rm(kap, recall)
metrs <- metric_set(yardstick::accuracy, yardstick::kap, yardstick::roc_auc, yardstick::precision, yardstick::recall, yardstick::f_meas)
# zestaw metryk: dokładność, statystyka Kappa(zgodność modeli i klasyfikacji losowej), pole pod krzywą ROC, precyzja(jak wiele z przewidzianych pozytywnych to prawdziwe pozytywne), czułość(jak wiele z prawdziwych pozytywnych zostało wykrytych), F1-score(harmoniczna średnia precyzji i czułości)




classification_models <- classification_models %>% 
  workflow_map("fit_resamples", seed = 2025, verbose = TRUE,
               resamples = dt_folds,
               control = keep_pred,
               metrics = metrs) # mapujemy fit_resamples na kazdy przeplyw

  #workflow_map() – stosuje określoną funkcję ("fit_resamples") do wszystkich workflowów w obiekcie classification_models, czyli np. naszych różnych modeli (np. regresja logistyczna, las losowy i knn).
  #"fit_resamples" – mówi: przeprowadź walidację krzyżową dla każdego workflowa

4.1.1 Regresja Logistyczna (Logistic Regression)

Regresja logistyczna należy do grupy liniowych metod klasyfikacyjnych i wykorzystuje funkcję logistyczną do modelowania prawdopodobieństwa przynależności obserwacji do jednej z dwóch klas. Formalnie jest częścią uogólnionych modeli liniowych (GLM). Technika ta znajduje zastosowanie, gdy zmienna zależna przyjmuje dwie możliwe wartości – zazwyczaj oznaczane jako 1 (sukces) oraz 0 (porażka).

W ramach tego podejścia modeluje się warunkowe prawdopodobieństwo sukcesu jako funkcję liniowej kombinacji zmiennych objaśniających \(X\):

Ogólna postać modelu:

\(Y \sim B(1,p)\)

\(p(X) = E(Y|X) = \frac{exp(\beta X)}{1 + \exp(\beta X)}\)

gdzie \(B(1,p)\) jest rozkładem dwumianowym o prawdopodobieństwie sukcesu \(p\), a \(\beta X\) oznacza kombinację liniową parametrów modelu i wartości zmiennych niezależnych, przyjmując, że \(x_0 = 1\). Jako funkcji łączącej (czyli opisującej związek między kombinacją liniową predyktorów i prawdopodobieństwem sukcesu) użyto logitu.

logreg_fit <- classification_models %>%
  extract_workflow("rec_d_lr") %>%
  fit(data = train)

logreg_preds <- predict(logreg_fit, new_data = test, type = "prob") %>%
  bind_cols(predict(logreg_fit, new_data = test)) %>%
  bind_cols(test %>% select(booking_status))


# Metryki
bind_rows(
  yardstick::metrics(logreg_preds, truth = booking_status, estimate = .pred_class),
  yardstick::roc_auc(logreg_preds, truth = booking_status, .pred_Not_Canceled),
  yardstick::precision(logreg_preds, truth = booking_status, estimate = .pred_class),
  yardstick::recall(logreg_preds, truth = booking_status, estimate = .pred_class),
  yardstick::specificity(logreg_preds, truth = booking_status, estimate = .pred_class),
  yardstick::f_meas(logreg_preds, truth = booking_status, estimate = .pred_class)
) %>%
  select(.metric, .estimate) %>%
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Dokładność (Accuracy)",
    .metric == "roc_auc" ~ "ROC AUC",
    .metric == "precision" ~ "Precyzja (Precision)",
    .metric == "recall" ~ "Czułość (Recall)",
    .metric == "specificity" ~ "Specyficzność (Specificity)",
    .metric == "f_meas" ~ "F1-score",
    TRUE ~ .metric
  )) %>%
  gt() %>%
  fmt_number(columns = vars(.estimate), decimals = 3) %>%
  cols_label(
    .metric = "Miara",
    .estimate = "Wartość"
  ) %>%
  tab_header(
    title = "Metryki modelu Regresji Logistycznej"
  ) %>% 
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "darkblue")
    ),
    locations = cells_column_labels(columns = everything())
  )
Metryki modelu Regresji Logistycznej
Miara Wartość
Dokładność (Accuracy) 0.777
kap 0.524
ROC AUC 0.870
Precyzja (Precision) 0.880
Czułość (Recall) 0.774
Specyficzność (Specificity) 0.783
F1-score 0.823

4.1.1.1 Confusion Matrix

cm <- conf_mat(logreg_preds, truth = booking_status, estimate = .pred_class)

autoplot(cm, type = "heatmap") +
  scale_fill_gradient(low = "white", high = "steelblue") +
  labs(title = "Macierz pomyłek - Regresja Logistyczna") +
  theme_minimal() +
  theme(legend.position = "right")

Model osiąga zrównoważone wyniki: accuracy 0.777, precision 0.880, recall 0.774 i F1-score 0.82. Wysoki ROC AUC (0.870) potwierdza jego dobrą zdolność klasyfikacyjną. To stabilny model bazowy, który dobrze rozróżnia obie klasy.

4.1.2 Drzewo decyzyjne (Decision Tree)

Drzewo decyzyjne to hierarchiczna struktura służąca do tworzenia modeli klasyfikacyjnych lub regresyjnych. Jest szczególnie użyteczne w sytuacjach, gdy relacje między zmiennymi niezależnymi a zmienną docelową są trudne do opisania za pomocą standardowych funkcji matematycznych. Struktura drzewa składa się z korzenia (root), węzłów pośrednich (nodes) oraz liści (leaves). Proces rozpoczyna się w korzeniu, który reprezentuje pierwszy podział zbioru danych. Każdy podział prowadzi do kolejnych węzłów potomnych, a końcowe węzły, w których dalsze podziały nie występują, nazywane są liśćmi. Elementy drzewa łączone są za pomocą gałęzi (branches), tworząc całą jego strukturę.

W naszym przypadku służy do klasyfikacji, gdzie każdy liść wskazuje najbardziej prawdopodobną klasę na podstawie warunków podziału prowadzących do danego węzła końcowego. Celem algorytmu budującego drzewo jest maksymalizacja jednorodności klas w obrębie liści, co oznacza, że model stara się tak dobierać podziały, aby dane trafiające do każdego liścia były możliwie jak najbardziej spójne względem klasy, do której należą.

Jedną z największych zalet drzew decyzyjnych jest ich czytelność – można je łatwo przedstawić graficznie, co umożliwia intuicyjne zrozumienie, jak model podejmuje decyzje.

dt_fit <- classification_models %>%
  extract_workflow("rec_dt") %>%
  fit(data = train)

dt_preds <- predict(dt_fit, new_data = test, type = "prob") %>%
  bind_cols(predict(dt_fit, new_data = test)) %>%
  bind_cols(test %>% select(booking_status))


# Metryki dla Decision Tree
bind_rows(
  yardstick::metrics(dt_preds, truth = booking_status, estimate = .pred_class),
  yardstick::roc_auc(dt_preds, truth = booking_status, .pred_Not_Canceled),
  yardstick::precision(dt_preds, truth = booking_status, estimate = .pred_class),
  yardstick::recall(dt_preds, truth = booking_status, estimate = .pred_class),
  yardstick::specificity(dt_preds, truth = booking_status, estimate = .pred_class),
  yardstick::f_meas(dt_preds, truth = booking_status, estimate = .pred_class)
) %>%
  select(.metric, .estimate) %>%
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Dokładność (Accuracy)",
    .metric == "roc_auc" ~ "ROC AUC",
    .metric == "precision" ~ "Precyzja (Precision)",
    .metric == "recall" ~ "Czułość (Recall)",
    .metric == "specificity" ~ "Specyficzność (Specificity)",
    .metric == "f_meas" ~ "F1-score",
    TRUE ~ .metric
  )) %>%
  gt() %>%
  fmt_number(columns = vars(.estimate), decimals = 3) %>%
  cols_label(
    .metric = "Miara",
    .estimate = "Wartość"
  ) %>%
  tab_header(
    title = "Metryki modelu Decision Tree"
  ) %>% 
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "lightgreen")
    ),
    locations = cells_column_labels(columns = everything())
  )
Metryki modelu Decision Tree
Miara Wartość
Dokładność (Accuracy) 0.797
kap 0.547
ROC AUC 0.797
Precyzja (Precision) 0.862
Czułość (Recall) 0.831
Specyficzność (Specificity) 0.727
F1-score 0.846

4.1.2.1 Confusion Matrix

cm_dt <- conf_mat(dt_preds, truth = booking_status, estimate = .pred_class)

autoplot(cm_dt, type = "heatmap") +
  scale_fill_gradient(low = "white", high = "lightgreen") +
  labs(title = "Macierz pomyłek - Decision Tree") +
  theme_minimal() +
  theme(legend.position = "right")

Model osiąga dobrą dokładność (0.797) oraz Kappa (0.547). Ma wysoką czułość (0.831) i precyzję (0.862), co przekłada się na dobry F1-score (0.846). ROC AUC wynosi 0.797, co świadczy o przyzwoitej zdolności rozróżniania klas.

4.1.2.2 Wizualizacja drzewa decyzyjnego

library(rpart.plot)

rpart_model <- dt_fit %>% 
  extract_fit_parsnip() %>% 
  .$fit

rpart.plot(rpart_model, type = 2, extra = 106, fallen.leaves = TRUE, main = "Drzewo decyzyjne")

To skuteczny i zrównoważony model do przewidywania anulacji rezerwacji

4.1.3 Las losowy (Random Forest)

Lasy losowe stanowią rozszerzenie metody baggingu, wzbogacone o dodatkowy element losowości. Podczas konstruowania każdego drzewa wchodzącego w skład lasu, losowo wybiera się \(m\) predyktorów spośród wszystkich \(p\) dostępnych zmiennych. Budowa drzewa opiera się wyłącznie na tej losowej podpróbie cech. Zazwyczaj wartość \(m\) przyjmuje się jako pierwiastek z liczby wszystkich predyktorów, czyli \(m = \sqrt{p}\).

rf_fit <- classification_models %>%
  extract_workflow("rec_rf") %>%
  fit(data = train)

preds <- predict(rf_fit, new_data = test, type = "prob") %>%
  bind_cols(predict(rf_fit, new_data = test)) %>%
  bind_cols(test %>% select(booking_status))


# Accuracy, F1, ROC AUC
bind_rows(
  yardstick::metrics(preds, truth = booking_status, estimate = .pred_class),
  yardstick::roc_auc(preds, truth = booking_status, .pred_Not_Canceled),
  yardstick::precision(preds, truth = booking_status, estimate = .pred_class),
  yardstick::recall(preds, truth = booking_status, estimate = .pred_class),
  yardstick::specificity(preds, truth = booking_status, estimate = .pred_class),
  yardstick::f_meas(preds, truth = booking_status, estimate = .pred_class)
  ) %>%
  select(.metric, .estimate) %>%
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Dokładność (Accuracy)",
    .metric == "roc_auc" ~ "ROC AUC",
    .metric == "precision" ~ "Precyzja (Precision)",
    .metric == "recall" ~ "Czułość (Recall)",
    .metric == "specificity" ~ "Specyficzność (Specificity)",
    .metric == "f_meas" ~ "F1-score",
    TRUE ~ .metric
  )) %>%
  gt() %>%
  fmt_number(columns = vars(.estimate), decimals = 3) %>%
  cols_label(
    .metric = "Miara",
    .estimate = "Wartość"
  ) %>%
  tab_header(
    title = "Metryki modelu Random Forest"
  ) %>% 
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "darkgreen")
    ),
    locations = cells_column_labels(columns = everything())
  )
Metryki modelu Random Forest
Miara Wartość
Dokładność (Accuracy) 0.897
kap 0.765
ROC AUC 0.955
Precyzja (Precision) 0.920
Czułość (Recall) 0.927
Specyficzność (Specificity) 0.834
F1-score 0.924

4.1.3.1 Confusion Matrix

cm_rf <- conf_mat(preds, truth = booking_status, estimate = .pred_class)

autoplot(cm_rf, type = "heatmap") +
  scale_fill_gradient(low = "white", high = "darkgreen") +
  labs(title = "Macierz pomyłek - Random Forest") +
  theme_minimal() +
  theme(legend.position = "right")

Model osiąga bardzo wysoką dokładność (0.897) i Kappa (0.765). Zarówno precyzja (0.920), jak i czułość (0.927) są na wysokim poziomie, co przekłada się na dość dobry F1-score (0.924). ROC AUC (0.955) wskazuje na bardzo dobrą zdolność rozróżniania klas. To najlepiej sprawdzający się model w zadaniu przewidywania anulacji rezerwacji.

4.1.3.2 Wykres ważności zmiennych

p <- vip(extract_fit_parsnip(rf_fit)$fit, num_features = 10)

p + 
  ggplot2::geom_col(fill = "darkgreen") + 
  ggplot2::theme_minimal()

Z wykresu ważności zmiennych wynika, że najważniejszym czynnikiem rozróżniającym jest lead_time — czyli czas od dokonania rezerwacji do planowanego przyjazdu. Kolejne istotne zmienne to avg_price_per_room, no_of_special_requests oraz arrival_month, które również znacząco wpływają na przewidywanie anulacji rezerwacji.

4.1.4 Naive Bayes

W naiwnym klasyfikatorze Bayesa zakłada się warunkową niezależność poszczególnych atrybutów względem klasy do której (zgodnie z hipotezą) ma należeć dany obiekt. Założenie to często nie jest spełnione i stąd nazwa “naiwny”.

# Dopasowanie modelu Naive Bayes
nb_fit <- classification_models %>%
  extract_workflow("rec_d_nb") %>%
  fit(data = train)

# Predykcje
nb_preds <- predict(nb_fit, new_data = test, type = "prob") %>%
  bind_cols(predict(nb_fit, new_data = test)) %>%
  bind_cols(test %>% select(booking_status))


# Metryki
bind_rows(
  yardstick::metrics(nb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::roc_auc(nb_preds, truth = booking_status, .pred_Not_Canceled),
  yardstick::precision(nb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::recall(nb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::specificity(nb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::f_meas(nb_preds, truth = booking_status, estimate = .pred_class)
) %>%
  select(.metric, .estimate) %>%
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Dokładność (Accuracy)",
    .metric == "roc_auc" ~ "ROC AUC",
    .metric == "precision" ~ "Precyzja (Precision)",
    .metric == "recall" ~ "Czułość (Recall)",
    .metric == "specificity" ~ "Specyficzność (Specificity)",
    .metric == "f_meas" ~ "F1-score",
    TRUE ~ .metric
  )) %>%
  gt() %>%
  fmt_number(columns = vars(.estimate), decimals = 3) %>%
  cols_label(
    .metric = "Miara",
    .estimate = "Wartość"
  ) %>%
  tab_header(
    title = "Metryki modelu Naive Bayes"
  )%>% 
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "darkorange")
    ),
    locations = cells_column_labels(columns = everything())
  )
Metryki modelu Naive Bayes
Miara Wartość
Dokładność (Accuracy) 0.373
kap 0.044
ROC AUC 0.839
Precyzja (Precision) 0.989
Czułość (Recall) 0.068
Specyficzność (Specificity) 0.998
F1-score 0.127

Model Naive Bayes osiąga bardzo wysoką precyzję (0.989) oraz specyficzność (0.998) i jednocześnie bardzo niska czułość (Recall = 0.068) i F1-score (0.127), co oznacza, że model nie radzi sobie z wykrywaniem anulowanych rezerwacji.

4.1.4.1 Confusion Matrix

cm_nb <- conf_mat(nb_preds, truth = booking_status, estimate = .pred_class)

autoplot(cm_nb, type = "heatmap") +
  scale_fill_gradient(low = "white", high = "darkorange") +
  labs(title = "Macierz pomyłek - Naive Bayes") +
  theme_minimal() +
  theme(legend.position = "right")

Naive Bayes jest zbyt uproszczonym modelem dla tego problemu — jego silne założenie niezależności cech i skrajna asymetria predykcji skutkują bardzo słabym wynikiem ogólnym, mimo wysokiej precyzji. W kontekście przewidywania anulacji rezerwacji (prawie zawsze wykrywa, że rezerwacja jest odwołana), ten model jest niewystarczający praktycznie.

4.1.5 XGBoost

W metodzie boosting odpowiednio modyfikuje się drzewo wyjściowe w kolejnych krokach, ucząc je na tym samym zbiorze treningowym. Uczenie drzew klasyfikacyjnych metodą boosting przebiega w sposób podobny do uczenia drzew regresyjnych. Wynik takiego procesu zależy od trzech głównych parametrów:

  1. Liczby drzew \(B\) - zbyt duża wartość \(B\) może prowadzić do przeuczenia modelu. Najczęściej parametr ten ustalany jest na podstawie walidacji krzyżowej.
  2. Parametru “kurczenia” \(\lambda\) - kontroluje on tempo uczenia się kolejnych drzew. Bardzo małe wartości \(\lambda\) mogą wymagać dobrania większego \(B\), aby zapewnić dobrą jakość predykcyjną modelu.
  3. Liczby podziałów w drzewach \(d\), która decyduje o złożoności pojedynczego drzewa.
xgb_fit <- classification_models %>%
  extract_workflow("rec_d_xgb") %>%
  fit(data = train)

xgb_preds <- predict(xgb_fit, new_data = test, type = "prob") %>%
  bind_cols(predict(xgb_fit, new_data = test)) %>%
  bind_cols(test %>% select(booking_status))


bind_rows(
  yardstick::metrics(xgb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::roc_auc(xgb_preds, truth = booking_status, .pred_Not_Canceled),
  yardstick::precision(xgb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::recall(xgb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::specificity(xgb_preds, truth = booking_status, estimate = .pred_class),
  yardstick::f_meas(xgb_preds, truth = booking_status, estimate = .pred_class)
) %>%
  select(.metric, .estimate) %>%
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Dokładność (Accuracy)",
    .metric == "roc_auc" ~ "ROC AUC",
    .metric == "precision" ~ "Precyzja (Precision)",
    .metric == "recall" ~ "Czułość (Recall)",
    .metric == "specificity" ~ "Specyficzność (Specificity)",
    .metric == "f_meas" ~ "F1-score",
    TRUE ~ .metric
  )) %>%
  gt() %>%
  fmt_number(columns = vars(.estimate), decimals = 3) %>%
  cols_label(
    .metric = "Miara",
    .estimate = "Wartość"
  ) %>%
  tab_header(
    title = "Metryki modelu XGBoost"
  )%>% 
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "maroon")
    ),
    locations = cells_column_labels(columns = everything())
  )
Metryki modelu XGBoost
Miara Wartość
Dokładność (Accuracy) 0.861
kap 0.690
ROC AUC 0.932
Precyzja (Precision) 0.907
Czułość (Recall) 0.884
Specyficzność (Specificity) 0.814
F1-score 0.896

4.1.5.1 Confusion Matrix

cm_xgb <- conf_mat(xgb_preds, truth = booking_status, estimate = .pred_class)

autoplot(cm_xgb, type = "heatmap") +
  scale_fill_gradient(low = "white", high = "maroon") +
  labs(title = "Macierz pomyłek - XGBoost") +
  theme_minimal() +
  theme(legend.position = "right")

Model osiąga wysoką dokładność (0.861) oraz Kappa (0.690). Zarówno precyzja (0.907), jak i czułość (0.884) są bardzo dobre, co daje dobry wynik F1-score (0.896). ROC AUC (0.932) potwierdza wysoką zdolność rozróżniania klas. To bardzo skuteczny model, ustępujący nieco tylko Random Forest.

5 Porównanie modeli

library(ggrepel)

acc <- autoplot(classification_models, metric = "accuracy")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")

kap <- autoplot(classification_models, metric = "kap")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")

roc <- autoplot(classification_models, metric = "roc_auc")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")

recall <- autoplot(classification_models, metric = "recall")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")

f1 <- autoplot(classification_models, metric = "f_meas")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")

prec <- autoplot(classification_models, metric = "precision")+
  geom_text_repel(aes(label = model))+
  theme(legend.position = "none")


gridExtra::grid.arrange(acc, kap, roc, recall, prec, f1)

Random Forest (las losowy) oraz Boosted Tree (XGBoost) okazują się najlepiej radzącymi sobie modelami w zadaniu klasyfikacyjnym. Spośród wszystkich testowanych algorytmów osiągają najwyższe wyniki w kluczowych metrykach, takich jak Accuracy, Kappa, Recall, F1 Score oraz ROC AUC. Z kolei Naive Bayes, mimo że charakteryzuje się bardzo wysoką precyzją, znacząco odstaje od pozostałych modeli pod względem pozostałych miar skuteczności, co ogranicza jego przydatność w praktyce.

5.1 Krzywa ROC

classification_models %>%
  collect_predictions() %>%
  group_by(model) %>%
  roc_curve(booking_status, .pred_Not_Canceled) %>%
  autoplot() +
  theme_minimal()

Krzywa ROC ilustruje zależność pomiędzy czułością (sensitivity) a specyficznością (1 - specificity), pozwalając ocenić skuteczność modeli przy różnych progach decyzyjnych.

Można zauważyć, że najlepszy wynik osiągnął model lasu losowego, którego krzywa znajduje się najwyżej względem pozostałych, co świadczy o bardzo wysokiej skuteczności klasyfikacji. Niewiele ustępuje mu model boost_tree, którego krzywa również znajduje się bardzo blisko lewego górnego rogu wykresu, wskazując na wysoką czułość i niską liczbę fałszywie pozytywnych wyników.

Model regresji logistycznej wykazuje umiarkowaną skuteczność – jego krzywa przebiega pośrodku wykresu. Model drzewa decyzyjnego prezentuje się nieco słabiej, a jego krzywa znajduje się poniżej tej uzyskanej przez regresję logistyczną.

Najgorsze wyniki osiągnął model naive_Bayes. Jego krzywa przebiega najbliżej przekątnej wykresu, która reprezentuje klasyfikację losową. Oznacza to, że skuteczność tego modelu jest niska i niewystarczająca.

Podsumowując, najbardziej efektywnym modelem w tym porównaniu okazał się las losowy, natomiast najmniej skutecznym – naiwny klasyfikator Bayesa.

5.2 Metryki

Porównanie modeli klasyfikacyjnych
Model Accuracy F1_Score Precision Recall ROC_AUC
Regresja logistyczna 0.781 0.778 0.778 0.777 0.870
Decision T 0.780 0.788 0.751 0.828 0.796
Random Forest 0.927 0.926 0.935 0.917 0.979
Naive Bayes 0.576 0.231 0.957 0.158 0.845
XGBoost 0.858 0.860 0.836 0.886 0.938

Random Forest zdecydowanie dominuje pod względem wszystkich metryk — osiąga najwyższą dokładność (Accuracy 0.927), F1 Score (0.926) oraz ROC AUC (0.979), co wskazuje na jego wysoką skuteczność i dobrą równowagę między czułością a specyficznością.

XGBoost także radzi sobie bardzo dobrze, szczególnie pod kątem Recall (0.886) i ROC AUC (0.938), co sugeruje, że dobrze identyfikuje pozytywne przypadki.

Natomiast Naive Bayes ma zdecydowanie najniższą skuteczność ogólną, mimo wysokiej precyzji (0.957), co oznacza, że często pomija prawdziwe przypadki (niski Recall 0.158).

Regresja logistyczna i drzewo decyzyjne wypadają umiarkowanie, z wyższym Recall dla drzewa.

6 Podsumowanie

Celem projektu było stworzenie modelu klasyfikacyjnego przewidującego anulowanie rezerwacji hotelowej.

Dane zostały przygotowane z zachowaniem proporcji klas poprzez 5-krotną walidację krzyżową ze stratyfikacją, co zapewniło rzetelną ocenę modeli.

Przetestowano kilka algorytmów, takich jak regresja logistyczna (Logistic Regression), drzewo decyzyjne (Decision Tree), las losowy (Random Forest), Naive Bayes oraz XGBoost.

Najlepsze wyniki osiągnął las losowy (Random Forest), który uzyskał najwyższą dokładność i zrównoważone metryki oceny, potwierdzając jego skuteczność w przewidywaniu anulacji rezerwacji.

Wyniki pokazują, że zastosowanie zaawansowanych metod, takich jak las losowy czy XGBoost, znacząco poprawia przewidywania w porównaniu do prostszych modeli.

Projekt pokazuje, jak wykorzystanie różnych metod klasyfikacyjnych oraz odpowiednia walidacja mogą znacząco podnieść jakość prognoz w zastosowaniach biznesowych. Uzyskane modele mogą wspierać decyzje operacyjne hotelu, pomagając lepiej zarządzać rezerwacjami i minimalizować straty związane z anulacjami.

7 Bibliografia