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 mínima, media, máxima y precipitaciones en México (2005 - 2020)

Los datos de Temperatura y Precipitaciones de México se obtuvieron de la página de CONAGUA que se encuentra en el siguiente enlace: https://smn.conagua.gob.mx/es/climatologia/temperaturas-y-lluvias/resumenes-mensuales-de-temperaturas-y-lluvias

Se cuenta con registros a nivel Estatal del año 2005 hasta 2020, que incluyen Temperatura Mínima, Promedio y Máxima así como la cantidad de precipitaciónes en Milímetros

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

Datos de temperatura mínima, media, máxima promedio, ademas de la Precipitacion por metro cubico en México por Estado del año 2005 hasta 2020

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 mínima, media, máxima, precipitaciones en México e IVF (Indice del Volumen Fisico del año 2021)

La siguiente tabla es una es similar a la anterior, sólo que esta incluye el índice de Volumen Físico de producción pecuaria en toneladas, este también es obtenido del SIAP, que se encuentra en el siguiente enlace: http://infosiap.siap.gob.mx/gobmx/datosAbiertos.php

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

Datos de temperatura mínima, media, máxima 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 - Indice de Volumen Físico en toneladas sobre la variación de generación de productos Pecuarios (Siendo Pecuarios la Carne en Canal de Bovino, Caprino, Ovino, Pavo, Pollo y Gallina, Porcino, huevos de gallina, leche de bovino, caprino y miel de abeja) en referencia a la producción del año 2013.
• Sequia - Representa si el estado se encuentra actualmente con más del 25% de su territorio con problemas de sequía.

Datos

El desarrollo del siguiente análisis solo será realizado al año 2021.

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

Los datos de este caso estan etiquetados en Se presenta Sequia=1 y No se presenta=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 sequía, vamos a conocer si la temperatura máxima promedio es un factor determinante para que un estado tenga problemas de sequía.

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, podemos observar que entre mayor temperatura tenemos, más problemas de sequías se sufren, por lo que podemos pensar que las temperaturas máximas tienen cierta influencia para determinar si un estado presenta problemas de sequía o no. Ahora procederemos a crear un modelo con el uso de la regresión logística para comprobar si realmente existe una correlación entre ambas variables.

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, podemos ver que la sequía en función de la temperatura máxima promedio tiene un PValor de 0.105 por lo que podemos decir que se puede identificar a los estados con problemas de sequía en base a la Temperatura Máxima Promedio con un 89.5% de seguridad.

• Análisis del modelo

• Nuestra fórmula quedaría de la siguiente manera:

P(Y=1|X)={e^{{-35.1229+0.1194x}}{1+e}{-35.1229+0.1194x}}

Con ella podemos predecir si un Estado tiene probabilidades de sufrir sequías o no, en función de sus temperaturas máximas promedio, según nuestro resultado se acerque mas al 0 o al 1, será nuestra respuesta, siendo 0 = No sufres sequía y 1 = sufre sequía.

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 cual llamaremos datos nuevos, con separaciones de 0.1.

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

##   Temperatura_Maxima_Promedio_Celsius
## 1                                20.0
## 2                                20.1
## 3                                20.2
## 4                                20.3
## 5                                20.4
## 6                                20.5

Cálculo de las nuevas probabilidades

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

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)

Como podemos observar en la gráfica, la línea gris va mostrando la probabilidad de presentar sequía en función a la temperatura, y notamos que en efecto, a mayores temperaturas, la probabilidad de sufrir sequías aumenta considerablemente, por lo que determinamos que las temperaturas son un factor importante en las sequías y a su vez, ambas variables afectan directamente a toda la cadena de producción pecuaria.

Desarollo

Los datos a utilizar en el siguiente analis KNN serán datos del año 2021

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 un mejor entendimiento de los datos, graficaremos los datos según su promedio de IVF y las Precipitaciones, adicionalmente, se muestra si dicho registro presenta sequía.

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

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]

Datos de Entrenamiento

head(modelo_knn_train) 

##           MM Promedio_IVF
## 4  0.4659401    0.1261086
## 1  0.1348774    0.3604442
## 22 0.1748411    0.2522893
## 6  0.3714805    0.1938135
## 32 0.1507720    0.4573509
## 8  0.1139873    0.3070877

Datos de Prueba

head(modelo_knn_test) 

##            MM Promedio_IVF
## 5  0.07039055    0.2889177
## 9  0.23841962    0.3339102
## 12 0.42370572    0.3008148
## 13 0.27202543    0.1912899
## 14 0.29745686    0.2779580
## 15 0.30971844    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

Ejecucón el Modelo

Para ejecutar el algoritmo de KNN se utilizarán tanto los datos deentrenamiento como los datos de prueba

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] SI NO NO NO NO NO NO SI NO 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] SI NO NO NO NO NO NO SI NO NO
## Levels: NO SI

