Este análisis tiene como objetivo aplicar modelos estadísticos predictivos para analizar dos escenarios empresariales distintos mediante simulación de datos. En la primera parte, se estudiarán los factores que explican las variaciones en las ventas mensuales de una cadena de tiendas minoristas con presencia en Puerto Rico. Se utilizará un modelo de regresión lineal múltiple para evaluar el impacto de variables como la inversión en publicidad televisiva y en redes sociales, el tamaño del local y la competencia cercana, con el fin de orientar futuras decisiones de mercadeo y optimización de recursos.
En la segunda parte, se analiza el caso de una institución financiera interesada en identificar los determinantes que influyen en la aprobación de solicitudes de crédito personal. Mediante un modelo de regresión logística, se buscará estimar la probabilidad de aprobación según el ingreso, el nivel de endeudamiento, la edad, el historial crediticio y la existencia de una garantía, con el propósito de establecer políticas crediticias más justas y eficientes.
A través de ambos ejercicios, se busca demostrar la utilidad de los modelos de regresión lineal y logística como herramientas fundamentales para la toma de decisiones estratégicas en contextos empresariales reales.
Se estarán evaluando los Factores que impulsan las ventas mensuales de sucursales de tiendas minoristas con presencia en Puerto Rico. Se tomarán en cuenta estas variables:
library(knitr)
library(kableExtra)
# Datos de la tabla
tabla_vars <- data.frame(
Variable = c("Ventas", "Publicidad_TV", "Publicidad_Redes", "Tamano", "Competidores", "Zona"),
Tipo = c("Continua (dependiente)", "Continua", "Continua", "Continua", "Discreta", "Categórica"),
Descripción = c(
"Monto mensual vendido (en miles de USD).",
"Gasto mensual en publicidad televisiva.",
"Gasto mensual en publicidad en redes sociales.",
"Tamaño de la tienda (metros cuadrados).",
"Número de competidores cercanos en un radio de 5 km.",
"Centro, Norte, Sur."
),
stringsAsFactors = FALSE
)
# Tabla (HTML)
kbl(tabla_vars, align = "lll", col.names = c("Variable", "Tipo", "Descripción")) |>
kable_classic(full_width = FALSE, html_font = "Times") |>
column_spec(1, bold = TRUE) |>
kable_styling(font_size = 14)| Variable | Tipo | Descripción |
|---|---|---|
| Ventas | Continua (dependiente) | Monto mensual vendido (en miles de USD). |
| Publicidad_TV | Continua | Gasto mensual en publicidad televisiva. |
| Publicidad_Redes | Continua | Gasto mensual en publicidad en redes sociales. |
| Tamano | Continua | Tamaño de la tienda (metros cuadrados). |
| Competidores | Discreta | Número de competidores cercanos en un radio de 5 km. |
| Zona | Categórica | Centro, Norte, Sur. |
Aquí como grupo decidimos los rangos de los valores para cada uno de las variables también tomando en cuenta que el valor de nuestra semilla es 6075 cuando sumamos nuestras fechas de nacimiento.
set.seed(6075)
n <- 300
# Simulación de variables
Publicidad_TV <- runif(n, 0, 100)
Publicidad_Redes <- runif(n, 0, 100)
Tamano <- runif(n, 50, 400)
Competidores <- sample(0:10, n, replace = TRUE)
Zona <- sample(c("Centro", "Norte", "Sur"), n, replace = TRUE)
# Coeficientes elegidos (dentro de rangos sugeridos)
b0 <- 45
b1 <- 0.35
b2 <- 0.50
b3 <- 0.04
b4 <- -2
aNorte <- 3
aSur <- -2
b5_Norte <- -0.10
b5_Sur <- -0.20
sd_error <- 8
# Interacción Redes × Zona
Zona_Norte <- ifelse(Zona == "Norte", 1, 0)
Zona_Sur <- ifelse(Zona == "Sur", 1, 0)
# Modelo de ventas
Ventas <- b0 + b1*Publicidad_TV + b2*Publicidad_Redes +
b3*Tamano + b4*Competidores +
aNorte*Zona_Norte + aSur*Zona_Sur +
b5_Norte*(Publicidad_Redes*Zona_Norte) +
b5_Sur*(Publicidad_Redes*Zona_Sur) +
rnorm(n, 0, sd_error)
data_lineal <- data.frame(Ventas, Publicidad_TV, Publicidad_Redes,
Tamano, Competidores, Zona)El modelo ajustado en este caso va a explicar las ventas mensuales en (miles de USD) de una cadena de tiendas minoristas a partir de factores como la inversión publicitaria, el tamaño físico del local, la competencia y la zona geográfica.
\[ \text{Ventas} = \beta_0 + \beta_1(\text{TV}) + \beta_2(\text{Redes}) + \beta_3(\text{Tamano}) + \beta_4(\text{Competidores}) + \alpha_1(\text{Zona}) + \beta_{5_1}(\text{Redes} \times \text{Zona}) + \varepsilon \]
Modelo de regresión Ajustado:
modelo_lineal <- lm(Ventas ~ Publicidad_TV + Publicidad_Redes + Tamano +
Competidores + Zona + Publicidad_Redes:Zona,
data = data_lineal)
summary(modelo_lineal)##
## Call:
## lm(formula = Ventas ~ Publicidad_TV + Publicidad_Redes + Tamano +
## Competidores + Zona + Publicidad_Redes:Zona, data = data_lineal)
##
## Residuals:
## Min 1Q Median 3Q Max
## -24.1865 -4.8269 0.1834 6.0420 19.4621
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 47.431760 2.336989 20.296 < 2e-16 ***
## Publicidad_TV 0.307234 0.017792 17.268 < 2e-16 ***
## Publicidad_Redes 0.505022 0.029994 16.838 < 2e-16 ***
## Tamano 0.038967 0.004924 7.914 5.27e-14 ***
## Competidores -2.054755 0.161991 -12.684 < 2e-16 ***
## ZonaNorte 3.603654 2.610747 1.380 0.1685
## ZonaSur -2.037299 2.445908 -0.833 0.4056
## Publicidad_Redes:ZonaNorte -0.115890 0.045016 -2.574 0.0105 *
## Publicidad_Redes:ZonaSur -0.224599 0.042252 -5.316 2.12e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.625 on 291 degrees of freedom
## Multiple R-squared: 0.8119, Adjusted R-squared: 0.8067
## F-statistic: 157 on 8 and 291 DF, p-value: < 2.2e-16
Coeficientes:
\(\beta_0\) -> (47.43) Representa el valor promedio esperado de ventas cuando todas las demás variables son cero. Por ejemplo, cuando una tienda promedio no tiene una inversión adicional tendría ventas cercanas a $47,430.
\(\beta_1\) -> Publicidad_TV (0.307) Por cada unidad adicional invertida en publicidad televisiva (mil USD), las ventas aumentan en $307, manteniendo las demás variables constantes. Esta variable tiene un impacto positivo siginificativo sobre las ventas.
\(\beta_2\) -> Publicidad_Redes (0.505) Por cada unidad adicional invertida en publicidad en redes sociales, las ventas aumentan en $505, controlando las demás variables. Esta varible también tiene un impacto positivo significativo que indica que la publicidad digital es incluso más efectiva que la televisiva, posiblemente por su alcance y segmentación.
\(\beta_3\) -> Tamaño (0.0389) Por metro cuadrado adicional de tienda se asocia con un aumento promedio de $38.90 en ventas mensuales, manteniendo las demás variables constantes. Esto puede significar que los locales más grandes tienden a generar mayores ingresos debido a una mayor capacidad operativa y flujo de clientes.
\(\beta_4\) -> Competidores (–2.05) Por cada competidor adicional en un radio de 5 km, las ventas disminuyen en promedio $2,055, manteniendo constantes las demás variables. Esto
\(\alpha_1\) -> ZonaNorte (3.60) y ZonaSur (–2.03) Las zonas geográficas no presentan diferencias significativas en las ventas promedio respecto a la zona de referencia (Centro), dado que ambos coeficientes tienen valores p > 0.05.
\(\beta_5\) -> Publicidad_Redes:ZonaNorte (–0.1159) La interacción negativa indica que el efecto de la publicidad en redes sociales en la Zona Norte es $115.90 menor por cada unidad invertida comparado con la zona Centro.
\(R^2\) -> Los resultados muestran que el modelo explica un 81% de la variabilidad en las ventas (R² ajustado = 0.8067), lo que indica un alto poder explicativo.
Aquí estaremos evaluando los errores de este modelo para poder ver si estos cumplen con los supuestos para ver la validez del modelo de regresión.
Este supuesto se utiliza para verificar que los residuos del modelo sigan una distribución normal, lo cual es importante porque garantiza la validez de las pruebas de significancia aplicadas a los coeficientes de regresión.
library(ggplot2)
library(broom)
df <- data.frame(
yhat = fitted.values(modelo_lineal),
res = rstandard(modelo_lineal))
ggplot(df, aes(sample = res)) +
stat_qq(color = "blue") +
stat_qq_line(linewidth = 1) +
labs(x = "Cuantiles teóricos", y = "Cuantiles muestrales") +
theme_minimal(base_size = 14)Después de evaluar la gráfica podemos ver que hay una leve desviación en las colas de la linea. Se puede asumir que el modelo no cumple con este supuesto pero no es muy claro que que no se desvían por mucho. Tenemos que hacer una prueba de hipotesis para confirmar que nuestra conclusión sea la correcta.
##
## Shapiro-Wilk normality test
##
## data: df$res
## W = 0.99242, p-value = 0.13
Después de evaluar el p-value el resultado respalda esta observación, ya que el valor p es mayor a 0.05, por lo que no se rechaza la hipótesis nula de normalidad. Esto indica que los residuos del modelo siguen una distribución aproximadamente normal. Este modelo si cumple con el supuesto.
El supuesto de Homoscendasticidad nos ayuda a ver si la varianza se ha mantenido constante a lo largo de todos los niveles de los valores ajustados. Viendo las gráficas hay que evaluar como se distribuye la variabilidad de los datos, velando que la nube de puntos debe permanecer constante alrededor de 0 (sin ningún patrón).
ggplot(df, aes(x = yhat, y = res)) +
geom_point(alpha = 0.6, color = "blue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
labs(x = "Valores ajustados", y = "Residuales estandarizados") +
theme_minimal(base_size = 14)Al ver la gráfica y la lozalización de los puntos se puede verse aprecia que los puntos se encuentran distribuidos de manera aleatoria alrededor de cero, sin formar ningún patrón o forma específica (como un cono o curva). Para comprobar esta observaión si la varianza es (homocedasticidad) o no (heterocedasticidad) se utilizará la prueba de hipotesis Bptest:
##
## studentized Breusch-Pagan test
##
## data: modelo_lineal
## BP = 5.4262, df = 8, p-value = 0.7112
Al ver la prueba de hipotesis podemos aceptar la hipotesis nula y concluir que la varianza de este modelo tiene una varianza constante (homocedasticidad), así que podemos decir que este modelo si cumple con este supuesto. Esto significa que la dispersión de las ventas no cambia significativamente entre tiendas con ventas bajas o altas, lo que refuerza la estabilidad del modelo al explicar los factores que influyen en las ventas mensuales.
El supuesto de Independencia muestra si los errores no están correlacionados entre sí. Es para ver que los puntos no vayan a depender de uno y del otro.
df3 <- data.frame(
res = rstandard(modelo_lineal)
) %>%
mutate(orden = 1:length(res))
ggplot(df3, aes(x = orden, y = res)) +
geom_point(alpha = 0.6, color = "blue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
labs(x = "Orden/tiempo", y = "Residuales estandarizados") +
theme_minimal(base_size = 14)
Observación
Al observar el gráfico de residuos estandarizados en función del orden o tiempo, se aprecia que los puntos se encuentran distribuidos de forma aleatoria alrededor de cero, sin mostrar ningún patrón visible ni tendencia sistemática. Esto sugiere que los errores son independientes entre sí. Pero para corroborar se estará haciendo una prueba de Hipótesis. Usando el Durbin-Watson Test:
H0: No hay correlación entre los residuales.
Ha: Hay correlación entre los reciduales.
##
## Durbin-Watson test
##
## data: modelo_lineal
## DW = 1.9761, p-value = 0.4197
## alternative hypothesis: true autocorrelation is greater than 0
Al ver el valor del p-value podemos concluir que nuestra observación es correcta, podemos decir que no hay correlación entre los residuales y que cada dato es independiente.Esto significa que los errores de predicción de las ventas en una tienda no dependen de los errores de otras tiendas, lo que refuerza la confiabilidad del modelo para explicar las variaciones en las ventas mensuales de manera independiente.
El objetivo de este ejercicio es utilizar un modelo de regresión logística que permita estimar la probabilidad de aprobación y determinar qué variables aumentan o reducen las posibilidades de que una solicitud sea aceptada.
set.seed(6075)
n <- 600
# Datos Simulados
ingreso <- pmax(0, round(rlnorm(n, meanlog = log(3.0), sdlog = 0.5), 1))
deuda <- round(runif(n, 0.1, 0.9), 2)
edad <- round(rnorm(n, 40, 20))
historial <- factor(
sample(c("Buena","Regular","Mala"), n, prob = c(0.3, 0.4, 0.3), replace = TRUE),
levels = c("Buena","Regular","Mala")
)
garantia <- factor(
sample(c("No","Si"), n, replace = TRUE),
levels = c("No","Si")
)Cada una de las variables ha sio simulada de manera que puedan escogerse valores al azar de manera lógica y racional.
El ingreso fue sampleado utilizando una función log-normal que se estira con sesgo hacia la derecha. El ingreso está en miles de dólares (1 = 1000 dólares) con media de 3 y desviación estándar de 1.
El grado de endeudamiento fue sampleado utilizando una distribución uniforme que de manera porcentual evalúa cuanto % de deuda posee el individuo solicitante (1 = 1%).
La edad fue sampleada utilizando una función normal donde se entiende que la media de los solicitantes de 40 años y con una desviación estándar de 20.
El historial crediticio del solicitantees una variable categórica con niveles: Buena, Regular y Mala, siendo Regular la que tiene más probabilidades de ser escogida con un 40%, esto dando a entender que la mayoría de los solicitantes caen bajo un renglón regular.
La garantía es una variable categórica que contiene dos niveles: Si y No. Esta variable responde a si los solicitantes ofrecen una garantía real a la hora de solicitar un préstamo.
## **Coeficientes**
```r
# Coeficientes
b0 <- -4
b1 <- 0.06
b2 <- -2.5
b3 <- 0.12
hRegular <- -1
hMala <- -2.5
garantiaNo <- 1
b4_hRegular <- -0.6
b4_hMala <- -1.2
sd_error <- 0.75
eta <- b0 + b1 * ingreso + b2 * deuda + b3 * edad +
ifelse(historial == "Regular", hRegular, 0) +
ifelse(historial == "Mala", hMala, 0) +
ifelse(garantia == "No", garantiaNo, 0) +
ifelse(historial == "Regular", b4_hRegular * deuda, 0) +
ifelse(historial == "Mala", b4_hMala * deuda, 0)
p <- 1 / (1 + exp(-eta))
aprobado <- rbinom(n, 1, p)
datos <- data.frame(aprobado, ingreso, deuda, edad, historial, garantia)
head(datos)
Primero, identificamos y simulamos unos coeficientes que tengan sentido con nuestras variables. Esto tanto para nuestras variables numéricas, categóricas e interacciones que deseamos evaluar. Establecemos que nuestras variables referencias son: “Buena”, para la variable historial, y “No” para la variable garantía. El valor “eta” contiene la fórmula de la regresión logística simulada en este ejercicio. Luego, debido a la naturaleza de la regresión logística, utilizamos la fórmula \[p = 1 / (1 + exp(-eta))\]
El valor aprobado contiene el valor de Y y el data frame datos colecciona este valor Y junto a los demás valores simulados anteriormente.
# Modelo Logístico
modelo <- glm(aprobado ~ ingreso + deuda + edad + historial + garantia + deuda:historial,
family = binomial, data = datos)
coefs <- summary(modelo)$coefficients
# Tabla
tabla_mod <- data.frame(
Termino = rownames(coefs),
Logit = round(coefs[, "Estimate"], 3),
Odds_Ratio = round(exp(coefs[, "Estimate"]), 3),
row.names = NULL,
check.names = FALSE
)
tabla_modLuego de establecer el modelo logístico, guardamos los coeficientes en un valor llamado “coefs” para luego proceder a calcular de logit de probabilidades y, por último, sacar conclusiones con sus odds ratio. Una vez obtenemos el odds ratio de los coeficientes, obtenemos las siguientes conclusiones.
Intercepto: Cuando el historial crediticio es bueno pero no hay una garantía real a la hora de solicitar y todas las demás variables son 0, la probabilidad de que acepten el préstamo es nula. Este intercepto no tiene interpretación real, (nadie que tiene 0 años de edad y $0 de ingreso pide un préstamo) pero es un punto de partida esencial que marca las referencias utilizadas en las próximas interpretaciones.
Ingreso: Cuando no hay garantía real y un buen historial crediticio, por cada 1000 dólares más de ingreso que genere el solicitante, la probabilidad de que se acepte el préstamo aumenta en 0.86%, manteniendo todo lo demás constante.
Deuda: Manteniendo intactas las referencias, por cada punto porcentual que se aumente de nivel de endeudamiento, la probabilidad de que se apruebe el préstamo es disminuye un 85%, manteniendo lo demás constante.
Edad: Por cada año de edad adicional, la probabilidad de que el préstamo sea concedido aumenta un 13%, manteniendo las referencias iguales y todo lo demás sea constante.
historialRegular: Aquí cambia la cosa. Cuando el historial crediticio del solicitante es regular, NO hay garantía real a la hora de solicitar y todo lo demás es constante, la probabilidad de que se acepte el préstamo disminuye un 54%, en comparación a que el historial crediticio sea bueno.
historialMala: El modelo nos indica que cuando el historial crediticio es malo y NO hay garantía real a la hora de solicitar, la probabilidad de que se acepte el préstamo disminuye un 93%, en comparación a que el historial crediticio sea bueno.
garantiaSi: Esto lo que quiere decir es que cuando el historial crediticio del solicitante es bueno y hay garantía real a la hora de solicitar el préstamo, mientras lo demás se queda igual, la probabilidad de que el préstamo sea aprobado disminuye un 34.2%
deuda:historialRegular: Cuando el hsitorial crediticio del solicitante es malo y la deuda aumenta un punto porcentual, la probabilidad de aprobación disminuye un 62%, manteniendo la garantia igual y lo demás constante.
deuda:historialMala: Cuando el historial crediticio es malo y el nivel de endeudamiento aumenbta un punto porcentual, la probabilidad de aprobación disminuye un 45%, manteniendo la garantía y lo demás constante.