Ejercicios 07 - Estadística Computacional (13311)

Cree su propio ejemplo de regresión lineal simple utilizando un conjunto de datos con dos variables y la función lm. Grafique utilizando las funciones plot y abline.

Utilizando el dataset ChickWeight, tenemos el tiempo y el peso de varios polluelos. ¿Existe alguna relación directa entre estas variables?

library("ggplot2")
# Dataset a utilizar
datos = datasets::ChickWeight 
# Graficamos los datos a utilizar
plot(weight~Time, datos)

Comenzando con el procedimiento de la regresión lineal simple:

mod = lm(weight~Time, datos)
plot(weight~Time, datos)
title("Tiempo y tamaño de polluelos nacidos hace días")
abline(mod)

Si queremos saber mas información sobre el modelo construido, aplicamos la función summary:

summary(mod)

## 
## Call:
## lm(formula = weight ~ Time, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -138.331  -14.536    0.926   13.533  160.669 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  27.4674     3.0365   9.046   <2e-16 ***
## Time          8.8030     0.2397  36.725   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 38.91 on 576 degrees of freedom
## Multiple R-squared:  0.7007, Adjusted R-squared:  0.7002 
## F-statistic:  1349 on 1 and 576 DF,  p-value: < 2.2e-16

Por lo tanto, el modelo que se ajusta a los datos es:

\[ y = mx + c \] \[ y = 8,8030m + 27,4674\]

También podemos obtener el coeficiente de determinación:

print(summary(mod)$r.squared)

## [1] 0.7007393

Si observamos los p-values, tanto el del tiempo como el del intercepto son muy bajos, menores a 0,05. Por lo tanto:

• Se rechaza la hipótesis Nula de que el intercepto de la recta es 0 y se acepta la Hipótesis Alternativa de que el intercepto si es representativo y distinto de 0.

• Se rechaza la hipótesis Nula de que la pendiente de la recta es 0 y se acepta la Hipótesis Alternativa de que la pendiente si es representativa y distinta de 0.

Finalmente, podemos generar una zona de confianza para ver que puntos estan representados por el modelo generado.

confianza = confint(mod, level = 0.95)
print(confianza)

##                 2.5 %    97.5 %
## (Intercept) 21.503534 33.431317
## Time         8.332247  9.273832

grafico = ggplot(datos,aes(x=Time, y=weight, label= "")) +
  geom_point(aes(Time,weight),datos,color = "green")+
  theme_bw() + ylab("Peso de polluelos")+
  xlab("Tiempo desde el nacimiento de los polluelos (en días)") + ggtitle("Tiempo VS Peso de polluelos nacidos hace días") +
  theme(plot.title = element_text(hjust = 0.5)) +
  geom_text(check_overlap = TRUE) +
  geom_line(aes(Time,weight),datos,color="blue",cex=0.1) +
  geom_smooth(method ="lm", formula = y ~ x,level=0.95)
plot(grafico)

De lo anterior, podemos concluir que utilizando un nivel de confianza del 95% si existe una relación directa entre el tiempo y el tamaño de los polluelos. Sin embargo, el modelo propuesto no es el adecuado para todos los puntos de datos ya que el coeficiente de determinación es 0,70 y no tan cercanos a 0,99, lo cual es el ideal para decir que una recta se ajusta perfectamente a los datos estudiados. Además, con las zonas de confianza claramente se puede observar que quedan muchos puntos quedan fuera de la zona.

Utilice el modelo de regresión lineal simple de la actividad 1 para predecir 5 nuevos registros e incorpórelos a su conjunto de datos. Calcule nuevamente la regresión lineal simple ¿Se observa algún cambio en los coeficientes?

df = data.frame(Time = datos$Time, weight = datos$weight)
Time = c(10, 12, 14, 16, 20)
predict.lm(mod, data.frame(Time = Time))

##        1        2        3        4        5 
## 115.4978 133.1039 150.7100 168.3161 203.5282

weight = c(115.4978, 133.1039, 150.7100, 168.3161, 203.5282)
datos_2 = data.frame(Time = Time, weight = weight)
datos_2 = rbind(df,datos_2)

Time = datos_2$Time
weight = datos_2$weight

Ahora, volvemos a realizar toda la regresión lineal simple:

mod = lm(weight ~ Time, datos_2)
plot(Time, weight)
title("Tiempo VS Peso de polluelos nacidos hace días")
abline(mod)

Si queremos saber mas información sobre el modelo construido, aplicamos la función summary:

summary(mod)

## 
## Call:
## lm(formula = weight ~ Time, data = datos_2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -138.331  -13.998    0.684   13.533  160.669 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  27.4674     3.0209   9.093   <2e-16 ***
## Time          8.8030     0.2381  36.973   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 38.75 on 581 degrees of freedom
## Multiple R-squared:  0.7017, Adjusted R-squared:  0.7012 
## F-statistic:  1367 on 1 and 581 DF,  p-value: < 2.2e-16

Por lo tanto, el modelo que se ajusta a los datos es:

\[ y = 8,8030m + 27,4674\]

También podemos obtener el coeficiente de determinación:

print(summary(mod)$r.squared)

## [1] 0.7017417

Si observamos los p-values, tanto el del tiempo como el del intercepto son muy bajos, menores a 0,05. Por lo tanto:

• Se rechaza la hipótesis Nula de que el intercepto de la recta es 0 y se acepta la Hipótesis Alternativa de que el intercepto si es representativo y distinto de 0.

• Se rechaza la hipótesis Nula de que la pendiente de la recta es 0 y se acepta la Hipótesis Alternativa de que la pendiente si es representativa y distinta de 0.

Finalmente, podemos generar una zona de confianza para ver que puntos estan representados por el modelo generado.

