…

Author

Antonio Leal & Irving Cauich

1. Introducción y Planteamiento del Problema

En este reporte utilizaremos el conjunto de datos disponible en R, los datos muestran la velocidad y las distancias que tardan en detenerse de 50 autos de la década de 1920. Nuestro objetivo es analizar cómo influye la velocidad (mph) del auto (\(X\) = speed ) sobre las distancias (pies) que tardan en detenerse (\(Y\) = dist).

library(mosaic)
Datos_cars <- cars

2. Análisis Exploratorio de Datos

Código 
favstats(~ speed , data = Datos_cars)
 min Q1 median Q3 max mean       sd  n missing
   4 12     15 19  25 15.4 5.287644 50       0
favstats(~ dist , data = Datos_cars)
 min Q1 median Q3 max  mean       sd  n missing
   2 26     36 56 120 42.98 25.76938 50       0

La distancia frenado tienen una media de 42.98 pies y una mediana 36 de pies, lo que indica que tiene una distribución sesgada a la derecha. Las distancias de frenado van de 2 a 120 pies.

Gráfico de dispersión

Visualizamos la relación entre ambas variables para comprobar si una tendencia lineal es adecuada.

Código 
library(ggplot2)
ggplot(Datos_cars, aes(x = speed, y = dist)) +
  geom_point(color = "#16a085", size = 3, alpha = 0.8) +
  geom_smooth(method = "lm", se = TRUE, color = "#2c3e50", fill = "#16a085", alpha = 0.2) +
  labs(
    title = "Relación entre Velocidad y Distancia de Frenado",
    subtitle = "Dataset cars",
    x = "Velocidad (mph)",
    y = "Distancia de frenado (pies)"
  ) +
  theme_minimal()

Se observa una tendencia lineal positiva: a medida que la velocidad aumenta, la distancia de frenado aumenta de forma aproximadamente lineal.

3. Ajuste del Modelo de Regresión Lineal Simple

El modelo matemático poblacional se define como:

\[y_i= \beta_0+\beta_1x_i+\varepsilon_i\]

Donde:

\(Y_i\) es la distancia frenado (dist)

\(X_i\) es la velocidad (speed)

\(\beta_0\) es el intercepto (la distancia frenado estimada cuando la velocidad es 0).

\(\beta_1\) es la pendiente (el incremento de la distancia frenado cuando aumenta la velocidad).

\(\varepsilon_1\) es el término de error aleatorio

Estimación de los coeficientes

Ajustamos el modelo en R utilizando la función lm( ):

Código 
library(lmtest) 
modelo <- lm(dist ~ speed, data = Datos_cars) 
summary(modelo) 

Call:
lm(formula = dist ~ speed, data = Datos_cars)

Residuals:
    Min      1Q  Median      3Q     Max 
-29.069  -9.525  -2.272   9.215  43.201 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -17.5791     6.7584  -2.601   0.0123 *  
speed         3.9324     0.4155   9.464 1.49e-12 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 15.38 on 48 degrees of freedom
Multiple R-squared:  0.6511,    Adjusted R-squared:  0.6438 
F-statistic: 89.57 on 1 and 48 DF,  p-value: 1.49e-12

Interpretación de los parámetros

  • Intercepto (\(\hat{\beta}_0\)): -17.5791 representa la distancia en pies por el modelo cuando la velocidad es de 0 millas por hora.

  • Pendiente (\(\hat{\beta}_1\)): 3.9324 por cada aumento de 1 milla por hora en la velocidad del vehículo, la distancia de frenado aumenta, en promedio 3.9324 pies.

4. Diagnóstico del Modelo

Para validar que las inferencias estadísticas del modelo sean confiables, debemos evaluar los supuestos sobre los residuos (εi): normalidad, homocedasticidad (varianza constante) e independencia.

Gráficos de Diagnóstico Estándar

library(ggplot2)
library(lmtest)
par(mfrow = c(2, 2))
plot(modelo)

Análisis detallado de los supuestos:

  1. Independencia (Residuals vs Fitted): En el primer gráfico, los puntos se distribuyen de manera aleaotoria alrededor de la línea central. Sin embargo, la línea roja presenta una ligera curvatura, lo que podría indicar una pequeña desviación de la linealidad del modelo.

  2. Normalidad de los errores (Q-Q Residuals): En el gráfico Normal Q-Q, la mayoría de puntos sigue aproximadamente la tendencia de la línea diagonal, aunque se observan algunas desviaciones en las colas. Esto puede indicar que el supuesto de normalidad de los residuos se cumple casi de forma aceptable.

  3. Homocedasticidad (Scale-Location): En el gráfico los residuales van teniendo una amplitud diferente en a lo largo del eje horizontal. Esto sugiere que el supuesto de homocedasticidad parace razonablemente aceptable.

  4. Puntos influyentes (Residuals vs Levarage): El gráfico muestra 3 observaciones que pueden estar alterando o sesgando de forma extrema la pendiente de la regresión por sí sola.

5. Análisis de la variable respuesta

