Untitled

library(ggplot2)
library(mosaic) 
library(knitr)
library(kableExtra)
library(modeest)
library(e1071)
library(nortest)
library(lmtest)
library(palmerpenguins)

data("penguins")

#Eliminamos NA en penguis
data = subset(
  penguins,
  species == "Adelie" &
    !is.na(sex) &
    !is.na(flipper_length_mm ) &
    !is.na(body_mass_g)
)
#Separar subconjubtos
adelie_machos <- subset(
  data,
  sex == "male")

adelie_hembras <- subset(
  data,
  sex == "female")

Modelo de regresión lineal por sexo

Modelo Machos

#MODELO DE REGRESIÓN LINEAL MACHOS
modelo_machos <- lm(
  flipper_length_mm ~ body_mass_g,
  data = adelie_machos
)
summary(modelo_machos)

Call:
lm(formula = flipper_length_mm ~ body_mass_g, data = adelie_machos)

Residuals:
     Min       1Q   Median       3Q      Max 
-13.4268  -3.8273   0.1439   3.1439  17.8873 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.647e+02  8.548e+00  19.264  < 2e-16 ***
body_mass_g 6.859e-03  2.106e-03   3.256  0.00173 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.199 on 71 degrees of freedom
Multiple R-squared:  0.1299,    Adjusted R-squared:  0.1177 
F-statistic:  10.6 on 1 and 71 DF,  p-value: 0.001734

Interpretación de los parámetros del modelo machos

• Intercepto : 164.7 representa la longitud estimada de la aleta, en milímetros, para una masa corporal de 0 gramos (interpretación matemática, fuera del rango observado).

• Pendiente : 0.006859 indica que, por cada incremento de 1,000 gramos en la masa corporal, se estima que la longitud de la aleta aumente en promedio 6.859 milímetros.

• Coeficiente de determinación : 0.1299 indica que el modelo explica aproximadamente el 12.99 % de la variabilidad observada en la longitud de la aleta a partir de la masa corporal.

Gráfica de regresión lineal: machos Adelie

# Gráfica de regresión lineal: machos Adelie
ggplot(adelie_machos,
       aes(x = body_mass_g, y = flipper_length_mm)) +
  geom_point(color = "navy", size = 2) +
  geom_smooth(
    method = "lm",
    formula = y ~ x + 0,
    color = "red",
    se = FALSE
  ) +
  labs(
    title = "Regresión Lineal: Peso vs Longitud de Aleta",
    subtitle = "Modelo OLS sin intercepto para pingüinos Adelie machos",
    x = "Peso corporal (g)",
    y = "Longitud de aleta (mm)"
  ) +
  theme_minimal()

Observaciones:

• Outliers: Algunas observaciones presentan una separación vertical respecto a la recta de regresión, lo cual podrían presentar residuos elevados.

• Leverage: Algunas observaciones están en los extremos de la variable explicativa (peso corporal), y además se alejan ligeramente de la recta de regresión (no siguen el comportamiento de la variable respuesta).

• La dispersión de los puntos alrededor de la recta dificulta establecer una clasificación únicamente mediante la inspección visual. Por ello, se requiere complementar el análisis gráfico mediante los residuos estudentizados, los valores de leverage y la distancia de Cook, con el propósito de identificar posibles outliers, good leverage y bad leverage, así como evaluar su influencia sobre el ajuste del modelo.

Detección Numérica de Valores Atípicos para modelo machos

# Número de observaciones y parámetros
n <- nrow(adelie_machos)
p <- 2 # Intercepto y pendiente

# 1. Leverage
hat_vals_machos <- hatvalues(modelo_machos)
umbral_hat_machos <- 3 * (p / n)

# 2. Distancia de Cook
cook_vals_machos <- cooks.distance(modelo_machos)
umbral_cook_machos <- 4 / (n - p)

# 3. Residuos estudentizados
r_student_machos <- rstudent(modelo_machos)

# Identificar observaciones problemáticas
atipicos_machos <- which(abs(r_student_machos) > 3)
leverage_machos <- which(hat_vals_machos > umbral_hat_machos)
cook_machos <- which(cook_vals_machos > umbral_cook_machos)

cat("Observaciones con RStudent > 3:", atipicos_machos, "\n")

Observaciones con RStudent > 3: 62 

cat("Observaciones con Leverage alto:", leverage_machos, "\n")

Observaciones con Leverage alto:  

cat("Observaciones con Distancia de Cook alta:", cook_machos, "\n")

Observaciones con Distancia de Cook alta: 17 58 62 

plot(modelo_machos, which = 4,
     col = "blue", pch = 16,
     main = "Distancia de Cook - Adelie machos")

abline(h = umbral_cook_machos,
       col = "red", lty = 2)

cook_machos <- cooks.distance(modelo_machos)