Evaluación de la prediccion del modelo

El modelo se revisará primeramente con las siguientes matrices, en las que nos muestra cuantas veces el modelo predijo un NO y realmente era un NO o por el contrario, si predijo un NO y los datos reales eran un SÍ.

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

##      test_df
## knn.A NO SI
##    NO  4  4
##    SI  0  2

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

##      test_df
## knn.B NO SI
##    NO  4  4
##    SI  0  2

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.6

A pesar de que nuestro modelo es muy simple y contiene muy pocos datos, podemos ver que la taza de error se situa en un 50%, esto se puede deber a la complejidad de determinar si un Estado presenta sequía o no y a la poca cantida de datos con la que disponemos.

Analisis de la produccion de ganado bovino en Sonora

dataSetVolumen <- subset(Produccion_Pecuaria_Mexico,  Produccion_Pecuaria_Mexico$Estado %in% "Sonora" )
dataSetVolumen <- subset(dataSetVolumen,  dataSetVolumen$Especie %in% "Bovino" )
dataSetVolumen <- subset(dataSetVolumen,  dataSetVolumen$Producto %in% "Ganado en pie" )


p <- plot_ly(data = , x = dataSetVolumen$Anio , y = dataSetVolumen$Volumen, mode = 'lines', type="scatter", name="Volumen") %>%
  layout(title = 'Serie de Tiempo del volumen de ganado bovino en Sonora 2005-2020' ,
         yaxis = list(zeroline = FALSE, title = 'Volumen'),
         xaxis = list(zeroline = FALSE, title = 'Año'), legend = list(font = list(size = 15)))
p

Como podemos observar en el Gráfico 15, la producción bovina en Sonora se está recuperando después de una caída, que llegó a su mínimo en el año 2016, pero para corroborar mejor esto, vamos a realizar una descomposición del a serie de tiempo.

Buscando datos Faltantes

anyNA(dataSetVolumen)

## [1] FALSE

Como podemos observar el valor booleano que nos arroja es “FALSE”, el cual nos indica que no se tiene valores faltantes en los datos.

Descomposición de la serie de tiempo

La descomposición de series de tiempo es el proceso que identifica y calcula las diversas componentes existentes en una serie temporal, así como la forma en que estas se relacionan entre sí. A continuación, se procederá hacer una descomposición de serie de tiempo del volumen de ganado bovino en Sonora 2005-2020.

dataSetVolumen<-ts(dataSetVolumen$Volumen , frequency = 2 )
datos_dcVolumen<- dataSetVolumen %>%
  decompose(type="multiplicative") %>%
  autoplot()
datos_dcVolumen

En el gráfico de la descomposición de la serie de tiempo, podemos observar que entre los años 2018 y 2020 tendemos una tendencia hacia la baja ya que a comienzas del año 2021 se estimó que se presentarían menos precipitaciones y la temperatura aumentaria, dando consigo diversas sequías provcando una baja en la producción

Modelo SARIMA para predicciones

Los modelos SARIMA (Seasonal Autoregressive Integrated Moving Average Model) captan el comportamiento puramente estacional de una serie, en forma similar, como hemos visto, se realiza para la componente regular o no estacional. Una serie con influencia solamente por la componente estacional puede ser descrito por un modelo SARIMA (P,D,Q).

Augmented Dickey-Fuller Test

adf.test(dataSetVolumen)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  dataSetVolumen
## Dickey-Fuller = -2.4488, Lag order = 2, p-value = 0.4014
## alternative hypothesis: stationary

Analizando el resultado que nos dió en el valor P, observamos que P es menor que el nivel de significancia de 2.4488, por lo cual se determina que el término no es estadisticamente significativo, y por ello, es conveniente reajustar el modelo sin el término.

Análisis de ajuste

Un analisis de ajuste o test de ajuste se considera como una prueba de hipótesis estadística, la cual se usa especificamente para deerminar si hay probabilidad de que una variable provenga o no desde una distribución específica. En esta seccion se representan los datos de una manera grafica con el apoyo de autoplot().

datos_diffVolumen <- dataSetVolumen

datos_diffVolumen %>%
  autoplot()

En este gráfico se muestrar una autoplot de los datos del volumen de produccion de ganado bovino en Sonora desde el año 2005-2020. Donde se presentan algunas disminuciones y aumentos, sin embargo, a partir de año 2020 se presenta una tendencia a la baja.

Analisis de los cambios diferenciales en la serie de tiempo

Una serie diferenciada nos muestra los cambios que tiene la serie a lo largo del tiempo.

tsdisplay(datos_diffVolumen)

• En esta seccion se muestra los cambios diferenciales en la serie de tiempo de tiempo evaluada. En la parte superior se muestra los cambios diferenciales en la serie de tiempo de los datos.

Analizando la serie de tiempo por medio de un modelo ARIMA