En este apartado se pretende realizar una análisis exploratorio de la variable respuesta (dist), en el cual se realizan diversos gráficos e indicadores para observar el comportamiento y la distribucción de la variable.

Código 
library(mosaic)  
library(ggplot2) 
library(lmtest) 

grafico_1<-ggplot(data=Datos_cars)+   
  geom_histogram(aes(x= dist),binwidth = 3.2,fill = "#4D6291", color = "black")+
  theme(axis.text.x = element_text(size = 10))+ 
  labs(title = "Histograma variable distancia frenado", x = "distancia frenado", y = "Frecuencia")+  
  theme(plot.title = element_text(hjust = 0.5))  

grafico_1

Código 
library(kableExtra) 

Adjuntando el paquete: 'kableExtra'
The following object is masked from 'package:dplyr':

    group_rows
library(mosaic) 
kable(data.frame(Cuartiles =quantile(Datos_cars$dist,prob=c(0.25,0.5,0.75))),       
      caption= "Indicadores de posición",aling= "cc")
Indicadores de posición
Cuartiles
25% 26
50% 36
75% 56
Código 
library(mosaic)  
library(ggplot2) 
library(lmtest) 
grafico_2<-ggplot(data=Datos_cars)+   
  geom_boxplot(aes(x=dist), col= "blue", outlier.color = "red")+   
  labs(title = "Diagrama de cajas - Variable dits", x = "dist", y="Porcentaje")+   theme(plot.title = element_text(hjust = 0.5)) 

grafico_2

Código
Indicadores Descriptivos de la distancia frenado por hora (dist)
Estadístico Valor
Moda 26.00
Varianza 664.06
Desviación Estándar 25.77
Coeficiente de Variación (%) 59.96
Curtosis 0.12 
[1] 120

6. Supuesto de Normalidad de los residuales

Planteamiento de las Hipótesis

\[H_0=\text{Los residuales del modelo siguen una distribución normal } (\varepsilon_i∼N(0,\sigma^2)).\]

\[H_1=\text{Los residuales no siguen una distribución normal}\]


    Shapiro-Wilk normality test

data:  modelo$residuals
W = 0.94509, p-value = 0.02152

Conclusión

Como el p-valor=0.02152 es menor que el nivel de significancia α=0.05, se rechaza la hipótesis nula (H0). Por lo tanto, con un nivel de confianza del 95%, existe suficiente evidencia estadística para rechazar que los residuales del modelo satisfacen el supuesto de normalidad.

7. Supuesto de Homocedasticidad

Planteamiento de las Hipótesis

\[H_0=\text{Los residuales son homocedásticos (la varianza de los errores es constante, )}.\]

\[H_1= \text{Los residuales son heterocedásticos (la varianza de los errores no es constante)}.\]


    studentized Breusch-Pagan test

data:  modelo
BP = 3.2149, df = 1, p-value = 0.07297

Mediante la prueba de Breusch-Pagan se obtuvo un estadístico χ2=3.2149 con un p-valor=0.07297. Al ser el p-valor>0.05, no existe evidencia estadística para rechazar la hipótesis nula con un nivel de confianza del 95%.

8. Supuesto de Independencia

Planteamiento de las Hipótesis

\[H_0:ρ=0 (\text{Los errores son independientes / No existe autocorrelación en los residuales}).\]

\[H1:ρ\neq0(\text{Existe autocorrelación en los residuales})\]


    Durbin-Watson test

data:  modelo
DW = 1.6762, p-value = 0.09522
alternative hypothesis: true autocorrelation is greater than 0

Al ejecutar la prueba sobre el modelo ajustado, se obtuvo un estadístico DW=1.6762 con un p-valor=0.09522. Al ser el p-valor>0.05, no se rechaza la hipótesis nula de independencia bajo la ordenación original de los datos. 

ggplot(Datos_cars, aes(x = speed, y = dist)) +
  geom_point(color = "navy", size = 2) +
  geom_smooth(method = "lm", color = "red", se = FALSE) +
  labs(title = "Regresión Lineal: Dist vs Speed",
       subtitle = "Modelo OLS con observaciones originales",
       x = "Speed (mph)",
       y = "Dist (pies)") +
  theme_minimal()
`geom_smooth()` using formula = 'y ~ x'

n <- nrow(Datos_cars)
p <- 2 # Intercepto y pendiente

# 1. Leverage
hat_vals <- hatvalues(modelo)
umbral_hat <- 3 * (p / n)

# 2. Distancia de Cook
cook_vals <- cooks.distance(modelo)
umbral_cook <- 4 / (n - p)

# 3. RStudent
r_student <- rstudent(modelo)

# Identificar filas problemáticas
atipicos_rstudent <- which(abs(r_student) > 3)
atipicos_cook <- which(cook_vals > umbral_cook)

cat("Observaciones con RStudent > 3:", atipicos_rstudent, "\n")
Observaciones con RStudent > 3: 23 49 
cat("Observaciones con Distancia de Cook alta:", atipicos_cook, "\n")
Observaciones con Distancia de Cook alta: 23 49 
plot(modelo, which = 4, col = "blue", pch = 16)
abline(h = umbral_cook, col = "red", lty = 2)