confianza = confint(mod, level = 0.95)
print(confianza)

##                 2.5 %    97.5 %
## (Intercept) 21.534259 33.400591
## Time         8.335405  9.270673

grafico = ggplot(datos_2,aes(x=Time, y=weight, label= "")) +
  geom_point(aes(Time,weight),datos,color = "green")+
  theme_bw() + ylab("Peso de polluelos")+
  xlab("Tiempo desde el nacimiento de los polluelos (en días)") + ggtitle("Tiempo VS Peso de polluelos nacidos hace días") +
  theme(plot.title = element_text(hjust = 0.5)) +
  geom_text(check_overlap = TRUE) +
  geom_line(aes(Time,weight),datos_2,color="blue",cex=0.1) +
  geom_smooth(method ="lm", formula = y ~ x,level=0.95)
plot(grafico)

De lo anterior, podemos concluir que utilizando un nivel de confianza del 95% si existe una relación directa entre el tiempo y el tamaño de los polluelos. Sin embargo, el modelo propuesto no es el adecuado para todos los puntos de datos ya que el coeficiente de determinación es 0,70 y no tan cercanos a 0,99, lo cual es el ideal para decir que una recta se ajusta perfectamente a los datos estudiados. Además, con las zonas de confianza claramente se puede observar que quedan muchos puntos quedan fuera de la zona.

Solamente en el coeficiente de determinación se puede observar un cambio, aún asi minimo. Antes, el valor del coeficiente era 0.7007393, ahora es 0.7017417, por lo que los nuevos datos provocaron una diferencia de 0,0010024 entre coeficientes. No se observa ningún cambio en los demas coeficientes, por lo que se podria decir que la predicción de los valores fue muy correcta, a tal punto que casi no provocó un cambio significativo ni en el gráfico ni en los coeficientes.

Tome un punto cualquiera de su conjunto de datos y multiplíquelo por 100, calcule nuevamente la regresión lineal simple ¿Se observa algún cambio en los coeficientes?

df_2 = data.frame(Time = 2 * 100, weight = 48 * 100)
datos_3 = rbind(df, df_2)

Time = datos_3$Time
weight = datos_3$weight

Ahora, volvemos a realizar toda la regresión lineal simple.

mod = lm(weight ~ Time, datos_3)
plot(Time, weight)
title("Tiempo VS Peso de polluelos nacidos hace días")
abline(mod)

Si queremos saber mas información sobre el modelo construido, aplicamos la función summary:

summary(mod)

## 
## Call:
## lm(formula = weight ~ Time, data = datos_3)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -234.74  -47.98    5.02   54.66 1275.62 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -68.5183     5.4914  -12.48   <2e-16 ***
## Time         17.9645     0.3627   49.53   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 90.39 on 577 degrees of freedom
## Multiple R-squared:  0.8096, Adjusted R-squared:  0.8093 
## F-statistic:  2454 on 1 and 577 DF,  p-value: < 2.2e-16

Por lo tanto, el modelo que se ajusta a los datos es:

\[ y = 17,9645m - 68,5183\]

También podemos obtener el coeficiente de determinación:

print(summary(mod)$r.squared)

## [1] 0.8096179

Si observamos los p-values, tanto el del tiempo como el del intercepto siguen siendo muy bajos, menores a 0,05. Por lo tanto:

• Se rechaza la hipótesis Nula de que el intercepto de la recta es 0 y se acepta la Hipótesis Alternativa de que el intercepto si es representativo y distinto de 0.

• Se rechaza la hipótesis Nula de que la pendiente de la recta es 0 y se acepta la Hipótesis Alternativa de que la pendiente si es representativa y distinta de 0.

Finalmente, podemos generar una zona de confianza para ver que puntos estan representados por el modelo generado.

confianza = confint(mod, level = 0.95)
print(confianza)

##                 2.5 %    97.5 %
## (Intercept) -79.30385 -57.73268
## Time         17.25222  18.67681

grafico = ggplot(datos_3,aes(x=Time, y=weight, label= "")) +
  geom_point(aes(Time,weight),datos,color = "green")+
  theme_bw() + ylab("Peso de polluelos")+
  xlab("Tiempo desde el nacimiento de los polluelos (en días)") + ggtitle("Tiempo VS Peso de polluelos nacidos hace días") +
  theme(plot.title = element_text(hjust = 0.5)) +
  geom_text(check_overlap = TRUE) +
  geom_line(aes(Time,weight),datos_3,color="blue",cex=0.1) +
  geom_smooth(method ="lm", formula = y ~ x,level=0.95)
plot(grafico)

De lo anterior, podemos concluir que utilizando un nivel de confianza del 95% todavia existe una relación directa entre el tiempo y el tamaño de los polluelos. Sin embargo, el modelo propuesto no es el adecuado para todos los puntos de datos, aunque si es mejor que el modelo propuesto anteriormente en las partes 1 y 2, ya que el coeficiente de determinación es 0,81 y a pesar de que es mucho mejor que el coeficiente anterior, todavia no es cercano a 0,99, lo cual es el ideal para decir que una recta se ajusta perfectamente a los datos estudiados. Además, con las zonas de confianza claramente se puede observar que quedan muchos puntos quedan fuera de la zona, lo cual se puede apreciar aún mas considerando que hay un punto que es mucho mayor que todos los otros.

Se observan varios cambios en los coeficientes, principalmente:

• El coeficiente de estimación de la pendiente cambió de 8.8030 a 17.9645, por lo que se tiene una diferencia de 9,1615.

• El coeficiente de estimación del intercepto cambió de 27.4674 a -68.5183, por lo que se tiene una diferencia de -95,9857.

• El coeficiente de determinación cambió de 0,70 a 0,81, por lo que se tiene una diferencia de 0,11.