5. Ejercicios Regresión Lineal Múltiple

Ejercicio 5.1 Medidas del cuerpo V. Base de datos bdims del paquete openintro.

Proponga un modelo de regresión múltiple que explique el peso medido en kilogramos (wgt) utilizando el contorno de la cadera medida en centímetros (hip.gi) y la altura media en centímetros (hgt) como covariables.
Escriba el modelo que está ajustando. Realice el ajuste con el R.

modelo propuesto: \[ wgt = \beta_0 + \beta_1*hip.gi + \beta_1*hgt + \epsilon \] modelo ajustado \[ \widehat{wgt} = \widehat{\beta_0} + \widehat{\beta_1}*hip.gi + \widehat{\beta_1}*hgt \]

ajuste <- lm(wgt ~ hip.gi + hgt, data = bdims)
summary(ajuste)

Call:
lm(formula = wgt ~ hip.gi + hgt, data = bdims)

Residuals:
     Min       1Q   Median       3Q      Max 
-14.7727  -4.0102  -0.3395   4.1441  20.2723 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -170.17696    5.10621  -33.33   <2e-16 ***
hip.gi         1.17353    0.04012   29.25   <2e-16 ***
hgt            0.73544    0.02849   25.82   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 5.673 on 504 degrees of freedom
Multiple R-squared:  0.8201,    Adjusted R-squared:  0.8193 
F-statistic:  1148 on 2 and 504 DF,  p-value: < 2.2e-16
  1. Interprete los coeficientes estimados.
  • Para una altura dada, frente a un aumento en un cm del contorno de la cadera se espera un aumento de 1,17 kg.
  • Para una contorno de la cadera dado, frente a un aumento en un cm del alto se espera un aumento de 0,74 kg.
    ¿Resultan significativos?
  • Si
    Cambian sus valores respecto de los que tenían los coeficientes que acompañaban a estas variables en los modelos de regresión lineal simple?
  • hip.gi 1.52417
  • hgt 1.01762
  • Cambia la magnitud, pero no el sentido.
  1. Evalúe la bondad del ajuste realizado, a través del R2: Indique cuánto vale y qué significa. Se quiere comparar este ajuste con el que dan los dos modelos lineales simples propuestos en los ejercicios 2.1 y 2.2. ¿Es correcto comparar los R2 de los tres ajustes? ¿Qué valores puedo comparar? ¿Es mejor este ajuste múltiple?
kable(data.frame( modelo      = c("wgt~hip.gi", "wgt ~ hgt", "wgt ~ hip.gi + hgt"),
                  R2          = c(0.5821, 0.5145, 0.8201),
                  R2.ajustado = c(0.5813, 0.5136, 0.8193 )))
modelo R2 R2.ajustado
wgt~hip.gi 0.5821 0.5813
wgt ~ hgt 0.5145 0.5136
wgt ~ hip.gi + hgt 0.8201 0.8193

el modelo que incluye el alto y el ancho de la cintura explica un 82% del peso esperado del individuo. Para comparar este modelo con las regresiones simples, utilizamos el \(R^{2}_{ajustado}\), donde el modelo múltiple es claramente superior a las regresiones simples.

  1. Estime la varianza de los errores. Compare este estimador con los obtenidos en los dos ajustes simples.
kable(data.frame( modelo = c("wgt~hip.gi", "wgt ~ hgt", "wgt ~ hip.gi + hgt"),
                  'Residual standard error' = c(8.636 ,9.308 , 5.673)))
modelo Residual.standard.error
wgt~hip.gi 8.636
wgt ~ hgt 9.308
wgt ~ hip.gi + hgt 5.673

\(\widehat{\sigma^2}\) es mayor en los modelos simples que en el modelo múltiple. Este último logra captar una mayor variablidad de la información como variabilidad explicada por el modelo.

  1. Estime el peso esperado para la población de adultos cuyo contorno de cadera mide 100 cm y su altura es de 174cm. Dé un intervalo de confianza de nivel 0.95 para este valor esperado.
pob <- data.frame(hip.gi =  100,hgt = 174, wgt=NA)
predict(ajuste, newdata = pob,interval="confidence",level = 0.95)
       fit      lwr      upr
1 75.14322 74.58586 75.70058
  1. Prediga el peso de un adulto cuyo contorno de cadera mide 100 cm y su altura es de 174cm. Dé un intervalo de predicción de nivel 0.95 para este valor.Compare las longitudes de los tres intervalos de predicción que se obtienen usando el modelo que solamente tiene al contorno de cadera como explicativa, al que solamente usa la altura y al modelo múltiple que contiene a ambas.