Los modelos ARIMA son modelos autorregresivos que nos permiten encontrar patrones dentro de datos distribuidos a lo largo del tiempo con el fin de realizar predicciones a futuro, gracias a este modelo analizaremos los datos de la producción bovina en Sonora para intentar predecir su comportamiento.

test_datosVolumen <- tail(dataSetVolumen, 4) 
train_datosVolumen <- head(dataSetVolumen, length(dataSetVolumen)-4) 

datos_autoVolumen <- auto.arima(y = train_datosVolumen, seasonal = T)
summary(datos_autoVolumen)

## Series: train_datosVolumen 
## ARIMA(0,1,0) 
## 
## sigma^2 = 43712678:  log likelihood = -112.37
## AIC=226.74   AICc=227.19   BIC=227.14
## 
## Training set error measures:
##                    ME     RMSE      MAE      MPE     MAPE     MASE       ACF1
## Training set 371.5695 6330.083 5325.005 0.163627 3.773122 0.712366 -0.1142822

De acuerdo con la prueba del modelo ARiMA, se observa que cuenta con un error medio del 3.7%, por lo que nuestro modelo es capaz de predecir el volumen de producción de ganado bovino.

Comparación entre Datos Reales y Predecidos

Para tener una mejor prespectiva de nuestro modelo, vamos a comprar los datos reales, contra los que fue capaz de predecir

train_datosVolumen %>%
  autoplot(series= "Datos Reales") +
  autolayer (datos_autoVolumen$fitted, series = "SARIMA auto") +
  theme_minimal()

En el siguiente gráfico podemos observar que los datos obtenidos en el modelo SARIMA son demasiado similares a los datos reales. Esto quiere decir que nuestro modelo se acerca a lo que buscabamos, lo cuales predecir el comportamiento de la producción bovina.

Serie de tiempo de las precipitaciones anuales 2005-2020 Sonora

dataSetTMP<-subset(Temperaturas,Temperaturas$Entidad %in% "SONORA" )
dataSetTMP<-subset(dataSetTMP,dataSetTMP$Año != 2021 )
p <- plot_ly(data = , x = dataSetTMP$Año , y = dataSetTMP$MM, mode = 'lines', type="scatter", name="Volumen") %>%
  layout(title = 'Precipitaciones anuales 2005-2020' ,
         yaxis = list(zeroline = FALSE, title = 'Preciítaciones'),
         xaxis = list(zeroline = FALSE, title = 'Año'), legend = list(font = list(size = 15)))
p

Como se puede observar en el gráfico, parece que hay un aumento considerable en las precipitaciones en los últimos años

Serie de tiempo de la temperatura promedio anual 2005-2020 Sonora

p <- plot_ly(data = , x = dataSetTMP$Año , y = dataSetTMP$Temperatura_Media_Promedio_Celsius, mode = 'lines', type="scatter", name="Volumen") %>%
  layout(title = 'Precipitaciones anuales 2005-2020' ,
         yaxis = list(zeroline = FALSE, title = 'Temperatura Promedio'),
         xaxis = list(zeroline = FALSE, title = 'Año'), legend = list(font = list(size = 15)))
p

En el gráfico 21 podemos ver como las temperaturas promedio del estado van en aumento, logrando en menos de una década un aumento de 0.5 grados.

Serie de tiempo del volumen de produccion de ganado bovino anual 2005-2020 Sonora

dataSetVolumen <- subset(Produccion_Pecuaria_Mexico,  Produccion_Pecuaria_Mexico$Estado %in% "Sonora" )
dataSetVolumen <- subset(dataSetVolumen,  dataSetVolumen$Especie %in% "Bovino" )
dataSetVolumen <- subset(dataSetVolumen, dataSetVolumen$Producto %in% "Ganado en pie" )
p <- plot_ly(data = , x = dataSetVolumen$Anio , y = dataSetVolumen$Volumen, mode = 'lines', type="scatter", name="Volumen") %>%
  layout(title = 'Serie de Tiempo del volumen de ganado bovino en Sonora 2005-2020' ,
         yaxis = list(zeroline = FALSE, title = 'Volumen'),
         xaxis = list(zeroline = FALSE, title = 'Año'), legend = list(font = list(size = 15)))
p

Discusión de Reusltados

Como podemos observar al verificar las tres series de tiempo donde se presentan la temperatura promedio, las precipitacion y el volumen de produccion de ganado bovino anual se presenta cierta relacion entre la temperatura y el volumen de produccion, ya que entre el año 20018-2020 al descender la temperatura promedio la produccion de ganado bovino se vio afectada, aunque las precipitaciones presentadas se vieron a la alza, lo que comprueba que la temperatura resulta ser un factor clave en la produccion ganadera que se realiza en Sonora e incluso en otros estados.

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 ## Datos logístca

xfun::embed_file("datosLogistica.xlsx")

Download datosLogistica.xlsx