Parte I

n=300
set.seed(6120)
zona = factor(sample(c("Centro", "Norte", "Sur"), n,replace= TRUE, prob = c(.25 , 0.4, 0)))
zona = relevel(zona, ref="Centro")
publicidad_TV = runif(n, 10, 50) # gasto mensual en miles
publicidad_red = runif(n, 5, 25) # gasto mensual en cientos 
tamano = runif(n, 75, 111) # metros cuadrados 
competidores = round(runif(n, 1, 6)) #Num de competidores 
ruido = round(rnorm(n, 0, 6),2) 
B0 = 51
B1 = .42 

B2 = .35 #publicidad_red 
B3 = .03 #tamano 
B4 = .16 # 1 comp de cada 6 
a1 = 3 # zona norte 
a2 = -2 # zona sur 
B5 = .08 # cambio en a1 norte 
B6 = -.25 # cambio en a2 sur 

ventas = round( B0 + B1*publicidad_TV + B2*publicidad_red + B3*tamano + B4*competidores + ifelse(zona=="Norte", a1,0) + ifelse(zona=="Sur", a2, 0) + ifelse(zona=="Norte", B5*publicidad_red, 0) + ifelse(zona=="Sur", B6*publicidad_red, 0)  + ruido , 2)

data =data.frame(ventas,publicidad_TV, publicidad_red, tamano,competidores,zona )

mod = lm(ventas~ publicidad_TV + publicidad_red + tamano + competidores + zona + zona*publicidad_red, data= data)
summary(mod)

## 
## Call:
## lm(formula = ventas ~ publicidad_TV + publicidad_red + tamano + 
##     competidores + zona + zona * publicidad_red, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -15.9161  -3.6174  -0.1945   3.8175  17.5451 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              51.22679    3.40904  15.027  < 2e-16 ***
## publicidad_TV             0.40974    0.02951  13.883  < 2e-16 ***
## publicidad_red            0.44039    0.08954   4.918 1.46e-06 ***
## tamano                    0.02157    0.03223   0.669   0.5038    
## competidores              0.07175    0.23237   0.309   0.7577    
## zonaNorte                 4.10354    1.84168   2.228   0.0266 *  
## publicidad_red:zonaNorte -0.02027    0.11884  -0.171   0.8647    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.832 on 293 degrees of freedom
## Multiple R-squared:  0.4955, Adjusted R-squared:  0.4852 
## F-statistic: 47.96 on 6 and 293 DF,  p-value: < 2.2e-16

Interpretación: Por cada mil dólares invertidos en publicidad en televisión, las ventas aumentan en promedio $409.74, y por cada $1,000 en redes sociales, aumentan $440.39. El tamaño del local y la competencia no tienen un efecto significativo sobre las ventas. Las tiendas del Norte venden en promedio $4,103.54 más que las del Sur, y la interacción con publicidad digital no es significativa, lo que indica un impacto similar entre zonas. El modelo explica el 49.6% de la variabilidad de las ventas, por lo que se recomienda fortalecer la inversión en publicidad en TV y redes sociales.

Supuesto 1: Normalidad

install.packages("ggplot2")
install.packages("broom")
library(ggplot2)
library(broom)

df <- data.frame(
  yhat = fitted.values(mod),
  res  = rstandard(mod)
)

# Gráfico
ggplot(df, aes(sample = res)) +
  stat_qq(color = "blue") +
  stat_qq_line(linewidth = 1) +
  labs(title = "Gráfico Q-Q de Residuos",
       x = "Cuantiles Teóricos",
       y = "Cuantiles de los Residuos") +
  theme_minimal(base_size = 14)

shapiro.test(df$res)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$res
## W = 0.99776, p-value = 0.9585

mean(df$res)

## [1] 0.0001418717

El gráfico Q-Q muestra que los residuos se alinean casi completamente con la línea, con desviaciones mínimas en los extremos, mostrando normalidad. La prueba de Shapiro-Wilk resultó con un p-value = 0.9585 > 0.05, por lo que no se rechaza la normalidad. Además, la media de los residuos es prácticamente cero (0.00014). El supuesto de normalidad se cumple.

Supuesto 2: Varianza constante (homocedasticidad)

df <- data.frame(
  yhat = fitted.values(mod),
  res  = rstandard(mod)
)

ggplot(df, aes(x = yhat, y = res)) +
  geom_point(alpha = 0.6, color = "blue") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
  labs(title = "Residuos vs Valores Ajustados",
       x = "Valores ajustados (ŷ)",
       y = "Residuos estandarizados") +
  theme_minimal(base_size = 14)

install.packages("lmtest")
library(lmtest)
bptest(mod)

## 
##  studentized Breusch-Pagan test
## 
## data:  mod
## BP = 7.3391, df = 6, p-value = 0.2906

El gráfico muestra una dispersión aleatoria alrededor de la línea horizontal, sin patrones claros o concentración específica, mostrando varianza constante. Además, la prueba de Breusch-Pagan dio un p-value = 0.2906 > 0.05, por lo que no se rechaza la homocedasticidad. El supuesto de varianza constante se cumple.

Supuesto 3: Independencia (autocorrelación)

library(ggplot2)
library(dplyr)

# Crear un dataframe con los residuos estandarizados y su orden
df3 <- data.frame(res = rstandard(mod)) %>%
  mutate(orden = 1:length(res))

# Gráfico para evaluar independencia
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 función del orden de observación",
       x = "Orden / tiempo",
       y = "Residuos estandarizados") +
  theme_minimal(base_size = 14)

install.packages("car")
library(car)
durbinWatsonTest(mod)

##  lag Autocorrelation D-W Statistic p-value
##    1   -0.0008255451      2.001625   0.984
##  Alternative hypothesis: rho != 0