ajuste_s_hip    <- lm(wgt ~ hip.gi , data = bdims)
ajuste_s_hgt    <- lm(wgt ~ hgt, data = bdims)
ajuste_multiple <- lm(wgt ~ hip.gi + hgt, data = bdims)
# ajuste wgt ~ hip.gi
predict(ajuste_s_hip,    newdata = pob, ,interval="predict",level = 0.95)
       fit      lwr      upr
1 74.20646 57.21927 91.19365
# ajuste wgt ~ hgt
predict(ajuste_s_hgt,    newdata = pob, ,interval="predict",level = 0.95)
       fit      lwr      upr
1 72.05406 53.74712 90.36101
# ajuste wgt ~ hip.gi + hgt
predict(ajuste_multiple, newdata = pob, ,interval="predict",level = 0.95)
       fit      lwr      upr
1 75.14322 63.98462 86.30183

El modelo de regresión múltiple, que explica mejor, tiene un intervalo más acotado que los modelos de regresión simple.

LS0tCnRpdGxlOiAiRWplcmNpY2lvcyBtb2RlbG8gbGluZWFsIFYiCm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgdG9jOiB5ZXMKICAgIHRvY19mbG9hdDogeWVzCi0tLQoKCiMgNS4gRWplcmNpY2lvcyBSZWdyZXNpw7NuIExpbmVhbCBNw7psdGlwbGUKCiMjIyBFamVyY2ljaW8gNS4xIE1lZGlkYXMgZGVsIGN1ZXJwbyBWLiBCYXNlIGRlIGRhdG9zIGJkaW1zIGRlbCBwYXF1ZXRlIG9wZW5pbnRyby4KClByb3BvbmdhIHVuIG1vZGVsbyBkZSByZWdyZXNpw7NuIG3Dumx0aXBsZSBxdWUgZXhwbGlxdWUgZWwgcGVzbyBtZWRpZG8gZW4ga2lsb2dyYW1vcyAod2d0KSB1dGlsaXphbmRvIGVsIGNvbnRvcm5vIGRlIGxhIGNhZGVyYSBtZWRpZGEgZW4gY2VudMOtbWV0cm9zIChoaXAuZ2kpIHkgbGEgYWx0dXJhIG1lZGlhIGVuIGNlbnTDrW1ldHJvcyAoaGd0KSBjb21vIGNvdmFyaWFibGVzLiAgICAKRXNjcmliYSBlbCBtb2RlbG8gcXVlIGVzdMOhIGFqdXN0YW5kby4gUmVhbGljZSBlbCBhanVzdGUgY29uIGVsIFIuCgpfX21vZGVsbyBwcm9wdWVzdG9fXzoKJCQKd2d0ID0gXGJldGFfMCArIFxiZXRhXzEqaGlwLmdpICsgXGJldGFfMSpoZ3QgKyBcZXBzaWxvbgokJApfX21vZGVsbyBhanVzdGFkb19fCiQkClx3aWRlaGF0e3dndH0gPSBcd2lkZWhhdHtcYmV0YV8wfSArIFx3aWRlaGF0e1xiZXRhXzF9KmhpcC5naSArIFx3aWRlaGF0e1xiZXRhXzF9KmhndAokJAoKYGBge3J9CmFqdXN0ZSA8LSBsbSh3Z3QgfiBoaXAuZ2kgKyBoZ3QsIGRhdGEgPSBiZGltcykKc3VtbWFyeShhanVzdGUpCmBgYAoKCmIpIEludGVycHJldGUgbG9zIGNvZWZpY2llbnRlcyBlc3RpbWFkb3MuICAgICAKICogUGFyYSB1bmEgYWx0dXJhIGRhZGEsIGZyZW50ZSBhIHVuIGF1bWVudG8gZW4gdW4gY20gZGVsIGNvbnRvcm5vIGRlIGxhIGNhZGVyYSBzZSBlc3BlcmEgdW4gYXVtZW50byBkZSAxLDE3IGtnLiAgCiAgKiBQYXJhIHVuYSBjb250b3JubyBkZSBsYSBjYWRlcmEgZGFkbywgZnJlbnRlIGEgdW4gYXVtZW50byBlbiB1biBjbSBkZWwgYWx0byBzZSBlc3BlcmEgdW4gYXVtZW50byBkZSAwLDc0IGtnLiAgCsK/UmVzdWx0YW4gc2lnbmlmaWNhdGl2b3M/ICAgICAgIAogICogX19TaV9fICAgICAgCkNhbWJpYW4gc3VzIHZhbG9yZXMgcmVzcGVjdG8gZGUgbG9zIHF1ZSB0ZW7DrWFuIGxvcyBjb2VmaWNpZW50ZXMgcXVlIGFjb21wYcOxYWJhbiBhIGVzdGFzIHZhcmlhYmxlcyBlbiBsb3MgbW9kZWxvcyBkZSByZWdyZXNpw7NuIGxpbmVhbCBzaW1wbGU/CiAgKiBoaXAuZ2kgMS41MjQxNyAgICAKICAqIGhndCAgICAxLjAxNzYyICAgIAogICogQ2FtYmlhIGxhIG1hZ25pdHVkLCBwZXJvIG5vIGVsIHNlbnRpZG8uCiAgCmMpIEV2YWzDumUgbGEgYm9uZGFkIGRlbCBhanVzdGUgcmVhbGl6YWRvLCBhIHRyYXbDqXMgZGVsIFIyOiBJbmRpcXVlIGN1w6FudG8gdmFsZSB5IHF1w6kgc2lnbmlmaWNhLiBTZSBxdWllcmUgY29tcGFyYXIgZXN0ZSBhanVzdGUgY29uIGVsIHF1ZSBkYW4gbG9zIGRvcyBtb2RlbG9zIGxpbmVhbGVzIHNpbXBsZXMgcHJvcHVlc3RvcyBlbiBsb3MgZWplcmNpY2lvcyAyLjEgeSAyLjIuIMK/RXMgY29ycmVjdG8gY29tcGFyYXIgbG9zIFIyIGRlIGxvcyB0cmVzIGFqdXN0ZXM/IMK/UXXDqSB2YWxvcmVzIHB1ZWRvIGNvbXBhcmFyPyDCv0VzIG1lam9yIGVzdGUgYWp1c3RlIG3Dumx0aXBsZT8KCgpgYGB7cn0Ka2FibGUoZGF0YS5mcmFtZSggbW9kZWxvICAgICAgPSBjKCJ3Z3R+aGlwLmdpIiwgIndndCB+IGhndCIsICJ3Z3QgfiBoaXAuZ2kgKyBoZ3QiKSwKICAgICAgICAgICAgICAgICAgUjIgICAgICAgICAgPSBjKDAuNTgyMSwgMC41MTQ1LCAwLjgyMDEpLAogICAgICAgICAgICAgICAgICBSMi5hanVzdGFkbyA9IGMoMC41ODEzLCAwLjUxMzYsIDAuODE5MyApKSkKCgpgYGAKIAplbCBtb2RlbG8gcXVlIGluY2x1eWUgZWwgYWx0byB5IGVsIGFuY2hvIGRlIGxhIGNpbnR1cmEgZXhwbGljYSB1biA4MiUgZGVsIHBlc28gZXNwZXJhZG8gZGVsIGluZGl2aWR1by4gUGFyYSBjb21wYXJhciBlc3RlIG1vZGVsbyBjb24gbGFzIHJlZ3Jlc2lvbmVzIHNpbXBsZXMsIHV0aWxpemFtb3MgZWwgJFJeezJ9X3thanVzdGFkb30kLCBkb25kZSBlbCBtb2RlbG8gbcO6bHRpcGxlIGVzIGNsYXJhbWVudGUgc3VwZXJpb3IgYSBsYXMgcmVncmVzaW9uZXMgc2ltcGxlcy4KCmQpIEVzdGltZSBsYSB2YXJpYW56YSBkZSBsb3MgZXJyb3Jlcy4gQ29tcGFyZSBlc3RlIGVzdGltYWRvciBjb24gbG9zIG9idGVuaWRvcyBlbiBsb3MgZG9zIGFqdXN0ZXMgc2ltcGxlcy4KCmBgYHtyfQprYWJsZShkYXRhLmZyYW1lKCBtb2RlbG8gPSBjKCJ3Z3R+aGlwLmdpIiwgIndndCB+IGhndCIsICJ3Z3QgfiBoaXAuZ2kgKyBoZ3QiKSwKICAgICAgICAgICAgICAgICAgJ1Jlc2lkdWFsIHN0YW5kYXJkIGVycm9yJyA9IGMoOC42MzYgLDkuMzA4ICwgNS42NzMpKSkKCmBgYAoKJFx3aWRlaGF0e1xzaWdtYV4yfSQgZXMgbWF5b3IgZW4gbG9zIG1vZGVsb3Mgc2ltcGxlcyBxdWUgZW4gZWwgbW9kZWxvIG3Dumx0aXBsZS4gRXN0ZSDDumx0aW1vIGxvZ3JhIGNhcHRhciB1bmEgbWF5b3IgdmFyaWFibGlkYWQgZGUgbGEgaW5mb3JtYWNpw7NuIGNvbW8gdmFyaWFiaWxpZGFkIGV4cGxpY2FkYSBwb3IgZWwgbW9kZWxvLgoKZSkgRXN0aW1lIGVsIHBlc28gZXNwZXJhZG8gcGFyYSBsYSBwb2JsYWNpw7NuIGRlIGFkdWx0b3MgY3V5byBjb250b3JubyBkZSBjYWRlcmEgbWlkZSAxMDAgY20geSBzdSBhbHR1cmEgZXMgZGUgMTc0Y20uIETDqSB1biBpbnRlcnZhbG8gZGUgY29uZmlhbnphIGRlIG5pdmVsIDAuOTUgcGFyYSBlc3RlIHZhbG9yIGVzcGVyYWRvLgoKYGBge3J9CnBvYiA8LSBkYXRhLmZyYW1lKGhpcC5naSA9ICAxMDAsaGd0ID0gMTc0LCB3Z3Q9TkEpCnByZWRpY3QoYWp1c3RlLCBuZXdkYXRhID0gcG9iLGludGVydmFsPSJjb25maWRlbmNlIixsZXZlbCA9IDAuOTUpCgpgYGAKCmYpIFByZWRpZ2EgZWwgcGVzbyBkZSB1biBhZHVsdG8gY3V5byBjb250b3JubyBkZSBjYWRlcmEgbWlkZSAxMDAgY20geSBzdSBhbHR1cmEgZXMgZGUgMTc0Y20uIETDqSB1biBpbnRlcnZhbG8gZGUgcHJlZGljY2nDs24gZGUgbml2ZWwgMC45NSBwYXJhIGVzdGUgdmFsb3IuQ29tcGFyZSBsYXMgbG9uZ2l0dWRlcyBkZSBsb3MgdHJlcyBpbnRlcnZhbG9zIGRlIHByZWRpY2Npw7NuIHF1ZSBzZSBvYnRpZW5lbiB1c2FuZG8gZWwgbW9kZWxvIHF1ZSBzb2xhbWVudGUgdGllbmUgYWwgY29udG9ybm8gZGUgY2FkZXJhIGNvbW8gZXhwbGljYXRpdmEsIGFsIHF1ZSBzb2xhbWVudGUgdXNhIGxhIGFsdHVyYSB5IGFsIG1vZGVsbyBtw7psdGlwbGUgcXVlIGNvbnRpZW5lIGEgYW1iYXMuCgoKYGBge3J9CmFqdXN0ZV9zX2hpcCAgICA8LSBsbSh3Z3QgfiBoaXAuZ2kgLCBkYXRhID0gYmRpbXMpCmFqdXN0ZV9zX2hndCAgICA8LSBsbSh3Z3QgfiBoZ3QsIGRhdGEgPSBiZGltcykKYWp1c3RlX211bHRpcGxlIDwtIGxtKHdndCB+IGhpcC5naSArIGhndCwgZGF0YSA9IGJkaW1zKQoKIyBhanVzdGUgd2d0IH4gaGlwLmdpCnByZWRpY3QoYWp1c3RlX3NfaGlwLCAgICBuZXdkYXRhID0gcG9iLCAsaW50ZXJ2YWw9InByZWRpY3QiLGxldmVsID0gMC45NSkKIyBhanVzdGUgd2d0IH4gaGd0CnByZWRpY3QoYWp1c3RlX3NfaGd0LCAgICBuZXdkYXRhID0gcG9iLCAsaW50ZXJ2YWw9InByZWRpY3QiLGxldmVsID0gMC45NSkKIyBhanVzdGUgd2d0IH4gaGlwLmdpICsgaGd0CnByZWRpY3QoYWp1c3RlX211bHRpcGxlLCBuZXdkYXRhID0gcG9iLCAsaW50ZXJ2YWw9InByZWRpY3QiLGxldmVsID0gMC45NSkKCmBgYAoKRWwgbW9kZWxvIGRlIHJlZ3Jlc2nDs24gbcO6bHRpcGxlLCBxdWUgZXhwbGljYSBtZWpvciwgdGllbmUgdW4gaW50ZXJ2YWxvIG3DoXMgYWNvdGFkbyBxdWUgbG9zIG1vZGVsb3MgZGUgcmVncmVzacOzbiBzaW1wbGUuCg==