indices_machos <- which(  cook_machos > 4/(nrow(adelie_machos) - 2))

data.frame(
  Observacion = indices_machos,
  Peso = adelie_machos$body_mass_g[indices_machos],
  Longitud_aleta = adelie_machos$flipper_length_mm[indices_machos],
  Cook = cook_machos[indices_machos])

   Observacion Peso Longitud_aleta       Cook
17          17 4650            184 0.12966380
58          58 3500            198 0.05955231
62          62 4000            210 0.05958645

No es posible determinar si estas observaciones corresponden a errores de medición o a variaciones biológicas extraordinarias ajenas al comportamiento general de los datos. Por tanto, no se justifica su eliminación y se propone evaluar la winsorización para reajustar el modelo y analizar su efecto sobre las estimaciones.

# 1. Definir límites de percentiles
q_inf_machos <- quantile( adelie_machos$flipper_length_mm,  0.05, na.rm = TRUE)

q_sup_machos <- quantile( adelie_machos$flipper_length_mm,  0.95, na.rm = TRUE)

# 2. Winsorizar longitud de aleta
adelie_machos$aleta_winsor <- pmin( pmax(adelie_machos$flipper_length_mm,q_inf_machos),  q_sup_machos)

# 3. Ajustar el modelo winsorizado
modelo_machos_winsor <- lm( aleta_winsor ~ body_mass_g, data = adelie_machos)

# 4. Comparar modelos
summary(modelo_machos)

Call:
lm(formula = flipper_length_mm ~ body_mass_g, data = adelie_machos)

Residuals:
     Min       1Q   Median       3Q      Max 
-13.4268  -3.8273   0.1439   3.1439  17.8873 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.647e+02  8.548e+00  19.264  < 2e-16 ***
body_mass_g 6.859e-03  2.106e-03   3.256  0.00173 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.199 on 71 degrees of freedom
Multiple R-squared:  0.1299,    Adjusted R-squared:  0.1177 
F-statistic:  10.6 on 1 and 71 DF,  p-value: 0.001734

summary(modelo_machos_winsor)

Call:
lm(formula = aleta_winsor ~ body_mass_g, data = adelie_machos)

Residuals:
     Min       1Q   Median       3Q      Max 
-12.1946  -3.5908   0.3149   3.4328  10.8502 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.659e+02  7.730e+00  21.464  < 2e-16 ***
body_mass_g 6.509e-03  1.905e-03   3.417  0.00105 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.606 on 71 degrees of freedom
Multiple R-squared:  0.1412,    Adjusted R-squared:  0.1291 
F-statistic: 11.68 on 1 and 71 DF,  p-value: 0.001051

Modelo hembras

modelo_hembras <- lm(
  flipper_length_mm ~ body_mass_g,
  data = adelie_hembras
)
summary(modelo_hembras)

Call:
lm(formula = flipper_length_mm ~ body_mass_g, data = adelie_hembras)

Residuals:
    Min      1Q  Median      3Q     Max 
-14.599  -3.149   0.397   3.718  13.216 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.694e+02  8.037e+00  21.077   <2e-16 ***
body_mass_g 5.461e-03  2.378e-03   2.296   0.0246 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.436 on 71 degrees of freedom
Multiple R-squared:  0.06913,   Adjusted R-squared:  0.05602 
F-statistic: 5.273 on 1 and 71 DF,  p-value: 0.02461

Interpretación de los parámetros del modelo hembras

• Intercepto : 169.4 representa la longitud estimada de la aleta, en milímetros, para una masa corporal de 0 gramos (interpretación matemática, fuera del rango observado).

• Pendiente : 0.005461 indica que, por cada incremento de 1,000 gramos en la masa corporal, se estima que la longitud de la aleta aumente en promedio 5.461 milímetros.

• Coeficiente de determinación : 0.06913 indica que el modelo explica aproximadamente el 6.91 % de la variabilidad observada en la longitud de la aleta a partir de la masa corporal.

Gráfica de regresión lineal: machos Adelie

# Gráfica de regresión lineal: hembras Adelie
ggplot(adelie_hembras, aes(x = body_mass_g, y = flipper_length_mm)) +
  geom_point(color = "navy", size = 2) +
  geom_smooth(method = "lm", color = "red", se = FALSE) +
  labs(
    title = "Regresión Lineal: Peso vs Longitud de Aleta",
    subtitle = "Modelo OLS para pingüinos Adelie hembras",
    x = "Peso corporal (g)",
    y = "Longitud de aleta (mm)"  ) +  theme_minimal()

`geom_smooth()` using formula = 'y ~ x'

Observaciones:

• Outliers: Algunas observaciones presentan una separación vertical respecto a la recta de regresión, lo que podría indicar residuos elevados.

• Leverage: Algunas observaciones se ubican en los extremos de la variable explicativa (peso corporal), sin embargo se visualiza que siguen el comportamiento de la variable respuesta.

