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

  • Preguntas a responder

  1. Haga un planteamiento del problema a resolver con estadística y realice una descripción exploratoria de los datos (MMM, MD, CB)

  2. ¿Que tienen de diferentes los estanques que SI llegaron a 12 gramos en la semana 12 con respecto a los que no?

3.- ¿Con qué variables se relaciona el aumento de peso de los camarones? (regresión lineal, residuos, confianza)

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?

5.- Realice un análisis de regresión logística para determinar que hace que los camarones llegen a 12 gramos.

#1era Parte.

1.- Haga un planteamiento del problema a resolver con estadística y realice una descripción exploratoria de los datos (MMM, MD, CB)

Datos

library(prettydoc)
library(readr)
library(DT)
CAMARONES <- read_csv("CAMARONES.csv")
## Parsed with 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(),
##   cumplepeso = col_double()
## )
datatable(CAMARONES)

P/ semana 12

CAMARONES2 <- read_csv("CAMARONES2.csv")
## Parsed with column specification:
## cols(
##   P = 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(),
##   cumplepeso = col_double()
## )
datatable(CAMARONES2)

Tabla de distribución de frecuencia (Alimento diario)

library(fdth)
## 
## Attaching package: 'fdth'
## The following objects are masked from 'package:stats':
## 
##     sd, var
alimento2 <- CAMARONES2$AlimentoDiario
distribucion <- fdt(alimento2, breaks="Sturges")
distribucion
##       Class limits f   rf rf(%) cf  cf(%)
##   [268.714,274.85) 3 0.25 25.00  3  25.00
##   [274.85,280.986) 2 0.17 16.67  5  41.67
##  [280.986,287.121) 3 0.25 25.00  8  66.67
##  [287.121,293.257) 2 0.17 16.67 10  83.33
##  [293.257,299.393) 2 0.17 16.67 12 100.00

Histogramas

# 1er histograma
hist(alimento2,breaks="sturges",col='blue')

par(mfrow=c(3,1))

# Histograma de frecuencias absolutas
plot(distribucion, type="fh", col='red', main="Histograma de frecuencias absolutas")

# Histograma de frecuencias relativas
plot(distribucion, type="rfh", col='pink',main="Histograma de frecuencias relativas" )

# Histograma de frecuencias acumuladas
plot(distribucion, type="cfh", col='yellow',main="Histograma de frecuencias acumuladas")

## Polígonos de distribución de frecuencias

par(mfrow=c(3,1))

# polígono de frecuencias absolutas
plot(distribucion, type="fp", col='red', main="Polígono de frecuencias absolutas")

# polígono de frecuencias relativas
plot(distribucion, type="rfp", col='brown',main="Polígono de frecuencias relativas" )

# polígono de frecuencias acumuladas
plot(distribucion, type="cfp", col='yellow',main="Polígono de frecuencias acumuladas")

# ordenar datos para visualizar (alim diario p/estanque en sem 12)
sort(alimento2)
##  [1] 271.4286 271.4286 271.4286 275.0000 278.5714 282.1429 282.1429 285.7143
##  [9] 289.2857 292.8571 296.4286 296.4286

Medidas de tendencia central

Media

mean(alimento2)
## [1] 282.7381

Mediana

median(alimento2)
## [1] 282.1429

Moda

library(modeest)
## 
## Attaching package: 'modeest'
## The following object is masked from 'package:fdth':
## 
##     mfv
mfv(alimento2)
## [1] 271.4286

Resumen de medidas

summary(alimento2)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   271.4   274.1   282.1   282.7   290.2   296.4

Boxplot

boxplot(alimento2,col='green',lwd=3 ,main='Diagrama de caja y bigotes alim. diario')

## Medidas de dispersión

Varianza

var(alimento2)
## [1] 90.05875

Desviación estandar

sd(alimento2)
## [1] 9.489929

Gráfico de dispersión (relación entre peso actual y alimento diario proporcionado)

library(ggplot2)
ggplot(data = CAMARONES2)+geom_point(mapping = aes(x=AlimentoDiario, y=PesoActual),col='red',lwd=4)

