Predicción cancelación de reserva de hoteles

Este proyecto consiste en generar un modelo de Inteligencia Artificial que sea capaz de predecir si una reserva de hotel será cancelada.

Partimos como base con el archivo de datos (bookings.csv) que contiene datos sobre la reserva de un hotel urbano y de un hotel turístico, e incluye información como la fecha de la reserva, la duración de la estancia, el número de adultos, niños y/o bebés, y el número de plazas de aparcamiento disponibles, entre otras variables.

Fase 1: Carga y limpieza de datos

Carga de librerías

library(tidyverse)
library(skimr)
library(corrplot)

Lectura del fichero

bookings <- read.csv("data/bookings.csv")

Examinando variables y tipos

Para tener una primera toma de contacto con las variables, vamos a utilizar la función skim(), la cual nos muestra un resumen de nuestro dataset donde podremos ver el número de filas, el número de columnas, cuáles son de tipo caracter o cuáles son numéricas, entre otras cosas. También nos muestra información relevante como si hay NAs en alguna columna, la media de las columnas que sean númericas o el número de valores distintos de las columnas categóricas.

skim(bookings)

Data summary
Name	bookings
Number of rows	119390
Number of columns	32
_______________________
Column type frequency:
character	14
numeric	18
________________________
Group variables	None

Variable type: character

skim_variable	complete_rate	min	max	n_unique
hotel	1	10	12	2
arrival_date_month	1	3	9	12
meal	1	2	9	5
country	1	2	4	178
market_segment	1	6	13	8
distribution_channel	1	3	9	5
reserved_room_type	1	1	1	10
assigned_room_type	1	1	1	12
deposit_type	1	10	10	3
agent	1	1	4	334
company	1	1	4	353
customer_type	1	5	15	4
reservation_status	1	7	9	3
reservation_status_date	1	10	10	926

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
is_canceled	0	1	0.37	0.48	0.00	0.00	0.00	1	1	▇▁▁▁▅
lead_time	0	1	104.01	106.86	0.00	18.00	69.00	160	737	▇▂▁▁▁
arrival_date_year	0	1	2016.16	0.71	2015.00	2016.00	2016.00	2017	2017	▃▁▇▁▆
arrival_date_week_number	0	1	27.17	13.61	1.00	16.00	28.00	38	53	▅▇▇▇▅
arrival_date_day_of_month	0	1	15.80	8.78	1.00	8.00	16.00	23	31	▇▇▇▇▆
stays_in_weekend_nights	0	1	0.93	1.00	0.00	0.00	1.00	2	19	▇▁▁▁▁
stays_in_week_nights	0	1	2.50	1.91	0.00	1.00	2.00	3	50	▇▁▁▁▁
adults	0	1	1.86	0.58	0.00	2.00	2.00	2	55	▇▁▁▁▁
children	4	1	0.10	0.40	0.00	0.00	0.00	0	10	▇▁▁▁▁
babies	0	1	0.01	0.10	0.00	0.00	0.00	0	10	▇▁▁▁▁
is_repeated_guest	0	1	0.03	0.18	0.00	0.00	0.00	0	1	▇▁▁▁▁
previous_cancellations	0	1	0.09	0.84	0.00	0.00	0.00	0	26	▇▁▁▁▁
previous_bookings_not_canceled	0	1	0.14	1.50	0.00	0.00	0.00	0	72	▇▁▁▁▁
booking_changes	0	1	0.22	0.65	0.00	0.00	0.00	0	21	▇▁▁▁▁
days_in_waiting_list	0	1	2.32	17.59	0.00	0.00	0.00	0	391	▇▁▁▁▁
adr	0	1	101.83	50.54	-6.38	69.29	94.58	126	5400	▇▁▁▁▁
required_car_parking_spaces	0	1	0.06	0.25	0.00	0.00	0.00	0	8	▇▁▁▁▁
total_of_special_requests	0	1	0.57	0.79	0.00	0.00	0.00	1	5	▇▁▁▁▁

Ahora vamos a clasificar las variables separándolas en dos vectores, en uno de ellos introduciremos el nombre de las catégoricas, y en el otro, el de las numéricas.

# Categóricas y binarias
categoricas <- c("hotel", "is_canceled", "arrival_date_month", "meal", "country", "market_segment", "distribution_channel", "reserved_room_type", "assigned_room_type", "is_repeated_guest", "deposit_type", "customer_type","reservation_status","arrival_date_year", "arrival_date_week_number", "arrival_date_day_of_month", "agent", "company")

# Numéricas
numericas <- c("lead_time", "stays_in_weekend_nights", "stays_in_week_nights", "adults", "children", "babies", "previous_bookings_not_canceled","previous_cancellations", "booking_changes", "days_in_waiting_list", "adr", "total_of_special_requests", "reservation_status_date",  "required_car_parking_spaces")

Limpieza de datos

Vamos a empezar localizando los valores nulos. Para ello, primero crearemos una variable con el número de filas totales.

totalfilas <- nrow(bookings)

En primer lugar, veremos qué columnas contienen nulos, después haremos la suma de los nulos en cada columna y, por último, vamos a mostrar el porcentaje de nulos sobre el total de filas de la columna.

bookings %>%
  mutate(is_canceled = factor(is_canceled)) %>%
  gather(key = "variable_str", value = "valor", -is_canceled) %>%
  filter(str_to_upper(valor) == "NULL" | str_to_upper(valor) == "null") %>%
  group_by(variable_str) %>%
  summarise(Nulls = n(),
            Porcentaje = (Nulls/totalfilas)*100)

## # A tibble: 3 × 3
##   variable_str  Nulls Porcentaje
##   <chr>         <int>      <dbl>
## 1 agent         16340     13.7  
## 2 company      112593     94.3  
## 3 country         488      0.409

Vemos que hay tres columnas que contienen nulos, que son agent, company y country. De las tres, company es la más afectada, ya que más de un 94% de sus valores son nulos, mientras que en las otras dos el porcentaje es mucho más bajo. Por tanto, lo que haremos con las columnas agent y country será sustituir los nulos por 0.

bookings <- bookings %>%
  mutate(agent = case_when(agent == "NULL" ~ "0", TRUE ~ as.character(agent)),
         country = case_when(country == "NULL" ~ "0", TRUE ~ as.character(country)))

Comprobamos que ahora hay 0 donde antes había nulos.

bookings %>%
  select(agent, country) %>%
  filter(agent == "0" | country == "0") %>%
  head()

##   agent country
## 1     0     PRT
## 2     0     PRT
## 3     0     GBR
## 4     0     PRT
## 5     0     FRA
## 6     0       0

Eliminamos la columna company, ya que tenía más de un 90% de valores nulos.

bookings <- bookings %>%
  select(-company)

Ahora vamos a realizar un filtro similar al que hemos utilizado para los nulos, para ver si hay columnas que contienen NA’s.

bookings %>%
  mutate(is_canceled = factor(is_canceled)) %>%
  gather(key = "variable_str", value = "valor", -is_canceled) %>%
  filter(is.na(valor) | valor == "NA" | valor == "na")

##   is_canceled variable_str valor
## 1           1     children  <NA>
## 2           1     children  <NA>
## 3           1     children  <NA>
## 4           1     children  <NA>

En este caso, al ser una columna que no puede tomar valores decimales, ya que estamos hablando del número de niños, lo que haremos será sustituirlos por la moda.

Creamos una función para calcular la moda y sustituimos los valores NA’s por la moda:

calcular_moda <- function(x) {
  return(as.numeric(names(which.max(table(x)))))
}

bookings <- bookings %>% 
  mutate(children = case_when(is.na(children) ~ calcular_moda(bookings$children), TRUE ~ as.double(children)))

El último paso que haremos de limpieza de datos será comprobar si hay datos fuera de rango en el número de personas de una reserva, es decir, comprobaremos que haya al menos una persona por reserva.

Creamos una columna con la suma de los adultos, niños y bebés por fila:

bookings <- bookings %>%
  mutate(people_count = adults+children+babies)

Contamos el número total de filas en las que la suma anterior es 0:

bookings %>%
  filter(people_count == 0) %>%
  summarise(n())

##   n()
## 1 180

Lo que haremos con esas filas será eliminarlas:

bookings <- bookings[!(bookings$people_count == 0), ]

Comprobamos que se han eliminado correctamente:

bookings %>%
  filter(people_count == 0) %>%
  summarise(n())

