Evaluacion1
Primer evaluación de estado de la materia de probabilidad y estadística para ingenierías
Caso de estudio 1: Acuacualtura
Se tienen 12 semanas de datos de 12 estanques en los cuales a partir de la semana número 2 se empiezan a pesar los camarones en crecimiento, también se cuantifica su nivel de comida.
En términos ideales los 12 estanques tendrían que llegar en la semana número 12 a 12 gramos para poder entonces realizar la ‘cosecha’, pero únicamente 3 de los 12 estanques llegaron a este peso.
¿Por qué esto es un problema? Dado que se tendrá que invertir una semana (o más) para poder llegar al peso ideal, y esto supone una pérdida de dinero.
- Preguntas a responder
- Haga un planteamiento del problema a resolver con estadística y realice una descripción exploratoria de los datos (MMM, MD, CB)
Al cosechar o criar camarones, es primordial tener la cantidad necesaria de la misma población y que esta a su vez cumpla con ciertos requisitos específicos. En este caso, el único establecido es que dentro de un intervalo de tiempo de 12 semanas, las crías de camarones alcancen un peso 12 gramos. Sin embargo, para esta situación, de 12 estanques, solo 3 lograron superar la brecha mencionada, por lo cuál se llevará a cabo una serie de análisis de varios tipos, para encontrar si existe alguna clase de factor determinante entre los datos registrados que provoque que el crecimiento se de esta manera.
Importar datos
library(pacman)
p_load("readr", "DT", "modeest", "dplyr", "tidyverse", "scales", "gridextra", "GGally")## Installing package into 'C:/Users/adolf/OneDrive/Documentos/R/win-library/3.6'
## (as 'lib' is unspecified)## Warning: package 'gridextra' is not available (for R version 3.6.3)## Warning: Perhaps you meant 'gridExtra' ?## Warning: unable to access index for repository http://www.stats.ox.ac.uk/pub/RWin/bin/windows/contrib/3.6:
## no fue posible abrir la URL 'http://www.stats.ox.ac.uk/pub/RWin/bin/windows/contrib/3.6/PACKAGES'## Warning: 'BiocManager' not available. Could not check Bioconductor.
##
## Please use `install.packages('BiocManager')` and then retry.## Warning in p_install(package, character.only = TRUE, ...):## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'gridextra'## Warning in p_load("readr", "DT", "modeest", "dplyr", "tidyverse", "scales", : Failed to install/load:
## gridextra##
## -- Column specification --------------------------------------------------------
## cols(
## Estanque = col_character(),
## EstanqueN = col_double(),
## Superficie = col_double(),
## Dias = col_double(),
## Semana = col_double(),
## PesoAnterior = col_double(),
## PesoActual = col_double(),
## TamanioAlimento = col_double(),
## AlimentoSemana = col_double(),
## AlimentoDiario = col_double()
## )Teniéndose conocimiento de todas las variables, se optará por realizar los siguientes análisis con las variables que representan el peso anterior y el actual (el nuevo al finalizar cada intervalo de una semana) y el alimento.
Medidas de tendencia central
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.130 1.550 4.015 4.253 6.338 10.360## Moda de Peso Anterior:## [1] 0.62 1.32## -------------## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.600 2.163 4.730 5.288 7.955 12.260## Moda de Peso Actual:## [1] 0.62 1.32## -------------## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 402 527 1060 1025 1329 2075## Moda del Alimento Semanal:## [1] 1060## -------------## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 57.43 75.29 151.43 146.37 189.82 296.43## Moda del Alimento Diario:## [1] 151.4286## -------------Las separación que existe entre cada medida es, para la variable de peso y peso actual, aparentemente mayor a partir de la mediana, pero se puede observar por el número tan bajo que había en un principio, que esta incrementa muy rápidamente para luego hacerlo de una manera más pausada. En lo que respecta al alimento, posee un desarrollo similar, pues desde el valor mínimo hasta la mediana se incrementa aproximadamente 3 veces, pero desde la mediana hasta el valor máximo únicamente es casi el doble del alimento.
Varianza y desviación estándar
## Desviación estándar para cada variable mencionada## [1] 3.035681## [1] 3.389719## [1] 497.6869## [1] 71.09813##
## Varianza para cada variable mencionada## [1] 9.215361## [1] 11.49019## [1] 247692.3## [1] 5054.945Como se observa en los datos, cada uno de ellos presenta tanto una desviación como una varianza, pero son aparentemente las que pertenecen a las cantidades de alimento las que presentan números tan exageradamente altos, debido a lo mucho que tienden a alejarse de la media. Con esta información se puede decir que para ninguna de estas variables, la media es, mediana o moda son verdaderamente representativas. Por ello se procede con otros tipos de análisis más complejos.
Gráficas de caja y bigote
#Gráficas de cajas y bigote para cada variable
boxplot(CAMARONES$PesoAnterior, ylab = "Peso anterior por semana")
Lo que se confirma con estas gráficas, es que al estar tan separadas cada una entre sí, no son del todo representativas. Sin embargo, algo a tomar en cuenta es que ninguna de ellas tampoco tiene valores atípicos.
- ¿Que tienen de diferentes los estanques que SI llegaron a 12 gramos en la semana 12 con respecto a los que no?
Todos los estanques tuvieron exactamente la misma cantidad de comida en cada semana, por la excepción de los estanques 11 y 12 que tuvieron aproximadamente un 20% más alimento en la primer semana al tener más superficie que los anteriores. Sin embargo, solamente este último alcanzó la brecha de los 12 gramos, quedando el estanque 11 relativamente lejos de esa cifra, con 11.26 gramos.
3.- ¿Con qué variables se relaciona el aumento de peso de los camarones? (regresión lineal, residuos, confianza)
Diagrama de dispersión
PAC <- as.numeric(CAMARONES$PesoActual)
PAN <- as.numeric(CAMARONES$PesoAnterior)
ALS <- as.numeric(CAMARONES$AlimentoSemana)
ALD <- as.numeric(CAMARONES$AlimentoDiario)
correla <- data.frame(PAC, PAN, ALS, ALD)
pairs(correla)
## Prueba de correlación de Pearson
## PAC PAN ALS ALD
## PAC 1.0000000 0.9915841 0.9514703 0.9514703
## PAN 0.9915841 1.0000000 0.9510608 0.9510608
## ALS 0.9514703 0.9510608 1.0000000 1.0000000
## ALD 0.9514703 0.9510608 1.0000000 1.0000000Basándose en los resultados obtenidos, se probarán 2 modelos, uno para observar la relación que existe entre el peso actual y el peso anterior y otra en relación al peso actual y a la cantidad de alimento que se da a los camarones por semana.
Regresión lineal simple
corrP <- data.frame(PAN, PAC)
corrA <- data.frame(ALS, PAC)
regresion1 <- lm (PAC ~ PAN, data = corrP )
summary(regresion1)##
## Call:
## lm(formula = PAC ~ PAN, data = corrP)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.26198 -0.26332 -0.00933 0.26919 1.23523
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.57889 0.06617 8.749 9.66e-15 ***
## PAN 1.10723 0.01268 87.328 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4405 on 130 degrees of freedom
## Multiple R-squared: 0.9832, Adjusted R-squared: 0.9831
## F-statistic: 7626 on 1 and 130 DF, p-value: < 2.2e-16##
## Call:
## lm(formula = ALS ~ PAN, data = corrA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -563.23 -93.08 15.52 82.99 375.54
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 361.436 23.187 15.59 <2e-16 ***
## PAN 155.922 4.443 35.09 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 154.4 on 130 degrees of freedom
## Multiple R-squared: 0.9045, Adjusted R-squared: 0.9038
## F-statistic: 1231 on 1 and 130 DF, p-value: < 2.2e-16Teniendo ambas regresiones, valores para p tan bajos de 2 x 10^-16, quiere decir que tiene sentido seguir con la pruebas de normalidad.
Recta de minimos cuadrados
Ecuación de la recta
\[ y = 0.57889 + 1.10723 x \] para la relación entre el Peso actual y el Peso anterior
\[ y = 361.436 + 155.922 x \] para la relación entre el Peso actual y el Alimento semanal
Ajuste de la recta
# Recta para la primer relación
plot(CAMARONES$PesoAnterior, CAMARONES$PesoActual, xlab = "Peso anterior", ylab="Peso actual")
abline(regresion1)
# Recta para la segunda relación
plot(CAMARONES$AlimentoSemana, CAMARONES$PesoActual, xlab = "Alimento semanal", ylab="Peso actual")
abline(regresion2)
Se observa claramente que la mayoria de los valores se mantiene de forma más apegada al modelo de regresión que implica el peso anterior y el peso actual que aquel que involucra el peso actual y el alimento semanal. Esto quiere probablemente decir que existe una mayor relación en el peso inicial de las crías que en la cantidad de alimento, pero también que es necesario notar que a medida que el peso se incrementa, la manera en que este lo hace también cambia, estando cada vez más dispersos todos los valores entre sí. Esto es gracias a que como en la mayoría de seres vivos, el desarrollo nunca es lineal, sino que aumenta muy rápidemente en los primeros intervalos de tiempo para después estabilizar cada vez más ese crecimiento.
Predicción
nuevas.PAN<- data.frame(PAN=seq(0.2,12))
nuevas.PAC <- data.frame(PAC=seq(0.2,13))
predict(regresion1,nuevas.PAC)## Warning: 'newdata' had 13 rows but variables found have 132 rows## 1 2 3 4 5 6 7
## 0.7394371 0.7482950 0.7438661 0.7494022 0.7626889 0.8169431 0.8224792
## 8 9 10 11 12 13 14
## 0.7272576 0.7560456 0.7460805 0.7350082 0.7228287 1.4314546 1.4425269
## 15 16 17 18 19 20 21
## 1.3428764 1.3760932 1.2542982 1.2653704 1.2875150 1.2653704 1.3539487
## 22 23 24 25 26 27 28
## 1.2653704 1.3650209 1.2432259 2.0404300 2.0404300 2.0957914 2.1843696
## 29 30 31 32 33 34 35
## 2.2286588 2.1622251 2.0404300 2.1068637 2.5165380 2.5054658 2.3172370
## 36 37 38 39 40 41 42
## 2.1179360 2.8265619 2.7490559 2.4943935 3.2915976 3.1919471 2.6051163
## 43 44 45 46 47 48 49
## 2.5386826 2.8819233 2.9483569 2.9815738 2.8929955 2.7158391 4.0445126
## 50 51 52 53 54 55 56
## 3.9116453 3.7455611 4.3213196 3.9670067 3.8009225 3.7677056 4.5427652
## 57 58 59 60 61 62 63
## 4.5870543 4.2770305 4.1109463 3.8673562 5.2846080 4.4763315 5.0631624
## 64 65 66 67 68 69 70
## 5.1074515 4.8970782 4.3656087 4.9081505 5.2292466 6.0596675 5.5614150
## 71 72 73 74 75 76 77
## 4.8417168 5.1960297 5.3621139 5.4728367 6.1371735 5.7939328 5.3288971
## 78 79 80 81 82 83 84
## 5.0410178 5.0078010 6.1593181 6.3475468 5.8382219 5.7164269 6.3032577
## 85 86 87 88 89 90 91
## 7.4547748 7.5654976 7.0118836 6.4804142 6.7018598 6.4804142 6.4361251
## 92 93 94 95 96 97 98
## 6.8347271 8.2519789 7.0340282 6.9122331 7.0672450 9.0381108 8.2741235
## 99 100 101 102 103 104 105
## 7.4547748 7.8090877 7.3108351 7.7869432 7.6872927 8.4291354 8.3184126
## 106 107 108 109 110 111 112
## 7.9419551 7.2222569 7.4990639 11.0532657 9.4588574 10.2007001 9.7910258
## 113 114 115 116 117 118 119
## 9.8796040 10.0013991 9.3038455 9.3702792 10.3557121 9.4477851 9.4367128
## 120 121 122 123 124 125 126
## 9.2706287 12.0497709 10.7986033 12.0497709 10.9536152 11.3411450 11.8615421
## 127 128 129 130 131 132
## 11.6622411 11.7176025 11.7951084 10.9979043 10.5550131 11.7840361Análisis de residuos
Diagnóstico del modelo
residuos <- rstandard(regresion1)
valores.ajustados <- fitted(regresion1)
plot(valores.ajustados,residuos)
Dado lo anterior, de esa prueba en adelante únicamente se trabaja con la relación entre peso anterior y actual. Que gracias a lo que se observa en la imagen, permite notar que efectivamente, el posible patrón que puede existir es que los residuos se encuentran muy cercanos entre sí en un comienzo, dispersándose mucho en la semana 6, para estar menos alejados cerca de la semana 6.
Pruebas de normalidad
La hipótesis de normalidad se suele comprobar mediante un QQ plot de los residuos. El siguiente código sirve para obtenerlo:
### Shapiro-wilk
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.99291, p-value = 0.7514Con la información de la prueba de Shapiro Wilks, es obvio como al estar W tan cerca de 1 y siendo el valor de p mucho mayor que 0.05, no se rechaza la hipótesis nula de que la distribución de los datos es normal.
Intervalos de confianza
## 2.5 % 97.5 %
## (Intercept) 0.4479851 0.7097931
## PAN 1.0821441 1.1323118ggplot(data = CAMARONES, mapping = aes(x = PesoAnterior, y = PesoActual)) +
geom_point(color = "firebrick", size = 2) +
geom_smooth(method = "lm", se = TRUE, color = "black") +
labs(title = "Peso Actual ~ Peso Anterior", x = "Peso Anterior", y = "Peso Actual") +
theme_bw() + theme(plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Según los resultado indicados por la gráfica, los intervalos de confianza del modelo son muy pequeños, pero a pesar de eso, la mayoría de valores no se encuentran dentro de ellos. Esto puede deberse a variar razones, pero una de ellas podría ser el que no se trate de un modelo lineal, sino de uno logarítmico, correspondiente al que podría tener un ser humano.
4.- ¿Los camarones que iniciaron con mayor peso ( semana 2) son también los que terminaron en mayor peso? ¿Cómo varía el crecimiento?
No, defininitivamente no es así, puesto que en las primeras semanas los que comenzaron con poco peso se mantienen de esa manera, hasta llegar a un punto en el cual los valores comienzan a cambiar la forma en que aumentan, su peso, siendo los que en un principio se mostraban menos robustos, los que alcanzan a superar la brecha de peso ideal a las 12 semanas que corresponde a los 12 gramos. Lo cierto es que existen muchísimos otros factores a tomar en cuenta que influyen en el crecimiento de la población, como lo son la salinidad del agua, la existencia de sustacias tóxicas para esos animales, el número de camarones que hay por estanque, el clima, el sexo mayoritario de la población, entre otros. Gracias a esto, muy posiblemente no se pueda decir de manera exacta cuál es el valor que influye de mayor manera en el desarrollo y el aumento del peso de la población de camarones.
5.- Realice un análisis de regresión logística para determinar que hace que los camarones lleguen a 12 gramos.
##
## -- Column specification --------------------------------------------------------
## cols(
## PesoAnterior = col_double(),
## PesoActual = col_double()
## )ggplot(data = CAMARONES1, aes(x = PesoAnterior, y = PesoActual)) +
geom_point(aes(color = as.factor(5)), shape = 1) +
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
color = "gray20",
se = FALSE) +
theme_bw() +
theme(legend.position = "none")## `geom_smooth()` using formula 'y ~ x'## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred