En este reporte se utilizará la base de datos cats disponible en R, que contiene la información de 144 gatos adultos: su sexo, el peso de su corazón y su peso corporal; todos con más de 2 kilogramos.
El propósito es analizar de que forma se relaciona el peso de cada gato (\(X=Bwt\), en kilogramos) con el peso de su corazon (\(Y=Hwt\), en gramos).
2. Retomando el modelo
Reajuste del modelo
Dado que el modelo original no pasó la pruea del intercepto, es necesario reajustarlo.
MISHO <-lm(Hwt ~ Bwt-1, data = cats)summary(MISHO)
Call:
lm(formula = Hwt ~ Bwt - 1, data = cats)
Residuals:
Min 1Q Median 3Q Max
-3.4563 -0.9980 -0.1003 1.0044 5.2623
Coefficients:
Estimate Std. Error t value Pr(>|t|)
Bwt 3.90711 0.04364 89.53 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.449 on 143 degrees of freedom
Multiple R-squared: 0.9825, Adjusted R-squared: 0.9823
F-statistic: 8015 on 1 and 143 DF, p-value: < 2.2e-16
Intercepto\(\hat{\beta}_0\): 0, lo cual indica que si el peso del gato fuese de 0kg, el peso de su corazón sería 0 g; a forma de interpretación matemática, fuera del rango observado.
Pendiente: \(\hat{\beta_1}\): 3.90711. Lo cual indica que por cada kilo que el gatito aumente, se estima que el peso de su corazón aumenta, en promedio, 3.90711 gramos.
R-squared: 0.9825, que es mayor a 0.7
Gráfica de dispersión del modelo reajustado
Gráfico de bigotes
Gráficos de diagnóstico estándar
Además, se habia concluido que el modelo, no cumplía ninguno de los tres supuesto: Normalidad, homocedasticidad e independencia.
3. Datos atípicos
Se puede observar la presencia de tres datos atípicos, sin embargo, es necesario ir un paso más allá de lo visual, y ocupar las tres herramientas que nos permiten conocer aquellos datos que influyen en nuestro modelo.
Leverage
Distancia de Cook
Residuales estandarizados
Observaciones con RStudent > 3: 144
Observaciones con Distancia de Cook alta: 125 135 136 140 144
Notese que la observación 144 aparece en ambos analisis, por lo que se procurará su tratamiento.
Y al visualizar las distancias de cook se tiene:
4. Tratamiento de valores atípicos
El peso fuera de lo normal del corazón (alto) en gatos puede tener múltiples razones, incluyendo la Miocardiopatía hipertrófica (MCH). El tipo más común de miocardiopatía. El músculo cardíaco se engrosa, lo que dificulta bombear sangre. Aunque se desconoce la causa exacta, se estima que 1 de cada 7 gatos lo padece (Purina, 2026). El gatito tiene un peso similar a otras observaciones pero el peso de su corazón es mayor en comparación al resto de datos, lo que podría implicar una mayor acumulación de grasa en el corazón, con otras causas como el sexo, edad y raza.
Opción A) Eliminación de observaciones extremas
La observación 144, correspondiente a un gato macho de 3.9 kilos y tiene un corazón que pesa 20 gramos; se repite en las observaciones de R-student y de las distancias de Cook. Por lo que la filtraremos y eliminaremos al ser la única coincidencia.
#Identificamos y filtramos la observación 144 (la de mayor RStudent/Cook) cats_filtered <- cats[-atipicos_rstudent, ] #Reajustar modelo sin el outlier modelo_filtrado <-lm(Hwt ~ Bwt -1, data = cats_filtered)summary(modelo_filtrado)
Call:
lm(formula = Hwt ~ Bwt - 1, data = cats_filtered)
Residuals:
Min 1Q Median 3Q Max
-3.3864 -0.9597 -0.0647 1.0459 3.5912
Coefficients:
Estimate Std. Error t value Pr(>|t|)
Bwt 3.88823 0.04199 92.61 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.384 on 142 degrees of freedom
Multiple R-squared: 0.9837, Adjusted R-squared: 0.9836
F-statistic: 8576 on 1 and 142 DF, p-value: < 2.2e-16
Nótese que el modelo sigue cumpliendo el \(R-quared>0.7\)
Lilliefors (Kolmogorov-Smirnov) normality test
data: modelo_filtrado$residuals
D = 0.091081, p-value = 0.005511
Sin embago, considerando un \(\alpha=0.05\) y un \(p=0.005\), el modelo no tiene un comportamiento normal.
Opción B) Winsorización
Considerando que con la opción A) el modelo no pasó la prueba de normalidad, recurrimos a la Winsorización. Considerando que 1 de cada 7 gatitos pueden tener algún problema cardíaco, puede ser un problema de salud común entre la población gatuna; por lo que quizá mantener el dato atípico sea la mejor opción.
#1. Definir los límites de los percentiles (por ejemplo, 5% inferior y 5% superior)q_inf <-quantile(cats$Hwt, 0.05, na.rm =TRUE) q_sup <-quantile(cats$Hwt, 0.95, na.rm =TRUE) #2. Crear una nueva columna en el dataframe con la variable Ozone winsorizada cats$Hwt_winsorized <-pmin(pmax(cats$Hwt, q_inf), q_sup) #3. Ajustar el nuevo modelo con la variable winsorizada modelo_winsor <-lm(Hwt_winsorized ~ Bwt -1, data = cats) summary(modelo_winsor)
Call:
lm(formula = Hwt_winsorized ~ Bwt - 1, data = cats)
Residuals:
Min 1Q Median 3Q Max
-3.3296 -0.8631 -0.0267 1.0797 3.0178
Coefficients:
Estimate Std. Error t value Pr(>|t|)
Bwt 3.87288 0.03899 99.34 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.294 on 143 degrees of freedom
Multiple R-squared: 0.9857, Adjusted R-squared: 0.9856
F-statistic: 9868 on 1 and 143 DF, p-value: < 2.2e-16
Ahora, con este nuevo modelo, hacemos la prueba de Lilliefors de normalidad
Lilliefors (Kolmogorov-Smirnov) normality test
data: modelo_winsor$residuals
D = 0.07857, p-value = 0.02974
considerando un \(\alpha=0.05\) y un \(p=0.02\), el modelo aún con el ajuste de los datos atípicos no satisface la prueba de normalidad, apesar de que se acerca más al valor de significancia que en la opción A).
5. Transformación de BoxCox
Calculamos el BoxCox
De manera gráfica, el punto máximo de la curva con un 95% de confianza parece indicar que el valor óptimo de \(\lambda\) parece aproximarse a cero o almenos a un valor muy cercano a el.
Encontramos el \(\lambda\) óptimo exacto:
El valor óptimo estimado de lambda es: -0.06060606
Como se había esperado, el valor de lambda está contenido en un intervalo que también contiene al 0, por lo que la transformación más adecuada es el logaritmo natural.
Transformación del modelo
modelo_trans <-lm(log(Hwt) ~ Bwt -1, data = cats) summary(modelo_trans)
Call:
lm(formula = log(Hwt) ~ Bwt - 1, data = cats)
Residuals:
Min 1Q Median 3Q Max
-0.72377 -0.13793 0.04596 0.25066 0.56390
Coefficients:
Estimate Std. Error t value Pr(>|t|)
Bwt 0.84369 0.00815 103.5 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.2705 on 143 degrees of freedom
Multiple R-squared: 0.9868, Adjusted R-squared: 0.9867
F-statistic: 1.072e+04 on 1 and 143 DF, p-value: < 2.2e-16
Notése que el R-quared se mantiene arriba de 0.7
Gráficos del nuevo modelo
Observamos que el gráfico Residuals vs Fitted, presenta una “pendiente” hacia abajo por lo que aplicamos la misma transformación, pero ahora al modelo con intercepto.
Reajuste del modelo transformado
modelo_trans3 <-lm(log(Hwt) ~ Bwt, data = cats_filtered) summary(modelo_trans3)
Call:
lm(formula = log(Hwt) ~ Bwt, data = cats_filtered)
Residuals:
Min 1Q Median 3Q Max
-0.38100 -0.08750 -0.00625 0.10045 0.28436
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.36479 0.06433 21.21 <2e-16 ***
Bwt 0.35698 0.02334 15.30 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.1326 on 141 degrees of freedom
Multiple R-squared: 0.624, Adjusted R-squared: 0.6213
F-statistic: 234 on 1 and 141 DF, p-value: < 2.2e-16
El valor de \(r-quared\) es de 0.624, que es ligeramente menor a 0.7; sin embargo, antes de descartarlo, observemos de manera gráfica los supuestos.
En estos nuevos gráficos, se sospecha normalidad y homocedasticidad.
6. Pruebas de normalidad, homocedasticidad e independencia
Antes de realizar el ajuste de los outliners, se desea comprobar si el modelo transformado cumple los supuestos.
Prueba de normalidad
Sean:
\(H_0:\) Los residuales del modelo siguen una distribución normal
\(H_1:\) Los residuales del modelo NO siguen una distribución normal
Considerando la Regla de decisión: \(\alpha=0.05\):
Si \(p-valor>0.05\): No se rechaza\(H_0\). Se concluye que existe evidencia suficiente de que se cumple el supuesto de normalidad en los residuales.
Si \(p-valor≤0.05\): Se rechaza $H_0$. Existen evidencias de que los residuales no se distribuyen de forma normal.
Lilliefors (Kolmogorov-Smirnov) normality test
data: modelo_trans3$residuals
D = 0.059281, p-value = 0.252
Sea \(p=0.252\), entonces hay evidencia suficiente para afirmar que se cumple el supuesto de normalidad (1/3).
Prueba de homocedasticidad
Sean:
\(H_0:\) Los residuales son homocedásticos (errores con varianza constante)
\(H_1:\) Los residuales son heterocedásticos.
Considerando la Regla de decisión: \(\alpha=0.05\):
Si \(p-valor>0.05\): No se rechaza\(H_0\). Se concluye que existe evidencia suficiente de que se cumple el supuesto de homocedasticidad.
Si \(p-valor≤0.05\): Se rechaza $H_0$. Existen evidencias de heterocedasticidad.
studentized Breusch-Pagan test
data: modelo_trans3
BP = 1.4188, df = 1, p-value = 0.2336
Sea \(p=0.2636\), entonces hay evidencia suficiente para afirmar que se cumple el supuesto de homocedasticidad (2/3).
Prueba de independencia
Sean:
\(H_0:p=0\) (errores independientes/no hay correlación en residuales)
\(H_1:p\neq0\) (Existe correlación entre los residuales).
Considerando la Regla de decisión: \(\alpha=0.05\):
Si \(p-valor>0.05\): No se rechaza\(H_0\). Se cumple el supuesto de independencia.
Si \(p-valor≤0.05\): Se rechaza\(H_0\). Existe autocorrelación entre residuales.
Durbin-Watson test
data: modelo_trans3
DW = 1.6155, p-value = 0.008209
alternative hypothesis: true autocorrelation is greater than 0
Sea \(p=0.08209\), entonces hay evidencia suficiente para afirmar que no se cumple el supuesto de independencia (2/3 :().