El gráfico muestra un patrón aleatorio sin tendencias, ciclos o secuencias repetitivas, mostrando independencia. Además, la prueba de Durbin-Watson dio un p-value = 0.978 > 0.05, por lo que no se detecta autocorrelación entre los residuos. El supuesto de independencia se cumple.

Parte II

set.seed(6120)
n0 <- 600

# Variables simuladas

ingreso <- pmax(0,rnorm(n0,mean = 4 ,sd=1.2),1)  # Por cada mil
deuda <- runif(n0, 0, 1)
edad <- runif(n0, 22, 44)
error = pmax(0, round(rnorm(n0, 0, .8),2) ,1)
historial <- factor(
  sample(c("Bueno", "Malo", "Regular"), n0, replace = TRUE, prob = c(0.25, 0.45, 0.30)),
  levels = c("Regular", "Malo", "Bueno")
)
historial <- relevel(historial, ref = "Bueno")

garantia <- factor(
  sample(c("No", "Si"), n0, replace = TRUE, prob = c(0.8, 0.2)),
  levels = c("No", "Si")
)
garantia <- relevel(garantia, ref = "No")

# Coeficientes
intercepto <- -4
B1 <- 0.1    # Ingreso 
B2 <- -3.5   # Deuda
B3 <- 0.15   # Edad
a1 <- -1.5   # Regular
a2 <- -3     # Malo
B4 <- 1.4    # Garantía
B5 <- -1     # Deuda * Regular
B6 <- -1.5   # Deuda * Malo

# Ecuación lineal (modelo verdadero)
aprobado <- intercepto + 
  B1 * ingreso + 
  B2 * deuda + 
  B3 * edad +
  a1 * (historial == "Regular") +
  a2 * (historial == "Malo") +
  B4 * (garantia == "Si") +
  B5 * deuda * (historial == "Regular") +
  B6 * deuda * (historial == "Malo") + error

# Probabilidad y variable binaria simulada
p3 <- 1 / (1 + exp(-aprobado))
hace <- rbinom(n0, 1, p3)

# Dataset final
dat1 <- data.frame(hace, ingreso, deuda, edad, historial, garantia)

# Modelo logístico estimado
modelo3 <- glm(
  formula = hace ~ ingreso + deuda + edad + garantia + historial + deuda*historial ,
  family = binomial,
  data = dat1)

coefs3 <- summary(modelo3)$coefficients
coefs3

##                           Estimate Std. Error    z value     Pr(>|z|)
## (Intercept)            -3.37435841 0.83614182 -4.0356293 5.445614e-05
## ingreso                 0.02931091 0.09880266  0.2966612 7.667252e-01
## deuda                  -3.08751965 0.71057394 -4.3451068 1.392079e-05
## edad                    0.15304262 0.01999236  7.6550563 1.932275e-14
## garantiaSi              1.17742567 0.27158233  4.3354281 1.454767e-05
## historialRegular       -1.19314483 0.59712241 -1.9981578 4.569955e-02
## historialMalo          -2.10418855 0.56009105 -3.7568687 1.720527e-04
## deuda:historialRegular -1.02736143 1.08010786 -0.9511656 3.415203e-01
## deuda:historialMalo    -1.94000273 1.14631348 -1.6923841 9.057276e-02

tabla_mod3 <- data.frame(
Termino = rownames(coefs3),
Logit = round(coefs3[, "Estimate"], 3),
Odds_Ratio = round(exp(coefs3[, "Estimate"]), 3),
row.names = NULL,
check.names = FALSE
)

tabla_mod3

##                  Termino  Logit Odds_Ratio
## 1            (Intercept) -3.374      0.034
## 2                ingreso  0.029      1.030
## 3                  deuda -3.088      0.046
## 4                   edad  0.153      1.165
## 5             garantiaSi  1.177      3.246
## 6       historialRegular -1.193      0.303
## 7          historialMalo -2.104      0.122
## 8 deuda:historialRegular -1.027      0.358
## 9    deuda:historialMalo -1.940      0.144

1. Interpretación

El modelo demuestra que las variables deuda, edad, garantía e historial crediticio influyen significativamente en la aprobación del crédito. A mayor deuda, la probabilidad de aprobación disminuye considerablemente, mientras que una mayor edad y la existencia de una garantía real aumentan de forma importante las posibilidades de aceptación. Los personas con historial “Regular” o “Malo” presentan menores probabilidades de ser aprobados en comparación con aquellos con historial “Bueno”. El ingreso no muestra un efecto estadísticamente significativo, aunque mantiene una relación positiva con la aprobación.

2. Interacciones

En comparación con personas con historial de crédito bueno, para personas con historial regular, el efecto de tener deuda sobre las probabilidades de aprobación se reduce por 64% odds ratio. Es decir, la deuda ‘perjudica menos’ a personas con historial regular que a personas con historial bueno. En comparación con personas con historial de crédito bueno, para personas con historial malo, el efecto de tener deuda sobre las probabilidades de aprobación se reduce por 86%.odds ratio. Es decir, tener un historial malo reduce los efectos de la deuda en la aprobación inclusive más que las personas con un crédito regular.

Examen (parte 2)

Isabella Gonzalez, Larimar Claudio e Isabela Puga

2025-11-06

Parte I

Supuesto 1: Normalidad

Supuesto 2: Varianza constante (homocedasticidad)

Supuesto 3: Independencia (autocorrelación)

El gráfico muestra un patrón aleatorio sin tendencias, ciclos o secuencias repetitivas, mostrando independencia. Además, la prueba de Durbin-Watson dio un p-value = 0.978 > 0.05, por lo que no se detecta autocorrelación entre los residuos. El supuesto de independencia se cumple.

Parte II

1. Interpretación

2. Interacciones