Datos de producción pecuaria en México (2005 - 2020)

Produccion_Pecuaria_Mexico <- read.csv("Produccion-Pecuaria-Mexico.csv")
Produccion_Pecuaria_Mexico <- Produccion_Pecuaria_Mexico %>% mutate_at("Estado" , factor)
Produccion_Pecuaria_Mexico <- Produccion_Pecuaria_Mexico %>% mutate_at("Especie" , factor)
Produccion_Pecuaria_Mexico <- Produccion_Pecuaria_Mexico %>% mutate_at("Producto" , factor)
datatable(Produccion_Pecuaria_Mexico)

Tabla de Datos Datos de la Producción Pecuaria en México por Estado del año 2005 hasta 2020

Significado de los datos

• Anio - Año de registro de los datos.
• Estado - Estado de la república mexicana de donde pertenecen los datos. (El antes llamado Distrito Federal es llamado Ciudad de México en todos los registros)
• Especie - Especie animal de la cual se obtuvieron los datos.
• Producto - Tipo de producto que se contempla en el registro.
• Volumen - Volumen de producción obtenido en el año medido en toneladas. (La producción de leche se expresa en miles de litros)
• Peso - Peso de en kilogramos de los animales sacrificados, una vez retiradas las partes que no se consideran dentro de la canal. La canal es determinada dependiendo la especie pecuaria que se trate.
• Precio_Promedio - Es el precio promedio por kilogramo de la carne canal pagado al productor. Para el caso de la leche, huevo para plato, miel, cera en greñay lana sucia, es el precio al que el productor realiza la primera venta a pie de rancho o granja. Las unidades están expresadas en peso por kilogramo, excepto para el caso de la leche, cuya unidad se expresa en pesos por litro.
• Valor - Es el valor monetario a pesos corrientes de los productos pecuarios durante el periodo de referencia, la unidad esta dada en miles de pesos.
• Sacrificado - Número de animales que se sacrificaron para obtener la producción de carne canal que se reporta. La unidad se expresa en cabezas.

Datos de temperatura minima,media,maxima y precipitaciones en México (2005 - 2020)

Temperaturas <- read_excel("Temperaturas.xlsx")
Temperaturas <-Temperaturas %>% mutate_at("Entidad" , factor)
Temperaturas<- Temperaturas %>% mutate_at("Año" , factor)
datatable(Temperaturas)

Tabla de Datos Datos de la temperatura minima,media y maxima promedio,ademas de la Precipitacion por metro cubico en México por Estado del año 2005 hasta 2020(Anual)

Significado de los datos

• Año - Año de registro de los datos.
• Entidad - Estado de la república mexicana de donde pertenecen los datos.
• Temperatura_Minima_Promedio_Celsius - Temperatura minima promedio en Celcius.
• Temperatura_Media_Promedio_Celsius - Temperatura media promedio en Celcius.
• Temperatura_Maxima_Promedio_Celsius - Temperatura maxima promedio en Celcius.
• MM - Precipitacion por metro cubico.