2da parte

2. ¿Que tienen de diferentes los estanques que SI llegaron a 12 gramos en la semana 12 con respecto a los que no?

El hecho de que a unos estanques se le proporcionará mayor alimento diario, no mostró una diferencia signficativa en la ganancia de peso entre los demás estanques, pero se logra visualizar a aquellos que superaron las 12 unidades , comenzaron con un peso mayor de 10 unidades en un principio de la semana No.12.

library(readr)
CAMARONES2 <- read_csv("CAMARONES2.csv", 
    col_types = cols(P = col_skip(), EstanqueN = col_number(), 
        Superficie = col_double(), Dias = col_number(), 
        Semana = col_number(), TamanioAlimento = col_number(), 
        AlimentoSemana = col_number(), cumplepeso = col_number()))
View(CAMARONES2)
cor(CAMARONES2)
## Warning in cor(CAMARONES2): the standard deviation is zero
##                  EstanqueN Superficie Dias Semana PesoAnterior PesoActual
## EstanqueN        1.0000000  0.6477503   NA     NA  -0.17956716  0.1136682
## Superficie       0.6477503  1.0000000   NA     NA  -0.26676353  0.1078016
## Dias                    NA         NA    1     NA           NA         NA
## Semana                  NA         NA   NA      1           NA         NA
## PesoAnterior    -0.1795672 -0.2667635   NA     NA   1.00000000  0.6590602
## PesoActual       0.1136682  0.1078016   NA     NA   0.65906024  1.0000000
## TamanioAlimento         NA         NA   NA     NA           NA         NA
## AlimentoSemana   0.5598435  0.6738525   NA     NA   0.08881388  0.2836590
## AlimentoDiario   0.5598435  0.6738525   NA     NA   0.08881388  0.2836590
## cumplepeso       0.0836242  0.2581989   NA     NA   0.45234956  0.7774753
##                 TamanioAlimento AlimentoSemana AlimentoDiario cumplepeso
## EstanqueN                    NA     0.55984353     0.55984352  0.0836242
## Superficie                   NA     0.67385255     0.67385254  0.2581989
## Dias                         NA             NA             NA         NA
## Semana                       NA             NA             NA         NA
## PesoAnterior                 NA     0.08881388     0.08881388  0.4523496
## PesoActual                   NA     0.28365902     0.28365903  0.7774753
## TamanioAlimento               1             NA             NA         NA
## AlimentoSemana               NA     1.00000000     1.00000000  0.4160582
## AlimentoDiario               NA     1.00000000     1.00000000  0.4160582
## cumplepeso                   NA     0.41605821     0.41605821  1.0000000

3ra parte

3.- ¿Con qué variables se relaciona el aumento de peso de los camarones? (regresión lineal, residuos, confianza)

regresión líneal

modelorecta <- lm(AlimentoDiario ~ PesoActual, data = CAMARONES2)
summary(modelorecta)
## 
## Call:
## lm(formula = AlimentoDiario ~ PesoActual, data = CAMARONES2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -11.735  -8.101   0.297   6.549  15.283 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  218.029     69.231   3.149   0.0103 *
## PesoActual     5.605      5.992   0.935   0.3716  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.544 on 10 degrees of freedom
## Multiple R-squared:  0.08046,    Adjusted R-squared:  -0.01149 
## F-statistic: 0.875 on 1 and 10 DF,  p-value: 0.3716

Ecuación de la recta de mínimos cuadrados.

\[ Y=218.029+5.605X \]

Intervalos de confianza

confint(modelorecta)
##                 2.5 %    97.5 %
## (Intercept) 63.772654 372.28469
## PesoActual  -7.746283  18.95704

Análisis de residuos

par(mfrow=c(2,2))
plot(modelorecta)

Prueba de Shapiro-Wilk

### Contraste de hipótesis 