##   n()
## 1   0

Guardamos en un.csv el dataframe limpio sin sobreescribir el original:

write.csv(bookings, "data/bookings_limpio.csv")

Fase 2: Análisis exploratorio y preprocesamiento

Variable objetivo: is_canceled

Vamos a ver cuál es la distribución de nuestra variable objetivo:

is_canceled_factor <- factor(bookings$is_canceled)
plot(is_canceled_factor, col= c("salmon", "cyan"), xlab="is canceled", ylab="count")

Como podemos observar los datos están algo desnivelados, por tanto lo que haremos será realizar un balanceo de los datos para obtener unas gráficas algo más claras.

Para ello primero creamos un dataframe con las reservas que se han cancelado:

bookings_cancelados <- bookings %>%
  filter(is_canceled == 1)

Después contamos el número total de reservas que se han cancelado:

total_cancelados <- nrow(bookings_cancelados)

Ahora crearemos otro dataframe con las reservas que no se han cancelado:

bookings_no_cancelados<- bookings %>%
  filter(is_canceled == 0)

Finalmente, creamos un dataframe realizando un muestreo a partir del dataframe que contiene las reservas que no han sido canceladas, dicho dataframe será del mismo tamaño que las reservas que se han cancelado.

bookings_no_cancelados_muestreo <- sample_n(bookings_no_cancelados, total_cancelados)
bookings_50_50 <- union_all(bookings_cancelados, bookings_no_cancelados_muestreo)

Vamos a realizar la misma gráfica que usamos para ver la distribución de nuestra variable objetivo, pero esta vez utilizando el dataframe que hemos creado:

factor50_50 <- factor(bookings_50_50$is_canceled)
plot(factor50_50, col= c("salmon", "cyan"), xlab="is canceled", ylab="count")

Explorando variables

Vamos a dividir la exploración de las relaciones de las variables con la variable objetivo en tres partes. Y estas, a su vez, en dos partes más, ya que analizaremos por una parte las categóricas y por otra las numéricas:

Variables relativas a fechas de llegada/reserva
Variables de tipo servicio contratado
Variables categóricas relativas al cliente y la forma de contratación o reserva

Variables relativas a fechas de llegada/reserva y su relación con la variable objetivo

Categóricas

Ya que al eliminar los nulos eliminamos la columna company, ahora debemos de eliminarla también del vector que contiene el nombre de las columnas categóricas.

categoricas <- categoricas[-which(categoricas == "company")]

Tanto arrival_date_month como arrival_date_year tienen una distribución muy similar con prácticamente los mismos casos de cancelaciones y de no cancelaciones. Por tanto, consideramos que la fecha de llegada no tiene prácticamente ninguna influencia sobre las cancelaciones.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(arrival_date_month, arrival_date_year,is_canceled) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Para arrival_date_day_of_month y para arrival_date_week_number ocurre algo parecido a las dos anteriores, si bien es cierto que hay casos en los que parece influir algo más, sigue sin ser algo relevante.

En cambio en assigned_room_type sí que podemos ver una fuerte relación con la variable objetivo, ya que el nivel de cancelación aumenta o disminuye según la habitación asignada, ya que, por ejemplo, no se cancelan prácticamente reservas con habitaciones asignadas ‘K’ o ‘I’ , mientras que se cancelan la mayoría en las que la habitación asignada es la ‘A’.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(arrival_date_day_of_month, arrival_date_week_number, assigned_room_type ,is_canceled) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Numéricas

En esta primera parte, las variables numéricas que vamos a analizar son stays_in_weekend_nights y stays_in_week_nights, las cuales son muy similares y muestran una clara influencia en nuestra variable objetivo, ya que las cancelaciones son bastante frecuentes en reservas con valores de hasta 24 en stays_in_weekend_nights y 9 en stays_in_week_nights, mientras que vemos como claramente se reducen al superar estas cifras.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(stays_in_weekend_nights,stays_in_week_nights, categoricas[2]) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Variables de tipo servicio contratado (hotel, régimen de alojamiento, habitación, … )

Categóricas

No se aprecia una influencia significativa sobre nuestra variable objetivo.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(hotel, reserved_room_type, meal, is_canceled) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Numéricas

