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úmer 2 se empiezan la 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 llegaros 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
library(pacman)
p_load("readr","DT","prettydoc","fdth","modeest","ggplot2")
CAMARONES <- read_csv("CAMARONES.csv",
col_types = cols(EstanqueN = col_number(),
Superficie = col_number(), Dias = col_number(),
Semana = col_number(), PesoAnterior = col_number(),
PesoActual = col_number(), TamanioAlimento = col_number(),
AlimentoSemana = col_number(), AlimentoDiario = col_number()))
View(CAMARONES)
Camarones
1. Haga un planteamiento del problema a resolver con estadística y realice una descripción exploratoria de los datos (MMM, MD, CB)
MMM
Peso anterior
## [1] 4.253091## [1] 4.015## [1] 0.62 1.32El peso promedio anterior de los camarones fue de 4.253091, mientras que la mediana fue de 4.015l, siendo resultados muy similares entre sí. Sin embargo, la moda se encuentra bastante alejada con los datos de 0.62 y 1.32, que son los pesos que más se repitieron en el lapso de tiempo determinado.
Peso Actual
## [1] 5.28803## [1] 4.73## [1] 0.62 1.32A diferencia con el peso anterior de los camarones, hubo un aumento en el peso promedio actual con un valor de 5.28803 y en la mediana de 4.73, obteniendo datos un poco similares. Sin embargo, la moda fue la misma que en peso anterior con valores de 0.62 y 1.32, los cuales se repitieron más en el lapso de tiempo determinado.
Alimento Diario
## [1] 146.3696## [1] 151.4286## [1] 151.4286El valor promedio del alimento diario de los camarones fue de 146.3696, con una mediana y moda iguales de 151.4286 que fue el valor más repetido. Asimismo, los tres valores son muy parecidos y eso puede indicar una distribución casi unimodal.
Alimento Semanal
## [1] 1024.587## [1] 1060## [1] 1060El valor promedio del alimento semanal de los camarones fue de 1024.587, con otra vez, una mediana y moda iguales de 1060, siendo el valor más repetido entre los datos. Además, los tres valores se encuentran muy similares, lo que indica una distriución casi unimodal.
MD
MD Peso anterior
Varianza y DE peso anterior
## [1] 9.215361## [1] 3.035681El valor de la varianza es de 9.215361, este es un valor no tan pequeño, el cual puede expresar una gran dispersión entre los datos del peso anterior de camarones. Asimismo, la desviación que se tiene con respecto a la media es de 3.035681, lo que presenta una cierta desviación algo grande.
Varianza y DE peso actual
## [1] 11.49019## [1] 3.389719El valor de la varianza es de 11.49019, este es un valor un poco grande, el cual puede expresar una gran dispersión entre los datos del peso actual de camarones. Asimismo, la desviación que se tiene con respecto a la media es de 3.389719, lo que presenta una cierta desviación algo grande.
MD Alimento Diario
Varianza y DE alimento diario
## [1] 5054.945## [1] 71.09813El valor de la varianza es de 5054.945, este es un valor grande, el cual puede expresar una gran dispersión entre los datos de alimento diario de los camarones. Asimismo, la desviación que se tiene con respecto a la media es de 71.09813, lo que presenta una gran desviación.
MD Alimento Semanal
Varianza y DE alimento semanal
## [1] 247692.3## [1] 497.6869La varianza es de 247692.3, el cual es un valor muy grande, indicando que los datos se encuentran dispersos y además su desviación estándar fue de 497.6869, lo que indica un valor muy grande de desviación con respecto a la media.
Gráfico de caja y bigote
CB Peso anterior
En el gráfico se puede observar en que valor se encuentra la mediana que se obtuvo anteriormente de 4.015, también se observan los cuantiles con una distribución simétrica y además, que no existen valores atípicos.
CB Peso actual
Se observa la mediana como anteriormente se calculó, de 4.73 casi 5 como se puede observar, los cuantiles y tampoco existen valores atípicos.
CB Alimento diario
En este caso la mediana esta representada por el valor de 151.4286, se observa que el primer cuantil se encuentra alejado de la media, representando una distribución asimétrica y no se encuentran valores atípicos.
2. ¿Que tienen de diferentes los estanques que SI llegaron a 12 gramos en la semana 12 con respecto a los que no?
Haciendo un análisis en la tabla de los datos, se puede observar que en la semana 12, los estanques que si llegaron al peso esperado, fueron también los de mayor peso anterior y mayor alimento. Por otra parte, se revisaron los datos desde la semana 2 en donde se presentó algo muy curioso, los camarones que tenían un peso anterior más bajo, fueron los que comenzaron a pesar más.
semana2 <- read_csv("semana2.csv",
col_types = cols(PesoAnterior = col_number(),
PesoActual = col_number()))
peso.anterior2 <- semana2$PesoAnterior
peso.actual2 <- semana2$PesoActual
semana2 <- data.frame(peso.anterior2, peso.actual2)ggplot(data=semana2) +
geom_point(mapping=aes(x=peso.actual2,y=peso.anterior2)) +
ggtitle("Gráfica del peso de camarones en la 2da semana")
3. ¿Con qué variables se relaciona el aumento de peso de los camarones? (regresión lineal, residuos, confianza)
Correlación
peso.anterior <- CAMARONES$PesoAnterior
peso.actual <- CAMARONES$PesoActual
alimento.diario <- CAMARONES$AlimentoDiario
alimento.semanal <- CAMARONES$AlimentoSemana
datos <- data.frame(peso.anterior, peso.actual, alimento.diario, alimento.semanal)
cor(datos)## peso.anterior peso.actual alimento.diario alimento.semanal
## peso.anterior 1.0000000 0.9915841 0.9510608 0.9510608
## peso.actual 0.9915841 1.0000000 0.9514703 0.9514703
## alimento.diario 0.9510608 0.9514703 1.0000000 1.0000000
## alimento.semanal 0.9510608 0.9514703 1.0000000 1.0000000Con el coeficiente de correlación se puede decir que el peso actual de los camarones se encuentra relacionado con el peso anterior, debido a que su valor fue de 0.9915841. Sin embargo, el alimento también tiene que ver en el crecimiento debido a que su valor fue de 0.9514703.
Regresión lineal simple
A continuación se hará la regresión simple con los datos del peso anterior y el peso actual
##
## Call:
## lm(formula = peso.anterior ~ peso.actual, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.06410 -0.26143 -0.01954 0.25843 1.16553
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.44278 0.06380 -6.94 1.67e-10 ***
## peso.actual 0.88802 0.01017 87.33 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3945 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-16A continuación se hará la regresión simple con los datos del alimento semanal y el peso actual
##
## Call:
## lm(formula = alimento.semanal ~ peso.actual, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -526.00 -89.86 9.59 90.77 380.46
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 285.864 24.864 11.50 <2e-16 ***
## peso.actual 139.697 3.963 35.25 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 153.7 on 130 degrees of freedom
## Multiple R-squared: 0.9053, Adjusted R-squared: 0.9046
## F-statistic: 1243 on 1 and 130 DF, p-value: < 2.2e-16Recta de minimos cuadrados
Ecuación de la recta
Con los datos que proporcionó el sumario, se puede obtener la ecuación de la recta con el peso anterior y el actual \[ y = -0.44278 + 0.88802 x \]
Con los datos que proporcionó el sumario, se puede obtener la ecuación de la recta con el alimento semanal y el actual \[ y = 285.864 + 139.697 x \]
Ajuste de la recta
Ajuste con el peso anterior y el peso actual
plot(datos$peso.actual, datos$peso.anterior, xlab = "Peso Actual", ylab="Peso Anterior")
abline(regresion)
Se muestran los datos muy cerca de la recta, además no cuentan con mucha dispersión.
Ajuste con el alimento semanal y el peso actual
plot(datos$peso.actual, datos$alimento.semanal, xlab = "Peso Actual", ylab="Alimento Semanal")
abline(regresion2)
En este caso los datos se encuentran más dispersos entre sí y un poco alejados de la recta. Además se pueden ir comparando los modelos del peso anterior - peso actual y alimento semanal - peso actual.
Predicción
Se pueden predecir valores del peso anterior y el actual con un rango más amplio al original
nuevo.peso.anterior <- data.frame(peso.anterior=seq(0.1,11))
nuevo.peso.actual <- data.frame(peso.actual=seq(0.5,13))
predict(regresion,nuevo.peso.actual)## 1 2 3 4 5 6
## 0.001230749 0.889249389 1.777268030 2.665286670 3.553305311 4.441323951
## 7 8 9 10 11 12
## 5.329342592 6.217361232 7.105379873 7.993398513 8.881417154 9.769435794
## 13
## 10.657454435Se pueden predecir valores del alimento semanal y el peso actual con un rango más amplio al original
nuevo.alimento.semanal <- data.frame(alimento.semanal=seq(300,2200))
nuevo.peso.actual <- data.frame(peso.actual=seq(0.5,13))
predict(regresion2,nuevo.peso.actual)## 1 2 3 4 5 6 7 8
## 355.7128 495.4101 635.1073 774.8045 914.5018 1054.1990 1193.8962 1333.5935
## 9 10 11 12 13
## 1473.2907 1612.9879 1752.6852 1892.3824 2032.0796Intervalos de confianza
Para peso anterior y actual
## 2.5 % 97.5 %
## (Intercept) -0.5690027 -0.3165544
## peso.actual 0.8679009 0.9081364nuevo.peso.actual <- data.frame(peso.actual=seq(0.5,13))
#Recta ajustada al gráfico de dispersión
plot(datos$peso.actual, datos$peso.anterior, xlab = "Peso Actual", ylab="Peso Anterior")
abline(regresion)
#Intervalos de confianza para la respuesta media
# ic es una matriz con tres columnas: la primera es la prediccion, las otras dos son los extremos del intervalo
ic <- predict(regresion, nuevo.peso.actual, interval = 'confidence')
lines(nuevo.peso.actual$peso.actual, ic[, 2], lty = 2)
lines(nuevo.peso.actual$peso.actual, ic[, 3], lty = 2)
# Intervalos de predicción
ic <- predict(regresion, nuevo.peso.actual, interval = 'prediction')
lines(nuevo.peso.actual$peso.actual, ic[, 2], lty = 2, col = "red")
lines(nuevo.peso.actual$peso.actual, ic[, 3], lty = 2, col = "red")
Se observa un buen modelo debido a que los valores de confianza están demasiado cercanos a la recta de mínimos cuadrados. Por otra parte, los valores predecidos se encuentran un poco más alejados.
Para alimento semanal y peso actual
## 2.5 % 97.5 %
## (Intercept) 236.6740 335.0544
## peso.actual 131.8572 147.5372nuevo.peso.actual2 <- data.frame(peso.actual=seq(0.5,13))
#Recta ajustada al gráfico de dispersión
plot(datos$peso.actual, datos$alimento.semanal, xlab = "Peso Actual", ylab="Alimento Semanal")
abline(regresion2)
#Intervalos de confianza para la respuesta media
# ic es una matriz con tres columnas: la primera es la prediccion, las otras dos son los extremos del intervalo
ic <- predict(regresion, nuevo.peso.actual2, interval = 'confidence')
lines(nuevo.peso.actual2$peso.actual, ic[, 2], lty = 2)
lines(nuevo.peso.actual2$peso.actual, ic[, 3], lty = 2)
# Intervalos de predicción
ic <- predict(regresion, nuevo.peso.actual2, interval = 'prediction')
lines(nuevo.peso.actual2$peso.actual, ic[, 2], lty = 2, col = "red")
lines(nuevo.peso.actual2$peso.actual, ic[, 3], lty = 2, col = "red")
A diferencia del modelo anterior, los intervalos de confianza en este modelo si se encuentran cercanos a la recta. Sin embargo, los intervalos de predicción o datos predecidos están bastante alejados, puesto que existen datos más dispersos en este modelo.
Análisis de residuales
Análisis ANOVA (Análisis de varianza)
Para peso anterior y peso actual
## Analysis of Variance Table
##
## Response: peso.anterior
## Df Sum Sq Mean Sq F value Pr(>F)
## peso.actual 1 1186.98 1186.98 7626.1 < 2.2e-16 ***
## Residuals 130 20.23 0.16
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Para alimento semanal y peso actual
## Analysis of Variance Table
##
## Response: alimento.semanal
## Df Sum Sq Mean Sq F value Pr(>F)
## peso.actual 1 29374753 29374753 1242.7 < 2.2e-16 ***
## Residuals 130 3072936 23638
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Diagnóstico del modelo
Para peso anterior y peso actual
residuos <- rstandard(regresion)
valores.ajustados <- fitted(regresion)
plot(valores.ajustados,residuos)
Se observa que los datos están un poco dispersos. Sin embargo no se ve una correlación notoria.
Para alimento semanal y peso actual
residuos2 <- rstandard(regresion2)
valores.ajustados2 <- fitted(regresion2)
plot(valores.ajustados2,residuos2)
Se observa que los datos están un poco dispersos. Sin embargo no se ve una correlación notoria.
Pruebas de normalidad
No se observa ningún patrón especial, por lo que tanto la homocedasticidad como la linealidad resultan hipótesis razonables.
La hipótesis de normalidad se suele comprobar mediante un QQ plot de los residuos. El siguiente código sirve para obtenerlo: Para peso anterior y peso actual
Los datos presentan una linealidad, por ello se puede expresar como residuos normales
Para alimento semanal y peso actual
Los residuos presentan cierta linealidad en el medio pero en los extremos se dispersan mucho.
Shapiro-wilk
Para peso anterior y actual
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.99069, p-value = 0.526los residuos son normales
Para alimento semanal y peso actual
##
## Shapiro-Wilk normality test
##
## data: residuos2
## W = 0.98704, p-value = 0.2487Los residuos también se encuentran normales.
Por lo tanto, la hipótesis nula de que las variables peso anterior y alimento semanal se encuentran relacionadas con el peso actual, se aceptan debido a sus residuos normales y la regresión lineal.
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?
ggplot(data = semana2, mapping = aes(x = peso.actual2, y = peso.anterior2)) +
geom_point(color = "firebrick", size = 2) +
geom_smooth(method = "lm", se = TRUE, color = "black") +
labs(title = "Crecimiento de camarones en la semana 2", x = "Peso Actual", y = "Peso Anterior") +
theme_bw() + theme(plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Con esta gráfica se puede decir que los camarones que pesaban más en la semana 2, tuvieron un MENOR peso en la actualidad, mientras que los que tuvieron un menor peso con anterioridad, tuvieron un MAYOR peso actual y fueron los camarones que SI llegaron a los 12. Por lo tanto, su crecimiento en la semana 2 fue inversamente proporcional.
Sin embargo, a medida que aumentaba el alimento, comenzaba a aumentar el peso de los camarones de los estanques en los que pesaban menos. Además el alimento fue el mismo en todos los estanques, pero fue en la semana 9 que la cantidad de alimento comenzó a ser diferente para cada estanque, variando de manera aleatoria y provocando que variara más el peso de cada estanque.
5. Realice un análisis de regresión logística para determinar que hace que los camarones llegen a 12 gramos.
Se considera que la causalidad de la llegada de 12 g fue debido al crecimiento que tuvieron los camarones de la semana 2, siendo que los menos pesados fueron aquellos que pesaron más al final, creando una relación inversamente proporcional al inicio con las variables peso anterior y peso actual. Sin embargo, esta relación fue cambiando con el paso del tiempo y la alimentación, creando una relación directamente proporcional de las variables.
Regresión lineal simple
Semana 2
##
## Call:
## lm(formula = peso.anterior2 ~ peso.actual2, data = semana2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.037459 -0.014540 -0.002881 0.003270 0.056700
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.2298 0.0944 2.435 0.0352 *
## peso.actual2 -0.1040 0.1396 -0.745 0.4736
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.02938 on 10 degrees of freedom
## Multiple R-squared: 0.05255, Adjusted R-squared: -0.0422
## F-statistic: 0.5546 on 1 and 10 DF, p-value: 0.4736Recta de minimos cuadrados
Ecuación de la recta
Con los datos que proporcionó el sumario, se puede obtener la ecuación de la recta \[ y = 0.2298 - 0.1040 x \]
Ajuste de la recta
Aquí se puede analizar como están distribuidos los datos con respecto a la recta, los cuales se ven un poco alejados
plot(semana2$peso.actual2, semana2$peso.anterior2, xlab = "Peso actual", ylab="Peso anterior")
abline(regresion3)
Relación inversamente proporcional, a menor peso anterior, mayor peso actual.
semana12 <- read_csv("semana12.csv",
col_types = cols(PesoAnterior = col_number(),
PesoActual = col_number()))
peso.anterior3 <- semana12$PesoAnterior
peso.actual3 <- semana12$PesoActual
semana12 <- data.frame(peso.anterior3, peso.actual3)ggplot(data=semana12) +
geom_point(mapping=aes(x=peso.actual3,y=peso.anterior3)) +
ggtitle("Gráfica del peso de camarones en la semana 12")
Regresión lineal simple
Semana 12
##
## Call:
## lm(formula = peso.anterior3 ~ peso.actual3, data = semana12)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.63931 -0.21255 0.03181 0.14407 0.63012
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.4565 2.6633 0.922 0.3781
## peso.actual3 0.6388 0.2305 2.771 0.0197 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3672 on 10 degrees of freedom
## Multiple R-squared: 0.4344, Adjusted R-squared: 0.3778
## F-statistic: 7.679 on 1 and 10 DF, p-value: 0.01975Recta de minimos cuadrados
Ecuación de la recta
Con los datos que proporcionó el sumario, se puede obtener la ecuación de la recta \[ y = 2.4565 + 0.6388 x \]
Ajuste de la recta
Aquí se puede analizar como están distribuidos los datos con respecto a la recta, los cuales se ven un poco alejados
plot(semana12$peso.actual3, semana12$peso.anterior3, xlab = "Peso actual", ylab="Peso anterior")
abline(regresion4)
Tal como se observaban en la tabla, el peso anterior y el actual comenzaron siendo inversamente proporcionales pero solo un poco, debido a que los camarones con menor peso tenían un mayor peso actual, entonces al paso del tiempo y al consumir el alimento que se les proporcionó, dicha relación cambió a ser directamente proporcional debido a que comenzaron a obtener más y más peso con comida que tal vez era mejor que la que consumían anteriormente. Entonces, la causalidad sería el peso anterior y entrarían distintos factores acompañados, como lo es la alimentación.
Finalmente, se necesitaría realizar el experimento de probar con camarones de menor peso para tener un mejor resultado en cuanto al peso deseado y sin tener que gastar dinero extra con el alimento.