# 1. Definir los límites de los percentiles (por ejemplo, 5% inferior y 5% superior)
q_inf <- quantile(Datos_cars$dist, 0.05, na.rm = TRUE)
q_sup <- quantile(Datos_cars$dist, 0.95, na.rm = TRUE)

# 2. Crear una nueva columna en el dataframe con la variable Ozone winsorizada
Datos_cars$dist_winsorized <- pmin(pmax(Datos_cars$dist, q_inf), q_sup)

# 3. Ajustar el nuevo modelo con la variable winsorizada
modelo_winsor <- lm(dist_winsorized ~ speed, data = Datos_cars)

# Comparar los coeficientes del modelo original vs el winsorizado
summary(modelo)

Call:
lm(formula = dist ~ speed, data = Datos_cars)

Residuals:
    Min      1Q  Median      3Q     Max 
-29.069  -9.525  -2.272   9.215  43.201 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -17.5791     6.7584  -2.601   0.0123 *  
speed         3.9324     0.4155   9.464 1.49e-12 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 15.38 on 48 degrees of freedom
Multiple R-squared:  0.6511,    Adjusted R-squared:  0.6438 
F-statistic: 89.57 on 1 and 48 DF,  p-value: 1.49e-12
summary(modelo_winsor)

Call:
lm(formula = dist_winsorized ~ speed, data = Datos_cars)

Residuals:
    Min      1Q  Median      3Q     Max 
-26.994  -9.661  -1.881   8.409  42.532 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -12.759      6.131  -2.081   0.0428 *  
speed          3.588      0.377   9.517 1.25e-12 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 13.95 on 48 degrees of freedom
Multiple R-squared:  0.6536,    Adjusted R-squared:  0.6464 
F-statistic: 90.58 on 1 and 48 DF,  p-value: 1.247e-12
# Gráfico comparativo
plot(Datos_cars$speed, Datos_cars$dist, pch = 16, col = "gray70",
     main = "Efecto de la Winsorización en Regresión Lineal",
     xlab = "speed (°F)", ylab = "dist (ppb)")

# Puntos originales que fueron "recortados" (winsorizados)
points(Datos_cars$speed[Datos_cars$dist > q_sup], 
       Datos_cars$speed[Datos_cars$dist > q_sup], 
       col = "purple", pch = 17, cex = 1.3)

# Rectas de regresión
abline(modelo, col = "red", lwd = 2)         # OLS Original (afectado por el pico)
abline(modelo_winsor, col = "forestgreen", lwd = 2, lty = 2) # OLS Winsorizado

legend("topleft", 
       legend = c("OLS Original", "OLS Winsorizado", "Valores acotados"),
       col = c("red", "forestgreen", "purple"), 
       lty = c(1, 2, NA), pch = c(NA, NA, 17), lwd = 2)

# Obtener los residuos estandarizados o estudentizados del modelo
residuos_std <- rstandard(modelo)

# Crear un data frame para ggplot
df_qq <- data.frame(residuos = residuos_std)

# Generar el Q-Q plot con ggplot2
ggplot(df_qq, aes(sample = residuos)) +
  stat_qq(color = "navy", size = 2) +
  stat_qq_line(color = "red", linetype = "dashed", linewidth = 1) +
  labs(
    title = "Gráfico Q-Q de Residuos Estándar",
    subtitle = "Verificación del supuesto de normalidad para modelo_orig",
    x = "Cuantiles Teóricos",
    y = "Cuantiles Muestrales (Residuos)"
  ) +
  theme_minimal()

# Obtener los residuos estandarizados o estudentizados del modelo
residuos_stdwin <- rstandard(modelo_winsor)

# Crear un data frame para ggplot
df_qqwin <- data.frame(residuos = residuos_stdwin)

# Generar el Q-Q plot con ggplot2
ggplot(df_qqwin, aes(sample = residuos)) +
  stat_qq(color = "navy", size = 2) +
  stat_qq_line(color = "red", linetype = "dashed", linewidth = 1) +
  labs(
    title = "Gráfico Q-Q de Residuos Estándar",
    subtitle = "Verificación del supuesto de normalidad para modelo_winsor",
    x = "Cuantiles Teóricos",
    y = "Cuantiles Muestrales (Residuos)"
  ) +
  theme_minimal()

shapiro.test(modelo$residuals)

    Shapiro-Wilk normality test

data:  modelo$residuals
W = 0.94509, p-value = 0.02152
shapiro.test(modelo_winsor$residuals)

    Shapiro-Wilk normality test

data:  modelo_winsor$residuals
W = 0.9663, p-value = 0.163
bptest(modelo_winsor)

    studentized Breusch-Pagan test

data:  modelo_winsor
BP = 0.85954, df = 1, p-value = 0.3539
dwtest(modelo_winsor)

    Durbin-Watson test

data:  modelo_winsor
DW = 1.7185, p-value = 0.1238
alternative hypothesis: true autocorrelation is greater than 0