Examen 1 Parte Grupal
Alexandra Arroyo, Maria Placer y Pedro Lorenzi
2025-11-04
Parte 1.
Paso 1: Simular Datos
1. Simulen la base de datos. En grupo deben decidir los rangos de valores para cada variable y tomar un valor dentro de los rangos dados para los coeficientes. Además, usar como numero de semilla la suma de las fechas de cumpleaños de los integrantes.
set.seed(6084)
n <- 300
b0 <- 50.0 # Intercepto: 40 a 55
b_TV <- 0.35 # Publicidad TV: 0.25 a 0.45
b_Redes <- 0.50 # Publicidad Redes: 0.35 a 0.65
b_Tam <- 0.04 # Tamaño: 0.02 a 0.06
b_Comp <- 3.00 # Competidores: 1 a 6 (positivo como piden)
a_Norte <- 3.5 # Zona Norte: 2 a 5
a_Sur <- -2.0 # Zona Sur: -3 a 1
i_Norte <- -0.05 # Redes×ZonaNorte: -0.20 a 0.10
i_Sur <- -0.12 # Redes×ZonaSur : -0.25 a -0.05
sigma <- 8 # Desviación de los errores: 6 a 10
## Generación de variables explicativas (rangos realistas)
TV <- runif(n, 0, 200) # gasto TV (miles USD/mes)
Redes <- runif(n, 0, 100) # gasto Redes (miles USD/mes)
Tamano <- runif(n, 300, 2000) # m2 de tienda
Competidores <- sample(1:10, n, TRUE) # número de competidores cercanos
Zona <- sample(c("Centro","Norte","Sur"), n, TRUE, prob = c(0.4, 0.35, 0.25))
Zona <- factor(Zona, levels = c("Centro","Norte","Sur"))
a_zona <- ifelse(Zona=="Norte", a_Norte,
ifelse(Zona=="Sur", a_Sur, 0))
int_Redes <- ifelse(Zona=="Norte", i_Norte*Redes,
ifelse(Zona=="Sur", i_Sur*Redes, 0))
eps <- rnorm(n, 0, sigma)
Ventas <- b0 + b_TV*TV + b_Redes*Redes + b_Tam*Tamano + b_Comp*Competidores +
a_zona + int_Redes + eps
datos <- data.frame(Ventas, TV, Redes, Tamano, Competidores, Zona)
summary(datos)## Ventas TV Redes Tamano
## Min. : 77.96 Min. : 1.412 Min. : 0.1453 Min. : 302.8
## 1st Qu.:148.66 1st Qu.: 49.438 1st Qu.:24.0398 1st Qu.: 701.7
## Median :175.36 Median : 99.252 Median :50.5538 Median :1183.7
## Mean :172.93 Mean :101.306 Mean :51.2296 Mean :1166.5
## 3rd Qu.:195.97 3rd Qu.:151.132 3rd Qu.:77.7166 3rd Qu.:1669.2
## Max. :249.34 Max. :199.315 Max. :99.6238 Max. :1999.5
## Competidores Zona
## Min. : 1.00 Centro:119
## 1st Qu.: 3.00 Norte :101
## Median : 6.00 Sur : 80
## Mean : 5.66
## 3rd Qu.: 8.00
## Max. :10.00head(datos)## Ventas TV Redes Tamano Competidores Zona
## 1 223.45688 121.269712 31.994707 1992.1155 8 Centro
## 2 201.44279 165.560858 53.831763 1092.6332 6 Centro
## 3 145.86033 156.441441 35.820075 681.7658 4 Sur
## 4 170.07158 137.101592 29.134084 1205.9503 4 Centro
## 5 96.92414 3.658116 8.509468 823.1383 3 Centro
## 6 133.19363 49.366047 26.345250 833.7007 7 CentroPaso 2: Modelo de Regresion Lineal Multiple
2. Ajusten el mejor modelo de regresión lineal múltiple.
Verificamos Correlacion:
library(corrplot)## corrplot 0.95 loadedR <- cor(Filter(is.numeric, datos), use = "pairwise.complete.obs")
corrplot(R,
method = "color",
type = "lower",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45,
diag = FALSE)
La matriz de correlación muestra que las ventas presentan correlaciones moderadas y positivas con la inversión en televisión (0.56), en redes sociales (0.48) y con el tamaño de la tienda (0.60), lo que sugiere que un mayor gasto publicitario y un mayor tamaño se asocian con mayores ventas. La variable “Competidores” muestra una correlación más baja (0.18), indicando un efecto menos directo. No aparecen las categorías de la variable Zona porque se trata de una variable categórica, y la correlación de Pearson solo se calcula entre variables numéricas continuas; en su caso, los efectos de zona se analizarán posteriormente dentro del modelo de regresión mediante variables indicadoras (dummies) e interacciones.
Ajustamos del modelo aplicando regresion lineal multiple:
# Creamos el modelo saturado
datos$Zona <- factor(datos$Zona, levels = c("Centro","Norte","Sur"))
saturado <- Ventas ~ TV + Redes + Tamano + Competidores + Zona + Redes:Zona
reg <- lm(saturado, data = datos)
summary(reg)##
## Call:
## lm(formula = saturado, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18.8297 -4.9953 -0.1758 5.1695 21.2089
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 50.9344068 2.1484277 23.708 < 2e-16 ***
## TV 0.3491969 0.0076426 45.691 < 2e-16 ***
## Redes 0.5168709 0.0241318 21.419 < 2e-16 ***
## Tamano 0.0390508 0.0008406 46.456 < 2e-16 ***
## Competidores 3.0511080 0.1555514 19.615 < 2e-16 ***
## ZonaNorte 0.6789511 2.0338474 0.334 0.738751
## ZonaSur -2.7809300 2.2639044 -1.228 0.220298
## Redes:ZonaNorte -0.0040158 0.0350159 -0.115 0.908775
## Redes:ZonaSur -0.1450325 0.0374984 -3.868 0.000136 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.498 on 291 degrees of freedom
## Multiple R-squared: 0.9526, Adjusted R-squared: 0.9513
## F-statistic: 731.7 on 8 and 291 DF, p-value: < 2.2e-16library(leaps)
p <- ncol(model.matrix(saturado, data = datos)) - 1
ajuste <- regsubsets(
saturado, data = datos,
nvmax = p,
method = "exhaustive")
s <- summary(ajuste)
names(s)## [1] "which" "rsq" "rss" "adjr2" "cp" "bic" "outmat" "obj"El modelo presenta un excelente ajuste general (R² ≈ 0.95) y muestra que las variables inversión en TV, inversión en redes, tamaño y número de competidores son las que más contribuyen al aumento de las ventas. La interacción significativa entre Redes y Zona Sur indica que la eficacia de la publicidad digital varía según la ubicación geográfica. En cambio, las zonas por sí solas (sin interacción) no producen diferencias estadísticamente relevantes respecto al Centro.
Paso 3: Interpretacion Modelo Final
3. Interpreten la salida del modelo final.
Elegimos el modelo optimo:
best_bic <- which.min(s$bic)
best_r2 <- which.max(s$adjr2)
# Visualización comparativa
par(mfrow = c(1,2))
plot(s$bic, type="b", col="red", pch=19,
xlab="Número de predictores", ylab="BIC",
main="Criterio BIC")
points(best_bic, s$bic[best_bic], pch=19, cex=1.5, col="blue")
plot(s$adjr2, type="b", col="darkgreen", pch=19,
xlab="Número de predictores", ylab="R² ajustado",
main="Criterio R² ajustado")
points(best_r2, s$adjr2[best_r2], pch=19, cex=1.5, col="blue")
best_bic## [1] 5best_r2## [1] 6El criterio BIC alcanza su valor mínimo con cinco predictores, mientras que el R² ajustado llega a su punto máximo con seis predictores. Sin embargo, a partir del quinto predictor, las mejoras en el ajuste (R² ajustado) son mínimas, lo que indica que incluir más variables no incrementa de forma sustancial la capacidad explicativa del modelo, pero sí aumenta su complejidad. Por tanto, aunque el R² ajustado favorece un modelo con seis variables, el criterio BIC que penaliza la inclusión de predictores innecesarios sugiere que el modelo con cinco predictores ofrece el mejor equilibrio entre simplicidad y precisión, siendo la opción más eficiente para describir las ventas en función de las variables disponibles.
sel_names <- names(coef(ajuste, best_bic))[-1] # sin intercepto
X <- model.matrix(saturado, data = datos) # incluye intercepto
dfX <- data.frame(Ventas = datos$Ventas, X[, -1, drop = FALSE])
f_final <- as.formula(paste("Ventas ~", paste(sel_names, collapse = " + ")))
# 5) Ajuste del modelo final
modelo_final <- lm(f_final, data = dfX)
summary(modelo_final)##
## Call:
## lm(formula = f_final, data = dfX)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18.575 -4.996 -0.155 5.336 21.376
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 50.4747758 1.7734065 28.46 <2e-16 ***
## TV 0.3492969 0.0076132 45.88 <2e-16 ***
## Redes 0.5262432 0.0157650 33.38 <2e-16 ***
## Tamano 0.0390001 0.0008379 46.55 <2e-16 ***
## Competidores 3.0626815 0.1537040 19.93 <2e-16 ***
## Redes:ZonaSur -0.1876368 0.0161584 -11.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.492 on 294 degrees of freedom
## Multiple R-squared: 0.9522, Adjusted R-squared: 0.9514
## F-statistic: 1172 on 5 and 294 DF, p-value: < 2.2e-16Conclusión:
El modelo final seleccionado mediante el criterio BIC mantiene prácticamente el mismo poder explicativo que el modelo saturado (R² ajustado ≈ 0.95), pero utiliza un número menor de variables, quedándose solo con las que resultan estadísticamente significativas: inversión en TV, inversión en redes, tamaño de la tienda, número de competidores y la interacción Redes:Zona Sur. Esto lo convierte en un modelo más parsimonioso y eficiente, ya que explica las ventas con la misma precisión pero sin incluir variables redundantes o no significativas. En otras palabras, es el mejor modelo porque logra el equilibrio ideal entre simplicidad y capacidad predictiva, evitando el sobreajuste y haciendo la interpretación más clara.
Interpretación de los coeficientes:
β₀ = 50.47 (Intercepto): representa las ventas promedio (en miles de USD) para una tienda ubicada en la zona Centro, cuando la inversión en TV y redes sociales, el tamaño y el número de competidores son cero.
β₁ = 0.35 (TV): por cada mil dólares adicionales invertidos en publicidad televisiva, las ventas aumentan en promedio 0.35 mil USD, manteniendo las demás variables constantes.
β₂ = 0.53 (Redes): en la zona Centro, por cada mil dólares adicionales invertidos en publicidad en redes sociales, las ventas aumentan en promedio 0.53 mil USD, manteniendo constantes las demás variables.
=β₃ = 0.039 (Tamaño): por cada metro cuadrado adicional de superficie de la tienda, las ventas aumentan en promedio 0.039 mil USD, manteniendo las demás variables constantes.
β₄ = 3.06 (Competidores): cada competidor adicional dentro del radio de 5 km se asocia con un aumento promedio de 3.06 mil USD en las ventas, lo que podría reflejar que las zonas con más competencia también tienen mayor concentración de clientes.
β₅ = -0.19 (Redes × ZonaSur): indica que el efecto de la inversión en redes sociales en la zona Sur es 0.19 unidades menor que en la zona Centro. En otras palabras, la publicidad digital es menos efectiva en la zona Sur. El modelo incluye dos interacciones que muestran cómo varía el efecto de la inversión en publicidad digital según la zona.
Paso 4: Supuestos
4. Evalúen los supuestos (normalidad, homocedasticidad e independencia).
Evaluamos Supuesto de Normalidad:
library(ggplot2)
library(broom)
df <- data.frame(
yhat = fitted.values(modelo_final),
res = rstandard(modelo_final))
ggplot(df, aes(sample = res)) +
stat_qq(color = "blue") +
stat_qq_line(linewidth = 1) +
labs(
title = "Gráfico Q-Q de residuos estandarizados",
x = "Cuantiles teóricos",
y = "Cuantiles muestrales"
) +
theme_minimal(base_size = 14)
Prueba de Normalidad Shapiro-Wilk
shapiro.test(df$res)##
## Shapiro-Wilk normality test
##
## data: df$res
## W = 0.99693, p-value = 0.8397Media de los residuos
mean(df$res)## [1] -4.740743e-05El gráfico Q-Q muestra que los puntos de los residuos estandarizados se alinean casi perfectamente sobre la línea diagonal, lo que indica que siguen una distribución aproximadamente normal. Esta observación se confirma con la prueba de Shapiro-Wilk (W = 0.9969, p = 0.8397), cuyo valor p es mayor a 0.05, por lo que no se rechaza la hipótesis nula de normalidad. Además, la media de los residuos es prácticamente cero (-4.7e-05), lo cual refuerza que no existe sesgo sistemático en los errores del modelo. En conjunto, estos resultados permiten concluir que el supuesto de normalidad de los residuos se cumple adecuadamente, validando el uso de inferencias estadísticas sobre los coeficientes del modelo.
Evaluamos Supuesto de Homocedasticidad:
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericggplot(df, aes(x = yhat, y = res)) +
geom_point(alpha = 0.6, color = "blue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
labs(title = "Residuos estandarizados vs valores ajustados",
x = "Valores ajustados",y = "Residuos estandarizados" ) +
theme_minimal(base_size = 14)
Prueba de Breusch-Pagan
bptest(modelo_final)##
## studentized Breusch-Pagan test
##
## data: modelo_final
## BP = 2.9638, df = 5, p-value = 0.7056El gráfico de dispersión de residuos frente a los valores ajustados muestra que los puntos se distribuyen de forma aleatoria alrededor de la línea horizontal cero, sin evidenciar un patrón definido ni forma de embudo, lo que sugiere que la varianza de los errores se mantiene constante a lo largo de las predicciones. Además, la prueba de Breusch-Pagan (BP = 2.96, p-value = 0.7056) presenta un valor p mayor que 0.05, por lo que no se rechaza la hipótesis nula de homocedasticidad. En conjunto, estos resultados indican que el modelo cumple con el supuesto de varianza constante, es decir, los residuos son homogéneos y no presentan problemas de heterocedasticidad.
Evaluamos Supuesto de Independencia:
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondf3 <- data.frame(
res = rstandard(modelo_final)) %>%
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(title = "Residuos estandarizados en orden de observación",
x = "Orden / tiempo",y = "Residuos estandarizados") +
theme_minimal(base_size = 14)
Prueba de Durbin-Watson
dwtest(modelo_final)##
## Durbin-Watson test
##
## data: modelo_final
## DW = 2.0289, p-value = 0.5984
## alternative hypothesis: true autocorrelation is greater than 0El gráfico de residuos estandarizados frente al orden de observación muestra una distribución aleatoria alrededor de la línea cero, sin patrones visibles ni tendencias sistemáticas, lo que indica independencia entre los errores. Además, la prueba de Durbin-Watson (DW = 2.0289, p-value = 0.5984) arroja un estadístico muy cercano a 2 y un valor p mayor a 0.05, por lo que no se rechaza la hipótesis nula de independencia. En conjunto, estos resultados permiten concluir que no existe autocorrelación entre los residuos, cumpliéndose así el supuesto de independencia del modelo de regresión.
Conclusión:
El análisis de regresión lineal múltiple permitió identificar los principales factores que impulsan las ventas mensuales de las tiendas. El modelo final, seleccionado mediante el criterio BIC, explica un 95% de la variabilidad de las ventas, lo que refleja un excelente poder predictivo. Las variables con mayor influencia fueron la inversión en publicidad televisiva, la inversión en redes sociales, el tamaño del local y el número de competidores cercanos, todas con efectos positivos y significativos. Además, la interacción Redes × Zona mostró que el impacto de la publicidad digital varía según la zona geográfica: en la zona Sur, su efecto es menor que en la zona Centro, mientras que en la zona Norte no hay diferencia significativa. Esto evidencia que las estrategias de mercadeo deben adaptarse a las características de cada región, priorizando la inversión digital en zonas donde es más efectiva. Finalmente, la verificación de los supuestos (normalidad, homocedasticidad e independencia) confirmó que el modelo es estadísticamente válido y confiable, por lo que sus resultados pueden usarse para orientar decisiones futuras de inversión en mercadeo.
Parte 2
PASO 1 — Simular los datos
Simulen la base de datos. En grupo deben decidir los rangos de valores para cada variable y tomar un valor dentro de los rangos dados para los coeficientes. Además, usar como numero de semilla la suma de las fechas de cumpleaños de los integrantes.
## Datos simulados
set.seed(6084)
n <- 600
# Variables simuladas
Ingreso <- round(rnorm(n, mean = 3500, sd = 800), 0) # ingreso mensual en $
Deuda <- round(runif(n, 0, 1), 2) # proporción de endeudamiento
Edad <- round(rnorm(n, mean = 38, sd = 10), 0) # edad del solicitante
Historial <- sample(c("Buena", "Regular", "Mala"), n, replace = TRUE, prob = c(0.5, 0.3, 0.2))
Garantia <- sample(c("Si", "No"), n, replace = TRUE, prob = c(0.6, 0.4))
# Coeficientes dentro de los rangos del examen
b0 <- -4.5
b1 <- 0.07 # Ingreso
b2 <- -1.8 # Deuda
b3 <- 0.10 # Edad
aR <- -1.0 # Historial Regular
aM <- -2.5 # Historial Mala
b4 <- 0.9 # Garantia No
iR <- -0.6 # Deuda × Regular
iM <- -1.0 # Deuda × Mala
# Ecuación logística
eta <- b0 +
b1*(Ingreso/1000) + b2*Deuda + b3*Edad +
ifelse(Historial=="Regular", aR, ifelse(Historial=="Mala", aM, 0)) +
ifelse(Garantia=="No", b4, 0) +
ifelse(Historial=="Regular", iR*Deuda, ifelse(Historial=="Mala", iM*Deuda, 0))
p <- 1/(1 + exp(-eta))
Aprobado <- rbinom(n, 1, p)
data1 <- data.frame(Aprobado, Ingreso, Deuda, Edad, Historial, Garantia)
head(data1)## Aprobado Ingreso Deuda Edad Historial Garantia
## 1 1 3716 0.09 47 Buena Si
## 2 0 4124 0.92 32 Buena No
## 3 0 1828 0.66 23 Regular No
## 4 0 2641 0.87 36 Buena No
## 5 1 3729 0.19 42 Mala Si
## 6 0 4873 0.02 30 Buena SiPASO 2 — Modelo logistico ajustado
Ajusten un modelo de regresión logística.
set.seed(6084)
# Ajuste del modelo logístico
modelo1 <- glm(Aprobado ~ I(Ingreso/1000) + Deuda + Edad + Historial + Garantia + Deuda:Historial,
family = binomial, data = data1)
coefs <- summary(modelo1)$coefficients
# Tabla de resultados
tabla_mod1 <- data.frame(
Termino = rownames(coefs),
Logit = round(coefs[, 1], 3),
Odds_Ratio = round(exp(coefs[, 1]), 3),
row.names = NULL)
tabla_mod1## Termino Logit Odds_Ratio
## 1 (Intercept) -3.159 0.042
## 2 I(Ingreso/1000) 0.009 1.009
## 3 Deuda -2.006 0.135
## 4 Edad 0.105 1.111
## 5 HistorialMala -1.936 0.144
## 6 HistorialRegular -1.312 0.269
## 7 GarantiaSi -1.204 0.300
## 8 Deuda:HistorialMala -1.996 0.136
## 9 Deuda:HistorialRegular -0.119 0.887PASO 3 — Interpretar los resultados
Interpreten la salida del modelo final.
• Intercepto: representa la situación base (solicitante con ingresos bajos, poca deuda, historial “Buena” y con garantía). En esta condición, la probabilidad de aprobación del préstamo es baja 4.2%.
• Ingreso: por cada $1,000 adicionales en ingresos, la probabilidad de aprobación del préstamo aumenta en aproximadamente .9% respecto a no hacerlo, manteniendo constantes las demás variables.
• Deuda: por cada incremento en la proporción de deuda, la probabilidad de aprobación disminuye en un 87% respecto a no hacerlo, manteniendo constantes las demás variables.
• Edad: por cada año adicional del solicitante, la probabilidad de aprobación del préstamo aumenta en un 11%, manteniendo las demás variables constantes.
• Historial Malo: tener historial “Malo” reduce en un 86% la probabilidad de aprobación respecto a un historial “Buena”, manteniendo constantes las demás variables.
• Historial Regular: tener historial “Regular” reduce en un 73% la probabilidad de aprobación respecto a tener historial “Buena”, manteniendo constantes las demás variables.
• Garantía (No):No presentar una garantía disminuye la probabilidad de aprobación en un 70% respecto a presentarla, manteniendo constantes las demás variables.
• Interacción Deuda × Historial Malo: cuando el solicitante tiene historial Malo y deuda disminuye la probabilidad de aprobación, en aproximadamente un 86%.
• Interacción Deuda × Historial Regular: cuando el solicitante tiene historial Regular y un aumento en la deuda reduce un 11% la probabilidad de aprobación.
Conclusión:
El modelo logístico permitió identificar los principales factores que determinan la aprobación de un préstamo. Los resultados muestran que los solicitantes con mayores ingresos y mayor edad tienen una probabilidad más alta de aprobación, mientras que una mayor proporción de deuda, la falta de garantía y un historial crediticio deficiente reducen significativamente las posibilidades de obtenerlo. Además, las interacciones entre deuda e historial revelan que el impacto negativo del endeudamiento es más fuerte en quienes tienen historial “Malo” o “Regular”, lo que evidencia que las instituciones financieras penalizan con mayor severidad el riesgo crediticio en combinación con altos niveles de deuda. En conjunto, el modelo describe de manera precisa el proceso de evaluación crediticia, resaltando la importancia de la estabilidad económica, la responsabilidad financiera y el respaldo del cliente en las decisiones de aprobación.