Camarones Peso Optimo(Regresion Logistica)
Introducción
La acuicultura o acuacultura1 es el conjunto de actividades, técnicas y conocimientos de crianza de especies acuáticas vegetales y animales. Es una importante actividad económica de producción de alimentos, materias primas de uso industrial y farmacéutico, y organismos vivos para repoblación u ornamentación.
Descripción
El cultivo del camarón se considera una de las actividades pesqueras más importantes en el noroeste del país y sobre todo en el estado de Sonora. Por lo tanto se debe tener un control estable sobre los recursos a utilizar, con el fin de una mayor y mejor producción de camarones con un peso optimo de 12 gramos y no menor, sin tener que utilizar una mayor cantidad de los recursos a necesitar, ya que para el cultivo de camarón utiliza una gran cantidad de alimento y mantenimiento de equipo en los que estos se crían. La producción del camarón se debe de realizar en zonas cercanas al mar, esto es debido a que los estanques donde los camarones son criados reciben agua del mar, la cual es bombeada y distribuida a los estanques a través de un sistema de canales que aprovisiona las granjas durante la crianza de los camarones.
## Objetivo
El objetivo del siguiente documento y estudio sobre los camarones es utilizar la Regresión Logística Simple para determinar la cantidad óptima de comida diara en la útlima semana de crecimiento para los camarones para que estos lleguen a tener un peso óptimo de 12 gramos, debido a que la crianza del camaron es bastante complicada.( 0 = menor a 12 gramos, 1= mayor o igual a 12 gramos).
Desarrollo
Paquetes
A continuación se presentan los paquetes necesarios para la realización de este caso.
library(pacman)
p_load("DT","xfun","ggplot2", "readr")Importar datos
Para la obtención de los datos, estos son importados desde un archivo csv.
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.datatable(camarones)Los datos de este caso estan etiquetados en exito=1 y fracaso=0 variable categórica “Y” donde el pesimo optimo es=1 y el peso no optimo=0.
Tabla de frecuencia de los datos
tabla <- table(camarones$Exito)
tabla##
## 0 1
## 9 3Según la tabla anterior se presentaron datos de la tabla de frecuencias, de las 12 cantidades de alimento que fueron suministradas a los camarones, solo 3 cantidades tuvieron exito en que el camarón tuviera un peso óptimo de 12 gramos.
Viendo esta relación gráficamente
colores <- NULL
colores[camarones$Exito == 0] <- "blue"
colores[camarones$Exito == 1] <- "red"
plot(camarones$AlimentoDiario , camarones$Exito, pch=21, bg= colores,
xlab = "Cantidad Alimento", ylab = "Probabilidad Peso Óptimo")
legend("top", c("Peso No óptimo", "Peso Óptimo"), pch=21, col = c("blue", "red"))
A simple vista los datos nos hacen pensar que la cantidad de alimento puede influir en la probabilidad de que los camarones tengan un peso optimo o no. Por lo tanto la idea a realizar a continuacion es ajustar por medio de la regresión logistica,un modelo de regresión logística para estudiar la posible relación entre Y=1 dado diferentes valores de alimento suministrado: P(Y=1|X). Para ajustar el modelo se usa el comando glm (para modelos lineales generalizados) indicando que la respuesta es binomial mediante el argumento family:
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 anterior el alimento es lo suficientemente significativo con un pvalor = 0.185, el cual es mayor al valor de 0.05, por lo que podemos razonar que la hipótesis nula desarrollada es la verdadera, en la cual nos menciona que una mayor cantidad de alimento suministrado hacia los camarones, tendra una mayor probabilidad de tener un peso ideal en los camarones.
Análisis del modelo
Formulación matemática del modelo de regresión logísitca
\[ P(Y=1|X)=\dfrac{e^{-35.1229+0.1194x}}{1+e^{-35.1229+0.1194x}} \]
Predicción para valores nuevos con el modelo ajustado
Para representar gráficamente la función logística estimada, calculamos las probabilidades de fallo estimadas (usando el comando predict) para un vector adecuado de nuevas cantidades de alimento a sumnistrar (270 y 300 ): Por lo tanto generamos una secuencia de datos, el cula llamaremos datos nuevos, con separaciones de 0.1.
datos_nuevos <-data.frame(AlimentoDiario= seq(270,300,0.1) )
datos_nuevos## AlimentoDiario
## 1 270.0
## 2 270.1
## 3 270.2
## 4 270.3
## 5 270.4
## 6 270.5
## 7 270.6
## 8 270.7
## 9 270.8
## 10 270.9
## 11 271.0
## 12 271.1
## 13 271.2
## 14 271.3
## 15 271.4
## 16 271.5
## 17 271.6
## 18 271.7
## 19 271.8
## 20 271.9
## 21 272.0
## 22 272.1
## 23 272.2
## 24 272.3
## 25 272.4
## 26 272.5
## 27 272.6
## 28 272.7
## 29 272.8
## 30 272.9
## 31 273.0
## 32 273.1
## 33 273.2
## 34 273.3
## 35 273.4
## 36 273.5
## 37 273.6
## 38 273.7
## 39 273.8
## 40 273.9
## 41 274.0
## 42 274.1
## 43 274.2
## 44 274.3
## 45 274.4
## 46 274.5
## 47 274.6
## 48 274.7
## 49 274.8
## 50 274.9
## 51 275.0
## 52 275.1
## 53 275.2
## 54 275.3
## 55 275.4
## 56 275.5
## 57 275.6
## 58 275.7
## 59 275.8
## 60 275.9
## 61 276.0
## 62 276.1
## 63 276.2
## 64 276.3
## 65 276.4
## 66 276.5
## 67 276.6
## 68 276.7
## 69 276.8
## 70 276.9
## 71 277.0
## 72 277.1
## 73 277.2
## 74 277.3
## 75 277.4
## 76 277.5
## 77 277.6
## 78 277.7
## 79 277.8
## 80 277.9
## 81 278.0
## 82 278.1
## 83 278.2
## 84 278.3
## 85 278.4
## 86 278.5
## 87 278.6
## 88 278.7
## 89 278.8
## 90 278.9
## 91 279.0
## 92 279.1
## 93 279.2
## 94 279.3
## 95 279.4
## 96 279.5
## 97 279.6
## 98 279.7
## 99 279.8
## 100 279.9
## 101 280.0
## 102 280.1
## 103 280.2
## 104 280.3
## 105 280.4
## 106 280.5
## 107 280.6
## 108 280.7
## 109 280.8
## 110 280.9
## 111 281.0
## 112 281.1
## 113 281.2
## 114 281.3
## 115 281.4
## 116 281.5
## 117 281.6
## 118 281.7
## 119 281.8
## 120 281.9
## 121 282.0
## 122 282.1
## 123 282.2
## 124 282.3
## 125 282.4
## 126 282.5
## 127 282.6
## 128 282.7
## 129 282.8
## 130 282.9
## 131 283.0
## 132 283.1
## 133 283.2
## 134 283.3
## 135 283.4
## 136 283.5
## 137 283.6
## 138 283.7
## 139 283.8
## 140 283.9
## 141 284.0
## 142 284.1
## 143 284.2
## 144 284.3
## 145 284.4
## 146 284.5
## 147 284.6
## 148 284.7
## 149 284.8
## 150 284.9
## 151 285.0
## 152 285.1
## 153 285.2
## 154 285.3
## 155 285.4
## 156 285.5
## 157 285.6
## 158 285.7
## 159 285.8
## 160 285.9
## 161 286.0
## 162 286.1
## 163 286.2
## 164 286.3
## 165 286.4
## 166 286.5
## 167 286.6
## 168 286.7
## 169 286.8
## 170 286.9
## 171 287.0
## 172 287.1
## 173 287.2
## 174 287.3
## 175 287.4
## 176 287.5
## 177 287.6
## 178 287.7
## 179 287.8
## 180 287.9
## 181 288.0
## 182 288.1
## 183 288.2
## 184 288.3
## 185 288.4
## 186 288.5
## 187 288.6
## 188 288.7
## 189 288.8
## 190 288.9
## 191 289.0
## 192 289.1
## 193 289.2
## 194 289.3
## 195 289.4
## 196 289.5
## 197 289.6
## 198 289.7
## 199 289.8
## 200 289.9
## 201 290.0
## 202 290.1
## 203 290.2
## 204 290.3
## 205 290.4
## 206 290.5
## 207 290.6
## 208 290.7
## 209 290.8
## 210 290.9
## 211 291.0
## 212 291.1
## 213 291.2
## 214 291.3
## 215 291.4
## 216 291.5
## 217 291.6
## 218 291.7
## 219 291.8
## 220 291.9
## 221 292.0
## 222 292.1
## 223 292.2
## 224 292.3
## 225 292.4
## 226 292.5
## 227 292.6
## 228 292.7
## 229 292.8
## 230 292.9
## 231 293.0
## 232 293.1
## 233 293.2
## 234 293.3
## 235 293.4
## 236 293.5
## 237 293.6
## 238 293.7
## 239 293.8
## 240 293.9
## 241 294.0
## 242 294.1
## 243 294.2
## 244 294.3
## 245 294.4
## 246 294.5
## 247 294.6
## 248 294.7
## 249 294.8
## 250 294.9
## 251 295.0
## 252 295.1
## 253 295.2
## 254 295.3
## 255 295.4
## 256 295.5
## 257 295.6
## 258 295.7
## 259 295.8
## 260 295.9
## 261 296.0
## 262 296.1
## 263 296.2
## 264 296.3
## 265 296.4
## 266 296.5
## 267 296.6
## 268 296.7
## 269 296.8
## 270 296.9
## 271 297.0
## 272 297.1
## 273 297.2
## 274 297.3
## 275 297.4
## 276 297.5
## 277 297.6
## 278 297.7
## 279 297.8
## 280 297.9
## 281 298.0
## 282 298.1
## 283 298.2
## 284 298.3
## 285 298.4
## 286 298.5
## 287 298.6
## 288 298.7
## 289 298.8
## 290 298.9
## 291 299.0
## 292 299.1
## 293 299.2
## 294 299.3
## 295 299.4
## 296 299.5
## 297 299.6
## 298 299.7
## 299 299.8
## 300 299.9
## 301 300.0Cálculo de las nuevas probabilidades
probabilidades_nuevas <- predict(regresion, datos_nuevos, type="response")
probabilidades_nuevas ## 1 2 3 4 5 6 7
## 0.05242200 0.05301810 0.05362060 0.05422956 0.05484503 0.05546707 0.05609576
## 8 9 10 11 12 13 14
## 0.05673114 0.05737328 0.05802224 0.05867808 0.05934087 0.06001067 0.06068755
## 15 16 17 18 19 20 21
## 0.06137156 0.06206276 0.06276124 0.06346704 0.06418023 0.06490089 0.06562907
## 22 23 24 25 26 27 28
## 0.06636484 0.06710826 0.06785941 0.06861835 0.06938514 0.07015986 0.07094257
## 29 30 31 32 33 34 35
## 0.07173333 0.07253223 0.07333931 0.07415466 0.07497834 0.07581042 0.07665097
## 36 37 38 39 40 41 42
## 0.07750006 0.07835775 0.07922413 0.08009924 0.08098318 0.08187600 0.08277778
## 43 44 45 46 47 48 49
## 0.08368858 0.08460848 0.08553755 0.08647586 0.08742348 0.08838047 0.08934692
## 50 51 52 53 54 55 56
## 0.09032289 0.09130844 0.09230367 0.09330862 0.09432338 0.09534802 0.09638260
## 57 58 59 60 61 62 63
## 0.09742720 0.09848188 0.09954672 0.10062180 0.10170717 0.10280291 0.10390909
## 64 65 66 67 68 69 70
## 0.10502578 0.10615305 0.10729096 0.10843960 0.10959902 0.11076930 0.11195050
## 71 72 73 74 75 76 77
## 0.11314270 0.11434596 0.11556035 0.11678593 0.11802278 0.11927096 0.12053053
## 78 79 80 81 82 83 84
## 0.12180157 0.12308413 0.12437829 0.12568410 0.12700164 0.12833096 0.12967212
## 85 86 87 88 89 90 91
## 0.13102520 0.13239025 0.13376733 0.13515650 0.13655782 0.13797136 0.13939716
## 92 93 94 95 96 97 98
## 0.14083529 0.14228581 0.14374876 0.14522421 0.14671221 0.14821282 0.14972607
## 99 100 101 102 103 104 105
## 0.15125204 0.15279076 0.15434229 0.15590668 0.15748396 0.15907420 0.16067744
## 106 107 108 109 110 111 112
## 0.16229371 0.16392307 0.16556555 0.16722120 0.16889005 0.17057215 0.17226752
## 113 114 115 116 117 118 119
## 0.17397622 0.17569826 0.17743369 0.17918254 0.18094482 0.18272059 0.18450985
## 120 121 122 123 124 125 126
## 0.18631264 0.18812899 0.18995890 0.19180241 0.19365953 0.19553029 0.19741469
## 127 128 129 130 131 132 133
## 0.19931276 0.20122449 0.20314991 0.20508903 0.20704184 0.20900836 0.21098859
## 134 135 136 137 138 139 140
## 0.21298253 0.21499018 0.21701153 0.21904658 0.22109534 0.22315777 0.22523389
## 141 142 143 144 145 146 147
## 0.22732366 0.22942708 0.23154414 0.23367480 0.23581906 0.23797688 0.24014824
## 148 149 150 151 152 153 154
## 0.24233311 0.24453146 0.24674327 0.24896848 0.25120707 0.25345899 0.25572421
## 155 156 157 158 159 160 161
## 0.25800268 0.26029434 0.26259916 0.26491708 0.26724804 0.26959199 0.27194887
## 162 163 164 165 166 167 168
## 0.27431861 0.27670116 0.27909644 0.28150439 0.28392493 0.28635798 0.28880348
## 169 170 171 172 173 174 175
## 0.29126134 0.29373148 0.29621381 0.29870824 0.30121469 0.30373307 0.30626327
## 176 177 178 179 180 181 182
## 0.30880520 0.31135876 0.31392384 0.31650035 0.31908816 0.32168718 0.32429728
## 183 184 185 186 187 188 189
## 0.32691836 0.32955029 0.33219294 0.33484621 0.33750996 0.34018406 0.34286838
## 190 191 192 193 194 195 196
## 0.34556279 0.34826715 0.35098133 0.35370518 0.35643856 0.35918132 0.36193332
## 197 198 199 200 201 202 203
## 0.36469440 0.36746442 0.37024321 0.37303063 0.37582650 0.37863068 0.38144300
## 204 205 206 207 208 209 210
## 0.38426328 0.38709137 0.38992709 0.39277027 0.39562074 0.39847832 0.40134284
## 211 212 213 214 215 216 217
## 0.40421411 0.40709195 0.40997619 0.41286662 0.41576308 0.41866537 0.42157330
## 218 219 220 221 222 223 224
## 0.42448667 0.42740531 0.43032901 0.43325757 0.43619080 0.43912851 0.44207048
## 225 226 227 228 229 230 231
## 0.44501653 0.44796645 0.45092004 0.45387708 0.45683739 0.45980074 0.46276695
## 232 233 234 235 236 237 238
## 0.46573579 0.46870705 0.47168054 0.47465604 0.47763335 0.48061224 0.48359251
## 239 240 241 242 243 244 245
## 0.48657394 0.48955634 0.49253948 0.49552314 0.49850713 0.50149123 0.50447521
## 246 247 248 249 250 251 252
## 0.50745888 0.51044202 0.51342441 0.51640585 0.51938612 0.52236502 0.52534232
## 253 254 255 256 257 258 259
## 0.52831782 0.53129131 0.53426258 0.53723142 0.54019763 0.54316098 0.54612129
## 260 261 262 263 264 265 266
## 0.54907834 0.55203193 0.55498185 0.55792790 0.56086988 0.56380758 0.56674082
## 267 268 269 270 271 272 273
## 0.56966938 0.57259308 0.57551172 0.57842510 0.58133303 0.58423532 0.58713178
## 274 275 276 277 278 279 280
## 0.59002223 0.59290646 0.59578431 0.59865558 0.60152010 0.60437769 0.60722816
## 281 282 283 284 285 286 287
## 0.61007135 0.61290707 0.61573517 0.61855546 0.62136777 0.62417196 0.62696784
## 288 289 290 291 292 293 294
## 0.62975526 0.63253406 0.63530408 0.63806517 0.64081717 0.64355994 0.64629332
## 295 296 297 298 299 300 301
## 0.64901718 0.65173136 0.65443573 0.65713014 0.65981447 0.66248858 0.66515233Representación gráfica del ajuste:
colores <- NULL
colores[camarones$Exito == 0] <- "blue"
colores[camarones$Exito == 1] <- "red"
plot(camarones$AlimentoDiario , camarones$Exito, pch=21, bg= colores,
xlab = "Cantidad Alimento", ylab = "Probabilidad Peso óptimo")
legend("top", c("Peso No óptimo", "Peso Óptimo"), pch=21, col = c("blue", "red") )
lines(datos_nuevos$AlimentoDiario, probabilidades_nuevas, col ="black", lwd= 3)
Conclusión Final
Ya desarrollado el siguiente caso y aplicando la regresion logistica a la cantidad de alimento sumnistrada hacia los camarones y observando los datos obtenidos, podemos concluir que la cantidad de alimento sumnistrado a los camarones en una mayor cantidad influye en la probablidad de tener un peso optimo en la crianza del camaron. Sin embargo, al ser un caso con datos relativamente mas sencillos no podemos asegurar con certeza que la cantidad de alimento influyan, existiran otras variables a contemplar para tener una mayor certeza, por ejemplo el clima, la cantidad de agua, el espacio, etc.