Aquí podemos observar que en adults hay especialmente un número bastante alto de cancelaciones, mientras que en children hay más cancelados que no cancelados, pero con una diferencia menor a adults, y ocurre lo contrario en babies, donde la mayoría son no cancelados.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(adults, babies, children, categoricas[2]) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

En bookings_changes vemos una clara influencia tanto en no cancelaciones, que es la mayor parte, como en cancelaciones, circunstancia que se da con menos frecuencia en general pero es un número considerable para las reservas con 16 cambios.

En total_of_special_requests vemos una tendencia, en la cual, cuantos más requerimientos se soliciten, menor probabilidad de cancelación.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(booking_changes, total_of_special_requests, categoricas[2]) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Variables categóricas relativas al cliente y la forma de contratación o reserva (agente, segmento, país, tipo de cliente, …)

Categóricas

En distribution_channel podemos ver como las reservas hechas por un medio indefinido son canceladas en su totalidad, las realizadas mediante TA/TO se cancelan más de un 50% y el resto se sitúan por encima del 25%, por lo que existe relación con la variable objetivo.

En el caso de is_repeated_guest vemos que los huéspedes repetidos no suelen cancelar, en cambio para los nuevos la cosa estaría prácticamente 50/50.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(distribution_channel, is_repeated_guest, is_canceled) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

En customer_type vemos que hay menos cancelaciones en las categoría group y ligeramente en transient-party , mientras que para el resto están en torno al 50%.

Para deposit_type vemos que hay un número bastante elevado de cancelaciones para Non Refund mientras que las otras dos categorías tienen alrededor de un 40% de cancelaciones.

En market_segment vemos que igual que en distribution_channel, la categoría undefined tiene un 100% de cancelaciones. En cuanto al resto, groups también tiene un porcentaje alto de cancelaciones, online_ta y online_ta/to tienen valores similares cercanos al 50% y el resto se sitúan con valores relativamente bajos en cancelaciones.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(market_segment, customer_type, deposit_type, is_canceled) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Numéricas

previous_bookings_not_canceled no tiene apenas cancelaciones, tiene dos casos en los que la cancelación es del 100%, pero teniendo en cuenta el número de datos que hay, no es determinante para la valoración final.

En required_car_parking_spaces vemos que no hay casi cancelaciones y, por el contrario, previous_cancellations sí que tiene la mayoría de casos cancelados.

bookings_50_50 %>% 
  mutate(is_canceled = factor(is_canceled)) %>%
  select(previous_bookings_not_canceled,previous_cancellations, required_car_parking_spaces, categoricas[2]) %>%
  gather(key = "variable", value = "valor", -is_canceled) %>% 
  ggplot( aes(y = valor, fill = is_canceled)) +
  facet_wrap(facets = ~variable, scales = "free") +
  geom_bar(alpha = 0.7, position = "fill")

Preprocesamiento

Para la creación de los modelos será necesario transformar las variables categóricas a factor y normalizar las variables numéricas por rango. En nuestro caso no será necesario hacerlo previamente, ya que lo haremos al crear la receta. De todos modos, en caso de que se tuviese que hacer antes de crear la receta, se haría de la siguiente forma:

Primero creamos una función para normalizar por rango:

normalizacion_rango <- function(col) {
  (col - min (col)) / (max (col) - min (col))
  }

Después transformamos las variables categóricas en factor con un mutate_if y normalizamos por rango las variables numéricas utilizando la función que hemos creado en el paso anterior. En este caso, las variables que no están normalizadas por rango y, por tanto, queremos normalizar, son adr y lead_time.

bookings_factor_normalizado <- bookings %>%
  mutate_if(is.character, as.factor) %>%
  mutate(adr =  normalizacion_rango(adr),
         lead_time = normalizacion_rango(lead_time))

Por último, vamos a crear una variable para reducir las categorías de la columna country, dicha variable contendrá un 1 si la persona de esa fila es portugués o un 0 si es procedente de cualquier otro país.

bookings <- bookings %>%
    mutate(is_portuguese = case_when(country == "PRT" ~ 1, TRUE ~ 0))

Guardamos en fichero en un .csv el dataset listo para crear los modelos.

write.csv(bookings, "data/bookings_for_models.csv")

Bookings Analysis

Andrés Expóstio Atiénzar