##CASO PRÁCTICO LAB 2 1º Voy a Impotar un cojunto de datos seleccionado de https://lib.stat.cmu.edu/datasets/IQ_Brain_Size. He copiado y ejecutado el código mediante los comandos: datos<- read.table(text= “pego lo copiado”, header=TRUE). Ahora voy a cambiar las variables numéricas necesarias a categóricas.
datos <- read.table(text = "
CCMIDSA FIQ HC ORDER PAIR SEX TOTSA TOTVOL WEIGHT
6.08 96 54.7 1 1 2 1913.88 1005 57.607
5.73 89 54.2 2 1 2 1684.89 963 58.968
6.22 87 53 1 2 2 1902.36 1035 64.184
5.8 87 52.9 2 2 2 1860.24 1027 58.514
7.99 101 57.8 1 3 2 2264.25 1281 63.958
8.42 103 56.9 2 3 2 2216.4 1272 61.69
7.44 103 56.6 1 4 2 1866.99 1051 133.358
6.84 96 55.3 2 4 2 1850.64 1079 107.503
6.48 127 53.1 1 5 2 1743.04 1034 62.143
6.43 126 54.8 2 5 2 1709.3 1070 83.009
7.99 101 57.2 2 6 1 1689.6 1173 61.236
8.76 96 57.2 1 6 1 1806.31 1079 61.236
6.32 93 57.2 2 7 1 2136.37 1067 83.916
6.32 88 57.2 1 7 1 2018.92 1104 79.38
7.6 94 55.8 2 8 1 1966.81 1347 97.524
7.62 85 57.2 1 8 1 2154.67 1439 99.792
6.03 97 57.2 1 9 1 1767.56 1029 81.648
6.59 114 56.5 2 9 1 1827.92 1100 88.452
7.52 113 59.2 2 10 1 1773.83 1204 79.38
7.67 124 58.5 1 10 1 1971.63 1160 72.576
", header = TRUE)
datos$SEX<- factor(datos$SEX, levels = c(1,2), labels = c("Male", "Female"))
head(datos)## CCMIDSA FIQ HC ORDER PAIR SEX TOTSA TOTVOL WEIGHT
## 1 6.08 96 54.7 1 1 Female 1913.88 1005 57.607
## 2 5.73 89 54.2 2 1 Female 1684.89 963 58.968
## 3 6.22 87 53.0 1 2 Female 1902.36 1035 64.184
## 4 5.80 87 52.9 2 2 Female 1860.24 1027 58.514
## 5 7.99 101 57.8 1 3 Female 2264.25 1281 63.958
## 6 8.42 103 56.9 2 3 Female 2216.40 1272 61.690Este conjunto de datos trata distintas medidas sobre la capacidad cerebral y sus las medidas del encéfalo, tomadas en gemelos monocigóticos. Con esto se quiere comprobar si los gemelos comparten características neuroanatómicas y si estas características afectan al tamaño del cerebro. Las variables son: área de superficie del cuerpo calloso (cm^2), cociente intelectual global, circunferencia de la cabeza (cm), orden de nacimiento, identificador, sexo, área total de superficie cerebral(cm^2), volumen cerebral total (cm^3), peso corporal (kg).
Resumen estadístico completo:
summary(datos)## CCMIDSA FIQ HC ORDER PAIR
## Min. :5.730 Min. : 85.0 Min. :52.90 Min. :1.0 Min. : 1.0
## 1st Qu.:6.295 1st Qu.: 92.0 1st Qu.:54.77 1st Qu.:1.0 1st Qu.: 3.0
## Median :6.715 Median : 96.5 Median :56.75 Median :1.5 Median : 5.5
## Mean :6.992 Mean :101.0 Mean :56.12 Mean :1.5 Mean : 5.5
## 3rd Qu.:7.633 3rd Qu.:105.5 3rd Qu.:57.20 3rd Qu.:2.0 3rd Qu.: 8.0
## Max. :8.760 Max. :127.0 Max. :59.20 Max. :2.0 Max. :10.0
## SEX TOTSA TOTVOL WEIGHT
## Male :10 Min. :1685 Min. : 963 Min. : 57.61
## Female:10 1st Qu.:1772 1st Qu.:1035 1st Qu.: 61.58
## Median :1864 Median :1079 Median : 75.98
## Mean :1906 Mean :1126 Mean : 77.80
## 3rd Qu.:1983 3rd Qu.:1181 3rd Qu.: 85.05
## Max. :2264 Max. :1439 Max. :133.36datosn<- datos[sapply(datos, is.numeric)]
resumen.estadistico<- data.frame(Media= sapply(datosn, mean), Mediana= sapply(datosn, median), Desviación_tipica= sapply(datosn, sd),Minimo= sapply(datosn, min), Q1=sapply(datosn, quantile, probs=0.25), Q3=sapply(datosn, quantile, probs=0.75), maximo=sapply(datosn, max))
resumen.estadistico## Media Mediana Desviación_tipica Minimo Q1 Q3
## CCMIDSA 6.9925 6.715 0.9145829 5.730 6.2950 7.6325
## FIQ 101.0000 96.500 13.2108408 85.000 92.0000 105.5000
## HC 56.1250 56.750 1.8266665 52.900 54.7750 57.2000
## ORDER 1.5000 1.500 0.5129892 1.000 1.0000 2.0000
## PAIR 5.5000 5.500 2.9468985 1.000 3.0000 8.0000
## TOTSA 1906.2805 1863.615 174.8297268 1684.890 1772.2625 1983.4525
## TOTVOL 1125.9500 1079.000 124.9389219 963.000 1034.7500 1180.7500
## WEIGHT 77.8037 75.978 20.0413933 57.607 61.5765 85.0500
## maximo
## CCMIDSA 8.760
## FIQ 127.000
## HC 59.200
## ORDER 2.000
## PAIR 10.000
## TOTSA 2264.250
## TOTVOL 1439.000
## WEIGHT 133.358Primero hacemos la tabla sólo de las variables numéricas ya que los datos estadísticos se pueden obtener de estas. Primero hemos obtenido la media de cada variable, es decir el valor promedio. La Mediana es el valor central de las observaciones. La desviación típica indica la dispersión de los datos alrededor de la media. El mínimo y el máximo indican el valor más pequeño y el más alto. Por último, los cuantiles 1 y 3 delimitan el 50% central de los datos.
Ahora vamos a realizar los gráficos.
jpeg("Gráficos_Caso_Práctico_Lab2.jpg")
plot(datos$TOTVOL, datos$TOTSA)
dev.off()## png
## 2jpeg("Gráficos_Caso_Práctico_Lab2.1.jpg")
boxplot(datos$FIQ~datos$SEX)
dev.off()## png
## 2jpeg("Gráficos_Caso_Práctico_Lab2.2.jpg")
hist(datos$FIQ)
dev.off()## png
## 2jpeg("Gráficos_Caso_Práctico_Lab2.3.jpg")
boxplot(datos$WEIGHT)
dev.off()## png
## 2jpeg("Gráficos_Caso_Práctico_Lab2.4.jpg")
pie(table(datos$SEX))
dev.off()## png
## 2knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.jpg")## Warning in
## knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.jpg"):
## It is highly recommended to use relative paths for images. You had absolute
## paths: "C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.jpg"
knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.1.jpg")## Warning in
## knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.1.jpg"):
## It is highly recommended to use relative paths for images. You had absolute
## paths: "C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.1.jpg"
knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.2.jpg")## Warning in
## knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.2.jpg"):
## It is highly recommended to use relative paths for images. You had absolute
## paths: "C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.2.jpg"
knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.3.jpg")## Warning in
## knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.3.jpg"):
## It is highly recommended to use relative paths for images. You had absolute
## paths: "C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.3.jpg"
knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.4.jpg")## Warning in
## knitr::include_graphics("C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.4.jpg"):
## It is highly recommended to use relative paths for images. You had absolute
## paths: "C:/Users/amayu/OneDrive/Documentos/Gráficos_Caso_Práctico_Lab2.4.jpg"
El gráfico uno relaciona el volumen cerebral frente a la superficie
cerebral, para ver si puede haber una asociación. En este caso no la
hay. En el gráfico dos vemos un diagrama de cajas que relaciona el
cociente intelectual según el sexo. La mediana de la mujer se encuentra
un poco superior, pero los hombres tienen más variabilidad. De todas
maneras al haber en estos datos únicamente 20 observaciones no son
significativos. En el gráfico 3 podemos observar un histograma con los
datos de IQ, para ver cuales son las frecuencias de estos. En el gráfico
4 vemos un diagrama de cajas según el peso de los gemelos monocigóticos.
Por último, en el diagrama 5 vemos un gráfico de tartas de los sexos,
que como podemos observar son 50/50.
Ahora realizamos los gráficos con ggplot2:
library(ggplot2)
jpeg("Gráficas_ggplot_1.jpg")
ggplot(datos, aes(x= HC, y=FIQ))+geom_point()
dev.off()## png
## 2jpeg("Gráficas_ggplot_2jpg")
ggplot(datos, aes(x= SEX))+geom_bar(fill = "pink")
dev.off()## png
## 2knitr::include_graphics("D:/RSTUDIO/Gráficas_ggplot_1.jpg")
knitr::include_graphics("D:/RSTUDIO/Gráficas_ggplot_2jpg") La primera imagen
muestra un diagrama de dispersión donde no podemos observar una relación
entre la variable de IQ y de la circumferencia de la cabeza. En la
segunda imagen vemos una gráfica de tablas según el sexo, donde volvemos
a ver la proporción 50/50.
Ahora vamos a realizar la regresión lineal con estos datos para ver si hay relación en alguna de las variables.
summary(datos)## CCMIDSA FIQ HC ORDER PAIR
## Min. :5.730 Min. : 85.0 Min. :52.90 Min. :1.0 Min. : 1.0
## 1st Qu.:6.295 1st Qu.: 92.0 1st Qu.:54.77 1st Qu.:1.0 1st Qu.: 3.0
## Median :6.715 Median : 96.5 Median :56.75 Median :1.5 Median : 5.5
## Mean :6.992 Mean :101.0 Mean :56.12 Mean :1.5 Mean : 5.5
## 3rd Qu.:7.633 3rd Qu.:105.5 3rd Qu.:57.20 3rd Qu.:2.0 3rd Qu.: 8.0
## Max. :8.760 Max. :127.0 Max. :59.20 Max. :2.0 Max. :10.0
## SEX TOTSA TOTVOL WEIGHT
## Male :10 Min. :1685 Min. : 963 Min. : 57.61
## Female:10 1st Qu.:1772 1st Qu.:1035 1st Qu.: 61.58
## Median :1864 Median :1079 Median : 75.98
## Mean :1906 Mean :1126 Mean : 77.80
## 3rd Qu.:1983 3rd Qu.:1181 3rd Qu.: 85.05
## Max. :2264 Max. :1439 Max. :133.36pairs(datos)
Creo que se puede observar una pequeña correlación entre la variable
CCMIDSA y TOTVOL, vamos a comprobarlo.
cor.test(datos$CCMIDSA, datos$TOTVOL)##
## Pearson's product-moment correlation
##
## data: datos$CCMIDSA and datos$TOTVOL
## t = 3.7452, df = 18, p-value = 0.001482
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.3100757 0.8541635
## sample estimates:
## cor
## 0.6617891Como podemos observar p-valor<0,05 por lo que las variables son dependientes. Por lo que, ahora hacemos el modelo de regresión para obtener la recta y=mx+n.
modelregcp1<- lm(datos$TOTVOL~datos$CCMIDSA)
summary(modelregcp1)##
## Call:
## lm(formula = datos$TOTVOL ~ datos$CCMIDSA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -206.742 -39.624 -7.516 20.338 256.321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 493.79 170.16 2.902 0.00951 **
## datos$CCMIDSA 90.41 24.14 3.745 0.00148 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 96.23 on 18 degrees of freedom
## Multiple R-squared: 0.438, Adjusted R-squared: 0.4067
## F-statistic: 14.03 on 1 and 18 DF, p-value: 0.001482Obtenemos y= 493,79x + 90,41. El r^2= 0,438 por lo que el modelo explica el 43,8% de la variabilidad de volumen cerebral total a partir del área del cuerpo calloso, lo cual no es un porcentaje muy elevado.. Por ello la desviación típica es elevada (96,23), al igual que los errores B0(170,16) y B1(24,14).
plot(datos$CCMIDSA, datos$TOTVOL)
abline(modelregcp1, col="brown")
Hacemos el gráfico de nube de puntos con la recta de regresión. Como
podemos ver hay una asociación entre los puntos y la recta, aunque
también econtramos una gran dispersión.
Mediante los datos obtenidos vemos que hay una evidencia significativa de que son variables dependientes pero la capacidad predictiva de la recta es muy limitada. Eso se debe a que la dispersión de los datos es muy grande.