In tweed1e/idiosyncratics:

knitr::opts_chunk$set(fig.width = 7, fig.height = 5, message = FALSE, warning = FALSE)

How much do idiosyncratic shocks contribute to aggregate growth? I'll test the Gabaix and the DiGiovanni-Levchenko-Mejean (DLM) methods. We'll use some fake firm panel data to document the process.

Steps:

1. Create fake firm data with some time series properties
2. Process the data:
   • add (lagged) firm weights,
   • add growth rates,
   • add upper/lower growth rate quantiles,
   • deal with outliers based on those quantiles (drop or winsorize)
   • demean the data (find idiosyncratic shocks $e_{it}$)
3. Aggregate idiosyncratic shocks to get $e_t$ and the common factor $m_t$
4. Analyze the results given by Gabaix and DLM methods

Step 0: Load the libraries.

``` {r echo = TRUE} library(idiosyncratics) library(tidyverse)

via devtools::install_github('tweed1e/fakedata')

library(fakedata)

## Step 1: Create the fake data.
``` {r echo = TRUE}
# Suppose the data has N firms and T years
N <- 100
T <- 30

# A function to create a fake panel.
asm <- fakedata::fake_panel(N = N, T = T, I = 5, 
                            model = list(order = c(1,0,1), ar = 0.75, ma = 0.75), 
                            missing = 0.1) # with 10% of the data randomly missing

asm <- asm %>% rename(industry = I, g_i = g)

Step 2: Process the data.

``` {r echo = TRUE}

Process the data:

asm <- asm %>% add_weights(x_var = sales) %>% # Add weights based on firm sales lag_panel(x_var = w, l_var = w) %>% # Lag the weight variable so we can weight growth rates correctly add_growth_rates(x_var = sales, drop = TRUE) %>% # Calculate growth rates, dropping observations with NA growth rates add_quantiles(g_var = 'g_i') %>% # Add upper/lower quantiles of growth rates (0.025, 0.975), by year drop_outliers(g_var = g_i, method = 'winsorize') # winsorize growth rates.

Demean the growth rates

asm <- asm %>% demean(t_var = year, ind_var = industry, g_var = g)

## Step 3: Aggregate components

Finally, we get a dataset of growth rates that satisfies $g_{it} = m_{it} + e_{it}$, to which we aggregate to idiosyncratic and common factor components by getting the weighted sum $g_t = m_t + e_t$:

``` {r echo = TRUE}
components <- asm %>% aggregate_components(t_var = year, g_var = g_i, w_var = w) 
components

We could graph the components to get a picture of how the components track aggregate growth:

``` {r echo = TRUE} tidy_components <- components %>% gather(key = type, value = x, -year)

ggplot(tidy_components, aes(x = year, y = x, colour = type)) + geom_line() + labs(x = "Year", y = "Growth") + scale_colour_discrete(name="Type of shock", breaks=c("e", "g", "m"), labels=c("Idiosyncratic", "Aggregate", "Common"))

## Step 4: Gabaix vs. DLM

Finally, we need to calculate the results. Gabaix regresses the aggregate growth rate $g_t$ on the idiosyncratic shock $e_t$, and calls the $R^2$ the amount that $e_t$ explains $g_t$. In ```R```, ```lm``` will do OLS and report the $R^2$ in the as an element of the summary:

``` {r echo = TRUE}
lms <- . %>% lm(g ~ e, data = .) %>% summary() %>% .$r.squared

DLM take a different approach, saying the contribution of idiosyncratic shocks depends on the standard deviation of the idiosyncratic component relative to the standard deviation of the aggregate growth rate. ``` {r echo = TRUE} dlm <- function(tbl) { cov <- tbl %>% select(one_of(c('e', 'm', 'g'))) %>% var() # gives a V-C matrix # get the relative variance on the diagonal and take the square root (cov / cov[dim(cov)[1], dim(cov)[2]]) %>% diag() %>% sqrt() }

Now apply those functions to the components data and put them in a table:
``` {r echo = TRUE}
library(knitr)

tab <- cbind(components %>% lms() %>% t(), components %>% dlm() %>% t()) %>% tbl_df()
names(tab) <- c('e_t, R^2', 'e_t, DLM', "m_t, DLM", "g_t, DLM")
kable(tab %>% round(2), caption = 'Contribution to aggregate growth')

(These are random results, so there's not much to say about them---comparing Gabaix [the 1st column, labelled '$R^2$'] to DLM [the second column, labelled $e_t$].)

tweed1e/idiosyncratics documentation built on May 29, 2019, 10:51 a.m.