library(pacman)
p_load("DT","xfun","ggplot2", "readr")Utilizando regresión logística
En el siguiente documento se mostrará un analisis de una caso de estudio utilizando regresion logístca, esta nos permite clasificar en grupos a los datos a partir de variables cuantitativas. El modelo de regresión modela el logaritmo de la probabilidad de pertenecer a cada grupo.
Caso de estudio: camarones
En esta ocación se utilizará como caso de estudio datos de una empresa productora de camaron, donde se muestran las variables de alimento diario y éxito, que representa si el camaron tiene el tamaño requerido para su venta (12 gramos o más). El objetivo de este estudio es determinar la cantidad óptima de comida diaria en la última semana de crecimiento para que los camarones lleguen a tener su peso óptimo de 12 gramos.
Obtención de los datos
camarones <- read_csv("camarones.csv")## Rows: 12 Columns: 2## -- Column specification --------------------------------------------------------
## Delimiter: ","
## dbl (2): AlimentoDiario, Exito##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message. cols(
AlimentoDiario = col_double(),
Exito = col_double()
)## cols(
## AlimentoDiario = col_double(),
## Exito = col_double()
## )Tabla de datos
datatable(camarones)Tabla de frecuencia de datos
tabla <- table(camarones$Exito)
tabla##
## 0 1
## 9 3Aquí podemos ver como solo 3 grupos de camarones lograron crecer lo suficiente.Veamoslo ahora de forma gráfica.
colores <- NULL
colores[camarones$Exito == 1] <- "green"
colores[camarones$Exito == 0] <- "red"
plot(camarones$AlimentoDiario, camarones$Exito, pch=21, bg= colores,
xlab = "Alimento diario", ylab = "Probabilidad de exitos")
legend("bottomleft", c("Exito", "No exito"), pch=21, col = c("green", "red") )
Lo que se puede notar es que no se ve una gran relación entre el alimento diario y los exitos, por lo que deben haber otros factores que esten afectando el crecimiento de los camarones, ya sea por enfermedad, temperatura, cuidados,
Creando el modelo de regresión logística
Para ver más a detalle la correlación entre las dos variables se construirá un modelo de regresión logistica que a la vez nos ayude a predecir con nuevos datos los exitos que se tendría con diferentes valores de alimentación diaria. De esta forma podremos saber como afecta el alimento diario en el crecimiento de los camarones.
regresion <- glm(Exito ~ AlimentoDiario, data=camarones, family= binomial)
summary(regresion)##
## Call:
## glm(formula = Exito ~ AlimentoDiario, family = binomial, data = camarones)
##
## 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: 5En la tabla coeficientes, la temperatura es significativa con pvalor= 0.185 el cual es menor que el valor de significancia de 0.05. Lo anterior nos permite concluir que la hipoesis nula se rechaza
$ H_0:{1}=0 $ $ H_1:{1} $
Con respecto al intercepto: También es sinificativo dado que p valor= 0.0175< 0.05. Lo que significa que se rechaza la hipotesis nula, que afirma el intercepto es cero. Más aun, significa que bajísimos, lo que demuestra que ambas variables son importantes para explicar la variable dependiente (probabilidad de éxito).
Predicción para valores nuevos con el modelo ajustado
A continuación se creará un nueva secuencia de datos de alimento diario, esta se utilizará junto con el modelo de regresión previamente hecho para obtener una predicción estimada de exitos.
datos_nuevos <-data.frame(AlimentoDiario= seq(250,350,2) )
datos_nuevos## AlimentoDiario
## 1 250
## 2 252
## 3 254
## 4 256
## 5 258
## 6 260
## 7 262
## 8 264
## 9 266
## 10 268
## 11 270
## 12 272
## 13 274
## 14 276
## 15 278
## 16 280
## 17 282
## 18 284
## 19 286
## 20 288
## 21 290
## 22 292
## 23 294
## 24 296
## 25 298
## 26 300
## 27 302
## 28 304
## 29 306
## 30 308
## 31 310
## 32 312
## 33 314
## 34 316
## 35 318
## 36 320
## 37 322
## 38 324
## 39 326
## 40 328
## 41 330
## 42 332
## 43 334
## 44 336
## 45 338
## 46 340
## 47 342
## 48 344
## 49 346
## 50 348
## 51 350Ahora con estos nuevos datos calculamos las predicciones:
probabilidades_nuevas <- predict(regresion, datos_nuevos, type="response")
probabilidades_nuevas ## 1 2 3 4 5 6
## 0.005057235 0.006412092 0.008126955 0.010295693 0.013035568 0.016492425
## 7 8 9 10 11 12
## 0.020846632 0.026319639 0.033180821 0.041753922 0.052421995 0.065629069
## 13 14 15 16 17 18
## 0.081876000 0.101707168 0.125684103 0.154342290 0.188128986 0.227323661
## 19 20 21 22 23 24
## 0.271948870 0.321687180 0.375826503 0.433257569 0.492539476 0.552031926
## 25 26 27 28 29 30
## 0.610071349 0.665152328 0.716073739 0.762021931 0.802584268 0.837705397
## 31 32 33 34 35 36
## 0.867609000 0.892708408 0.913523621 0.930614432 0.944532581 0.955791495
## 37 38 39 40 41 42
## 0.964850095 0.972106700 0.977899513 0.982510933 0.986173752 0.989077977
## 43 44 45 46 47 48
## 0.991377499 0.993196210 0.994633384 0.995768275 0.996663973 0.997370586
## 49 50 51
## 0.997927840 0.998367188 0.998713504De manera grafica se ve de la siguiente manera:
colores[camarones$Exito == 1] <- "green"
colores[camarones$Exito == 0] <- "red"
plot(camarones$AlimentoDiario, camarones$Exito, pch=21, bg= colores,
xlab = "Alimento diario", ylab = "Probabilidad de exitos")
legend("bottomleft", c("Exito", "No exito"), pch=21, col = c("green", "red") )
lines(datos_nuevos$AlimentoDiario, probabilidades_nuevas, col ="blue", lwd= 3)
Al analisar las probabilidades arrojadas se puede concluir que la cantidad de alimento optimo para que los camarones crescan a su peso ideal es de 314 en adelante, contando con mas de 90% de probabilidades de éxito.