U1A7

SEGUNDO CASO DE ESTUDIO: Análisis de productividad en acuacultura “caso granjas de Camarón”

México es uno de los países con mayor potencial para el desarrollo de la acuacultura debido a su diversidad de climas, cuenta con el 12% de la biodiversidad mundial y más de 12,000 especies endémicas.La actividad acuícola ha sido muy relevante en años recientes. Luego del desplome del cultivo de camarón, la producción se recuperó y va en aumento a partir de 2014. En este caso de estudio estamos viendo los datos reales directamente de una granja acuícola. - [R] (https://www.cedo.org/read/cedo-es/importancia-pesca-acuicultura-sonora/)

Acerca de esta asignación

• Esta asignación consiste en analizar datos, dar respuestas a las preguntas y hacer recomendaciones con el uso de la regresión logística.

setwd("~/estadistica")
library(readxl)
library(tidyverse)

## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --

## v ggplot2 3.3.3     v purrr   0.3.4
## v tibble  3.0.5     v dplyr   1.0.4
## v tidyr   1.1.2     v stringr 1.4.0
## v readr   1.4.0     v forcats 0.5.1

## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(prettydoc)
library(readr)
library(DT)
library(pacman)
p_load("base64enc","htmltools","mime","xfun","prettydoc","readr","knitr","DT","dplyr","ggplot2","plotly","gganimate","gifski","scales")

Importar datos

CAMARONES <- read.csv("~/estadistica/CAMARONES.csv")
View(CAMARONES)

Gráfico semanal de peso actual por estanque e incremento

ggplot(data = CAMARONES) +
  geom_point(mapping = aes(x = Semana, y = PesoActual, color = Estanque))

#Incremento 

Incremento <- (CAMARONES$PesoActual - CAMARONES$PesoAnterior)

Lo que nos muestra la gráfica es la relación semanal del peso actual que tienen los estanques de la granja de camarones, como podemos observar el peso fue aumentando semana tras semana, lo cual nos muestra que alimento esta generando su incremento y los pesos de los diferentes estanques se mantien relativamente entre los mismos pesos

Gráfico semanal de incremento de peso por estanque

ggplot(data = CAMARONES) +
  geom_point(mapping = aes(x = Semana, y = Incremento, color = Estanque))

ggplot(data = CAMARONES) +
  geom_point(mapping = aes(x = Semana, y = PesoActual, color = Estanque))

Matriz de correlación

Semana <- CAMARONES$Semana
PesoAnterior <- CAMARONES$PesoAnterior 
PesoActual <- CAMARONES$PesoActual
AlimentoSemana <- CAMARONES$AlimentoSemana
datos <- data.frame(Semana, PesoAnterior, PesoActual, AlimentoSemana, Incremento)
pairs(datos)

cor(datos)

##                   Semana PesoAnterior PesoActual AlimentoSemana Incremento
## Semana         1.0000000    0.9832002  0.9817825      0.9441085  0.6282754
## PesoAnterior   0.9832002    1.0000000  0.9915841      0.9510608  0.5957456
## PesoActual     0.9817825    0.9915841  1.0000000      0.9514703  0.6947139
## AlimentoSemana 0.9441085    0.9510608  0.9514703      1.0000000  0.6187860
## Incremento     0.6282754    0.5957456  0.6947139      0.6187860  1.0000000

Grafico de dispersión

ggplot(data = CAMARONES, aes(x = AlimentoSemana, y = PesoActual)) + 
  geom_point(colour = "blue4") +
  ggtitle("Diagrama de dispersión") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))

Como muestra la gráfica los puntos de color azul estan muy separados lo cual nos dice que su correlación es muy débil, es decir no existe mucha correlación entre el alimento que es dado semanalmete y el peso actual de la granja

Representación gráfica de analisis de normalidad

par(mfrow = c(1, 2))
hist(AlimentoSemana, breaks = 10, main = "", xlab = "Alimento Semanal", border = "yellow")
hist(PesoActual, breaks = 10, main = "", xlab = "Peso Actual",
     border = "pink")

Analisis de cuantiles

qqnorm(AlimentoSemana, main = "Alimento Semanal", col = "green")
qqline(AlimentoSemana)

qqnorm(PesoActual, main = "Peso Actual", col = "purple")
qqline(PesoActual)

Como muestran las graficas los cuantiles son puntos tomados a intervalos regulares de la función de distribución de una variable aleatoria y podemos obesvar que en los gráficos Q-Q como los datos de alimento semanal y peso actual estan distribuidos ascendetemente

Importar datos 2

camarones1 <- read_excel("~/estadistica/camarones1.xlsx")
View(camarones1)

Regresión logóstica binaria

# 1 = Camarón que pesa más de 12g
# 0 = Camarón que pesa menos de 12g

hist(camarones1$AlimentoDiario)

table(camarones1$Exito)

## 
## 0 1 
## 9 3

Gráfica de exitos vs fracasos

colores <- NULL
colores[camarones1$Exito==0] <-"purple"
colores[camarones1$Exito==1] <-"orange"
plot(camarones1$AlimentoDiario, camarones1$Exito, pch=21, bg=colores, xlab="Alimento", ylab="Pesos ideales")
legend ("bottomleft", c("Peso no ideal", "peso ideal"), pch=21, col = c("blue","pink"))

Gráfica de alimento vs peso ideal

reg <- glm (Exito ~ AlimentoDiario, family=binomial, data= camarones1) 
summary(reg)

## 
## Call:
## glm(formula = Exito ~ AlimentoDiario, family = binomial, data = camarones1)
## 
## 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

datos <- data.frame(AlimentoDiario = seq(270, 300, 0.1))
probabilidades <- predict(reg, datos, type = 'response')
plot(camarones1$AlimentoDiario,camarones1$Exito, pch = 21, bg = colores, xlab = "Alimento", ylab = "Pesos ideales")
legend('topleft', c("Peso no ideal", "peso ideal"), pch = 21, col = c('red', 'purple'))
lines(datos$AlimentoDiario, probabilidades, col = 'pink', lwd = 2)