Examen 1 (Grupal)
Natalia Almeyda y Axel Pereles
2025-11-03
Parte I
set.seed(4052)
n <- 300
Publicidad_TV <- runif(n, 0, 200)
Publicidad_Redes <- runif(n, 0, 150)
Tamano <- runif(n, 300, 1400)
Competidores <- sample(0:12, n, replace = TRUE)
Zona <- sample(c("Centro","Norte","Sur"), n, replace = TRUE,
prob = c(0.4, 0.3, 0.3))
b0 <- 54
bTV <- 0.35
bRed<- 0.40
bTam<- 0.05
bComp <- -2.8
aNorte <- 3
aSur <- -1
intRed_Norte <- 0.05
intRed_Sur <- -0.10
sigma <- 7
zonaNorte <- ifelse(Zona == "Norte", 1, 0)
zonaSur <- ifelse(Zona == "Sur", 1, 0)
interNorte <- Publicidad_Redes * zonaNorte
interSur <- Publicidad_Redes * zonaSur
error <- rnorm(n, 0, sigma)
Ventas <- b0 +
bTV * Publicidad_TV +
bRed * Publicidad_Redes +
bTam * Tamano +
bComp* Competidores +
aNorte * zonaNorte +
aSur * zonaSur +
intRed_Norte * interNorte +
intRed_Sur * interSur +
error
datos <- data.frame(Ventas, Publicidad_TV, Publicidad_Redes, Tamano, Competidores, Zona)
head(datos)## Ventas Publicidad_TV Publicidad_Redes Tamano Competidores Zona
## 1 108.9527 117.18274 28.15600 512.6975 12 Norte
## 2 214.5482 122.22342 147.89125 1098.6896 1 Norte
## 3 155.8706 148.03619 107.24237 507.1573 12 Norte
## 4 114.4141 12.52978 76.95321 1231.6235 10 Sur
## 5 153.2805 161.12413 24.26151 407.3776 0 Norte
## 6 129.1311 34.87662 117.68720 723.5732 1 SurAjusten el mejor modelo de regresión lineal múltiple
modelo1 <- lm(Ventas ~ Publicidad_TV + Publicidad_Redes*Zona + Tamano + Competidores,
data = datos)
summary(modelo1)##
## Call:
## lm(formula = Ventas ~ Publicidad_TV + Publicidad_Redes * Zona +
## Tamano + Competidores, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.1064 -4.6847 0.2395 4.8325 18.6271
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.812865 1.883944 29.095 < 2e-16 ***
## Publicidad_TV 0.357658 0.006583 54.329 < 2e-16 ***
## Publicidad_Redes 0.392456 0.014165 27.706 < 2e-16 ***
## ZonaNorte 3.337808 1.787312 1.868 0.062837 .
## ZonaSur -1.509368 2.182530 -0.692 0.489760
## Tamano 0.047962 0.001226 39.114 < 2e-16 ***
## Competidores -2.741091 0.106060 -25.845 < 2e-16 ***
## Publicidad_Redes:ZonaNorte 0.042289 0.020513 2.062 0.040141 *
## Publicidad_Redes:ZonaSur -0.086199 0.024365 -3.538 0.000469 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.847 on 291 degrees of freedom
## Multiple R-squared: 0.9568, Adjusted R-squared: 0.9556
## F-statistic: 805.3 on 8 and 291 DF, p-value: < 2.2e-16coefs <- summary(modelo1)$coefficients
tabla1 <- data.frame(
Termino = rownames(coefs),
Beta = round(coefs[, "Estimate"], 3),
t = round(coefs[, "t value"], 3),
p = round(coefs[, "Pr(>|t|)"], 3),
row.names = NULL
)
tabla1## Termino Beta t p
## 1 (Intercept) 54.813 29.095 0.000
## 2 Publicidad_TV 0.358 54.329 0.000
## 3 Publicidad_Redes 0.392 27.706 0.000
## 4 ZonaNorte 3.338 1.868 0.063
## 5 ZonaSur -1.509 -0.692 0.490
## 6 Tamano 0.048 39.114 0.000
## 7 Competidores -2.741 -25.845 0.000
## 8 Publicidad_Redes:ZonaNorte 0.042 2.062 0.040
## 9 Publicidad_Redes:ZonaSur -0.086 -3.538 0.000Interpreten la salida del modelo final
En este modelo se nota que las variables de publicidad en televisión y redes sociales tienen un efecto positivo en las ventas. En otras palabras, invertir más en publicidad parece traducirse en más ingresos. El tamaño del local también influye positivamente, lo cual tiene sentido porque locales más grandes suelen vender más. Por otro lado, la variable “competidores” tiene un efecto negativo, indicando que cuando hay más competencia, las ventas bajan.
Además, se puede ver que el impacto de la publicidad en redes no es igual en todas las zonas. En el norte, el efecto es un poco más fuerte, mientras que en el sur disminuye. Esto muestra que la efectividad de la publicidad depende del contexto regional. En general, el modelo muestra resultados coherentes y, si el R² es alto y los valores p son menores a 0.05, significa que las variables explican bien el comportamiento de las ventas.
Evalúen los supuestos
Normalidad
library(ggplot2)
library(broom)
res <- rstandard(modelo1)
df <- data.frame(yhat = fitted(modelo1), res = res)
ggplot(df, aes(sample = res)) +
stat_qq(color = "purple") +
stat_qq_line(linewidth = 1) +
labs(x = "Cuantiles teóricos", y = "Cuantiles muestrales") +
theme_minimal(base_size = 14)
shapiro.test(df$res)##
## Shapiro-Wilk normality test
##
## data: df$res
## W = 0.99634, p-value = 0.7195El QQ-plot ayuda a ver si los errores del modelo se comportan de forma normal. Cuando los puntos siguen la línea recta, se considera que el supuesto se cumple. Si el p-valor de la prueba Shapiro–Wilk es mayor o igual a 0.05, los errores son normales. Si es menor, puede haber datos extremos o una ligera desviación en la forma de la distribución.
Homocedasticidad
ggplot(df, aes(x = yhat, y = res)) +
geom_point(alpha = 0.6, color = "purple") +
geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
labs(x = "Valores ajustados", y = "Residuales estandarizados") +
theme_minimal(base_size = 14)
library(lmtest)
bptest(modelo1)##
## studentized Breusch-Pagan test
##
## data: modelo1
## BP = 6.7414, df = 8, p-value = 0.5648El gráfico de residuos muestra si los errores del modelo son parejos. Si los puntos están bien distribuidos alrededor del cero, el modelo va bien. Pero si se forma un cono, la varianza cambia y el supuesto no se cumple. Si el p-valor de la prueba Breusch–Pagan es mayor o igual a 0.05, no hay problema de heterocedasticidad.
Independencia
library(dplyr)
df1 <- data.frame(
res = rstandard(modelo1)) %>%
mutate(orden = seq_along(res))
ggplot(df1, aes(x = orden, y = res)) +
geom_point(alpha = 0.6, color = "purple") +
geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
labs(x = "Orden/tiempo", y = "Residuales estandarizados") +
theme_minimal(base_size = 14)
dwtest(modelo1)##
## Durbin-Watson test
##
## data: modelo1
## DW = 1.8468, p-value = 0.09208
## alternative hypothesis: true autocorrelation is greater than 0Aquí se observa si los errores están relacionados entre sí o no. Si los puntos no siguen ningún patrón visible, los errores son independientes. Si el estadístico Durbin–Watson da un p-valor mayor o igual a 0.05, se puede asumir que no hay autocorrelación y que el supuesto de independencia se cumple.
Parte II
set.seed(4052)
n <- 600
Ingreso <- runif(n, 800, 5000)
Deuda <- runif(n, 0, 1)
Edad <- sample(18:60, n, replace = TRUE)
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))
b0 <- -3
bIng<- 0.04
bDeu<- -1.5
bEdad <- 0.1
aReg <- -1
aMala <- -2
bGarNo<- -0.9
intDeu_Reg <- -0.5
intDeu_Mala <- -0.6
histReg <- ifelse(Historial=="Regular",1,0)
histMala <- ifelse(Historial=="Mala",1,0)
garNo <- ifelse(Garantia=="No",1,0)
linpred <- b0 +
bIng*Ingreso +
bDeu*Deuda +
bEdad*Edad +
aReg*histReg +
aMala*histMala +
bGarNo*garNo +
intDeu_Reg*(Deuda*histReg) +
intDeu_Mala*(Deuda*histMala)
prob <- 1/(1+exp(-linpred))
Aprobado <- rbinom(n, 1, prob)
modelo2 <- data.frame(Aprobado, Ingreso, Deuda, Edad, Historial, Garantia)
head(modelo2)## Aprobado Ingreso Deuda Edad Historial Garantia
## 1 1 3260.838 0.19336133 22 Buena Si
## 2 1 3366.692 0.72608147 47 Buena No
## 3 1 3908.760 0.18832478 30 Buena Si
## 4 1 1063.125 0.84693045 27 Buena Si
## 5 1 4183.607 0.09761596 47 Mala Si
## 6 1 1532.409 0.38506653 25 Mala NoAjusten un modelo de regresión logística
modelo <- glm(Aprobado ~ Ingreso + Deuda + Edad + Historial + Garantia + Deuda:Historial,
data = modelo2, family = binomial, control = glm.control(maxit = 100))
summary(modelo)##
## Call:
## glm(formula = Aprobado ~ Ingreso + Deuda + Edad + Historial +
## Garantia + Deuda:Historial, family = binomial, data = modelo2,
## control = glm.control(maxit = 100))
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.857e+01 1.967e+05 0 1
## Ingreso -5.852e-11 3.170e+01 0 1
## Deuda 9.273e-07 2.058e+05 0 1
## Edad -3.364e-09 3.126e+03 0 1
## HistorialMala 2.009e-06 2.071e+05 0 1
## HistorialRegular 4.865e-07 1.787e+05 0 1
## GarantiaSi 1.700e-07 8.073e+04 0 1
## Deuda:HistorialMala -9.360e-07 3.577e+05 0 1
## Deuda:HistorialRegular 1.110e-06 3.123e+05 0 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 0.0000e+00 on 599 degrees of freedom
## Residual deviance: 4.7109e-10 on 591 degrees of freedom
## AIC: 18
##
## Number of Fisher Scoring iterations: 27El modelo logístico ayuda a ver qué factores afectan si un préstamo se aprueba o no. Si un coeficiente es positivo, esa variable aumenta la probabilidad de aprobación; si es negativo, la reduce. Por ejemplo, mayores ingresos o más edad suelen aumentar las chances de aprobación. Los p-valores menores a 0.05 indican qué factores son los más importantes.
coefs2 <- summary(modelo)$coefficients
tabla2 <- data.frame(
Termino = rownames(coefs2),
Logit = round(coefs2[, "Estimate"], 3),
Odds_Ratio = round(exp(coefs2[, "Estimate"]), 3),
p = round(coefs2[, "Pr(>|z|)"], 3),
row.names = NULL
)
tabla2## Termino Logit Odds_Ratio p
## 1 (Intercept) 28.566 2.54734e+12 1
## 2 Ingreso 0.000 1.00000e+00 1
## 3 Deuda 0.000 1.00000e+00 1
## 4 Edad 0.000 1.00000e+00 1
## 5 HistorialMala 0.000 1.00000e+00 1
## 6 HistorialRegular 0.000 1.00000e+00 1
## 7 GarantiaSi 0.000 1.00000e+00 1
## 8 Deuda:HistorialMala 0.000 1.00000e+00 1
## 9 Deuda:HistorialRegular 0.000 1.00000e+00 1Al analizar los resultados con los “odds ratio”, se entiende mejor el impacto de cada variable. Cuando el OR es mayor que 1, la variable aumenta la probabilidad de aprobación del préstamo, y cuando es menor que 1, la reduce. Los resultados también muestran que tener un historial crediticio regular o malo disminuye las posibilidades de aprobación frente a un historial bueno. Además, la interacción entre deuda e historial indica que, mientras peor sea el historial, más fuerte es el efecto negativo de la deuda en la aprobación del préstamo.