u4a2
Carlos Esteban
7/7/2020
Análisis de correlacion
*Importar paquetes y definir folder de trabajo
library(pacman)
p_load("base64enc", "htmltools", "mime", "xfun", "prettydoc", "readr", "ggplot2", "tidyr", "plotly", "DT")
setwd("~/veranoPyE")- Importar datos
grasas <- read.table("http://verso.mat.uam.es/~joser.berrendero/datos/EdadPesoGrasas.txt", header= TRUE)
names(grasas)## [1] "peso" "edad" "grasas"- Descripción de datos
Se tienen datos de 25 personas de peso, edad y grasas.
datatable(grasas)Correlación con matriz de diagrama de dispersión
pairs(grasas)
*Cuantificar el grado de relación lineal (coef. de correlación)
cor(grasas)## peso edad grasas
## peso 1.0000000 0.2400133 0.2652935
## edad 0.2400133 1.0000000 0.8373534
## grasas 0.2652935 0.8373534 1.0000000*Estimación y representación de la recta de mínimos cuadrados
regresion <- lm(grasas ~ peso, data=grasas )
summary(regresion)##
## Call:
## lm(formula = grasas ~ peso, data = grasas)
##
## Residuals:
## Min 1Q Median 3Q Max
## -127.729 -53.686 -9.239 46.537 128.404
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 199.298 85.818 2.322 0.0294 *
## peso 1.622 1.229 1.320 0.2000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 76.65 on 23 degrees of freedom
## Multiple R-squared: 0.07038, Adjusted R-squared: 0.02996
## F-statistic: 1.741 on 1 and 23 DF, p-value: 0.2- Los siguientes comandos representan la nube de puntos (comando plot) y añaden la representación gráfica de la recta de mínimos cuadrados (comando abline aplicado al objeto generado por lm):
plot(grasas$peso, grasas$grasas, xlab="peso", ylab="Grasas" )
abline(regresion)
- Cálculo de predicciones
nuevas.edades <- data.frame(peso= seq(30,90))
predict(regresion,nuevas.edades)## 1 2 3 4 5 6 7 8
## 247.9678 249.5901 251.2125 252.8348 254.4572 256.0795 257.7018 259.3242
## 9 10 11 12 13 14 15 16
## 260.9465 262.5689 264.1912 265.8136 267.4359 269.0582 270.6806 272.3029
## 17 18 19 20 21 22 23 24
## 273.9253 275.5476 277.1700 278.7923 280.4146 282.0370 283.6593 285.2817
## 25 26 27 28 29 30 31 32
## 286.9040 288.5264 290.1487 291.7710 293.3934 295.0157 296.6381 298.2604
## 33 34 35 36 37 38 39 40
## 299.8828 301.5051 303.1274 304.7498 306.3721 307.9945 309.6168 311.2391
## 41 42 43 44 45 46 47 48
## 312.8615 314.4838 316.1062 317.7285 319.3509 320.9732 322.5955 324.2179
## 49 50 51 52 53 54 55 56
## 325.8402 327.4626 329.0849 330.7073 332.3296 333.9519 335.5743 337.1966
## 57 58 59 60 61
## 338.8190 340.4413 342.0637 343.6860 345.3083- Inferencia en el modelo de regresión simple
confint(regresion)## 2.5 % 97.5 %
## (Intercept) 21.7696109 376.825392
## peso -0.9209324 4.165618confint(regresion, level = 0.90)## 5 % 95 %
## (Intercept) 52.2166142 346.378389
## peso -0.4847468 3.729432nuevas.edades <- data.frame(peso=seq(20,60))
#Gráfica de disperión y recta
plot(grasas$peso, grasas$grasas, xlab="peso", ylab="Grasas")
abline(regresion)
#Intervalos de confianza de la respuesta media
#ic es una matriz de tres columnas: la primera es la predicción, las otras son los extremos del intervalo
ic <- predict(regresion, nuevas.edades, interval="confidence")
lines(nuevas.edades$peso, ic[, 2], lty =2, col="red")
lines(nuevas.edades$peso, ic[, 3], lty =2, col="red")
#Intervalo de predicción
ic <- predict(regresion, nuevas.edades, interval="prediction" )
lines(nuevas.edades$peso, ic[, 2], lty =2, col="red" )
lines(nuevas.edades$peso, ic[, 3], lty =2, col="red" )
Análisis ANOVA
anova(regresion)## Analysis of Variance Table
##
## Response: grasas
## Df Sum Sq Mean Sq F value Pr(>F)
## peso 1 10232 10231.7 1.7413 0.2
## Residuals 23 135145 5875.9- Diagnóstico del modelo
residuos <- rstandard(regresion)
valores.ajustados <- fitted(regresion)
plot(valores.ajustados, residuos)
qqnorm(residuos)
qqline(residuos)
* Dado que los puntos están bastante alineados, la normalidad también parece aceptable.