Note on the synthetic sample. This rendered version of the report runs against data/sample.csv, a 265-row synthetic sample (the original 8,000-row dataset is not redistributed for course-licensing reasons — see data/README.md). Some of the more heavily-parameterized specifications below (the modelp2 conditional logit with interactions and the modelp3 mixed logit) may fail on this small sample because the Hessian becomes singular. Their failures are rendered inline so you can see exactly where the original analysis used the full dataset; the qualitative findings in the README still hold against the original 8k-row run.

Preparación del entorno

Carga de librerías y lectura del dataset (muestra sintética de 265 filas).

#Preliminares 

rm(list=ls())         # Limpia la lista de objetos 
graphics.off()        # Limpia la lista de gráficos
options(digits = 4)   # Número de dígitos a utilizar
set.seed(123)         # Seed
#cargamos las librerias necesarias
library(readr)      #Para leer el .csv
library(glmnet)     #Ajusta modelo lineal
library(ggplot2)    #Para realización de gráficos
library(ggcorrplot) #Para realizar grafico correlacion
library(fixest)     #Para correr modelos con efectos fijos
library(tidyverse)  #Funcionalidades para manipular y desplegar datos
library(kableExtra)   # Para formatear tablas
library(modelsummary) # Para resumir resultados del modelo
library(caret)          # for most ML models
library(earth)          # for MARS
library(randomForest)   # for random Forest.
library(stargazer)  # Tablas
library(gridExtra) #Graficos en una grilla
library(mlogit)
library(dplyr)
library(gt)
library(psych)
library(kernlab)

Lectura de la base de datos:

df <- read.csv("data/sample.csv", sep = ";", encoding = "UTF-8")

Verificación de valores faltantes por columna:

colSums(is.na(df)) 
##                           choice_id                     numero_eleccion 
##                                   0                                   0 
##                                 idp                     feat.CantCuotas 
##                                   0                                   0 
##                            feat.CAE                            feat.CTC 
##                                   0                                   0 
##                             feat.VC                              choice 
##                                   0                                   0 
##                              option              condicion_experimental 
##                                   0                                   0 
##                           type_cons                      macroescenario 
##                                   0                                   0 
##                        monto_oferta            ola1.cuotas_optimas_100k 
##                                   0                                   0 
##            ola1.cuotas_optimas_200k            ola1.cuotas_optimas_400k 
##                                   0                                   0 
##            ola1.cuotas_optimas_500k              ola1.cuotas_optimas_1m 
##                                   0                                   0 
##              ola1.cuotas_optimas_5m     ola2.error_estimacion_CTC_O2_E2 
##                                   0                                   0 
##      ola2.error_estimacion_VC_O2_E2                 ola2.error_esq_pago 
##                                   0                                   0 
##    ola2.error_recordacion_CTC_O3_E2 ola2.error_recordacion_Cuotas_O3_E2 
##                                   0                                   0 
##    ola2.error_recordacion_CAE_O3_E2     ola2.error_recordacion_VC_O3_E2 
##                                 264                                   0 
##             ola2.grado_consistencia          ola2.grado_corr.dominancia 
##                                   0                                   0 
##                    ola2.est_mercado                           dem.mujer 
##                                   0                                   0 
##                        dem.liquidez                         dem.lit_fin 
##                                   0                                   0
#dada la gran cantidad de NA que tiene ola2.error_recordacion_VC_O3_E2, se procede a eliminar 

df <- df %>% select(-ola2.error_recordacion_VC_O3_E2)
# se crea la variable dummy estima_bien, que será usada para explorar el entendimiento
rango_inferior <- 0
rango_superior <- 10000

df$estima_bien <- ifelse(abs(df$ola2.error_estimacion_CTC_O2_E2) >= rango_inferior & abs(df$ola2.error_estimacion_CTC_O2_E2) <= rango_superior, 1, 0)
# Se crean variables para usar en los modelos logit
df <- df %>%
  mutate(GC = ifelse(condicion_experimental == "GC", 1, 0),
         T1 = ifelse(condicion_experimental == "T1", 1, 0),
         T2 = ifelse(condicion_experimental == "T2", 1, 0),
         T3 = ifelse(condicion_experimental == "T3", 1, 0))

df <- df %>%
  mutate(dominada = ifelse(type_cons == "eleccion_dominada", 1, 0),
         TV = ifelse(macroescenario == "TV", 1, 0))

# Crear la variable option_2
df$option_2 <- ifelse(df$option == 2, "izquierda", "derecha")

Análisis

1. Análisis Exploratorio

Antes de modelar, exploramos la distribución de la variable dependiente y las principales covariables del experimento, para entender qué patrones plausiblemente impulsan las decisiones de los participantes.

EDA

Exploramos qué variables influyen en la elección de oferta, si los participantes entendieron las ofertas y si sus decisiones fueron consistentes entre olas.

Resumen descriptivo de las variables:

#decidir si usar esta o summary o ninguna

describe(df)

Correlación entre las variables numéricas de las ofertas:

# base númerica
df2 <- df %>%
  mutate_all(as.numeric)

# Calcula la matriz de correlación
cor_matrix <- cor(df2[c("feat.CTC", "feat.CAE", "feat.CantCuotas", "feat.VC")], use = "complete.obs")

# Crea un gráfico de la matriz de correlación con ggcorrplot
ggcorrplot(cor_matrix, hc.order = TRUE, type = "upper", lab = TRUE)

Como es esperable, los atributos de la oferta están altamente correlacionados: el costo total del crédito (CTC) correlaciona fuertemente con la cantidad de cuotas y el CAE, y en menor medida con el valor de la cuota.

Conteos y caracterización general de la muestra:

Distribución de variables demográficas — empezando por género:

# Contamos la cantidad de cada género y luego los metemos a un dataframe
conteo_genero <- table(df$dem.mujer)

datos_genero <- data.frame(Genero = factor(names(conteo_genero), labels = c("Hombre", "Mujer")), Cantidad = as.vector(conteo_genero/12))

# Creamos gráfico de torta
ggplot(datos_genero, aes(x = "", y = Cantidad, fill = Genero, label = Cantidad)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = Cantidad), position = position_stack(vjust = 0.5), color = "white", size = 5) +  
  coord_polar(theta = "y") +  # Convertir el gráfico en uno de torta
  labs(title = "Distribución de Género") +
  scale_fill_manual(values = c("Hombre" = "blue", "Mujer" = "pink")) + 
  theme_void()

Luego se ve la distribución de la liquidez mensual para gastos financieros.