Datos de temperatura minima,media,maxima, precipitaciones en México e IVF(Indice del Volumen Fisico del año 2021

datos2021 <- read_excel("Datos-2021.xlsx")
datatable(datos2021)

Tabla de Datos Datos de la temperatura minima,media y maxima promedio, de la Precipitacion por metro cubico en México y el IVF por Estado del año 2021 ### Significado de los datos

• Año - Año de registro de los datos.
• Entidad - Estado de la república mexicana de donde pertenecen los datos.
• Temperatura_Minima_Promedio_Celsius - Temperatura minima promedio en Celcius.
• Temperatura_Media_Promedio_Celsius - Temperatura media promedio en Celcius.
• Temperatura_Maxima_Promedio_Celsius - Temperatura maxima promedio en Celcius.
• MM - Precipitacion por metro cubico.
• Promedio_IVF Promedio del Indice de Volumen Fisico
• Sequia - Presenta Sequia=No =No Presenta Sequia=SI

Impacto de la ganadería en el medio ambiente

A medida que el sector ganadero se desarrolla, sus requerimientos de tierra crecen y el sector sufre una transición geográfica que involucra cambios en la intensidad del uso de la tierra y en los patrones de distribución geográfica. En cuanto al impacto de la ganadería en el cambio climático y la contaminación del aire, se reconoce que las actividades ganaderas emiten cantidades considerables de gases invernadero, dióxido de carbono (CO2), metano (CH4) y óxido nitroso (N2O), que contribuyen de manera importante al cambio climático. Los rumiantes, y en menor medida, los monogástricos emiten metano como parte de su proceso digestivo que involucra la fermentación microbiana de alimentos fibrosos. Las excretas animales emiten metano (CH4), óxido nitroso (N2O), amoniaco (NH3) y dióxido de carbono (CO2), en función de cómo salen de las instalaciones (sólida o líquida) y de su manejo en la recolección, almacenamiento y aplicación a la agricultura. La ganadería afecta el balance de carbono de la tierra que se usa para alimento animal y contribuye, de forma indirecta, a la liberación de enormes cantidades de carbono a la atmósfera. Lo mismo sucede cuando se clarea el bosque para pastizales. Los combustibles fósiles empleados en los procesos productivos, desde la producción de alimento animal, hasta el mercadeo de productos, también emiten gases invernadero. Muchos de estos efectos indirectos son difíciles de cuantificar. Aunque las enfermedades humanas ocasionadas por excretas animales no son frecuentes, en granjas avícolas los trabajadores pueden presentar asma, pulmonía y enfermedades oculares (irritación) cuando la ventilación en las granjas es deficiente. Otro riesgo de enfermedades para la población humana es el consumo de agua contaminada con: El estiércol contiene bacterias patógenas y la más común es Escherichia coli que causa diarrea y gases abdominales, contenidos altos de nitratos que reducen la capacidad de transporte de oxígeno en la sangre, conocida como metahemoglobinemia, hormonas, principalmente estrógenos, relacionadas con una reducción en la cantidad de esperma en humanos. Los estudios comparativos de impacto ambiental entre sistemas de producción animal extensivos y tecnificados son escasos. Sugieren que los sistemas de producción de leche de tipo orgánico impactan menos al agua y al suelo, pero emiten más gases de efecto invernadero, comparados con los sistemas de producción de leche convencionales. Sin embargo, los resultados son inciertos porque en su mayoría se basan en el concepto de cantidad y no de eficiencia. Por ejemplo, los contaminantes de la cadena productiva de la industria lechera se deben evaluar considerando aquellos provenientes de la producción de cultivos y granos, producción y transporte de leche, procesamiento, empaque, distribución, venta al detalle, consumo y eliminación. La aplicación de estiércol en tierras de cultivo proporciona un beneficio ecológico al depositar nutrientes como nitrógeno y fósforo en el suelo; el nitrógeno del estiércol se encuentra principalmente en forma de amoniaco y las plantas lo usan como nutriente

(graficas?)

El estado de Sonora es uno de los principales sectores donde la ganadería se desarrolla de una manera más usual y con una muy buena producción actualmente alberga 553 millones de aves, 33,8 millones de bovinos, 16,7 millones de cerdos, 8,8 millones de ovejas y 1,9 millones de colmenas. Por ende, además de brindar alimento a las familias mexicanas, la industria ganadera ha contribuido en gran medida al crecimiento, estabilidad y fortalecimiento de la economía. Sin embargo, dada a las fuertes sequías que se han presentado en estos últimos años, la Conagua expuso que la falta de precipitaciones ha ocasionado que en Sonora, al menos 50 municipios se encuentren anormalmente secos, mientras que 14 presentan sequía en nivel moderado y dos en una forma más severa ,afectando principalmente al sector agropecuaria donde se presentaron pérdidas de miles(400000) de cabezas de ganado, debido a mortandad, venta o sacrificio.

Impacto ganadero: El 40% de los cereales que se producen se dedica a la alimentación de animales para la producción de carne. Según el informe Perspectivas del Medio Ambiente Mundial de la ONU, “La agricultura utiliza un promedio del 70 por ciento de los recursos de agua dulce”, y en algunos países esta cifra alcanza el 90 por ciento.

Datos de consumo: Una persona que come carne necesita 6100 litros de agua a la semana, el equivalente a beber 8 años de agua.

Para producir un kilo de carne en Hermosillo, Sonora se necesitan entre 10 mil y 13 mil litros de agua, además la agricultura y la ganadería gastan más del 70% del recurso natural en Sonora. Mientras que 8 personas solo pueden comer un kilogramo de carne para obtener un kilo de trigo solo se requieren 1.500 litros logrando alimentar a 150 personas. La huella hídrica de la carne de vacuno es seis veces mayor que la de las legumbres.

Amenaza inminente: informe de Nestlé filtrado por Wikileaks muestra que el consumo excesivo de carne podría conducir a una escasez de agua que podría afectar a un tercio de la población mundial para 2025, y alcanzaremos una condición crítica para 2050. Esto se debe a que para alimentar a 9600 millones de personas en la Tierra para 2050, la producción de alimentos deberá aumentar en un 50 %.

El clima del planeta Tierra varía según las épocas y las zonas donde los cambios climáticos observados se extienden generalmente por largos períodos de tiempo. No obstante, en las últimas décadas, estos cambios parecen haberse acelerado de acuerdo a algunos indicadores, como el aumento de la temperatura, la reducción de la superficie del hielo Ártico y de los glaciares continentales, el aumento del nivel medio global del mar, e indicadores biológicos como el desplazamiento de las poblaciones de animales terrestres y marinos; así como el desplazamiento de las etapas de las actividades agrícolas. La acumulación de gases de efecto invernadero en la atmósfera terrestre está ocasionando un cambio climático con graves implicaciones, como fenómenos meteorológicos extremos, cambios en la función y composición de los ecosistemas. Debido a su importancia, resulta relevante analizar el impacto del cambio climático en los sistemas de producción pecuarios. Un área que requiere especial atención es precisamente la salud animal, la emergencia y reemergencia de enfermedades vectoriales en numerosas regiones del planeta constituye un claro ejemplo de asociación entre cambio climático y efectos sobre la interfaz de la salud humana/animal. Dichas afectaciones a la salud animal pueden obedecer a múltiples factores sociales y medioambientales, provocando las llamadas “enfermedades de la producción”, los cuales influencian la aparición de enfermedades emergentes. Sin embargo, cada región y cada sistema de producción tiene sus propias vulnerabilidades. Estos aspectos deben tomarse en cuenta para diseñar mapas de riesgos locales y regionales; así como diseñar, instrumentar y socializar eficientemente procesos de manejo de riesgos ante enfermedades. El sector ganadero se enfrenta a una paradoja. Por un lado, se le atribuye la generación de GEI, de acuerdo con datos de la FAO15, ya que a nivel mundial la producción de carne y leche de bovino es responsable de la mayoría de las emisiones, pues contribuye con el 41 y el 29 %, respectivamente, de las emisiones del sector. La carne de cerdo y los huevos de aves de corral contribuyen con el 9 y el 8 % de las emisiones del sector. La producción y elaboración de piensos y la fermentación entérica debida a los animales rumiantes son las dos fuentes principales de emisiones, responsables del 45 y el 39 % de las emisiones del sector. El almacenamiento y elaboración del estiércol representa el 10 %. La parte restante se atribuye a la elaboración y el transporte de productos pecuarios. El impacto del cambio climático en los sistemas extensivos se traduce en la menor disponibilidad de alimentos, por consecuencia de la disminución de la producción agrícola y la insuficiencia de condiciones para mantener a la producción pecuaria que requiere amplias cantidades de pastizales para mantener al ganado, lo que, en suma, deriva en una dieta pobre en nutrientes para las poblaciones más vulnerables. Las condiciones se tornan más graves, toda vez que la dependencia de los productores con respecto de los ciclos naturales de la producción e, incluso, la ubicación geográfica de las tierras donde habitan los coloca en una situación de vulnerabilidad.

Datos

El desarrollo del siguiente analisis solo sera realizado al año 2021, el año mas actual donde se presentan mejores, datos con el fin de obtener mejores resultados.

datosL0<-read_excel("datosLogistica.xlsx")
datosL<-data.frame(datosL0)
datatable(datosL)

Los datos de este caso estan etiquetados en Se presento Sequia=1 y No se presento=0.

Tabla de frecuencia de los datos

tabla <- table(datosL$Sequia)
tabla

## 
##  0  1 
## 16 16

Según la tabla anterior se presentaron 16 estados que tuvieron problemas de sequia gracias a la temperatura que promedio maxima que se presento, sin embargo, sera un factor clave la temperatura o no.

Viendo esta relación gráficamente

colores <- NULL
colores[datosL$Sequia == 0] <- "blue"
colores[datosL$Sequia == 1] <- "red"
plot(datosL$Temperatura_Maxima_Promedio_Celsius, datosL$Sequia, pch=21, bg= colores,
     xlab = "Temperatura maxima promedio", ylab = "Probabilidad Sequia")
legend("top", c( "No presenta Sequia","Presenta sequia"), pch=21, col = c("blue", "red"))

A simple vista los datos nos hacen pensar que la temperatura maxima registrada puede influir en una gran mandera a la probabilidad de que los estados de mexico presenten o no sequia. 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(Sequia ~ Temperatura_Maxima_Promedio_Celsius, data=datosL , family= binomial)
summary(regresion)

## 
## Call:
## glm(formula = Sequia ~ Temperatura_Maxima_Promedio_Celsius, family = binomial, 
##     data = datosL)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.53102  -1.04325   0.06474   1.09614   1.48535  
## 
## Coefficients:
##                                     Estimate Std. Error z value Pr(>|z|)
## (Intercept)                          -6.4842     4.0269   -1.61    0.107
## Temperatura_Maxima_Promedio_Celsius   0.2208     0.1363    1.62    0.105
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 44.361  on 31  degrees of freedom
## Residual deviance: 41.445  on 30  degrees of freedom
## AIC: 45.445
## 
## Number of Fisher Scoring iterations: 4

En la tabla anterior el alimento es lo suficientemente significativo con un pvalor = 0.105, 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 temperatura mayor porbabilidad de sequia.

• 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 temperaturas maximas promedio (20 y 35 ): Por lo tanto generamos una secuencia de datos, el cula llamaremos datos nuevos, con separaciones de 0.1.

datos_nuevos <-data.frame(Temperatura_Maxima_Promedio_Celsius= seq(20,35,0.1)   )
datos_nuevos

##     Temperatura_Maxima_Promedio_Celsius
## 1                                  20.0
## 2                                  20.1
## 3                                  20.2
## 4                                  20.3
## 5                                  20.4
## 6                                  20.5
## 7                                  20.6
## 8                                  20.7
## 9                                  20.8
## 10                                 20.9
## 11                                 21.0
## 12                                 21.1
## 13                                 21.2
## 14                                 21.3
## 15                                 21.4
## 16                                 21.5
## 17                                 21.6
## 18                                 21.7
## 19                                 21.8
## 20                                 21.9
## 21                                 22.0
## 22                                 22.1
## 23                                 22.2
## 24                                 22.3
## 25                                 22.4
## 26                                 22.5
## 27                                 22.6
## 28                                 22.7
## 29                                 22.8
## 30                                 22.9
## 31                                 23.0
## 32                                 23.1
## 33                                 23.2
## 34                                 23.3
## 35                                 23.4
## 36                                 23.5
## 37                                 23.6
## 38                                 23.7
## 39                                 23.8
## 40                                 23.9
## 41                                 24.0
## 42                                 24.1
## 43                                 24.2
## 44                                 24.3
## 45                                 24.4
## 46                                 24.5
## 47                                 24.6
## 48                                 24.7
## 49                                 24.8
## 50                                 24.9
## 51                                 25.0
## 52                                 25.1
## 53                                 25.2
## 54                                 25.3
## 55                                 25.4
## 56                                 25.5
## 57                                 25.6
## 58                                 25.7
## 59                                 25.8
## 60                                 25.9
## 61                                 26.0
## 62                                 26.1
## 63                                 26.2
## 64                                 26.3
## 65                                 26.4
## 66                                 26.5
## 67                                 26.6
## 68                                 26.7
## 69                                 26.8
## 70                                 26.9
## 71                                 27.0
## 72                                 27.1
## 73                                 27.2
## 74                                 27.3
## 75                                 27.4
## 76                                 27.5
## 77                                 27.6
## 78                                 27.7
## 79                                 27.8
## 80                                 27.9
## 81                                 28.0
## 82                                 28.1
## 83                                 28.2
## 84                                 28.3
## 85                                 28.4
## 86                                 28.5
## 87                                 28.6
## 88                                 28.7
## 89                                 28.8
## 90                                 28.9
## 91                                 29.0
## 92                                 29.1
## 93                                 29.2
## 94                                 29.3
## 95                                 29.4
## 96                                 29.5
## 97                                 29.6
## 98                                 29.7
## 99                                 29.8
## 100                                29.9
## 101                                30.0
## 102                                30.1
## 103                                30.2
## 104                                30.3
## 105                                30.4
## 106                                30.5
## 107                                30.6
## 108                                30.7
## 109                                30.8
## 110                                30.9
## 111                                31.0
## 112                                31.1
## 113                                31.2
## 114                                31.3
## 115                                31.4
## 116                                31.5
## 117                                31.6
## 118                                31.7
## 119                                31.8
## 120                                31.9
## 121                                32.0
## 122                                32.1
## 123                                32.2
## 124                                32.3
## 125                                32.4
## 126                                32.5
## 127                                32.6
## 128                                32.7
## 129                                32.8
## 130                                32.9
## 131                                33.0
## 132                                33.1
## 133                                33.2
## 134                                33.3
## 135                                33.4
## 136                                33.5
## 137                                33.6
## 138                                33.7
## 139                                33.8
## 140                                33.9
## 141                                34.0
## 142                                34.1
## 143                                34.2
## 144                                34.3
## 145                                34.4
## 146                                34.5
## 147                                34.6
## 148                                34.7
## 149                                34.8
## 150                                34.9
## 151                                35.0

Cálculo de las nuevas probabilidades

probabilidades_nuevas <- predict(regresion, datos_nuevos, type="response")
probabilidades_nuevas 

##         1         2         3         4         5         6         7         8 
## 0.1121749 0.1143925 0.1166482 0.1189424 0.1212755 0.1236480 0.1260602 0.1285126 
##         9        10        11        12        13        14        15        16 
## 0.1310055 0.1335394 0.1361146 0.1387315 0.1413905 0.1440920 0.1468362 0.1496235 
##        17        18        19        20        21        22        23        24 
## 0.1524544 0.1553289 0.1582476 0.1612107 0.1642184 0.1672710 0.1703688 0.1735120 
##        25        26        27        28        29        30        31        32 
## 0.1767009 0.1799356 0.1832163 0.1865433 0.1899166 0.1933364 0.1968029 0.2003160 
##        33        34        35        36        37        38        39        40 
## 0.2038760 0.2074828 0.2111365 0.2148371 0.2185846 0.2223789 0.2262200 0.2301079 
##        41        42        43        44        45        46        47        48 
## 0.2340423 0.2380233 0.2420505 0.2461239 0.2502432 0.2544081 0.2586185 0.2628740 
##        49        50        51        52        53        54        55        56 
## 0.2671743 0.2715190 0.2759078 0.2803402 0.2848158 0.2893341 0.2938947 0.2984969 
##        57        58        59        60        61        62        63        64 
## 0.3031403 0.3078242 0.3125480 0.3173111 0.3221127 0.3269522 0.3318289 0.3367419 
##        65        66        67        68        69        70        71        72 
## 0.3416904 0.3466736 0.3516907 0.3567407 0.3618228 0.3669360 0.3720793 0.3772518 
##        73        74        75        76        77        78        79        80 
## 0.3824524 0.3876800 0.3929336 0.3982121 0.4035144 0.4088393 0.4141857 0.4195524 
##        81        82        83        84        85        86        87        88 
## 0.4249381 0.4303418 0.4357621 0.4411978 0.4466477 0.4521103 0.4575846 0.4630691 
##        89        90        91        92        93        94        95        96 
## 0.4685626 0.4740637 0.4795711 0.4850834 0.4905994 0.4961177 0.5016370 0.5071558 
##        97        98        99       100       101       102       103       104 
## 0.5126729 0.5181869 0.5236965 0.5292003 0.5346970 0.5401853 0.5456639 0.5511315 
##       105       106       107       108       109       110       111       112 
## 0.5565867 0.5620283 0.5674550 0.5728656 0.5782588 0.5836334 0.5889882 0.5943220 
##       113       114       115       116       117       118       119       120 
## 0.5996336 0.6049219 0.6101858 0.6154241 0.6206358 0.6258198 0.6309751 0.6361007 
##       121       122       123       124       125       126       127       128 
## 0.6411955 0.6462587 0.6512893 0.6562865 0.6612492 0.6661767 0.6710683 0.6759230 
##       129       130       131       132       133       134       135       136 
## 0.6807401 0.6855190 0.6902588 0.6949591 0.6996190 0.7042380 0.7088156 0.7133512 
##       137       138       139       140       141       142       143       144 
## 0.7178442 0.7222943 0.7267008 0.7310635 0.7353819 0.7396557 0.7438844 0.7480679 
##       145       146       147       148       149       150       151 
## 0.7522058 0.7562979 0.7603439 0.7643437 0.7682971 0.7722039 0.7760641

Representación gráfica del ajuste:

colores <- NULL
colores[datosL$Sequia == 0] <- "blue"
colores[datosL$Sequia == 1] <- "red"
plot(datosL$Temperatura_Maxima_Promedio_Celsius, datosL$Sequia, pch=21, bg= colores,
     xlab = "Temperatura maxima promedio", ylab = "Probabilidad Sequia")
legend("top", c("Presenta sequia", "No presenta Sequia"), pch=21, col = c("blue", "red"))
lines(datos_nuevos$Temperatura_Maxima_Promedio_Celsius, probabilidades_nuevas)

Desarollo

Los datos a utilizar en el siguiente analis KNN sera son datos del año 2021 ya que para realizar un maejor trabajo,no se encuentran datos del año 2000 al 2013, sin embargo, nos centraremos en el año anteriormente mencionado.

dim(datos2021)

## [1] 32  8

La dimension total de los datos es de 32 registros dividios en 8 columnas principales, como se muestra a continuación:

datatable(datos2021)

Representacion grafica

Para una mejor representacion de los datos estos sera clasificados en base a las precipitaciones y el promedio del indice de volumen fisico, clasificandolos en si estos presentan sequia o no.

data(datos2021) 

## Warning in data(datos2021): data set 'datos2021' not found

qplot(datos2021$MM,datos2021$Promedio_IVF, data =datos2021, color = datos2021$Sequia, xlab =  "Precipitacion MM", ylab = "Promedio del IVF")

## Warning: Use of `datos2021$MM` is discouraged. Use `MM` instead.

## Warning: Use of `datos2021$Promedio_IVF` is discouraged. Use `Promedio_IVF`
## instead.

## Warning: Use of `datos2021$Sequia` is discouraged. Use `Sequia` instead.

### Datos

Para un mejor desarrollo del ejemplo sera necesaria la normalizacion de los datos a trabajar, la normalización consiste en crear una función que transforme los datos de las dimensiones en una escala que se calcula del cociente del valor en cuestión menos el valor mínimo de la lista entre el rango de la lista.

datos <- datos2021
nor <-function(x) {(x -min(x))/(max(x)-min(x))}
datos_norm <- as.data.frame(lapply(datos[,c(6,8)], nor))
datos_norm <- cbind(datos_norm, datos[,7])
head(datos_norm)

##            MM Promedio_IVF Sequia
## 1 0.134877384    0.3604442     NO
## 2 0.005903724    0.5936982     SI
## 3 0.000000000    0.4001009     SI
## 4 0.465940054    0.1261086     SI
## 5 0.070390554    0.2889177     SI
## 6 0.371480472    0.1938135     NO

Al tratarse de un modelo supervisado, es necesario primero realizar un entrenamiento con una parte de los datos normalizados “datos_norm”. Se tomara el 70% como una muestra para “entrenar” el modelo y el 30% restante para probar el modelo.

id_muestra <- sample(1:nrow(datos_norm), 0.7*nrow(datos_norm))
modelo_knn_train <- datos_norm[id_muestra, -3]
modelo_knn_test <- datos_norm[-id_muestra, -3]

Modelo KNN de entrenamiento

head(modelo_knn_train) 

##           MM Promedio_IVF
## 13 0.2720254    0.1912899
## 19 0.1934605    0.2402480
## 17 0.3623978    0.3525128
## 10 0.1425976    0.1095248
## 22 0.1748411    0.2522893
## 8  0.1139873    0.3070877

Modelo knn de entrenamiento

head(modelo_knn_test) 

##             MM Promedio_IVF
## 1  0.134877384    0.3604442
## 2  0.005903724    0.5936982
## 9  0.238419619    0.3339102
## 11 0.198910082    0.3573437
## 12 0.423705722    0.3008148
## 15 0.309718438    0.4251208

Implementación del modelo

*Seleccionar el número K de los vecinos

Para determinar un número k de los vecinos se realizara calculando la raiz cuadrada de los datos totales de modelo_knn_train(Datos de entrenamiento) y modelo_knn_test.

train_df <- datos_norm[id_muestra, 3]
test_df <- datos_norm[-id_muestra, 3]

El calculo de las raices cuadradas se realizara mediante las siguientes funciones:

k_1 <- floor(sqrt(nrow(modelo_knn_train)))
k_1

## [1] 4

k_2 <- ceiling(sqrt(nrow(modelo_knn_test)))
k_2

## [1] 4

Corrida del modelo

Para la realización del algoritmo KNN sera realizado mediante los datos de entrenamiento y de prueba, por ende se correra la función knn de la librería “class” con la siguiente configuración:

Datos para entrenar: modelo_knn_train Datos para probar: modelo_knn_test k = coeficientes k_1 o k_2 cl = datos de salida train_df

Predicción de especies con un valor de k = k_1

knn.A <- knn(modelo_knn_train, modelo_knn_test, cl=train_df, k=k_1)
knn.A

##  [1] NO SI NO SI NO NO NO NO SI NO
## Levels: NO SI

Predicción de especies con un valor de k = k_2

knn.B <- knn(modelo_knn_train, modelo_knn_test, cl=train_df, k=k_2)
knn.B

##  [1] NO SI NO NO NO NO SI NO SI SI
## Levels: NO SI

Evaluación de la prediccion del modelo

El modelo se probara con los datos de “iris”, generando una matriz de para evaluar la efectividad del modelo y si este puede predecir la especie en función de los parámetros.

matriz_A <- table(knn.A, test_df)
matriz_A

##      test_df
## knn.A NO SI
##    NO  4  3
##    SI  1  2

matriz_B <- table(knn.B, test_df)
matriz_B

##      test_df
## knn.B NO SI
##    NO  4  2
##    SI  1  3

La tasa de los errores de clasificación se calcula dividiendo los valores predichos entre los valores reales de las matrices.

Precisión del modelo A(Datos de entrenamiento)

real <- table(test_df,test_df)
precision_knn.A <- sum(diag(matriz_A))/sum(diag(real))
precision_knn.A

## [1] 0.6

Precisión del modelo B(Datos de prueba)

precision_knn.B <- sum(diag(matriz_B))/sum(diag(real))
precision_knn.B

## [1] 0.7

Primer modelo de regresión lineal múltiple

A continuación, se evaluará el modelo utilizando todas las variables como predictoras, de esta manera podremos saber cuales se consideran más significativas para representar la esperanza de vida.

modelo2 <- (lm(formula = datosC$`Promedio IVF` ~ datosC$MM +datosC$Temperatura_Minima_Promedio_Celsius+datosC$Temperatura_Media_Promedio_Celsius+datosC$Temperatura_Maxima_Promedio_Celsius, data = datosC))
summary(modelo2) 

## 
## Call:
## lm(formula = datosC$`Promedio IVF` ~ datosC$MM + datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Media_Promedio_Celsius + datosC$Temperatura_Maxima_Promedio_Celsius, 
##     data = datosC)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -31.742 -10.786  -2.561   4.465  85.955 
## 
## Coefficients:
##                                             Estimate Std. Error t value
## (Intercept)                                68.891041  23.048194   2.989
## datosC$MM                                   0.001254   0.003621   0.346
## datosC$Temperatura_Minima_Promedio_Celsius -1.682384   2.740017  -0.614
## datosC$Temperatura_Media_Promedio_Celsius   0.846870   4.411817   0.192
## datosC$Temperatura_Maxima_Promedio_Celsius  1.636365   1.825918   0.896
##                                            Pr(>|t|)   
## (Intercept)                                 0.00318 **
## datosC$MM                                   0.72945   
## datosC$Temperatura_Minima_Promedio_Celsius  0.53996   
## datosC$Temperatura_Media_Promedio_Celsius   0.84799   
## datosC$Temperatura_Maxima_Promedio_Celsius  0.37130   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 18.31 on 187 degrees of freedom
## Multiple R-squared:  0.02457,    Adjusted R-squared:  0.003705 
## F-statistic: 1.178 on 4 and 187 DF,  p-value: 0.3221

• –> Podemos observar que nuestro modelo con todas sus variables puede describir con un 32.22% de exactitud el promedio Indice de Volumen Fisico con un error de 0.003705, esto resulta como mencionamos anteriormente el modelo puede ser mas exacto con dos variables o incluso una como el analis realizado anteriormente.

Para revisar nuestro modelo y hacer los ajustes necesarios utilizaremos el criterio de Akaike.

Evaluacion General del modelo(AIC)

El criterio de información de Akaike (AIC) es una medida de la calidad relativa de un modelo estadístico, para un conjunto dado de datos. Como tal, el AIC proporciona un medio para la selección del modelo. AIC maneja un trade-off entre la bondad de ajuste del modelo y la complejidad del modelo. Por lo tanto se procederá a evaluar el modelo anteriormente realizado, con el fin de que este nos proporcione cuales serían las mejores variables para la realización de un nuevo modelo.

step(object = modelo2, direction = "both", trace = 1)

## Start:  AIC=1121.37
## datosC$`Promedio IVF` ~ datosC$MM + datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Media_Promedio_Celsius + datosC$Temperatura_Maxima_Promedio_Celsius
## 
##                                              Df Sum of Sq   RSS    AIC
## - datosC$Temperatura_Media_Promedio_Celsius   1    12.352 62699 1119.4
## - datosC$MM                                   1    40.218 62726 1119.5
## - datosC$Temperatura_Minima_Promedio_Celsius  1   126.379 62813 1119.8
## - datosC$Temperatura_Maxima_Promedio_Celsius  1   269.233 62956 1120.2
## <none>                                                    62686 1121.4
## 
## Step:  AIC=1119.41
## datosC$`Promedio IVF` ~ datosC$MM + datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Maxima_Promedio_Celsius
## 
##                                              Df Sum of Sq   RSS    AIC
## - datosC$MM                                   1     30.09 62729 1117.5
## <none>                                                    62699 1119.4
## - datosC$Temperatura_Minima_Promedio_Celsius  1   1017.06 63716 1120.5
## + datosC$Temperatura_Media_Promedio_Celsius   1     12.35 62686 1121.4
## - datosC$Temperatura_Maxima_Promedio_Celsius  1   1551.42 64250 1122.1
## 
## Step:  AIC=1117.5
## datosC$`Promedio IVF` ~ datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Maxima_Promedio_Celsius
## 
##                                              Df Sum of Sq   RSS    AIC
## <none>                                                    62729 1117.5
## - datosC$Temperatura_Minima_Promedio_Celsius  1   1112.45 63841 1118.9
## + datosC$MM                                   1     30.09 62699 1119.4
## + datosC$Temperatura_Media_Promedio_Celsius   1      2.22 62726 1119.5
## - datosC$Temperatura_Maxima_Promedio_Celsius  1   1535.46 64264 1120.2

## 
## Call:
## lm(formula = datosC$`Promedio IVF` ~ datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Maxima_Promedio_Celsius, data = datosC)
## 
## Coefficients:
##                                (Intercept)  
##                                     72.623  
## datosC$Temperatura_Minima_Promedio_Celsius  
##                                     -1.076  
## datosC$Temperatura_Maxima_Promedio_Celsius  
##                                      1.878

• –> En el gráfico 1.7 nos muestra la prueba del modelo de Akaike, el cual ya mencionado anteriormente, nos permite conocer cuales variables son las que mejor se correlacionan con el promedio del Indice de Volumen Fisco. Podemos ver que los resultados muestran que Temperatura minima promedio y maxima son las variables que mas impacto tienen de acuerdo al pomedio del indice del volumen fisico, así mismo eliminando las que no tiene tanta importancia en el modelo.

Modelo Ajustado

Como resultado del proceso AIC nos muestra el modelo ajustado que quita la variable Área, Analfabetismo y Ingreso del modelo, esto por considerarlas no tan significativas para nuestro modelo.

Ahora vamos a revisar nuestro modelo ajustado.

modelo3 <- (lm(formula = datosC$`Promedio IVF` ~ datosC$Temperatura_Minima_Promedio_Celsius + 
    datosC$Temperatura_Maxima_Promedio_Celsius, data = datosC))
summary(modelo3)

## 
## Call:
## lm(formula = datosC$`Promedio IVF` ~ datosC$Temperatura_Minima_Promedio_Celsius + 
##     datosC$Temperatura_Maxima_Promedio_Celsius, data = datosC)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -32.263 -10.625  -1.816   4.544  85.768 
## 
## Coefficients:
##                                            Estimate Std. Error t value Pr(>|t|)
## (Intercept)                                 72.6232    18.6661   3.891 0.000138
## datosC$Temperatura_Minima_Promedio_Celsius  -1.0757     0.5876  -1.831 0.068707
## datosC$Temperatura_Maxima_Promedio_Celsius   1.8783     0.8733   2.151 0.032755
##                                               
## (Intercept)                                ***
## datosC$Temperatura_Minima_Promedio_Celsius .  
## datosC$Temperatura_Maxima_Promedio_Celsius *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 18.22 on 189 degrees of freedom
## Multiple R-squared:  0.02391,    Adjusted R-squared:  0.01358 
## F-statistic: 2.315 on 2 and 189 DF,  p-value: 0.1016

• –> Como podemos observar, el nuevo modelo ajustado es capaz de describir de una peor manera el promedio del IVF con una exactitud de 10.16% esto supone una caida del 70% con respecto al modelo inicial donde solo se utilizo las precipatciones por metro cubico, por el modelo se predice mejor con una sola variable con una exactitud del 80%.

Intervalo de Confianza de los coeficientes

El intervalo de confianza para los coeficientes parciales de regresión se puede observar en la siguiente tabla:

confint(lm(formula = datosC$`Promedio IVF` ~ datosC$MM+ datosC$Temperatura_Minima_Promedio_Celsius + 
    datosC$Temperatura_Maxima_Promedio_Celsius))

##                                                   2.5 %       97.5 %
## (Intercept)                                33.436365724 1.092089e+02
## datosC$MM                                  -0.005696286 7.742616e-03
## datosC$Temperatura_Minima_Promedio_Celsius -2.497062650 1.519750e-01
## datosC$Temperatura_Maxima_Promedio_Celsius  0.165741131 3.716411e+00

• –> Aquí podemos mobervar los intervalos de confianza de cada uno de las variables. Teniendo un IC(95%).

Análisis de residuales

plot1 <- ggplot(data = datosC, aes(datosC$MM, modelo2$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot2 <- ggplot(data = datosC, aes(datosC$Temperatura_Minima_Promedio_Celsius, modelo2$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot3 <- ggplot(data = datosC, aes(datosC$Temperatura_Media_Promedio_Celsius, modelo2$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot4 <- ggplot(data = datosC, aes(datosC$Temperatura_Maxima_Promedio_Celsius, modelo2$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
grid.arrange(plot1, plot2, plot3, plot4)

## Warning: Use of `datosC$MM` is discouraged. Use `MM` instead.
## Use of `datosC$MM` is discouraged. Use `MM` instead.

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Warning: Use of `datosC$Temperatura_Minima_Promedio_Celsius` is discouraged. Use
## `Temperatura_Minima_Promedio_Celsius` instead.

## Warning: Use of `datosC$Temperatura_Minima_Promedio_Celsius` is discouraged. Use
## `Temperatura_Minima_Promedio_Celsius` instead.

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Warning: Use of `datosC$Temperatura_Media_Promedio_Celsius` is discouraged. Use
## `Temperatura_Media_Promedio_Celsius` instead.

## Warning: Use of `datosC$Temperatura_Media_Promedio_Celsius` is discouraged. Use
## `Temperatura_Media_Promedio_Celsius` instead.

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Warning: Use of `datosC$Temperatura_Maxima_Promedio_Celsius` is discouraged. Use
## `Temperatura_Maxima_Promedio_Celsius` instead.

## Warning: Use of `datosC$Temperatura_Maxima_Promedio_Celsius` is discouraged. Use
## `Temperatura_Maxima_Promedio_Celsius` instead.

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Distribución normal de los residuos

¿Qué es una distribución normal de los residuos? Normal QQ-Plot: Es una forma de comparar la distribución de probabilidad normal con la distribución de probabilidad de los residuos de nuestro modelo lineal, si estos forman una línea recta, este es un indicador de que los residuos están distribuidos de forma normal. Por lo tanto se aplicara esta distribución al último modelo que se ha realizado esto con el fin observar los residuos de este modelo, que en este caso fue el mejor que nos proporcionó el método AIC, al aplicarlo a todas las variables en relación al promedio del indice del volumen fisico.

qqnorm(modelo3$residuals)
qqline(modelo3$residuals)

• –> En el grafico 2.1, podemos obervar que la comparación de la distribución de probabilidad normal con la distribución de probabilidad de los residuos de nuestro modelo lineal si forman en la mayoria de la gráfica una linea recta, lo cual indica que los datos de los residuos estan distribuidos de manera normal.

Prueba de normalidad de Shapiro-wilk

Se hizo un análisis de Shapiro-wilk con los valores teóricos vs los valores de las muestras, con lo que se pude llegar a observar que la mayoría de los datos si están tocando la línea de tendencia, lo que nos dice la teoría que se maneja es correcta con respecto a los datos recolectados.

shapiro.test(modelo3$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo3$residuals
## W = 0.84359, p-value = 4.309e-13

Comparación de los valores ajustados vs los valores residuales

ggplot(data = datosC, aes(modelo$fitted.values, modelo$residuals)) +
geom_point() +
geom_smooth(color = "firebrick", se = FALSE) +
geom_hline(yintercept = 0) +
theme_bw()

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

• –> Es requerido no tomar en cuenta los valores extremos, con lo que nos dice que los valores ajustados y los residuales, contienen un nivel de dispersión no muy grande, teniendo un buen porcentaje de aceptabilidad de la realidad en base a la teoría.

Por ende podemos concluir que las preciptaciones por metro cubrico presentadas en los estados influyen en gran medida en el indice de volumen fisico de los estados.

Código

xfun::embed_file("CasoEstudioFinal.Rmd")

Download CasoEstudioFinal.Rmd

Temperaturas minima, media y maxima 2005-2021

xfun::embed_file("Temperaturas.xlsx")

Download Temperaturas.xlsx

Produccion-Pecuaria-Mexico.xlsx 2005-2021

xfun::embed_file("Produccion-Pecuaria-Mexico.csv")

Download Produccion-Pecuaria-Mexico.csv