• La dndefinedispersión de los puntos alrededor de la recta dificulta establecer una clasificación únicamente mediante la inspección visual. Por ello, se requiere complementar el análisis gráfico mediante los residuos estudentizados, los valores de leverage y la distancia de Cook, con el propósito de identificar posibles outliers, good leverage y bad leverage, así como evaluar su influencia sobre el ajuste del modelo.

Detección Numérica de Valores Atípicos para el modelo hembras

# Número de observaciones y parámetros
n <- nrow(adelie_hembras)
p <- 2 # Intercepto y pendiente

# 1. Leverage
hat_vals_hembras <- hatvalues(modelo_hembras)
umbral_hat_hembras <- 3 * (p / n)

# 2. Distancia de Cook
cook_vals_hembras <- cooks.distance(modelo_hembras)
umbral_cook_hembras <- 4 / (n - p)

# 3. Residuos estudentizados
r_student_hembras <- rstudent(modelo_hembras)

# Identificar observaciones problemáticas
atipicos_hembras <- which(abs(r_student_hembras) > 3)
leverage_hembras <- which(hat_vals_hembras > umbral_hat_hembras)
cook_hembras <- which(cook_vals_hembras > umbral_cook_hembras)

cat("Observaciones con RStudent > 3:", atipicos_hembras, "\n")

Observaciones con RStudent > 3:  

cat("Observaciones con Leverage alto:", leverage_hembras, "\n")

Observaciones con Leverage alto:  

cat("Observaciones con Distancia de Cook alta:", cook_hembras, "\n")

Observaciones con Distancia de Cook alta: 13 43 51 53 

Visualización de las distancias de Cook

plot(modelo_hembras, which = 4,
     col = "blue", pch = 16,
     main = "Distancia de Cook - Adelie hembras")

abline(h = umbral_cook_hembras,
       col = "red", lty = 2)

# Distancia de Cook para hembras
cook_hembras <- cooks.distance(modelo_hembras)

# Identificar observaciones con Cook elevado
indices_hembras <- which(
  cook_hembras > 4/(nrow(adelie_hembras) - 2)
)

# Mostrar datos originales y distancia de Cook
data.frame(
  Observacion = indices_hembras,
  Peso = adelie_hembras$body_mass_g[indices_hembras],
  Longitud_aleta = adelie_hembras$flipper_length_mm[indices_hembras],
  Cook = cook_hembras[indices_hembras]
)

   Observacion Peso Longitud_aleta       Cook
13          13 3150            172 0.08636277
43          43 3550            202 0.06148164
51          51 3750            199 0.06363527
53          53 3825            198 0.06016516

No es posible determinar si estas observaciones corresponden a errores de medición o a variaciones biológicas extraordinarias ajenas al comportamiento general de los datos. Por tanto, no se justifica su eliminación y se propone evaluar la winsorización para reajustar el modelo y analizar su efecto sobre las estimaciones.

Winsorización del modelo machos

# 1. Definir límites de percentiles
q_inf_hembras <- quantile(adelie_hembras$flipper_length_mm, 0.05, na.rm = TRUE)

q_sup_hembras <- quantile(  adelie_hembras$flipper_length_mm, 0.95, na.rm = TRUE)

# 2. Winsorizar longitud de aleta
adelie_hembras$aleta_winsor <- pmin(pmax(adelie_hembras$flipper_length_mm, q_inf_hembras),q_sup_hembras)

# 3. Ajustar el modelo winsorizado
modelo_hembras_winsor <- lm(aleta_winsor ~ body_mass_g, data = adelie_hembras)
# 4. Comparar modelos
summary(modelo_hembras)

Call:
lm(formula = flipper_length_mm ~ body_mass_g, data = adelie_hembras)

Residuals:
    Min      1Q  Median      3Q     Max 
-14.599  -3.149   0.397   3.718  13.216 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.694e+02  8.037e+00  21.077   <2e-16 ***
body_mass_g 5.461e-03  2.378e-03   2.296   0.0246 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.436 on 71 degrees of freedom
Multiple R-squared:  0.06913,   Adjusted R-squared:  0.05602 
F-statistic: 5.273 on 1 and 71 DF,  p-value: 0.02461

summary(modelo_hembras_winsor)

Call:
lm(formula = aleta_winsor ~ body_mass_g, data = adelie_hembras)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.1426  -2.9164   0.5362   3.6493   7.7624 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 1.725e+02  6.993e+00  24.672   <2e-16 ***
body_mass_g 4.525e-03  2.069e-03   2.187    0.032 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.73 on 71 degrees of freedom
Multiple R-squared:  0.06311,   Adjusted R-squared:  0.04992 
F-statistic: 4.783 on 1 and 71 DF,  p-value: 0.03204