ggplot(df, aes(x = dem.liquidez)) +
  geom_histogram(binwidth = 10000, fill = "blue", color = "white", alpha = 0.7) +
  labs(title = "Distribución de Ingresos en Intervalos de Liquidez",
       x = "Liquidez",
       y = "Frecuencia en la base") +
  theme_minimal() +
  xlim(0, 90000)+
  ylim (0,900)#

Finalmente se visualiza la cantidad de personas en cada puntaje de literacidad financiera.

# conteo en cada puntaje de lit.fin
conteo_lit_fin <- df %>%
  group_by(dem.lit_fin, idp) %>%
  summarise(count = n_distinct(idp))

# gráfico
ggplot(conteo_lit_fin, aes(x = factor(dem.lit_fin), y = count, fill = factor(dem.lit_fin))) +
  geom_bar(stat = "identity") +
  labs(title = "Distribución puntajes literacidad financiera",
       x = "Puntaje literacidad financiera",
       y = "Cantidad de Personas") +
  theme_minimal()

Al revisar las 3 gráficas, se puede apreciar que el experimento incluye una proporción similar de hombres y mujeres, que la liquidez mensual que declaran tener para gastos financieros se distribuye en su mayoría en valores cercanos a los $50.000, y que las personas del estudio se encuentran acumuludas entre el puntaje 1 y 2 de literacidad financiera, teniendo que el puntaje máximo (3) es el que se encuentra en menor cantidad.

Créditos ofrecidos por macroescenario:

# Calcular el CTC promedio por cada macroescenario
ctc_promedio <- df %>%
  group_by(macroescenario) %>%
  summarise(ctc_promedio = mean(feat.CTC, na.rm = TRUE))

# Gráfico 
ggplot(ctc_promedio, aes(x = macroescenario, y = ctc_promedio, fill = macroescenario)) +
  geom_bar(stat = "identity") +
  labs(title = "CTC Promedio por Macroescenario",
       x = "Macroescenario",
       y = "CTC Promedio") +
  theme_minimal()

Se desprende que los créditos más costosos están en la categoría de viaje, seguido de salud y TV. Será interesante notar en los modelos si cómo afecta el macroescenario a la desición tomada.

Otro conteo que vale la pena realizar es el de la cantidad de personas en cada condición experimental.

# Conteo
conteo_personas <- df %>%
  distinct(idp, condicion_experimental) %>%
  group_by(condicion_experimental) %>%
  summarise(cantidad_personas = n())

