In this chapter, the formatted data from the previous chapters are aggregated to produce the data table used in the local projections.
The agricultural production for the crops of interest is detrended.
The resulting dataset, named df, is exported in ../data/output/df_lp.rda.
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 3.5.1 ✔ tibble 3.2.1
✔ lubridate 1.9.3 ✔ tidyr 1.3.1
✔ purrr 1.0.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(cli)library(gam)
Loading required package: splines
Loading required package: foreach
Attaching package: 'foreach'
The following objects are masked from 'package:purrr':
accumulate, when
Loaded gam 1.22-3
Weather <- weather_regions_df |># Add ENSO dataleft_join( ONI_temp |>mutate(Year =as.numeric(Year),month =as.numeric(month) ) |>rename(enso_start = date_start,enso_end = date_end ),by =c("year"="Year","month"="month" ) ) |>group_by(IDDPTO, month, State) |>mutate( temp_min_dev_ENSO = temp_min -mean(temp_min),temp_max_dev_ENSO = temp_max -mean(temp_max),temp_mean_dev_ENSO = temp_mean -mean(temp_mean),precip_sum_dev_ENSO = precip_sum -mean(precip_sum),precip_piscop_sum_dev_ENSO = precip_piscop_sum -mean(precip_piscop_sum))|>ungroup() |> labelled::set_variable_labels(temp_min_dev_ENSO ="Deviation of Min. Temperature from ENSO Normals",temp_max_dev_ENSO ="Deviation of Max. Temperature from ENSO Normals",temp_mean_dev_ENSO ="Deviation of Mean Temperature from ENSO Normals",precip_sum_dev_ENSO ="Deviation of Total Rainfall from ENSO Normals (Chirps)",precip_piscop_sum_dev_ENSO ="Deviation of Total Rainfall from ENSO Normals (Piscop)" )
Let us merge all these datasets in a single one:
data_total <- data_total |># Add weather data and ENSO left_join(#weather_regions_df |> Weather |> dplyr::select(-IDDPTO),by =c("year"="year","month"="month","region"="DEPARTAMEN", "date"="date" ) ) |># Add macroeconomic dataleft_join( df_macro |>rename(gdp = y),by ="date" ) |># Add commodity prices dataleft_join( int_prices,by =c("date", "product", "product_eng") ) |># Add share of each type of regionleft_join( natural_region_dep,by ="region" )
We compute percentage deviation of production from monthly regional average, but we will actually not use those values in the subsequent estimations. In the first version of the analysis we used to do so, but this implied estimating a monthly regional trend. As kindly pointed out by a reviewer, the estimation of the trend should not be performed independently of the estimation. In the current version of this work, we use demeaned values of production and estimate the trend in the regressions.
This section outlines a two-step procedure for expressing agricultural production data at the monthly regional level for a specific crop and month as a percentage deviation from the monthly regional crop-specific average. The procedure involves handling missing values.
Step 1: Handling Missing Values
In the first step, we address missing values by linear interpolation. This approach helps us estimate the missing values by considering the neighboring data points.
Step 1.1: Imputing missing values with linear interpolation.
The missing values get replaced by linear interpolation. However, if there are more than two consecutive missing values, they are not replaced with interpolated values. Instead, the series for the specific crop in the given region is split based on the locations of the missing values. The split with the highest number of consecutive non-missing values is retained, while the other splits are discarded.
Step 1.2: Dropping Series with Remaining Missing Values
After imputing missing values using the moving median, we check if any missing values still remain in the dataset. If there are any remaining missing values for a particular series, we choose to exclude that series from further analysis. By doing so, we ensure that the subsequent detrending process is performed only on reliable and complete data.
Step 2: Normalized Agricultural Production
For each month ( m ), region ( i ), and crop ( c ), we calculate the average production over the entire period (January 2001 to December 2015): \[\overline{y}_{c,i,m} = \frac{1}{n_{T_c}} \sum_{t=1}^{T_c} y_{c,i,m,t}^{\text{raw}}
\] Then, we express agricultural production relative to the average: \[y_{c,i,m,t} = \begin{cases}
\frac{y_{c,i,m,t}^{\text{raw}}}{\overline{y}_{c,i,m}}, & \overline{y}_{c,i,m} > 0\\
0, & \overline{y}_{c,i,m} = 0
\end{cases}\] Values of \(y_{c,i,m,t}>1\) means that the production for crop \(c\) in region \(i\) during month \(m\) of year \(t\) is higher than the average monthly production for that crop and region over the period 2001 to 2015. For example, a value of 1.5 means that the production is 50% higher than average.
Step 2 (alternative version): Deviation from regional monthly average, in percent (this step is useless in the new version of the analysis: it lead to discard too many observations)
Once we have addressed the missing values, we proceed to the second step, which consists in computing the deviation of production from the monthly regional average. First, we compute the average production of each crop \(c\) in each region \(i\) for calendar month \(m\): \[\overline{y}_{c,i,m} = \frac{1}{n_{T_c}} \sum_{t=1}^{T_c} y_{c,i,m,t}^{raw}\] Then, we compute the percentage deviation from this average at each date \(t\): \[y_{c,i,m,t} = \frac{y_{c,i,m,t}^{raw} - \overline{y}_{c,i,m}}{\overline{y}_{c,i,m}}\]
Let us implement this process in R. First, we need to define two functions to handle the missing values:
The get_index_longest_non_na() function retrieves the indices of the longest consecutive sequence without missing values from a given input vector. It helps us identify the positions of elements in that sequence.
The keep_values_longest_non_na() function uses the obtained indices to create a logical vector. Each element of this vector indicates whether the corresponding element in the input vector belongs to the longest consecutive sequence of non-missing values. This allows us to filter the data and retain only the values from the longest consecutive sequence without missing values.
These two functions combined help us handle missing data in the weather series and ensure that we work with the most complete sequences for each region and crop.
The first function:
#' Returns the index of the longest sequence of non NA values in a vector#'#' @param y vector of numerical values#' @exportget_index_longest_non_na <-function(y) { split_indices <-which(is.na(y)) nb_obs <-length(y)if (length(split_indices) ==0) { res <-seq_len(nb_obs) } else { idx_beg <-c(1, split_indices)if (idx_beg[length(idx_beg)] != nb_obs) { idx_beg <-c(idx_beg, nb_obs) } lengths <-diff(idx_beg) ind_max <-which.max(lengths) index_beginning <- idx_beg[ind_max]if(!index_beginning ==1|is.na(y[index_beginning])) { index_beginning <- index_beginning +1 } index_end <- idx_beg[ind_max] + lengths[ind_max]if(is.na(y[index_end])) { index_end <- index_end -1 } res <-seq(index_beginning, index_end) } res}
The second one:
#' Returns a logical vector that identifies the longest sequence of non NA#' values within the input vector#' #' @param y numeric vectorkeep_values_longest_non_na <-function(y) { ids_to_keep <-get_index_longest_non_na(y) ids <-seq(1, length(y)) ids %in% ids_to_keep}
Note
Those two functions are defined in weatherperu/R/utils.R.
We define another function, pct_prod_production(), that takes the data frame of observations as input, as well as a crop name and a region ID. It returns a tibble with the following variables:
product_eng: the English name of the crop
region_id: the ID of the region
month: month number
date: date
y_new_normalized (our variable of interest in Chapter 7): the production demeaned by the month-specific average for the crop of interest in the region of interest
y_new: the production (in tons) where missing values were imputed, if possible
y_dev_pct: the production expressed as the percentage deviation from the monthly-specific average (for the crop of interest, in the region of interest)
y: same as y_dev_pct but without an estimated month-specific quadratic trend estimated by OLS
t: month-specific trend.
#' Computes the percentage deviation of production from monthly regional average#'#' @param df data#' @param crop_name name of the crop#' @param region_id id of the region#'#' @returns tibble with the product, the region id, the date, the production#' where missing values were imputed (`y_new`), the percentage deviation of#' production from its monthly regional average (`y_dev_pct`), the percentage#' deviation of production from its monthly regional average where a quadratic#' trend has been removed (`y`), the demeaned production (`y_new_normalized`),#' a month-specific trend (`t`)#' @export#' @importFrom dplyr filter arrange mutate select row_number group_by#' @importFrom tidyr nest unnest#' @importFrom purrr map#' @importFrom imputeTS na_interpolation#' @importFrom stats lm predict residualspct_prod_production <-function(df, crop_name, region_id) {# The current data df_current <- df |>filter( product_eng ==!!crop_name, region_id ==!!region_id ) |>arrange(date)## Dealing with missing values ----# Look for negative production values df_current <- df_current |>mutate(y_new =ifelse(Value_prod <0, NA, Value_prod) )if (any(is.na(df_current$y_new))) {# Replacing NAs by interpolation# If there are more than two contiguous NAs, they are not replaced df_current <- df_current |>mutate(y_new = imputeTS::na_interpolation(y_new, maxgap =3) )# Removing obs at the beginning/end if they are still missing df_current <- df_current |>mutate(row_to_keep =!(is.na(y_new) &row_number() %in%c(1:2, (n()-1):(n()))) ) |>filter(row_to_keep) |>select(-row_to_keep)# Keeping the longest series of continuous non-NA values df_current <- df_current |>mutate(row_to_keep =keep_values_longest_non_na(y_new) ) |>filter(row_to_keep) |>select(-row_to_keep) } rle_y_new <-rle(df_current$y_new) check_contiguous_zeros <- rle_y_new$lengths[rle_y_new$values==0]# If there are more than 8 contiguous 0, the series is discardedif (any(check_contiguous_zeros >8)) { resul <-NULL } else {## Percent deviation from monthly regional average resul <- df_current |>group_by(month) |>arrange(date) |>mutate(y_new_normalized =case_when(mean(y_new) ==0~0,TRUE~ y_new /mean(y_new) ),y_dev_pct =case_when(mean(y_new) ==0~0,TRUE~ (y_new -mean(y_new)) /mean(y_new) ) ) |>ungroup() |>mutate(t =row_number()) |>ungroup() |>nest(.by =c(product_eng, region_id, month)) |># distinct OLS per monthmutate(ols_fit =map(data, ~lm(y_new_normalized ~-1+ t +I(t^2), data = .x)),resid =map(ols_fit, residuals),fitted =map(ols_fit, predict) ) |>unnest(cols =c(data, resid, fitted)) |>group_by(month) |>mutate(y = resid ) |>select(product_eng, region_id, month, date, y_new, y_dev_pct, y_new_normalized, y, t) |>ungroup() |>arrange(date) } resul}
We can apply this function to all crops of interest, in each region. Let us define a table that contains all the possible values for the combination of crops and regions:
The dataset that can be used to estimate the impact of weather shocks on agricultural production can be saved in the data output folder:
# Add labels to the new columnsdf <- df |> labelled::set_variable_labels(y_new ="Monthly Agricultural Production (tons)",y_dev_pct ="Agricultural Production (percent deviation from monthly regional values)", )save(df, file ="../data/output/df_lp.rda")