# Quitar notación cientifica
options(scipen=999)
# Cargar librerias
library(readxl) # Para leer los archivos
library(dplyr) # Manipulación de datos
library(ggplot2) # Gráficos
library(tidyr) # Manipulación de datos
library(skimr) # Resumen estadísticos
library(reactable) # Tablas dinámicas
library(plotly) # Gráficos dinámicos
library(cluster) # Implementar K-means
library(factoextra) # Manipulación de datos
library(coefplot) # Visualización de coeficientes
library(fastDummies) # Manipulacion de variables dicotomicas
library(GGally) # Grafico comparativo
# Importar datos, especificando el tipo de variable
data <- read_excel("TESTING.xlsx",
col_types = c("text", "text", "numeric",
"text", "text", "text", "date", "text",
"text", "numeric", "text", "text",
"numeric", "numeric", "numeric",
"numeric", "numeric", "text", "text",
"text", "text", "numeric", "text",
"text"))
Informacion acerca del conjunto de datos
https://www.kaggle.com/datasets/pankajjsh06/ibm-watson-marketing-customer-value-data
# Resumen estadistico
skim(data)
Name | data |
Number of rows | 9134 |
Number of columns | 24 |
_______________________ | |
Column type frequency: | |
character | 15 |
numeric | 8 |
POSIXct | 1 |
________________________ | |
Group variables | None |
Variable type: character
skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
---|---|---|---|---|---|---|---|
Customer | 0 | 1 | 7 | 7 | 0 | 9134 | 0 |
State | 0 | 1 | 6 | 10 | 0 | 5 | 0 |
Response | 0 | 1 | 2 | 3 | 0 | 2 | 0 |
Coverage | 0 | 1 | 5 | 8 | 0 | 3 | 0 |
Education | 0 | 1 | 6 | 20 | 0 | 5 | 0 |
EmploymentStatus | 0 | 1 | 7 | 13 | 0 | 5 | 0 |
Gender | 0 | 1 | 1 | 1 | 0 | 2 | 0 |
Location Code | 0 | 1 | 5 | 8 | 0 | 3 | 0 |
Marital Status | 0 | 1 | 6 | 8 | 0 | 3 | 0 |
Policy Type | 0 | 1 | 12 | 14 | 0 | 3 | 0 |
Policy | 0 | 1 | 10 | 12 | 0 | 9 | 0 |
Renew Offer Type | 0 | 1 | 6 | 6 | 0 | 4 | 0 |
Sales Channel | 0 | 1 | 3 | 11 | 0 | 4 | 0 |
Vehicle Class | 0 | 1 | 3 | 13 | 0 | 6 | 0 |
Vehicle Size | 0 | 1 | 5 | 7 | 0 | 3 | 0 |
Variable type: numeric
skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
---|---|---|---|---|---|---|---|---|---|---|
Customer Lifetime Value | 0 | 1 | 8004.94 | 6870.97 | 1898.01 | 3994.25 | 5780.18 | 8962.17 | 83325.38 | ▇▁▁▁▁ |
Income | 0 | 1 | 37657.38 | 30379.90 | 0.00 | 0.00 | 33889.50 | 62320.00 | 99981.00 | ▇▆▅▅▃ |
Monthly Premium Auto | 0 | 1 | 93.22 | 34.41 | 61.00 | 68.00 | 83.00 | 109.00 | 298.00 | ▇▂▁▁▁ |
Months Since Last Claim | 0 | 1 | 15.10 | 10.07 | 0.00 | 6.00 | 14.00 | 23.00 | 35.00 | ▇▆▅▅▃ |
Months Since Policy Inception | 0 | 1 | 48.06 | 27.91 | 0.00 | 24.00 | 48.00 | 71.00 | 99.00 | ▇▇▇▇▆ |
Number of Open Complaints | 0 | 1 | 0.38 | 0.91 | 0.00 | 0.00 | 0.00 | 0.00 | 5.00 | ▇▁▁▁▁ |
Number of Policies | 0 | 1 | 2.97 | 2.39 | 1.00 | 1.00 | 2.00 | 4.00 | 9.00 | ▇▂▁▁▁ |
Total Claim Amount | 0 | 1 | 434.09 | 290.50 | 0.10 | 272.26 | 383.95 | 547.51 | 2893.24 | ▇▂▁▁▁ |
Variable type: POSIXct
skim_variable | n_missing | complete_rate | min | max | median | n_unique |
---|---|---|---|---|---|---|
Effective To Date | 0 | 1 | 2011-01-01 | 2011-02-28 | 2011-01-29 | 59 |
Las imágenes muestran un resumen descriptivo detallado de un conjunto de datos con 9,134 filas y 24 columnas, categorizadas en 15 variables de tipo carácter, 8 numéricas y 1 de tipo fecha (POSIXct). La primera sección presenta información general del dataframe, indicando la frecuencia de cada tipo de columna. Para las variables de tipo carácter, se muestra el número de valores faltantes, tasa de completitud, valores mínimo y máximo en longitud de texto, valores únicos y espacios en blanco, con cada variable categórica teniendo entre 2 y 14 valores únicos. En las variables numéricas, se observa el promedio, desviación estándar, percentiles y un histograma para cada una, destacando que variables como “Customer Lifetime Value” e “Income” presentan una alta dispersión. Finalmente, la única variable de fecha incluye estadísticas de completitud, rango de fechas y valores únicos, útil para observar la cobertura temporal del conjunto de datos.
# Gráfico de pares para las variables numéricas
ggpairs(data, columns = 3:6, aes(color = Response)) +
labs(title = "Gráfico de Pares de las Variables Físicas")
El gráfico de pares compara varias variables (Customer Lifetime
Value, Response, Coverage, y Education) y muestra las relaciones entre
ellas diferenciadas por la variable de color Response
(con
categorías “Yes” y “No”). Se observa que los clientes con una respuesta
negativa (“No”) predominan en todas las variables, especialmente en las
categorías de cobertura “Basic” y nivel educativo “Bachelor, College y
High School or below”. Además, la distribución de
Customer Lifetime Value
es asimétrica hacia valores bajos
para ambos grupos, aunque algunos valores altos están presentes. Los
boxplots indican diferencias en el valor de vida del cliente entre
categorías de cobertura y educación, con clientes en categorías de
cobertura más altas (por ejemplo, “Premium”) y niveles educativos
avanzados (como “Master”) mostrando mayor dispersión y algunos valores
más elevados. Este análisis sugiere que existen patrones específicos en
el perfil de clientes según su respuesta y sus características
demográficas y de cobertura.
total_responded <- data %>%
filter(Response == "Yes") %>%
summarise(total = n())
print(paste("El numero total de clientes que si han respondido es:",total_responded))
## [1] "El numero total de clientes que si han respondido es: 1308"
data %>%
count(Response) %>%
ggplot(aes(x = Response, y = n, fill = Response)) +
geom_bar(stat = "identity", show.legend = FALSE) +
geom_text(aes(label = n), vjust = -0.5, size = 5, color = "black") +
scale_fill_manual(values = c("No" = "#FF9999", "Yes" = "#66B2FF")) +
labs(
title = "Número de clientes que han respondido",
x = "Respuesta",
y = "Cantidad"
) +
theme_minimal(base_size = 15) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(margin = margin(r = 10))
)
El gráfico muestra el número de clientes que han respondido, diferenciando entre quienes respondieron “Sí” (Yes) y quienes respondieron “No”. La mayoría de los clientes, 7826, no han respondido, mientras que solo 1308 sí lo hicieron, lo que sugiere una baja tasa de participación o respuesta en esta actividad.
response_percentage <- data %>%
count(Response) %>%
mutate(percentage = n / sum(n) * 100)
print(response_percentage)
## # A tibble: 2 × 3
## Response n percentage
## <chr> <int> <dbl>
## 1 No 7826 85.7
## 2 Yes 1308 14.3
En el análisis de compromiso de los clientes, se observa que el 85.7% de los clientes no ha mostrado interés o no ha respondido (No), mientras que solo el 14.3% sí ha respondido o mostrado compromiso (Yes). Esto indica una participación baja, ya que la gran mayoría de los clientes no están comprometidos o no interactúan activamente.
engagement_rates <- data %>%
group_by(`Renew Offer Type`, Response) %>%
summarise(count = n()) %>%
mutate(percentage = count / sum(count) * 100)
print(engagement_rates)
## # A tibble: 7 × 4
## # Groups: Renew Offer Type [4]
## `Renew Offer Type` Response count percentage
## <chr> <chr> <int> <dbl>
## 1 Offer1 No 3158 84.2
## 2 Offer1 Yes 594 15.8
## 3 Offer2 No 2242 76.6
## 4 Offer2 Yes 684 23.4
## 5 Offer3 No 1402 97.9
## 6 Offer3 Yes 30 2.09
## 7 Offer4 No 1024 100
# Crear el gráfico de barras
ggplot(engagement_rates, aes(x = `Renew Offer Type`, y = percentage, fill = Response)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Tasa de participación por tipo de oferta de renovación",
x = "Tipo de oferta de renovación",
y = "Porcentaje de participación") +
scale_fill_manual(values = c("No" = "red", "Yes" = "blue")) +
theme_minimal() +
theme(legend.title = element_blank())
Las tasas de participación varían considerablemente según el tipo de oferta de renovación. Para la oferta “Offer1”, el 15.8% de los clientes respondió afirmativamente, mientras que el 84.2% no participó. En “Offer2”, la participación aumentó ligeramente, con un 23.4% de respuestas afirmativas y un 76.6% de negativas. Sin embargo, en “Offer3”, solo el 2.09% de los clientes participó, dejando un 97.9% sin responder. Finalmente, “Offer4” muestra una falta total de participación, con un 100% de respuestas negativas. Esto sugiere que ciertos tipos de oferta tienen mayores tasas de respuesta que otros, destacando una posible preferencia o rechazo hacia ofertas específicas.
engaged_customers <- data %>%
filter(Response == "Yes")
glimpse(engaged_customers)
## Rows: 1,308
## Columns: 24
## $ Customer <chr> "OC83172", "XZ87318", "DY87989", "SJ95…
## $ State <chr> "Oregon", "Oregon", "Oregon", "Arizona…
## $ `Customer Lifetime Value` <dbl> 8256.298, 5380.899, 24127.504, 8819.01…
## $ Response <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Ye…
## $ Coverage <chr> "Basic", "Basic", "Basic", "Basic", "B…
## $ Education <chr> "Bachelor", "College", "Bachelor", "Hi…
## $ `Effective To Date` <dttm> 2011-01-25, 2011-02-24, 2011-01-26, 2…
## $ EmploymentStatus <chr> "Employed", "Employed", "Medical Leave…
## $ Gender <chr> "F", "F", "M", "M", "M", "F", "F", "F"…
## $ Income <dbl> 62902, 55350, 14072, 99845, 14072, 500…
## $ `Location Code` <chr> "Rural", "Suburban", "Suburban", "Subu…
## $ `Marital Status` <chr> "Married", "Married", "Divorced", "Mar…
## $ `Monthly Premium Auto` <dbl> 69, 67, 71, 110, 71, 71, 99, 106, 65, …
## $ `Months Since Last Claim` <dbl> 14, 0, 13, 23, 13, 3, 12, 18, 1, 13, 5…
## $ `Months Since Policy Inception` <dbl> 94, 13, 3, 25, 3, 32, 28, 95, 36, 20, …
## $ `Number of Open Complaints` <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 3, 0, 5,…
## $ `Number of Policies` <dbl> 2, 9, 2, 8, 2, 1, 1, 2, 3, 5, 9, 8, 5,…
## $ `Policy Type` <chr> "Personal Auto", "Corporate Auto", "Co…
## $ Policy <chr> "Personal L3", "Corporate L3", "Corpor…
## $ `Renew Offer Type` <chr> "Offer2", "Offer1", "Offer1", "Offer2"…
## $ `Sales Channel` <chr> "Web", "Agent", "Agent", "Branch", "Ag…
## $ `Total Claim Amount` <dbl> 159.38304, 321.60000, 511.20000, 528.0…
## $ `Vehicle Class` <chr> "Two-Door Car", "Four-Door Car", "Four…
## $ `Vehicle Size` <chr> "Medsize", "Medsize", "Medsize", "Meds…
engaged_customers %>%
count(`Renew Offer Type`)
## # A tibble: 3 × 2
## `Renew Offer Type` n
## <chr> <int>
## 1 Offer1 594
## 2 Offer2 684
## 3 Offer3 30
engaged_customers %>%
count(`Renew Offer Type`) %>%
ggplot(aes(x = `Renew Offer Type`, y = n)) +
geom_bar(stat = "identity", fill = "steelblue") +
geom_text(aes(label = n), vjust = -0.3, color = "black", size = 4) +
labs(
title = "Clientes comprometidos por tipo de oferta de renovación",
x = "Tipo de Oferta",
y = "Cantidad"
) +
theme_minimal(base_size = 15) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(margin = margin(r = 10))
)
El desglose de clientes comprometidos por tipo de oferta de renovación muestra que “Offer2” tiene la mayor cantidad de clientes comprometidos con 684, seguido de “Offer1” con 594, mientras que “Offer3” tiene solo 30 clientes comprometidos. Esto sugiere que la oferta 2 es la más atractiva o efectiva en generar compromiso entre los clientes, en comparación con las demás ofertas.
clientes_info <- data %>%
filter(Response == "Yes") %>%
group_by(`Vehicle Class`,
Coverage,
State,
Education,
EmploymentStatus,
Gender,
`Location Code`,
`Marital Status`,
`Renew Offer Type`,
`Sales Channel`) %>%
summarise(Engaged_Count = n()) %>%
arrange(desc(Engaged_Count))
# Creando una tabla interactiva con `reactable`
reactable(clientes_info,
searchable = TRUE,
filterable = TRUE,
pagination = TRUE,
highlight = TRUE)
En este código, estoy creando una tabla pivote a partir del dataframe
engaged_customers
. Primero, utilizo count
para
calcular el número de ocurrencias de cada combinación entre
Renew Offer Type
y Sales Channel
, lo que me da
una tabla con estas combinaciones y sus frecuencias. Luego, aplico
pivot_wider
para transformar esta tabla: las categorías de
Sales Channel
se convierten en columnas, y los valores en
cada celda representan la cantidad de ocurrencias (n
) de
cada tipo de oferta de renovación (Renew Offer Type
) por
canal de ventas. También he especificado values_fill = 0
para que cualquier combinación sin datos se complete con un valor de 0
en lugar de dejarla como NA. Finalmente, imprimo la tabla pivote
resultante (pivot_data
) para revisar su estructura.
pivot_data <- engaged_customers %>%
count(`Renew Offer Type`, `Sales Channel`) %>%
pivot_wider(names_from = `Sales Channel`, values_from = n, values_fill = 0)
print(pivot_data)
## # A tibble: 3 × 5
## `Renew Offer Type` Agent Branch `Call Center` Web
## <chr> <int> <int> <int> <int>
## 1 Offer1 336 168 42 48
## 2 Offer2 312 126 150 96
## 3 Offer3 18 0 0 12
El análisis muestra cómo los clientes comprometidos responden a diferentes canales de ventas según el tipo de oferta de renovación. Para “Offer1”, el mayor número de respuestas positivas se dio a través del canal de “Agent” con 336 respuestas, seguido por “Branch” con 168, y “Web” con 48. En “Offer2”, el patrón es similar, con el canal “Agent” liderando con 312 respuestas, “Call Center” con 150, y “Branch” con 126. En “Offer3”, la respuesta es significativamente menor, con solo 18 respuestas en el canal “Agent” y 12 en “Web”, mientras que “Call Center” no tuvo ninguna. Esto sugiere que el canal “Agent” es el más efectivo para las ofertas de renovación, especialmente para las ofertas 1 y 2, mientras que el canal “Call Center” y la oferta 3 tienen menos impacto en el compromiso del cliente.
pivot_data %>%
pivot_longer(-`Renew Offer Type`, names_to = "Sales Channel", values_to = "Engaged_Count") %>%
ggplot(aes(x = `Renew Offer Type`, y = Engaged_Count, fill = `Sales Channel`)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Tasa de participación por tipo de oferta y canal de ventas",
x = "Tipo de Oferta de Renovación",
y = "Cantidad de Clientes Comprometidos")
El gráfico de barras muestra la cantidad de clientes comprometidos para cada tipo de oferta de renovación, segmentados por el canal de ventas. Se observa que el canal “Agent” es el más efectivo, especialmente para las ofertas “Offer1” y “Offer2”, con más de 300 clientes comprometidos en ambos casos. “Offer1” también presenta una participación notable a través de “Branch”, aunque en menor medida. En “Offer2”, el canal “Web” tiene una mayor participación comparado con “Offer1”. Para “Offer3”, la participación es significativamente baja en todos los canales, con muy pocos clientes comprometidos a través de “Agent” y “Web”, y ninguna participación en “Branch” o “Call Center”. Esto sugiere que el tipo de oferta y el canal de ventas influyen en el nivel de compromiso de los clientes.
Para analizar las tasas de compromiso, podemos utilizar la columna Response, que indica si el cliente respondió (“Yes” para respuesta positiva o “No” para no responder). Esto nos permitirá calcular la tasa de respuesta como una métrica de compromiso en función de los diferentes canales de ventas (Sales Channel).
En el cálculo mean(Response == “Yes”) * 100, primero comparamos si el valor en Response es “Yes”, generando una serie de valores donde TRUE representa “Yes” y FALSE representa “No”. Luego, usamos mean() para calcular el promedio de estos valores lógicos, donde TRUE se cuenta como 1 y FALSE como 0. Este promedio representa el porcentaje de respuestas “Yes” en cada canal de ventas, y al multiplicarlo por 100, obtenemos el “engagement rate” o tasa de compromiso en formato de porcentaje para cada canal.
data %>%
group_by(`Sales Channel`) %>%
summarise(EngagementRate = mean(Response == "Yes") * 100)
## # A tibble: 4 × 2
## `Sales Channel` EngagementRate
## <chr> <dbl>
## 1 Agent 19.2
## 2 Branch 11.5
## 3 Call Center 10.9
## 4 Web 11.8
La metodología para analizar cómo difieren las tasas de compromiso entre los distintos canales de ventas se basa en calcular el porcentaje de respuestas “Yes” en la columna Response para cada canal, agrupando los datos por Sales Channel. Este cálculo, que representa la tasa de compromiso o “engagement rate”, permite identificar qué canal genera más respuestas positivas, facilitando la comparación entre canales. Con esto, se puede evaluar la efectividad de cada canal en términos de compromiso del cliente, ayudando a tomar decisiones estratégicas sobre cuál canal maximizar en futuras campañas o esfuerzos de marketing.
Aplicamos Regresión Logística Binomial
En este código, primero ajusto el dataframe data para crear un nuevo dataframe llamado df_reg. Modifico dos columnas usando mutate(): convierto la columna Response en una variable dicotómica, asignando 1 si el valor es “Yes” y 0 en caso contrario, y cambio la columna Sales Channel a un factor, renombrándola como Sales_Channel. Luego, genero variables dummy para la columna Sales_Channel en un nuevo dataframe df_dummies utilizando la función dummy_cols() del paquete fastDummies, sin eliminar la primera dummy (remove_first_dummy = FALSE).
# Ajustamos variables de interes
df_reg <- data %>%
mutate(
Response = ifelse(Response == "Yes", 1, 0), # Volver variable dicotomica
Sales_Channel = as.factor(`Sales Channel`) # Indicar variable categorica
)
# Generar variables dummy por tipo de canal
df_dummies <- dummy_cols(df_reg, select_columns = "Sales_Channel", remove_first_dummy = FALSE)
\[ \text{Response} = \beta_0 + \beta_1 \cdot \text{Sales_Channel_Agent} + \beta_2 \cdot \text{Sales_Channel_Branch} + \beta_3 \cdot \text{Sales_Channel_Call_Center} + \beta_4 \cdot \text{Sales_Channel_Web} + \epsilon \]
# Ajustar modelo de regresion logistica
modelo_logistico <- glm(Response ~ Sales_Channel_Agent + Sales_Channel_Branch + `Sales_Channel_Call Center` + Sales_Channel_Web,
data = df_dummies,
family = binomial(link="logit"))
# Ver los resultados del modelo
summary(modelo_logistico)
##
## Call:
## glm(formula = Response ~ Sales_Channel_Agent + Sales_Channel_Branch +
## `Sales_Channel_Call Center` + Sales_Channel_Web, family = binomial(link = "logit"),
## data = df_dummies)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.01405 0.08524 -23.628 < 0.0000000000000002
## Sales_Channel_Agent 0.57404 0.09551 6.010 0.00000000185
## Sales_Channel_Branch -0.03123 0.10539 -0.296 0.767
## `Sales_Channel_Call Center` -0.08920 0.11450 -0.779 0.436
## Sales_Channel_Web NA NA NA NA
##
## (Intercept) ***
## Sales_Channel_Agent ***
## Sales_Channel_Branch
## `Sales_Channel_Call Center`
## Sales_Channel_Web
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 7503.3 on 9133 degrees of freedom
## Residual deviance: 7398.3 on 9130 degrees of freedom
## AIC: 7406.3
##
## Number of Fisher Scoring iterations: 4
#graficamos los coeficientes de la regresion
coefplot(modelo_logistico)
El modelo de regresión logística ajustado busca predecir la variable
Response
en función de los diferentes canales de venta
(Sales_Channel_Agent
, Sales_Channel_Branch
,
Sales_Channel_Call Center
y
Sales_Channel_Web
). En los resultados del modelo, se
observa que solo Sales_Channel_Agent
tiene un coeficiente
significativo (p-valor < 0.001), lo que indica que este canal tiene
un impacto estadísticamente significativo en la probabilidad de
Response
. El gráfico de coeficientes ilustra que el canal
Sales_Channel_Agent
tiene un coeficiente positivo, lo que
sugiere que, al utilizar este canal, la probabilidad de un
Response
positivo es mayor. Los otros canales
(Branch
, Call Center
y Web
) no
son estadísticamente significativos, lo que implica que su influencia en
Response
no es concluyente en este modelo.
Los valores de la variable Sales_Channel_Web
aparecen
como NA
en el resumen del modelo debido a un problema de
colinealidad perfecta o singularidad.
Esto ocurre cuando una de las variables dummy es completamente
predecible a partir de las demás. En este caso, como
Sales_Channel_Web
es la última categoría de la variable
Sales_Channel
, es redundante porque su valor puede
inferirse a partir de los otros canales (es decir, si todas las demás
dummies son 0, entonces debe ser Sales_Channel_Web
).
\[ \text{Odds Ratio} = e^{\beta} \]
# Calcular e interpretar odds ratio
odds_ratios <- exp(coef(modelo_logistico))
odds_ratios
## (Intercept) Sales_Channel_Agent
## 0.1334474 1.7754289
## Sales_Channel_Branch `Sales_Channel_Call Center`
## 0.9692545 0.9146658
## Sales_Channel_Web
## NA
# Crear un dataframe con los odds ratios
odds_data <- data.frame(
Variable = names(odds_ratios),
Odds_Ratio = odds_ratios
)
# Crear el gráfico
ggplot(odds_data, aes(x = Variable, y = Odds_Ratio)) +
geom_point(color = "blue", size = 4) + # Puntos para los odds ratios
geom_hline(yintercept = 1, linetype = "dashed", color = "red") + # Línea de referencia en OR = 1
labs(title = "Odds Ratios de Variables en el Modelo",
x = "Variable",
y = "Odds Ratio") +
theme_minimal() +
coord_flip() # Rotar el gráfico para que las variables estén en el eje y
En el modelo, los odds ratios indican cómo cambia la probabilidad de
Response
en relación con cada canal de ventas comparado con
la categoría de referencia (en este caso,
Sales_Channel_Web
, que aparece como NA
debido
a la colinealidad). Un odds ratio mayor a 1 sugiere un aumento en la
probabilidad de Response
frente a la categoría de
referencia, mientras que un valor menor a 1 indica una disminución.
Sales_Channel_Agent
muestra un odds ratio de 1.77, lo que
significa que, en comparación con Sales_Channel_Web
, este
canal aumenta significativamente la probabilidad de un
Response
positivo. En contraste,
Sales_Channel_Branch
y
Sales_Channel_Call Center
tienen odds ratios menores a 1
(0.97 y 0.91 respectivamente), indicando una ligera reducción en la
probabilidad de Response
en comparación con
Sales_Channel_Web
.
\[ \text{invlogit}(\beta) = \frac{1}{1 + e^{-\beta}} \]
coefplot(modelo_logistico, trans=invlogit)
En este gráfico de coeficientes transformados mediante la función
inversa del logit (invlogit
), se puede interpretar la
probabilidad estimada de Response
para cada canal de ventas
en comparación con la categoría de referencia,
Sales_Channel_Web
. Sales_Channel_Agent
tiene
el mayor efecto positivo, lo que implica que su probabilidad de producir
un Response
positivo es más alta que la de los otros
canales, dada su posición más cercana al valor 1. Los canales
Sales_Channel_Branch
y
Sales_Channel_Call Center
presentan valores más bajos, lo
que indica una menor probabilidad de un Response
positivo
en comparación con Sales_Channel_Web
. Este gráfico facilita
la interpretación de cómo cambia la probabilidad de éxito en
Response
según el canal de ventas seleccionado.
Los odds ratios interpretan el cambio relativo
en las probabilidades de obtener un Response
positivo
cuando se utiliza cada canal de ventas en comparación con la categoría
de referencia (Sales_Channel_Web
).
En el gráfico de odds ratios, un valor mayor a 1 indica un
aumento en las probabilidades de éxito (es decir, obtener un
Response
positivo), mientras que un valor menor a 1 indica
una disminución en esas probabilidades.
Por ejemplo, el odds ratio de Sales_Channel_Agent
es
aproximadamente 1.77, lo que indica que el canal “Agent” aumenta las
probabilidades de un Response
positivo en un 77% en
comparación con el canal “Web”.
Este análisis es útil para entender la fuerza y dirección del efecto de cada canal de ventas en términos de proporción de probabilidades, ayudándote a ver qué canales son relativamente más o menos efectivos que el canal de referencia.
La función inversa del logit convierte los
coeficientes del modelo en probabilidades directas, lo que permite
interpretar la probabilidad de un Response
positivo para
cada canal en comparación con la referencia.
En el gráfico de la función inversa del logit, los valores se interpretan como probabilidades (entre 0 y 1) en lugar de cambios en la proporción de probabilidades.
En este caso, el canal Sales_Channel_Agent
muestra
una probabilidad más alta de obtener un Response
positivo,
cercana a 0.6, mientras que Sales_Channel_Branch
y
Sales_Channel_Call Center
muestran probabilidades más bajas
en comparación con el canal Sales_Channel_Web
.
Este análisis es más intuitivo cuando deseas interpretar los resultados en términos de probabilidades concretas de que un evento ocurra, ya que te da una visión directa del nivel de probabilidad de éxito según el canal.
Odds Ratios te permiten ver el cambio relativo
en las probabilidades (en términos de aumento o disminución) de un
Response
positivo para cada canal comparado con la
referencia. Es útil para entender el impacto relativo de cada canal de
ventas.
La Función Inversa del Logit transforma estos cambios en probabilidades directas, proporcionando una interpretación más clara sobre la probabilidad de que el evento ocurra, lo que puede ser más fácil de comunicar para quienes prefieren probabilidades sobre odds ratios.
resumen <- data %>%
group_by(`Vehicle Size`, `Sales Channel`, Response) %>%
summarise(Conteo = n()) %>%
ungroup()
# Ver los primeros resultados del resumen
print(resumen)
## # A tibble: 24 × 4
## `Vehicle Size` `Sales Channel` Response Conteo
## <chr> <chr> <chr> <int>
## 1 Large Agent No 269
## 2 Large Agent Yes 72
## 3 Large Branch No 237
## 4 Large Branch Yes 54
## 5 Large Call Center No 161
## 6 Large Call Center Yes 24
## 7 Large Web No 111
## 8 Large Web Yes 18
## 9 Medsize Agent No 1967
## 10 Medsize Agent Yes 504
## # ℹ 14 more rows
# Crear un gráfico de barras para visualizar si hay diferencias en la respuesta según el tamaño del vehículo y el canal de ventas
ggplot(resumen, aes(x = `Sales Channel`, y = Conteo, fill = Response)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~ `Vehicle Size`) +
labs(title = "Respuesta de clientes por Tamaño de Vehículo y Canal de Ventas",
x = "Canal de Ventas",
y = "Cantidad de Respuestas") +
theme_minimal()
El gráfico muestra la cantidad de respuestas de clientes, segmentadas por el tamaño del vehículo (Large, Medsize, Small) y el canal de ventas (Agent, Branch, Call Center, Web). En general, la mayoría de las respuestas son negativas (“No”), representadas en rojo, especialmente en los vehículos de tamaño mediano (“Medsize”) a través del canal de ventas “Agent”. Este canal también muestra un número considerable de respuestas positivas (“Yes”) en azul, aunque significativamente menor que las negativas. Los vehículos grandes pequeños (“Small”) y medianos (“Medsize”) tienen más participación en las respuestas, mientras que los vehículos grandes (“Large”) tienen poca representación en todos los canales.
resumen <- data %>%
group_by(`Vehicle Size`, `Sales Channel`, Response) %>%
summarise(Conteo = n()) %>%
ungroup()
# Transformar los datos a un formato ancho para que cada respuesta esté en una columna
resumen_ancho <- resumen %>%
pivot_wider(names_from = Response, values_from = Conteo, values_fill = 0)
# Mostrar el resultado
resumen_ancho
## # A tibble: 12 × 4
## `Vehicle Size` `Sales Channel` No Yes
## <chr> <chr> <int> <int>
## 1 Large Agent 269 72
## 2 Large Branch 237 54
## 3 Large Call Center 161 24
## 4 Large Web 111 18
## 5 Medsize Agent 1967 504
## 6 Medsize Branch 1588 192
## 7 Medsize Call Center 1098 120
## 8 Medsize Web 829 126
## 9 Small Agent 575 90
## 10 Small Branch 448 48
## 11 Small Call Center 314 48
## 12 Small Web 229 12
En este código, estoy transformando el dataframe resumen
a un formato ancho usando la función pivot_wider()
. Quiero
que cada tipo de Response
(Yes
y
No
) esté en una columna separada, con sus respectivos
conteos. Para lograr esto, especifico
names_from = Response
, indicando que los nombres de las
nuevas columnas deben derivarse de los valores en la columna
Response
. Utilizo values_from = Conteo
para
que los valores en las nuevas columnas provengan de la columna
Conteo
. Además, establezco values_fill = 0
para que, en caso de valores faltantes, se rellenen con 0. El resultado
es un dataframe resumen_ancho
con una columna para cada
respuesta (Yes
y No
), facilitando la
comparación directa entre ambas.
engagement_data <- data %>%
group_by(`Months Since Policy Inception`) %>%
summarise(Engagement_Rate = mean(Response == "Yes") * 100)
# Crear un gráfico de línea interactivo
fig <- plot_ly(engagement_data, x = ~`Months Since Policy Inception`, y = ~Engagement_Rate,
type = 'scatter', mode = 'lines+markers',
line = list(width = 2, color = 'blue'),
marker = list(size = 6, color = 'blue')) %>%
layout(title = "Tasa de Participación por Meses desde el Inicio de la Póliza",
xaxis = list(title = "Meses desde el Inicio de la Póliza"),
yaxis = list(title = "Tasa de Participación (%)"),
hovermode = "closest")
# Mostrar el gráfico
fig
Al finalizar, wss
es un vector que contiene la suma de
los errores cuadráticos dentro de los clusters (WSS) para cada valor de
K entre 2 y 10. Este vector se puede graficar para aplicar el método del
codo y ayudar a decidir el número óptimo de clusters.
# Seleccionar las columnas necesarias para la segmentación
df_segmentacion <- data %>%
select(`Customer Lifetime Value`, `Months Since Policy Inception`) %>%
na.omit() # Eliminar filas con valores NA si las hubiera
# Escalar los datos para mejorar el rendimiento de K-means
df_segmentacion_scaled <- scale(df_segmentacion)
# Definir el numero de cluesters
# Definir un rango de clusters para evaluar
num_clusters <- 2:10
# 1. Calcular el método del codo (inertia/wss) mediante una funcion
wss <- sapply(num_clusters, function(k){
kmeans(df_segmentacion_scaled, centers = k, nstart = 25)$tot.withinss
})
wss
## [1] 11508.259 6189.381 4988.748 3957.901 3302.068 2893.879 2529.094
## [8] 2262.800 2044.108
# Graficar el método del codo
plot(num_clusters, wss, type = "b", pch = 19, frame = FALSE,
xlab = "Número de clusters K",
ylab = "Suma de cuadrados dentro de los clusters (WSS)",
main = "Método del Codo para determinar el número óptimo de K")
Utilicé el método del codo para determinar el número óptimo de clusters al segmentar a los clientes según el valor de vida del cliente (CLV) y los meses desde el inicio de la póliza. Observé que la suma de cuadrados dentro de los clusters (WSS) disminuye rápidamente entre K = 2 y K = 4, lo que indica una reducción significativa en la varianza dentro de los clusters. A partir de K = 3, la curva empieza a estabilizarse, lo que sugiere que tres clusters podrían ser óptimos. Esto me indica que a partir de este punto, agregar más clusters no aporta grandes beneficios en términos de reducción de la variabilidad dentro de los grupos, proporcionando así una segmentación eficiente.
# Metodo de la siluesta
# 2. Calcular el puntaje de silueta para diferentes valores de K
sil_scores <- sapply(num_clusters, function(k){
model <- kmeans(df_segmentacion_scaled, centers = k, nstart = 25)
silhouette_score <- silhouette(model$cluster, dist(df_segmentacion_scaled))
mean(silhouette_score[, 3]) # Promedio del puntaje de silueta
})
# Graficar el puntaje de silueta para cada número de clusters
plot(num_clusters, sil_scores, type = "b", pch = 19, frame = FALSE,
xlab = "Número de clusters K", ylab = "Puntaje de Silueta Promedio",
main = "Análisis de Silueta para determinar el número óptimo de K")
sil_scores: Al final, sil_scores
es un vector que
contiene el puntaje de silueta promedio para cada valor de 𝐾 de 2 a 10.
Estos valores se pueden graficar para observar cuál valor de 𝐾 maximiza
el puntaje de silueta promedio, indicando el mejor número de clusters en
términos de compacidad y separación.
Utilicé el análisis de silueta para evaluar el número óptimo de clusters al segmentar a los clientes. Observé que el puntaje de silueta promedio alcanza su valor máximo en K = 3, lo que sugiere que este número de clusters podría ofrecer la mejor combinación de compacidad y separación entre los grupos. A partir de K = 3, el puntaje de silueta disminuye y luego se mantiene relativamente estable, indicando que añadir más clusters no mejora significativamente la cohesión y la separación de los grupos. Esto me lleva a concluir que tres clusters pueden ser la mejor opción para este análisis de segmentación.
# Aplicar el algoritmo K-means (eligiendo 3 clusters)
set.seed(123) # Fijar semilla para reproducibilidad
kmeans_result <- kmeans(df_segmentacion_scaled, centers = 3, nstart = 25)
# Añadir el cluster resultante al dataframe original
df <- data %>%
mutate(Cluster = kmeans_result$cluster)
df_distribucion <- df %>%
select(Customer,`Customer Lifetime Value`,Cluster)
# Gráfico de densidad
# Asumiendo que df_distribucion ya está cargado
ggplot(df_distribucion, aes(x = `Customer Lifetime Value`, fill = as.factor(Cluster))) +
geom_density(alpha = 0.5) +
labs(title = "Distribución de Customer Lifetime Value por Cluster",
x = "Customer Lifetime Value",
y = "Densidad",
fill = "Cluster") +
theme_minimal()
Realicé un análisis de densidad para observar la distribución del valor de vida del cliente (Customer Lifetime Value, CLV) en cada uno de los clusters. En el gráfico, noto que los tres clusters muestran patrones de densidad distintos. El Cluster 1 tiene la mayor concentración en los valores más bajos de CLV, lo que indica que agrupa a clientes con valores de vida relativamente bajos. El Cluster 2 presenta una distribución más amplia y se concentra alrededor de valores intermedios de CLV, mientras que el Cluster 3 tiene una menor densidad y se extiende hacia valores más altos, representando a clientes con mayor valor de vida. Este análisis me permite entender mejor las características de cada grupo en función de su CLV.
# Gráfico de violín y caja de bigotes
ggplot(df_distribucion, aes(x = as.factor(Cluster), y = `Customer Lifetime Value`, fill = as.factor(Cluster))) +
geom_violin(alpha = 0.5) + # Gráfico de violín
geom_boxplot(width = 0.1, outlier.shape = NA, alpha = 0.7) + # Gráfico de caja y bigotes
labs(
title = "Distribución de Customer Lifetime Value por Cluster",
x = "Cluster",
y = "Customer Lifetime Value",
fill = "Cluster"
) +
theme_minimal()
El gráfico muestra la distribución del Customer Lifetime Value (CLV) para cada uno de los clusters, combinando gráficos de violín y de caja y bigotes. El Cluster 2 tiene una distribución más amplia y presenta valores de CLV significativamente más altos, aunque con gran variabilidad, ya que incluye algunos valores atípicos muy altos. La mediana del Cluster 2 también es más alta en comparación con los otros clusters. En contraste, los Clusters 1 y 3 muestran distribuciones de CLV más compactas y centradas en valores bajos, con menos variabilidad. Este análisis indica que el Cluster 2 agrupa a clientes de mayor valor, mientras que los Clusters 1 y 3 representan segmentos de clientes con menor CLV.
# Visualizar los clusters
ggplot(df, aes(x = `Months Since Policy Inception`, y = `Customer Lifetime Value`, color = as.factor(Cluster))) +
geom_point() +
labs(title = "Segmentación de Clientes por K-means",
x = "Meses desde el inicio de la póliza",
y = "Customer Lifetime Value",
color = "Cluster") +
theme_minimal()
El gráfico muestra la segmentación de clientes basada en el valor de vida del cliente (Customer Lifetime Value, CLV) y los meses desde el inicio de la póliza. Se observa que el Cluster 1 (en rojo) agrupa a clientes con valores de CLV relativamente bajos y con un tiempo de relación de hasta casi 100 meses. El Cluster 3 (en azul) también contiene clientes de bajo CLV, pero están concentrados cerca de los primeros 50 meses desde el inicio de la póliza. Por otro lado, el Cluster 2 (en verde) representa a clientes con un rango mucho más amplio de CLV, incluyendo valores altos, y estos clientes tienen una duración de la póliza distribuida a lo largo de todo el rango de tiempo. Esto sugiere que los clientes en el Cluster 2 son los de mayor valor y tienen una relación continua y prolongada, mientras que los clientes en los Clusters 1 y 3 presentan valores más bajos de CLV y una duración más limitada desde el inicio de la póliza.
Las conclusiones del análisis destacan que el canal “Agent” es el más efectivo para generar respuestas positivas (engagement) entre los clientes, particularmente para las ofertas “Offer1” y “Offer2”. La efectividad de este canal en comparación con otros sugiere que puede ser una vía valiosa para impulsar compromisos de clientes en futuras estrategias de marketing. Además, el análisis de CLV indica que los clientes en el Cluster 2 tienen un valor de vida significativamente más alto, aunque con variabilidad, lo cual sugiere que este segmento contiene a los clientes más valiosos con relaciones más prolongadas desde el inicio de la póliza(Prueba Tecnica).
Recomendaciones:
Optimización de Canales de Ventas: Se recomienda priorizar el canal “Agent” en campañas de renovación de ofertas debido a su efectividad en la generación de respuestas positivas, especialmente para ofertas destacadas como “Offer1” y “Offer2”. Este canal podría beneficiarse de recursos adicionales para maximizar su alcance y efectividad.
Segmentación y Personalización: Dado que los clientes del Cluster 2 presentan un CLV más alto y relaciones más duraderas, se sugiere diseñar estrategias de fidelización y retención específicas para este segmento. Las campañas personalizadas para estos clientes podrían maximizar su valor y asegurar una relación continua.
Ajuste de Estrategias por Tipo de Oferta: La baja efectividad de “Offer3” y “Offer4” sugiere que es menos atractiva para los clientes. Sería útil revisar y posiblemente rediseñar estas ofertas o enfocarse en ofertas más populares para maximizar la tasa de compromiso.
Evaluación de Otros Canales: Aunque el canal “Agent” lidera, otros canales como “Web” también tienen potencial, especialmente en combinación con ciertas ofertas. Es recomendable realizar pruebas adicionales en estos canales para identificar formas de mejorar su efectividad.
Este análisis permite optimizar tanto las estrategias de canales como de segmentación, enfocándose en maximizar el retorno a través de un uso eficiente de los recursos y una alineación más precisa con las necesidades de los clientes de alto valor