# Gráfico de torta con etiquetas
ggplot(conteo_personas, aes(x = "", y = cantidad_personas, fill = condicion_experimental)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar(theta = "y") +
  geom_text(aes(label = cantidad_personas), position = position_stack(vjust = 0.5)) +
  labs(title = "Conteo de Personas por Condición Experimental",
       x = NULL,
       y = NULL) +
  theme_minimal() +
  theme(axis.text = element_blank(),
        axis.title = element_blank(),
        panel.grid = element_blank())

Se ve que la mayor cantidad de personas se encuentran en el grupo de control (GC), seguidos de tratamiento 1(T1), tratamiento 2(T2) y tratamiento 3(T3).

Para finalizar con los conteos previo a la exploración de variables relevantes para el estudio, se visualiza la cantidad de elecciones que recibió cada alternativa (izquierda o derecha).

# Contar la cantidad de elecciones por opción
conteo_elecciones <- df %>%
  group_by(option) %>%
  summarise(cantidad_elecciones = sum(choice == 1))

# Gráfico de torta con etiquetas
ggplot(conteo_elecciones, aes(x = "", y = cantidad_elecciones, fill = factor(option, labels = c("Derecha", "Izquierda")))) +
  geom_bar(stat = "identity") +
  coord_polar(theta = "y") +
  geom_text(aes(label = cantidad_elecciones), position = position_stack(vjust = 0.5)) +
  labs(title = "Cantidad de Elecciones por Opción",
       x = NULL,
       y = NULL,
       fill = "Alternativa") +  
  theme_minimal() +
  theme(axis.text = element_blank(),
        axis.title = element_blank(),
        panel.grid = element_blank())

Este resultado viene a ratificar que el experimento radica en caracterizar el contenido de la mejor oferta, ya que los tomadores de decisión eligen indiscriminadamente entre la posición de esta.

Tal como se había mencionado anteriormente, caracterizar o describir una mejor decisión financiera no posee un criterio único. Se comenzará por estudiar qué variables tienen efecto sobre las ofertas que fueron elegidas y la respectiva cuantificación de ese efecto.

# CTC promedio vs choice
graf1 <- ggplot(df, aes(x = factor(choice), y = feat.CTC, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Costo total crédito (promedio) ",
       x = "Elección",
       y = "Valor Promedio de CTC",
       fill = "Choice") +
  theme_minimal()


# cuotas promedio vs choice
graf2 <- ggplot(df, aes(x = factor(choice), y = feat.CantCuotas, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Cantidad de cuotas (promedio)",
       x = "Elección",
       y = "Valor Promedio de cuotas",
       fill = "Choice") +
  theme_minimal()

# cae promedio vs choice
graf3 <- ggplot(df, aes(x = factor(choice), y = feat.CAE, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "CAE (promedio)",
       x = "Elección ",
       y = "Valor Promedio de CAE",
       fill = "Choice") +
  theme_minimal()

# valor cuota vs choice
graf4 <- ggplot(df, aes(x = factor(choice), y = feat.VC, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Valor cuota (promedio)",
       x = "Elección",
       y = "Valor Promedio de valor cuota",
       fill = "Choice") +
  theme_minimal()

# Organizar los gráficos en una grilla
grid.arrange(graf1, graf2, graf3, graf4, ncol = 2)

De esta forma, quedan claras las diferencias entre las alternativas que son escogidas v/s las que no. En particular, se puede apreciar que los participantes eligen en promedio: créditos menos costosos, créditos con menor cantidad de cuotas, créditos con un CAE menor, créditos con un valor de cuota más grande.

Con esto, no se quiere concluir que la elección de una mejor oferta será siempre la de créditos que cumplan esas características, ya que esta es una decisión a nivel individual que claramente tiene una componente de restricción presupuestaria de los individuos, por tanto la elección de una alternativa no siempre será la mejor decisión para todas las personas. Así, será interesante caracterizar qué y cómo influencia la decisión en los modelos a realizar más adelante.

Exploramos ahora el entendimiento y la consistencia en la elección, y su relación con la condición experimental.

Distribución de ola2.grado_consistencia — cuántas veces cada participante eligió igual que en la ola 1, por condición experimental:

# Se filtran distintas bases por condicion experimental
df_gc <- df %>% filter(condicion_experimental == "GC")
df_t1 <- df %>% filter(condicion_experimental == "T1")
df_t2 <- df %>% filter(condicion_experimental == "T2")
df_t3 <- df %>% filter(condicion_experimental == "T3")

# luego se realizan conteos en cada base
conteo_consistencia_gc <- df_gc %>%
  group_by(ola2.grado_consistencia) %>%
  summarise(Cantidad_GC = n_distinct(idp))

conteo_consistencia_t1 <- df_t1 %>%
  group_by(ola2.grado_consistencia) %>%
  summarise(Cantidad_T1 = n_distinct(idp))

conteo_consistencia_t2 <- df_t2 %>%
  group_by(ola2.grado_consistencia) %>%
  summarise(Cantidad_T2 = n_distinct(idp))

conteo_consistencia_t3 <- df_t3 %>%
  group_by(ola2.grado_consistencia) %>%
  summarise(Cantidad_T3 = n_distinct(idp))

# se crean los graficos
plot_gc <- ggplot(conteo_consistencia_gc, aes(x = factor(ola2.grado_consistencia), y = Cantidad_GC, fill = factor(ola2.grado_consistencia))) +
  geom_bar(stat = "identity") +
  labs(title = "Consistencia en GC",
       x = "Puntaje consistencia",
       y = "Cantidad de Personas") +
  theme_minimal()

plot_t1 <- ggplot(conteo_consistencia_t1, aes(x = factor(ola2.grado_consistencia), y = Cantidad_T1, fill = factor(ola2.grado_consistencia))) +
  geom_bar(stat = "identity") +
  labs(title = "Consistencia en T1",
       x = "Puntaje consistencia",
       y = "Cantidad de Personas") +
  theme_minimal()

plot_t2 <- ggplot(conteo_consistencia_t2, aes(x = factor(ola2.grado_consistencia), y = Cantidad_T2, fill = factor(ola2.grado_consistencia))) +
  geom_bar(stat = "identity") +
  labs(title = "Consistencia en T2",
       x = "Puntaje consistencia",
       y = "Cantidad de Personas") +
  theme_minimal()

plot_t3 <- ggplot(conteo_consistencia_t3, aes(x = factor(ola2.grado_consistencia), y = Cantidad_T3, fill = factor(ola2.grado_consistencia))) +
  geom_bar(stat = "identity") +
  labs(title = "Consistencia en T3",
       x = "Puntaje consistencia",
       y = "Cantidad de Personas") +
  theme_minimal()


grid.arrange(plot_gc, plot_t1, plot_t2, plot_t3, ncol = 2)

Tal como se puede apreciar en la grilla, en realidad el puntaje de consistencia se distibuye de una forma similar en todas las condiciones experimentales. Si bien en T3 el tamaño de la barra del puntaje 4 es más grande en comparación a los demás grupos, no se diferencia tanto como para inducir que en T3 las personas son más consistentes.

Así, al observar la misma tendencia en todos los grupos experimentales, se puede concluir a priori que el experimento está bien aleatorizado y que la consistencia parece no depender del grupo experimental al cual se fue asignado, lo cual sugiere dudar de la efectividad de las diferencias entre los avisos promocionales.

Para buscar ampliar esta conclusión, se seguirá con el estudio del entendimiento.

Usamos ola2.error_esq_pago como proxy de entendimiento: los participantes con valor 0 entendieron la oferta(identificó secuencia) y 1 quienes no. De igual manera, conteos para ver la distribución de esta variable en las distintas condiciones experimentales.

# Crear los dataframes con el conteo de personas únicas para ola2.error_esq_pago igual a 1 y 0
conteo_error_gc <- df_gc %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_GC = n_distinct(idp))

conteo_error_t1 <- df_t1 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T1 = n_distinct(idp))

conteo_error_t2 <- df_t2 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T2 = n_distinct(idp))

conteo_error_t3 <- df_t3 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T3 = n_distinct(idp))

# Crear los gráficos de barras apiladas
plot_error_gc <- ggplot(conteo_error_gc, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_GC, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en GC",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  # Ajuste del eje y
  theme_minimal()

plot_error_t1 <- ggplot(conteo_error_t1, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T1, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T1",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_error_t2 <- ggplot(conteo_error_t2, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T2, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T2",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_error_t3 <- ggplot(conteo_error_t3, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T3, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T3",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

# Crear la grilla
grid.arrange(plot_error_gc, plot_error_t1, plot_error_t2, plot_error_t3, ncol = 2)

En la grilla se aprecia que la tendencia en todos los grupos experimentales es la misma, la cantidad de personas que identifican la secuencia (y por tanto entienden la oferta) supera por mucho a las que no identifican la oferta. Si bien en T2 y T3 la barrita de personas que no identifican la secuencia es mas pequeña (mostrando un mejor entendimiento), se debe recordar que tal como se observó anteriormente, estos grupos están compuestos por una menor cantidad de personas, por lo que la proporción es similar a la de los otros grupos también.

Otra variable que puede servir para estudiar el entendimiento es “ola2.grado_corr.dominancia”, ya que esta entrega un puntaje de cuántas veces fue escogida la opción que presentaba una dominancia. De esta forma se considera que escoger la opción dominante muestra un entendimiento mayor de cual oferta se debe escoger.

# Crear dataframes con los conteos
conteo_gc <- df_gc %>%
  group_by(ola2.grado_corr.dominancia) %>%
  summarise(Cantidad_GC = n_distinct(idp))

conteo_t1 <- df_t1 %>%
  group_by(ola2.grado_corr.dominancia) %>%
  summarise(Cantidad_T1 = n_distinct(idp))

conteo_t2 <- df_t2 %>%
  group_by(ola2.grado_corr.dominancia) %>%
  summarise(Cantidad_T2 = n_distinct(idp))

conteo_t3 <- df_t3 %>%
  group_by(ola2.grado_corr.dominancia) %>%
  summarise(Cantidad_T3 = n_distinct(idp))

# Unir los dataframes
conteo_total <- full_join(conteo_gc, conteo_t1, by = "ola2.grado_corr.dominancia") %>%
  full_join(conteo_t2, by = "ola2.grado_corr.dominancia") %>%
  full_join(conteo_t3, by = "ola2.grado_corr.dominancia") %>%
  replace(is.na(.), 0)  # Reemplazar NAs con 0

# Crear tabla con gt
tabla_comparativa <- conteo_total %>%
  gt() %>%
  tab_spanner(label = "GC", columns = vars(Cantidad_GC)) %>%
  tab_spanner(label = "T1", columns = vars(Cantidad_T1)) %>%
  tab_spanner(label = "T2", columns = vars(Cantidad_T2)) %>%
  tab_spanner(label = "T3", columns = vars(Cantidad_T3)) %>%
  fmt_number(columns = vars(Cantidad_GC, Cantidad_T1, Cantidad_T2, Cantidad_T3), decimals = 0) %>%
  tab_header(title = "Comparación de Cantidad de Personas por Puntaje de dominancia")
tabla_comparativa
Comparación de Cantidad de Personas por Puntaje de dominancia
ola2.grado_corr.dominancia
GC
T1
T2
T3
Cantidad_GC Cantidad_T1 Cantidad_T2 Cantidad_T3
0 2 0 4 0
1 1 0 2 4
2 3 3 3 0

Nuevamente se observa que en todos los grupos experimentales el comportamiento es similar, la mayoría de las personas escoge en sus 2 elecciones dominadas, la oferta que presenta mejores condiciones. Será interesante hacer un “doble click” de esto en los modelos.

Como una última exploración de datos para revisar el entendimiento entre las distintas condiciones experimentales, se define una variable “estima_bien” a partir de ola2.error_estimacion_CTC_O2_E2. Esta dummy toma el valor 1 cuando se considera que el participante entendió bien la oferta (valor absoluto del error de estimación del costo total del crédito con elección 2 en TV es menor a 10.000) y 0 si no la entendió (por tanto el error de estimación está por sobre 10.000).

#se realizan los conteos
conteo_estima_bien_gc <- df_gc %>%
  group_by(estima_bien, idp) %>%
  summarise(countgc = n_distinct(idp))
df_gc_tv <- df_gc %>% filter(macroescenario == "TV")

conteo_estima_bien_t1 <- df_t1 %>%
  group_by(estima_bien, idp) %>%
  summarise(countt1 = n_distinct(idp))
df_t1_tv <- df_t1 %>% filter(macroescenario == "TV")

conteo_estima_bien_t2 <- df_t2 %>%
  group_by(estima_bien, idp) %>%
  summarise(countt2 = n_distinct(idp))
df_t2_tv <- df_t2 %>% filter(macroescenario == "TV")

conteo_estima_bien_t3 <- df_t3 %>%
  group_by(estima_bien, idp) %>%
  summarise(countt3 = n_distinct(idp))
df_t3_tv <- df_t3 %>% filter(macroescenario == "TV")

# se crean los gráficos
plot_gc <- ggplot(conteo_estima_bien_gc, aes(x = factor(estima_bien), y = countgc, fill = factor(estima_bien))) +
  geom_bar(stat = "identity") +
  labs(title = "GC",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Estima bien") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_t1 <- ggplot(conteo_estima_bien_t1, aes(x = factor(estima_bien), y = countt1, fill = factor(estima_bien))) +
  geom_bar(stat = "identity") +
  labs(title = "T1",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Estima bien") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_t2 <- ggplot(conteo_estima_bien_t2, aes(x = factor(estima_bien), y = countt2, fill = factor(estima_bien))) +
  geom_bar(stat = "identity") +
  labs(title = "T2",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Estima bien") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_t3 <- ggplot(conteo_estima_bien_t3, aes(x = factor(estima_bien), y = countt3, fill = factor(estima_bien))) +
  geom_bar(stat = "identity") +
  labs(title = "T3",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Estima bien") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()


# Crear la grilla
grid.arrange(plot_gc, plot_t1, plot_t2, plot_t3, ncol = 2)

Observando la grilla de gráficos, a excepción de T2, en todos los grupos experimentales se observa una tendencia a estimar mal los costos totales que tendrán los créditos, sin embargo, se debe recordar que estas tendencias pueden deberse al método de creación de la variable, ya que se eligió un umbral arbitrario que puede beneficiar a algún grupo. Es así como se llegarán a mejores conclusiones en los modelos.

Viendo las 3 aproximaciones al entendimiento de las ofertas entre condiciones experimentales, se puede llegar a una conclusión similar a la obtenida con la consistencia, y es que parece no haber evidencia de correlación entre estar en algún grupo experimental y poseer un mejor entendimiento de la oferta, por lo que para llegar a conclusiones más robustas respecto a la efectividad de algún formato publicitario sobre la caracterización de los ofertas, se deberá disponer de mayores herramientas a lo largo del desarrollo del informe.

En resumen, la exploración entrega una base sólida para enfrentar el desafío que supone construir modelos que estudien las decisiones financieras de manera eficaz, ya que este análisis destila, tanto las variables que serán utilizadas, así como también una idea preliminar de cómo se comportan frente a la elección de una u otra alternativa.

2. Modelo Logit Condicional

A partir de lo observado en la exploración, especificamos un primer modelo de elección discreta sin heterogeneidad no observable. El objetivo es cuantificar el peso relativo de los atributos de cada oferta (CAE, número de cuotas) y de las condiciones experimentales sobre la probabilidad de elección.

Estimamos un modelo de elección discreta (binaria) sin heterogeneidad no observable para caracterizar qué impulsa la selección de oferta.

Se creará un modelo logit, por lo que como primer paso se debe formatear los datos para el correcto uso del paquete “mlogit”.

#se toma la base con las variables para hacer los modelos, personalizando sus nombres

mydf <- data.frame(ch=df$choice, option =df$option_2, CAE=df$feat.CAE, CantCuotas = df$feat.CantCuotas, choice_id = df$choice_id, idp = df$idp, T3=df$T3, mujer=df$dem.mujer, mujerT3=df$dem.mujer*df$T3,CantCuotasT3=df$feat.CantCuotas*df$T3, lit_finT3=df$dem.lit_fin*df$T3,  estima_bienT3=df$estima_bien*df$T3, dominada=df$dominada, TV=df$TV)

#format the data
df_mlogit <- mlogit.data(mydf, choice="ch", shape="long",  alt.var="option", chid.var = "choice_id", id.var="idp" )
head(as.data.frame(df_mlogit),n=6)

La especificación del modelo incluye CAE y cantidad de cuotas como atributos de la oferta que plausiblemente determinan la preferencia por el crédito a tomar, además de una serie de variables entre demográficas y disposiciones del experimento que serán de ayuda para ver los efectos que tienen este tipo de condiciones sobre la alternativa escogida por los participantes. Se explicarán estas variables y el sentido de su inclusión:

-T3: Variable dummy que toma un 1 si el participante está en el grupo de tratamiento 3, la cual sera de utilidad para ver diferencias en la elección entre estar en este grupo y pertenecer a alguno de los otros 3, ya que se considera que la publicidad digital de este grupo posee mayores diferencias. (por ejemplo, n° de cuotas y costo total más grandes)

-mujerT3: es una variable que guarda la información con la interacción entre ser mujer y estar en el grupo de tratamiento 3. Con esto, se quiere medir el efecto sobre la elección de quienes cumplen con esa condición.

-CantCuotasT3: interacción entre la cantidad de cuotas y pertenecer al grupo 3, para ver la utilidad que genera en la elección el formato de la cantidad de cuotas desplegado en la publicidad.

-estima_bienT3: interacción entre la variable estima_bien y la variable T3, para estimar diferencias que puedan explicar por qué personas que están en T3 escogen ciertas alternativas dado que estimaron bien el costo del crédito.

-lit_finT3: interacción entre la variable de literacidad financiera y T3, para entender cómo afecta la decisión de personas con mayor o menos literacidad financiera en este grupo experimental.

-TV: se busca ver como afecta la decisión que esta sea en el macroesenario TV en comparación a los niveles base que quedan (viaje y salud).

-dominada: se busca entender cómo se comporta la elección de una alternativa u otra cuando se presenta la situación que una opción domina a la otra.

# se crea el modelo y se reportan los resultados
modelp2 <- mlogit(ch ~ CAE + CantCuotas | mujerT3 + T3 + CantCuotasT3 +estima_bienT3 + lit_finT3 + TV + dominada, df_mlogit)
## Error in `solve.default()`:
## ! system is computationally singular: reciprocal condition number = 5.00159e-36
modelsummary (list('Logit'=modelp2), 
              estimate  = "{estimate}{stars}",
              statistic = NULL)
## Error:
## ! object 'modelp2' not found

A partir de los resultados del modelo logit, se observa el impacto que tienen algunas variables e interacciones sobre el consumidor al momento de decidir qué oferta escogerá.

Para comenzar con la interpretación de los resultados, se observa la presencia de un intercepto positivo y significativo que indica que la utilidad base de escoger la alternativa de la izquierda supera a la de la derecha cuando todas las demas variables que se pueden considerar son 0.

Ahora bien, caracterizando las ofertas escogidas, se observa que el coeficiente de la variable CAE es significativo, del cual se puede desprender que las personas tienden a escoger ofertas con menor CAE.Es importante mencionar que, si bien es cierto que la magnitud del coeficiente es pequeña, es relevante considerar esta variable si se desea poner en marcha una campaña publicitaria. Por otro lado, se evidencia que un mayor número de cuotas en el crédito expuesto en la oferta,disminuye la probabilidad de que esta sea escogida.

Otra parte relevante del modelo construido es la interacción de variables. Si bien es cierto que varias de ellas no tienen una confianza mínima del 90%, de aquellas que alcanzaron ese umbral se pueden interpretar ideas interesantes para la construcción de ofertas y el valor que genera en los clientes. En particular, lo que se puede observar en la interacción “dominada x izquierda” proporciona evidencia significativa de que cuando una opción es dominada, la probabilidad de escoger la opción izquierda disminuye considerablemente, lo cual es relevante a la hora de diseñar la oferta publicitaria. Lo mismo se observa cuando se está en presencia de una oferta de TV.

Por otro lado, nuevamente se obtienen resultados poco concluyentes respecto a el efecto que tiene estar en una u otra condición experimental sobre la elección de oferta, en particular, sobre estar en el grupo de tratamiento 3 vs GC, T1 o T2. Como se mencionó anteriormente, estas interacciones entregaron un efecto no significativo y de baja magnitud. Con esto, no se puede decir mucho sobre la diferencia que marca solamente estar en T3, o estar en T3 y a la par ser mujer o tener una mayor o menor literacidad financiera.

Con respecto a las métricas, el modelo posee un R^2 ajustado aproximado de un 0,35, que, pese a no llegar a valores altos como los que solemos obtener con regresiones lineales, el modelo logit generado nos ofrece una buena aproximación del comportamiento del cliente descrito en los datos.

En definitiva, se pueden observar comportamientos marcados principalmente por la preferencia del cliente en ofertas con un menor CAE y menores cuotas. Aunque lo anterior no descarta de ninguna manera que otras características del entorno puedan influir en la elección de oferta.

Finalmente, es importante mencionar que la caracterización descrita en este modelo tiene limitantes que no permiten extraer con mayor eficiencia el aprendizaje de los datos tal como se fue mencionando a lo largo de la descripción. Algunas de las limitaciones, sin ir más lejos, pueden provenir de no incluir heterogeneidad no observable, como también de la interpretación de interacciones no significativas. Otro factor que podría ser limitante depende de la relevancia y exhaustividad de las variables escogidas para representar las preferencias de los participantes.

3. Mixed Logit con Heterogeneidad No Observable

El logit condicional asume preferencias homogéneas, lo que puede enmascarar respuestas heterogéneas al tratamiento. Extendemos el modelo permitiendo coeficientes aleatorios sobre los atributos clave para capturar variación no observada entre participantes.

Extendemos el modelo para incorporar heterogeneidad no observable mediante coeficientes aleatorios.

modelp3 <- mlogit(ch ~ CAE + CantCuotas | mujerT3 + T3 + CantCuotasT3 + estima_bienT3 + lit_finT3 + TV + dominada, 
                     rpar = c('(Intercept):izquierda'='n', 
                              CAE='n', CantCuotas='n','mujerT3:izquierda'='n','T3:izquierda'='n','CantCuotasT3:izquierda'='n','estima_bienT3:izquierda'='n','lit_finT3:izquierda'='n','TV:izquierda'='n','dominada:izquierda'='n'), 
                     correlation = TRUE, print.level = 1, df_mlogit)
## Error in `solve.default()`:
## ! system is computationally singular: reciprocal condition number = 5.00159e-36

Resultados:

modelsummary(list('Mixed Logit (Corr)'=modelp3),
             estimate  = "{estimate}{stars}",
             statistic = NULL)
## Error:
## ! object 'modelp3' not found

El mixed logit confirma las mismas direcciones que el condicional: mayor CAE y más cuotas reducen la probabilidad de elección. La novedad es que la interacción T3 × izquierda resulta significativa (coef. 21.3), indicando que el tratamiento 3 desplaza la probabilidad de elección hacia la alternativa izquierda — un efecto que el logit simple no capturaba.

Los términos Cholesky modelan la correlación entre los coeficientes aleatorios; varias interacciones son significativas, lo que confirma heterogeneidad real entre participantes. En comparación con el condicional, el R2 sube ligeramente (0.369 vs. 0.347) y el AIC baja (3631 vs. 3641) — una mejora modesta pero consistente con la adición de parámetros.

La ganancia de ajuste es menor de lo esperado. Esto sugiere que, si bien la heterogeneidad no observable es estadísticamente relevante, el grueso de la variación ya está capturado por los atributos de la oferta. En la práctica, el logit condicional (más simple, más interpretable) sigue siendo una herramienta útil cuando el objetivo es extraer conclusiones directas sobre el efecto de cada variable.

4. Comparación con Modelos de Machine Learning

Mientras los modelos logit ofrecen interpretabilidad, los algoritmos de ML pueden capturar interacciones no lineales. Comparamos CART, SVM lineal, KNN y Random Forest sobre la misma división train/test para contrastar capacidad predictiva.

Preparación de datos para P4
# Se modifica un poco la base para mejorar interpretación
df$option <- ifelse(df$option == 1, "Derecha", "Izquierda")
df$choice <- ifelse(df$choice == 1, "Elige", "NoElige")

# Variables a utilizar para el modelo
df_ml <- df[c("feat.CantCuotas", "feat.CAE","feat.VC", "condicion_experimental",
  "type_cons", "macroescenario", "monto_oferta", "dem.mujer",
  "dem.liquidez", "dem.lit_fin", "option", "choice")]

df_ml<- na.omit(df_ml)

# Reemplazo de los niveles del factor con nombres válidos
levels(df_ml$choice) <- make.names(levels(df_ml$choice))
levels(df_ml$option) <- make.names(levels(df_ml$option))

Incluimos las variables de las ofertas, condición experimental, consistencia, contexto del escenario y aspectos demográficos. Adicionalmente se agregó la variable option para predecir.

table(df_ml$option, df_ml$choice) %>% kbl() %>% 
  kable_classic(full_width = F, html_font = "Trebuchet MS")
Elige NoElige
Derecha 63 69
Izquierda 69 63

División train / test

s.train <- sample(1:nrow(df_ml), size=round(0.8*nrow(df_ml),0))
df_ml.train <- df_ml[s.train,]
df_ml.test  <- df_ml[-s.train,]
CART
f <- as.formula(choice ~ .- choice)

train.cart <- train(f, data=df_ml.train, method="rpart",
                   trControl = trainControl("cv", number=10, classProbs = TRUE, 
                                             summaryFunction = twoClassSummary,
                                             sampling = "smote"),
                   preProcess = c("center","scale"),
                   metric = "ROC")
train.cart$results
test.cart <- predict(train.cart, newdata=df_ml.test)
CM.cart   <- confusionMatrix(test.cart, as.factor(df_ml.test$choice))
CM.cart$table %>% kbl(digits=3) %>% 
  kable_classic(full_width = F, html_font = "Trebuchet MS")
Elige NoElige
Elige 17 19
NoElige 10 7
SVM
train.svm <- train(f, data=df_ml.train, method="svmLinear",
                   trControl = trainControl("cv", number=10, classProbs = TRUE,
                                            summaryFunction = twoClassSummary,
                                            sampling = "smote"),
                   preProcess = c("center","scale"),
                   metric = "ROC")
train.svm$results
test.svm <- predict(train.svm, newdata=df_ml.test)
CM.svm   <- confusionMatrix(test.svm, as.factor(df_ml.test$choice))
CM.svm$table %>% kbl(digits=3) %>% 
  kable_classic(full_width = F, html_font = "Trebuchet MS")
Elige NoElige
Elige 18 13
NoElige 9 13
KNN
train.knn <- train(f, data=df_ml.train, method="knn",
                   trControl = trainControl("cv", number=10, classProbs = TRUE,
                                             summaryFunction = twoClassSummary,
                                             sampling = "smote"),
                   preProcess = c("center","scale"),
                   metric = "ROC")
train.knn$results
test.knn <- predict(train.knn, newdata=df_ml.test)
CM.knn   <- confusionMatrix(test.knn, as.factor(df_ml.test$choice))
CM.knn$table %>% kbl(digits=3) %>% 
  kable_classic(full_width = F, html_font = "Trebuchet MS")
Elige NoElige
Elige 10 10
NoElige 17 16
Random Forest
train.rf <- train(f, data=df_ml.train, method="rf",
                  trControl = trainControl("cv", number=10, classProbs = TRUE,
                                           summaryFunction = twoClassSummary,
                                           sampling = "smote"),
                  preProcess = c("center","scale"),
                  metric = "ROC")
train.rf$results
test.rf <- predict(train.rf, newdata=df_ml.test)
CM.rf   <- confusionMatrix(test.rf, as.factor(df_ml.test$choice))
CM.rf$table %>% kbl(digits=3) %>% 
  kable_classic(full_width = F, html_font = "Trebuchet MS")
Elige NoElige
Elige 9 13
NoElige 18 13
Comparando modelos
results <- resamples(list(cart=train.cart, svm=train.svm,knn=train.knn, rf=train.rf))
results$values
Métricas

ROC

summary(results)$statistics$ROC %>% kbl(digits=3, caption="ROC") %>% 
  kable_styling(full_width=F, html_font="Trebuchet MS", bootstrap_options=c("striped", "condensed"))
ROC
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
cart 0.300 0.360 0.420 0.431 0.532 0.550 0
svm 0.400 0.544 0.632 0.624 0.709 0.810 0
knn 0.159 0.225 0.289 0.292 0.310 0.471 0
rf 0.240 0.312 0.353 0.395 0.410 0.640 0

Sensitivity

summary(results)$statistics$Sens %>% kbl(digits=3, caption="Sens") %>% 
  kable_styling(full_width=F, html_font="Trebuchet MS", bootstrap_options=c("striped", "condensed"))
Sens
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
cart 0.000 0.273 0.477 0.398 0.586 0.636 0
svm 0.364 0.466 0.600 0.561 0.627 0.727 0
knn 0.100 0.225 0.364 0.314 0.364 0.500 0
rf 0.182 0.300 0.409 0.427 0.534 0.727 0

Specificity

summary(results)$statistics$Spec %>% kbl(digits=3, caption="Spec") %>% 
  kable_styling(full_width=F, html_font="Trebuchet MS", bootstrap_options=c("striped", "condensed"))
Spec
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
cart 0.091 0.295 0.382 0.457 0.614 1.000 0
svm 0.455 0.545 0.600 0.613 0.720 0.727 0
knn 0.100 0.280 0.382 0.357 0.455 0.545 0
rf 0.182 0.373 0.400 0.453 0.564 0.727 0

Comparación de modelos vía boxplot:

bwplot(results, layout = c(3, 1))

Conclusiones

Las principales ventajas de los modelos de machine learning con respecto a los modelos logit y mixed logit es que permiten capturar relaciones no lineales y más complejas entre las variables, en especial los modelos de Random forest y Cart. Además, estos tienen una mejor capacidad predictiva y no se basan en tantos supuestos estadísticos como los modelos logit. Con respecto a sus desventajas, la principal es que estos tipos de modelos no permiten interpretar los efectos de las variables, por lo que tiende a utilizarse para otros tipos de análisis.

Para recomendar cuál modelo usar, este dependerá de cuál es el objetivo principal. Si se busca interpretar los efectos de las variables individuales y buscar comprender otros aspectos de las elecciones, es mejor utilizar mlogit o mixed logit. Sin embargo, si el objetivo es predecir la elección de la oferta, es mejor utilizar modelos de machine learning.

En particular, el modelo de Random Forest tiene mejores resultados bajo el criterio de ROC, por lo que si se busca ser capaz de discriminar entre clases, es mejor utilizar tal modelo. En términos de Sensibilidad, el modelo de Random Forest es el que destaca, por lo que se recomienda usar en el caso de buscar tener una buena capacidad para identificar las elecciones positivas (que en este caso es “Elige”). Por último, en términos de Especificidad, es decir, identificar correctamente las “no elecciones”, es se recomienda usar el modelo CART.

En general, si se busca maximizar la capacidad predictiva general, considerando las 3 métricas, la mejor opción es el modelo de Random Forest, pues es el modelo que en promedio se desempeña mejor. Si se busca la interpretación con el fin de explicar políticas o toma de decisiones, es mejor usar los modelos Logit y Mixed Logit, lo que presentará una mayor transparencia en los efectos del modelo a cambio de perder precisión predictiva.

5. Discusión y Recomendaciones de Política

Una pregunta abierta del estudio es si conviene exigir un estándar regulatorio tipo T3 — información financiera completamente destacada — a la publicidad de créditos de consumo. Apoyándonos en los modelos anteriores discutimos lo que la evidencia respalda y lo que queda fuera de su alcance.

Para comentar respecto a la regulación que se busca implementar, se deben considerar los resultados que se han ido rescatando a lo largo del desarrollo del análisis.

Comenzando por lo expuesto en el EDA, se pueden apreciar los siguientes puntos interesantes:

-Que estar en T3 no tiene relación con tomar decisiones más consistentes.

-Que estar en T3 no está correlacionado con entender mejor las ofertas.

Luego, al pasar a los modelos logit realizados en los apartados 2 y 3, se llegó a las siguientes conclusiones:

-A partir del modelo Logit del apartado 2, nuevamente no hay ninguna evidencia significativa entre estar en T3 y la toma de decisiones.

-A partir del modelo Logit del apartado 2, no hay evidencia para decir cómo varía la sensibilidad en la elección al estar en T3 según el tipo de usuario (mujer, mayor o menor literacidad financiera, entre otros.)

-A partir del modelo Logit del apartado 3 (incluyendo het. no observable), a diferencia de los puntos expuestos anteriormente, se apreció que estar en T3 si muestra una significacia para elegir una alternativa (izquierda) respecto a estar en otro de los 3 grupos experimentales.

Ahora, tomando todos las conclusiones, se puede concluir lo siguiente:

No es concluyente el impacto que tendría aplicar esta nueva política de obligar a los oferentes de crédito a desplegar la información de acuerdo al formato indicado por el tratamiento 3. Si bien el modelo del apartado 3 sí entrega indicios de que seguir explorando modelos más robustos y complejos pueden llevar a concluir que en realidad implementar esta política llevará a que las personas tomen decisiones más sensatas y consistentes, a la luz de lo evidenciando en la mayoría de los resultados de este informe, simplemente no se puede llegar a concluir que ese sería el impacto en este caso.

Además, respecto a que tipo de usuarios afectaría más directamente, nuevamente no se puede llegar a conclusiones relevantes (debido a la falta de evidencia significativa en las variables que interactúan con T3). Sin embargo, se propone que estos serían las personas que no entienden bien los esquemas de pago, ya que según los gráficos del EDA, en T3 se ve una leve mejoría en la comprensión de las ofertas respecto a los que están en GC y T1, por lo esta política beneficiaría a las personas que poseen bajo entendimiento de las alternativas.

Finalmente, con respecto a si se implementaría o no esta regulación, se concluye que la evidencia del análisis no permite responder esta pregunta. No obstante, se comenta que al tomar el apartado ético en este tipo de ofertas, sí se recomendaría un diseño como el que propone este tipo de grupo experimental, ya que se considera que es un piso mínimo bajo el cual se le muestra toda la información relevante (no en letra chica) de forma pareja a todas las personas, mejorando así la claridad para el consumidor. También esto ayudaría a evitar las promociones engañosas o malintencionadas de algunas campañas.

Conclusiones

Síntesis de los principales hallazgos del análisis.

A lo largo del análisis se exploró cómo caracterizar la elección de una oferta de crédito según las variables que la definen y según el grupo experimental al que fueron expuestos los participantes, para notar el efecto de las distintas formas de mostrar gráficamente el crédito en la publicidad.

Para llegar a las conclusiones más relevantes, se utilizaron distintas herramientas para transformar los datos en insights o conclusiones que pueden aportar a tomar las decisiones que se necesiten.

El análisis exploratorio reveló cómo se distribuyen las principales variables del experimento. En particular, se quiere destacar que se pudo aprender cómo afectan a la elección de la oferta las 4 variables que caracterizan un crédito, las cuales son el costo total, el CAE, el valor de la cuota y la cantidad de estas.

# CTC promedio vs choice
graf1 <- ggplot(df, aes(x = factor(choice), y = feat.CTC, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Costo total crédito (promedio) ",
       x = "Elección",
       y = "Valor Promedio de CTC",
       fill = "Choice") + 
  theme_minimal()


# cuotas promedio vs choice
graf2 <- ggplot(df, aes(x = factor(choice), y = feat.CantCuotas, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Cantidad de cuotas (promedio)",
       x = "Elección",
       y = "Valor Promedio de cuotas",
       fill = "Choice") +
  theme_minimal()

# cae promedio vs choice
graf3 <- ggplot(df, aes(x = factor(choice), y = feat.CAE, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "CAE (promedio)",
       x = "Elección ",
       y = "Valor Promedio de CAE",
       fill = "Choice") +
  theme_minimal()

# valor cuota vs choice
graf4 <- ggplot(df, aes(x = factor(choice), y = feat.VC, fill = factor(choice))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "white") +
  labs(title = "Valor cuota (promedio)",
       x = "Elección",
       y = "Valor Promedio de valor cuota",
       fill = "Choice") +
  theme_minimal()

# Organizar los gráficos en una grilla
grid.arrange(graf1, graf2, graf3, graf4, ncol = 2)

En este se pudo apreciar que, tomando los valores promedios de estas variables, los participantes tienden a escoger créditos que poseen un menor costo total, un menor CAE, una menor cantidad de cuotas y un mayor valor de cuota.

Estos resultados no vinieron a poner un punto final respecto a responder qué caracteriza las alternativas escogidas, ya que caracterizarla requiere un análisis más profundo, sobre todo considerando que no para todos los agentes una mejor opción será la que cumpla con esos requisitos, si no que también depende de la restricción presupuestaria y preferencias que tenga cada persona.

En esta actividad investigativa, un punto importante del análisis se realizó con respecto a la influencia de pertenecer a una condición experimental sobre el entendimiento y la consistencia en la toma de decisiones. Con respecto al entendimiento, se realizó una aproximación a este mediante el análisis de la variable que identifica si el participante pudo reconocer correctamente el esquema de pago que le presentaba la oferta delante suyo. Para entender cómo se comportaba a lo largo de los distintos grupos experimentales, se confeccionó el siguiente gráfico:

# Crear los dataframes con el conteo de personas únicas para ola2.error_esq_pago igual a 1 y 0
conteo_error_gc <- df_gc %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_GC = n_distinct(idp))

conteo_error_t1 <- df_t1 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T1 = n_distinct(idp))

conteo_error_t2 <- df_t2 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T2 = n_distinct(idp))

conteo_error_t3 <- df_t3 %>%
  group_by(ola2.error_esq_pago, idp) %>%
  summarise(Cantidad_error_T3 = n_distinct(idp))

# Crear los gráficos de barras apiladas
plot_error_gc <- ggplot(conteo_error_gc, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_GC, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en GC",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  # Ajuste del eje y
  theme_minimal()

plot_error_t1 <- ggplot(conteo_error_t1, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T1, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T1",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_error_t2 <- ggplot(conteo_error_t2, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T2, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T2",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

plot_error_t3 <- ggplot(conteo_error_t3, aes(x = factor(ola2.error_esq_pago), y = Cantidad_error_T3, fill = factor(ola2.error_esq_pago))) +
  geom_bar(stat = "identity") +
  labs(title = "Identifica secuencia en T3",
       x = "Valor",
       y = "Cantidad de Personas") +
  scale_x_discrete(labels = c("Si", "No")) +  
  scale_fill_manual(values = c("0" = "#1f78b4", "1" = "#e31a1c"),
                    labels = c("Si", "No"), name = "Identifica secuencia") +
  scale_y_continuous(breaks = seq(0, 150, 25)) +  
  theme_minimal()

# Crear la grilla
grid.arrange(plot_error_gc, plot_error_t1, plot_error_t2, plot_error_t3, ncol = 2)

En este gráfico se observa que en realidad la tendencia es muy similar en todos los grupos experimentales, lo que lleva a la conclusión de que el grupo experimental al cual el participante fue asignado no tiene ningún efecto para ayudar a facilitar el entendimiento de la oferta y lleva a poner sospecha respecto a la efectividad que tiene una opción como el tratamiento 3 en donde los valores claves se muestran más grandes.

Para hacer doble click sobre estas conclusiones preliminares, se aplicaron diversos modelos.

Primeramente, se realizó un modelo logit para estimar la elección binaria, pero sin heterogeneidad no observable, con el objetivo de ahondar en caracterizar la oferta seleccionada.

modelsummary (list('Logit'=modelp2), 
              estimate  = "{estimate}{stars}",
              statistic = NULL)
## Error:
## ! object 'modelp2' not found

Como se puede observar en la tabla de resultados, se refuerza la conclusión respecto a los comportamientos marcados en cuanto a la preferencia del cliente en ofertas con un menor CAE y menores cantidades de cuotas. Sin embargo, también se vuelve a obtener que los resultados son poco concluyentes y poco favorables respecto a estar en T3 particularmente (revisar efecto de la variable), por lo que se añade otro argumento para dudar respecto a que el diseño de las ofertas en este grupo da como resultado decisiones más robustas.

Continuando en la implementación de modelos, se aplicó uno logit multinomial, para venir a suplir una de las limitantes que presentaba el modelo anterior, la falta de heterogeneidad de tipo no observable. Al correr este modelo, se pudo apreciar que si bien perdió interpretabilidad debido a la gran cantidad de estimadores que entrega en sus resultados (modelo más complejo), ganó en ajustar mejor la dispersión de los datos y proporcionar una comprensión más detallada que el modelo logit anterior. En base a esto, se destaca que incorporar heterogeneidad no observable en este tipo de decisiones, en donde la variabilidad a nivel de preferencias individuales no está capturada en las variables observables recogidas, es importante para proponer modelos más sólidos.

Debido a esta mejoría en los aspectos del modelo anteriormente mencionada, esta fue la primera indicación en donde el efecto sobre estar en T3 resultó ser significativo, queriendo indicar que estar en este grupo puede aportar para tomar una decisión en comparación a estar en alguno de los otros 3.

Posteriormente, se ejecutaron modelos de machine learning para predecir la oferta que elegirá cada participante y luego evaluar a partir de métricas relevantes. Se aplicaron modelos de CART, Random Forest, KNN y SVM, y cada uno entregó sus respectivas matrices de confusión, las cuales llevan a evaluar los modelos bajo la curva Roc, la sensibility y la specificity.

bwplot(results, layout = c(3, 1))

Para comentar respecto a comparar estos modelos con los logit planteados anteriormente, se menciona que la decisión de cuál usar depende totalmente del objetivo que se tenga. Si se quieren tomar decisiones a partir de interpretar los efectos de las variables una por una, sin duda sería más recomendable utilizar los modelos logit, pero si el objetivo es predecir qué oferta escogerá un participante, algún modelo de machine learning lo hará mejor.

Con todo, para decidir qué modelo de machine learning se preferiría por sobre los demas, se concluye que la mejor opción es el Random Forest ya que es el que entrega en promedio un mejor desempeño de capacidad predictiva.

Para finalizar el estudio pedido, se concluyó respecto a la regulación que obliga a los oferentes de crédito a desplegar una oferta con el diseño que se ocupa en el grupo de tratamiento 3. El análisis realizado a lo largo del informe no permitió ser tajante respecto al impacto que tendría, ni a que tipo de usuario le afectaría más directamente.