shapiro.test(modelorecta$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelorecta$residuals
## W = 0.92389, p-value = 0.3198
# anlizar si residuales son represenativos para el modelo.

#**como p>0.05 , no son significativos los residuos**

Matriz correlativa

Alimentodiario <- CAMARONES2$AlimentoDiario
Pesoactual <- CAMARONES2$PesoActual 
pairs(data.frame(Alimentodiario,Pesoactual),col='green',lwd=2, main= 'Matriz de correlaciones')

4ta Parte

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 , ya que analizando los datos podemos observar que los estanques 6 y 7 comenzaron con un mayor peso, pero al final de la semana 12 , ninguno de ellos logró superar la meta de las 12 unidades, a diferencia de otros.

5ta parte

5.- Realice un análisis de regresión logística para determinar que hace que los camarones llegen a 12 gramos.

modelorectag <- lm(AlimentoDiario ~ PesoActual, data = CAMARONES)
summary(modelorectag)
## 
## Call:
## lm(formula = AlimentoDiario ~ PesoActual, data = CAMARONES)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -75.14 -12.84   1.37  12.97  54.35 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  40.8377     3.5520   11.50   <2e-16 ***
## PesoActual   19.9567     0.5661   35.25   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 21.96 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-16
plot(CAMARONES$AlimentoDiario,CAMARONES$PesoActual, xlab = "Alimento diario", ylab = "Peso actual", col='green', lwd=1)

abline(modelorectag)

regreg <- glm(cumplepeso ~ Alimentodiario, data=CAMARONES2, family=binomial)

summary(regreg)
## 
## Call:
## glm(formula = cumplepeso ~ Alimentodiario, family = binomial, 
##     data = CAMARONES2)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.28965  -0.68424  -0.39705  -0.00008   2.00729  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)
## (Intercept)    -35.1229    25.8776  -1.357    0.175
## Alimentodiario   0.1194     0.0901   1.325    0.185
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 13.496  on 11  degrees of freedom
## Residual deviance: 11.311  on 10  degrees of freedom
## AIC: 15.311
## 
## Number of Fisher Scoring iterations: 5

Frecuencia de encontrar valores mayores a 12 unidades (1) y para los que no (0)

table(CAMARONES2$cumplepeso)
## 
## 0 1 
## 9 3
# Ajuste de un modelo logístico.

colores <- NULL
colores[CAMARONES2$cumplepeso==0] <- "yellow"
colores[CAMARONES2$cumplepeso==1] <- "red"
plot(CAMARONES2$AlimentoDiario, CAMARONES2$cumplepeso, pch = 21, bg = colores, xlab = 'Alimento diario', ylab = 'Probabilidad de peso en camarones de cumplir los 12g', main="Grafico representativo de si cumple o no cumple con los 12 unidades de peso")
legend('bottomleft', c('No cumple', 'Si cumple'), pch = 21, col = c('yellow', 'red'))

regt <- glm(cumplepeso ~ AlimentoDiario, data=CAMARONES2, family=binomial)
summary(regt)
## 
## Call:
## glm(formula = cumplepeso ~ AlimentoDiario, family = binomial, 
##     data = CAMARONES2)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.28965  -0.68424  -0.39705  -0.00008   2.00729  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)
## (Intercept)    -35.1229    25.8776  -1.357    0.175
## AlimentoDiario   0.1194     0.0901   1.325    0.185
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 13.496  on 11  degrees of freedom
## Residual deviance: 11.311  on 10  degrees of freedom
## AIC: 15.311
## 
## Number of Fisher Scoring iterations: 5
datost <- data.frame(AlimentoDiario= seq(200,300,0.2))
probabilidades <- predict(regt, datost, type = "response")
#gráfica

plot(CAMARONES2$AlimentoDiario, CAMARONES2$cumplepeso, pch = 21, bg = colores, xlab = 'Alimento diario', ylab = 'Probabilidad de peso en camarones de cumplir los 12g', main="Grafico regresion logistica")
legend('bottomleft', c('no cumple', 'Si cumple'), pch = 21, col = c('yellow', 'red'))

lines(datost$AlimentoDiario, probabilidades, col="green", lwd=4)

**No se observa relación significativa entre el alimento del día con el hecho de si se cumple con el peso de 12 unidades, ya que como se observa las probabilidades para las dosis empleadas en la mayoría de los casos se encuentra por debajo de 0.5