Food Crisis Analysis and, Forecasting with Neural Network Autoregression

[This article was first published on DataGeeek, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

The war between Russia and Ukraine has affected the global food supply other than many vital things. Primarily cereal crop products have been affected the most because the imports have been provided to the world mainly through Ukraine and Russia. Let’s check the situation we’ve mentioned for G20 countries.

library(tidyverse)
library(fpp3)
library(bbplot)
library(plotly) 
  

food <- read_csv("https://raw.githubusercontent.com/mesdi/wheat/main/ukraine-russia-food.csv")

#G20 countries
g20 <- c("Argentina", "Australia", "Brazil", "Canada", "China", "France", 
         "Germany", "India", "Indonesia", "Italy", "Japan", "South Korea", 
         "Mexico", "Saudi Arabia", "South Africa", "Turkey", "United Kingdom",
         "United States")

We will get a look at the 2010-2019 import shares totals of barley, maize(corn), sunflower oil, and wheat for the domestic supply. If we hoover at the chart bars, we can see the last year’s (2019) rates of imports for the interested country and product.

#Comparing the G20 Countries' Imported Crops 
#for Domestic Supply(%) from Russia or Ukraine 
p <- 
  food %>% 
  select(Entity, 
           Year, 
           `Barley imports from Ukraine + Russia (% supply)`,
           `Maize imports from Ukraine + Russia (% supply)`,
           `Sunflower oil imports from Ukraine + Russia (% supply)`,
           `Wheat imports from Ukraine + Russia (% supply)`) %>% 
    rename(Barley=`Barley imports from Ukraine + Russia (% supply)`,
           Maize=`Maize imports from Ukraine + Russia (% supply)`,
           `Sunflower oil`=`Sunflower oil imports from Ukraine + Russia (% supply)`,
           Wheat=`Wheat imports from Ukraine + Russia (% supply)`) %>% 
    mutate(across(where(is.numeric), ~replace_na(.,0))) %>% 
    filter(Entity %in% g20) %>% 
    pivot_longer(cols = -c(Entity,Year),names_to = "Crops",values_to = "n") %>% 
    group_by(Entity,Crops) %>% 
    summarise(total=sum(n),
              #tooltip text showing the last year's values for plotly chart
              percent=paste0(round(last(n),2),"%\nin 2019")) %>% 
    arrange(desc(total),.by_group = TRUE) %>% #ranking stacked fill descending
    ggplot(aes(Entity, total, group=Entity, fill= Crops, text=percent)) +
    geom_bar(stat = "identity", position = "fill")+
    bbc_style()+
    scale_y_continuous(labels = scales::percent)+
    coord_flip()+
    theme(legend.position = "top", 
          legend.justification = "center",
          panel.grid.major.y = element_blank(),
          title = element_text(size=5))
  


#Plotly Graph
ggplotly(p,tooltip = "text") %>% 
  #adjusting legend position to top and center 
  layout(legend = list(orientation = "h",
                       y =1.1,
                       x=0.25,
                       title=""),
         margin=list(r=50) #gives space to the hover information
         )

It seems that sunflower oil is the most dominant imported cereal crop; specifically, when we hover over China, we see that %86.47 of the domestic supply was acquired from those countries in 2019. And it is clear that Brazil and Argentina do not need those crops arriving from Russia and Ukraine.

We will now examine the impact of this situation on US wheat futures prices. We will predict weekly prices for the next year with the neural network autoregression model (NNAR).

wheat_future <- read_csv("https://raw.githubusercontent.com/mesdi/wheat/main/us_wheat_futures.csv")

wheat_ts <- 
  wheat_future %>% 
  #removes comma and then converts to the proper date format
  mutate(Date= parse_date(str_remove(Date,"\\,"),"%b %d %Y")) %>% 
  as_tsibble() %>% 
  fill_gaps() %>% #fills the gaps with NAs to provide regular time series
  fill(Price,.direction = "down") #replaces the NAs with the previous value

We can see from the below results that our model has 19 lagged inputs and ten nodes in the hidden layer.

set.seed(123)  

#NNAR modeling
fit_wheat <- 
  wheat_ts %>% 
  model(NNETAR(Price)) 
# A mable: 1 x 1
#  `NNETAR(Price)`
#          <model>
#1   <NNAR(19,10)>

To check our model, we have to do a residual diagnostic test. So, we can see whether there is some correlation and the distribution of residuals is similar to that normally distributed.

#Model residuals diagnostics
fit_wheat %>% 
  gg_tsresiduals()

All the lags are between the threshold lines so that there is no correlation, as seen on the ACF graph. When we look at the residual time plot, we can say that around zero mean and approximately constant variance across the historical data which means the distribution is similar to normal.

Now, we can make forecasting; in order to do that, we will do simulations with our model.

#Projection of prices of the US wheat futures 

fit_wheat %>% 
  generate(times = 100, h = 52) %>%
  autoplot(.sim) +
  autolayer(wheat_ts, Price) +
  scale_x_yearweek(date_breaks="104 week")+
  labs(title="1-Year Projection of US Wheat Futures (ZWU2) Prices",
       xlab="",
       ylab="")+
  bbc_style()+
  theme(legend.position = "none",
        axis.text.x=element_text(size=15),
        plot.title = element_text(size=20,hjust=0.5))

We clearly see that the prices were up above the 1200s because of the war, and then come back to around the 900s. But it seems for the next one-year period the prices will go down to about 600-700s.

To leave a comment for the author, please follow the link and comment on their blog: DataGeeek.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)