ChickWeight
2026-03-15
#Construcción de la Base de Datos
y = c(51, 66, 85, 103, 124, 155, 153, 175,184,199,204,42,49,63,84,103,126,160,174,204,234,269,281,42,55,69,96,131,157,184,18,
197,198,199,200,42,51,65,86,103,118,127,138,145,146,41,50,61,78,98,117,135,141,147,174,197,196,40,52,62,82,101,120,144,156,173,210,231,238,41,53,66,79,100,
123,148,157,168,185,210,205,39,50,62,80,104,125,154,170,222,261,303,322,40,53,64,85,108,128,152,166,184,203,233,237,41,54,67,84,105,122,155,175,205,234,264,264)
x1 = c(2,4,6,8,10,12,14,16, 18, 20,
21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21,0,2,4,6,8,10,12,14,16,18,20,21
)
x2 = c(41,41,41,41,41,41,41,41,41,41,41,42,42,42,42,42,42,42,42,42,42,42,42,43,43,43,43,43,43,43,43,43,43,43,43,44,44,44,44,44,44,44,44,44,44,45,45,45,45,45,45,45,45,45,45,45,45,46,46,46,46,46,46,46,46,46,46,46,46,47,47,47,47,47,47,47,47,47,47,47,47,48,48,48,48,48,48,48,48,48,48,48,48,49,49,49,49,49,49,49,49,49,49,49,49,50,50,50,50,50,50,50,50,50,50,50,50)
x3= c(4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4)
datos=data.frame(y,x1,x2,x3)pairs(ChickWeight)# diagramas de dispersion
Estadistica descriptiva
summary(ChickWeight)## weight Time Chick Diet
## Min. : 35.0 Min. : 0.00 13 : 12 1:220
## 1st Qu.: 63.0 1st Qu.: 4.00 9 : 12 2:120
## Median :103.0 Median :10.00 20 : 12 3:120
## Mean :121.8 Mean :10.72 10 : 12 4:118
## 3rd Qu.:163.8 3rd Qu.:16.00 17 : 12
## Max. :373.0 Max. :21.00 19 : 12
## (Other):506###• El promedio de datos para la variable peso es de 121.8 • El promedio de datos para la variable tiempo es de 10.72
Correlación
cor(datos) # Correlacion## Warning in cor(datos): La desviación estándar es cero## y x1 x2 x3
## y 1.00000000 0.931811244 0.062878410 NA
## x1 0.93181124 1.000000000 -0.008856143 NA
## x2 0.06287841 -0.008856143 1.000000000 NA
## x3 NA NA NA 1## y x1 x2 x3Y con y correlaion perfecta • Y con X1 correlacion buena de 0.9,van variando conjuntamente, indicando que el peso del polluelo cambia con el tiempo • Y con x2 correlacion de 0.66 presenta buena correlación indicando que el peso del pollo depende del polluelo • Y con X3 N/A correlacion
Ajuste de un Modelo Lineal (lm)
modelo=lm(y~x1+x2+x3,datos=data.frame)## Warning: In lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) :
## extra argument 'datos' will be disregardedsummary(modelo)##
## Call:
## lm(formula = y ~ x1 + x2 + x3, datos = data.frame)
##
## Residuals:
## Min 1Q Median 3Q Max
## -142.633 -9.745 -1.373 5.770 85.336
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -47.8088 36.7746 -1.300 0.196
## x1 9.6412 0.3447 27.972 <2e-16 ***
## x2 1.7085 0.8006 2.134 0.035 *
## x3 NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 24.87 on 114 degrees of freedom
## Multiple R-squared: 0.8733, Adjusted R-squared: 0.8711
## F-statistic: 393 on 2 and 114 DF, p-value: < 2.2e-16##
## Call:
## lm(formula = y ~ x1, y ~ x2, y ~ x3)El modelo de programación lineal indica que • Para aumentar el peso del pollo debo tomar un tiempo 18.8 según lo obtenido como coeficiente, La hipótesis de 0.12 me indica que puedo confiar en los datos obtenidos
• El coeficiente de -47.80 me indica que hay una relación directa entre el tipo de polluelo y el peso y una hipótesis inferior a 0.5 indica que es confiable
4)La nube de puntos y la recta: visualizacion de los residuales
modelo <- lm(y ~ x1 + x2 + x3, data = datos)
res <- residuals(modelo)
res_std <- rstandard(modelo)plot(modelo$fitted.values, res,
xlab = "Valores ajustados",
ylab = "Residuales",
main = "Residuales vs Ajustados")
abline(h = 0, col = "red")
###✔ Los residuales no están distribuidos aleatoriamente ✔ Hay presencia de heterocedasticidad ✔ Hay posible no linealidad ✔ Hay outliers influyentes
qqnorm(res)
qqline(res, col = "red")
Los residuales NO siguen una distribución normal
Colas largas (heavy tails) ✔ Asimetría ✔ Outliers severos `
plot(modelo, which = 4)
Punto 31 Es el más influyente del modelo. Coincide con lo visto en el
Q–Q plot y en los residuos vs ajustados:
Probablemente es un outlier severo Afecta significativamente la estimación de la regresión
🔹 Puntos 92 y 93 Muy cercanos y ambos influyentes. Esto sugiere:
Podrían ser valores extremos en X O casos que pertenecen a un subgrupo distinto de datos (posible heterogeneidad)
🔹 Conjuntamente: Estos tres puntos explican gran parte de las anomalías observadas en:
Heterocedasticidad No normalidad de residuos Curvatura en el Q‑Q plot Dispersión de residuos
cooks.distance(modelo)## 1 2 3 4 5 6
## 2.418529e-03 6.213658e-04 4.866202e-04 2.411359e-04 4.971267e-04 5.069149e-03
## 7 8 9 10 11 12
## 3.265703e-04 4.558207e-05 3.222381e-03 7.015464e-03 1.268517e-02 8.588900e-03
## 13 14 15 16 17 18
## 7.160920e-04 4.220785e-06 7.290884e-05 4.879249e-05 3.921454e-04 5.123712e-03
## 19 20 21 22 23 24
## 3.024349e-03 1.009741e-02 2.400678e-02 5.961974e-02 7.206077e-02 5.943985e-03
## 25 26 27 28 29 30
## 1.775655e-03 3.170999e-04 1.750696e-03 7.538921e-03 1.053146e-02 1.578007e-02
## 31 32 33 34 35 36
## 1.954066e-01 3.338325e-03 2.038961e-05 6.818076e-03 1.600616e-02 4.183350e-03
## 37 38 39 40 41 42
## 2.825617e-04 9.781043e-06 5.412357e-06 1.564830e-05 2.066488e-04 1.610677e-03
## 43 44 45 46 47 48
## 4.247335e-03 1.204316e-02 3.530329e-02 2.577755e-03 3.666320e-05 4.411128e-04
## 49 50 51 52 53 54
## 5.909920e-04 3.869293e-04 3.564176e-04 4.781299e-04 3.153399e-03 1.021537e-02
## 55 56 57 58 59 60
## 8.561326e-03 8.764128e-03 2.066683e-02 1.528577e-03 5.036046e-05 5.344584e-04
## 61 62 63 64 65 66
## 3.220740e-04 2.705055e-04 2.521383e-04 3.030089e-05 5.594155e-04 1.114369e-03
## 67 68 69 70 71 72
## 3.354894e-04 7.710116e-04 3.689245e-04 1.385117e-03 2.192751e-05 2.810364e-04
## 73 74 75 76 77 78
## 1.081642e-03 6.241604e-04 2.075022e-04 2.055574e-07 7.652141e-04 3.100489e-03
## 79 80 81 82 83 84
## 5.120591e-03 3.589834e-03 1.575617e-02 4.972218e-04 2.050202e-04 1.543950e-03
## 85 86 87 88 89 90
## 1.554146e-03 4.845297e-04 2.590928e-04 1.403447e-04 6.318039e-06 1.256479e-02
## 91 92 93 94 95 96
## 3.965374e-02 1.026442e-01 1.462008e-01 4.250593e-04 9.882962e-05 1.858370e-03
## 97 98 99 100 101 102
## 1.093995e-03 3.184760e-04 2.192305e-04 1.882376e-06 3.067555e-04 5.624271e-04
## 103 104 105 106 107 108
## 7.353941e-04 3.934180e-04 4.511953e-05 3.510089e-04 2.161292e-04 1.850080e-03
## 109 110 111 112 113 114
## 2.522875e-03 1.655490e-03 2.403230e-03 4.777506e-05 1.030423e-04 3.407991e-03
## 115 116 117
## 1.188780e-02 3.022343e-02 1.675095e-02Punto 31 Es el más influyente del modelo. Coincide con lo visto en el Q–Q plot y en los residuos vs ajustados:
Probablemente es un outlier severo Afecta significativamente la estimación de la regresión
🔹 Puntos 92 y 93 Muy cercanos y ambos influyentes. Esto sugiere:
Podrían ser valores extremos en X O casos que pertenecen a un subgrupo distinto de datos (posible heterogeneidad)
🔹 Conjuntamente: Estos tres puntos explican gran parte de las anomalías observadas en:
Heterocedasticidad No normalidad de residuos Curvatura en el Q‑Q plot Dispersión de residuos
5) Prediccion con intervalo de confianza
modelo <- lm(y ~ x1 + x2 + x3, data = datos)
nuevo <- data.frame(
x1 = 15,
x2 = 10,
x3 = 120
)
predict(modelo, newdata = nuevo, interval = "confidence")## Warning in predict.lm(modelo, newdata = nuevo, interval = "confidence"):
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful cases## fit lwr upr
## 1 113.8944 57.26062 170.5282###El valor medio esperado de la variable respuesta, para las condiciones especificadas en newdata, es aproximadamente 113.9, y tenemos un 95% de confianza en que el valor real esperado se encuentra entre 57.26 y 170.53.