Loading packages, defining colors and using data

We first clear the workspace using rm(list = ls())and then include all packages we need. If a package is missing in your R distribution (which is quite likely initially), just use install.packages("package_name") with the respective package name to install it on your system. If you execute the code in the file install_packages.R, then all necessary packages will be installed into your R distribution. If the variable export_graphs is set to TRUE, then the graphs will be exported as pdf-files. In addition, we define a set of colors here to make graphs look more beautiful.

rm(list = ls())
library(zoo)
library(xts)
library(dynlm)
library(reshape2)
library(base)
library(ggplot2)
library(grid)
library(scales)
library(stringr)
library(tidyverse)
library(pwt10)
library(fredr)

# should graphs be exported to pdf
export_pdf <- FALSE

# define some colors
mygreen <- "#00BA38"
myblue  <- "#619CFF"
myred   <- "#F8766D"

The model setup

In the stochastic permanent income setup, there are not many parameters to choose. In fact, for our analysis, we only have to define the number of periods T.

# number of model periods
T   <- 80

A function for modeling unexpected income shocks

The following function is used to analyze the effect of unexpected income shocks on household consumption expenditure. It silently assumes that, starting from age 1, households believe their current income stream to be \(y_t = 1\) and therefore \(E_1[y_p] = 1\). From this, we can calculate the baseline consumption path, which will also be characterizes by \(c_\text{base} = 1\).

We now assume that in the periods t_beg to t_end, the household receives and income shock of size shock. The shock period can be of arbitrary length and the shock can be positive or negative. The only important thing is that the shock is unanticipated as of date t_beg - 1. Following the news to income, the consumer adapts her estimate of expected permanent income E_y_p[t_beg:T] and therefore updates her consumption plan c. The remainder of the function is the same as under certain income.

income_shock <- function(T, t_beg, t_end, shock) {
  
  # generate expected income path in baseline
  y <- rep(1, T)
  
  # expected permanent income as of date t = 1
  E_y_p <- rep(mean(y), T)
  
  # calculate baseline consumption path
  c_base <- E_y_p
  
  # generate income shock
  y[t_beg:t_end] = y[t_beg:t_end] + shock
  
  # update expectations
  E_y_p[t_beg:T] = mean(y[t_beg:T])
  
  # calculate consumption path
  c <- E_y_p
  
  # calculate savings
  s <- y - c
  
  # derive asset path
  a <- 0
  for(t in 2:T) {
    a[t] = a[t-1] + s[t-1]
  }
  
  # create data set to return
  res <- data.frame(year=c(1:T), c_base, c, E_y_p, y, s, a)
  
  return(res)
}

Unexpected unemployment in period 11-15

Let us first study the consequences of an unexpected and extended period of unemployment in between the years \(t=11\) and \(t=15\). Income in this periods consequently drops to zero (i.e. we assume that there exists no unemployment benefit or social insurance scheme). While the income consequences of this shock are large, the consumption response is quite modest. In fact, the consumer only lowers their consumption by a little bit and buffers the remainder income loss by (negative) savings. As a consequence, the short-lived shock to labor income causes a permanent drop in consumption for the entire life cycle. Importantly, consumption does not return “back to normal” after a while.

# simulate shock
consumption <- income_shock(T, 11, 15, -1)

# Plot GDP and its components
myplot <- ggplot(data = consumption) + 
  geom_ribbon(aes(x=year, ymin=0, ymax=c,    fill= "1c", color="1c") , alpha=0.4) +
  geom_ribbon(aes(x=year, ymin=c, ymax=c+s, fill= "2s", color="2s")  , alpha=0.4) +
  geom_line(aes(x=year, y=y), color="darkblue", linewidth=1) +
  coord_cartesian(xlim=c(1, T), ylim=c(0, 1.5)) + 
  scale_x_continuous(breaks=seq(0, T, 10), expand=c(0, 0)) +
  labs(x = "Year t",
       y = "Consumption and Savings") +
  scale_fill_manual(breaks = c("1c", "2s"), name = "", 
                    labels = c("Consumption", "Savings"),
                    values = c(mygreen, myblue)) +
  scale_color_manual(breaks = c("1c", "2s"),
                     values = c(mygreen, myblue)) +
  guides(colour = "none") +
  theme_bw() + 
  theme(legend.position="bottom")

# print the plot
print(myplot)


The consequences for the wealth accumulation path are clear. The consumer finances the short-run income short-fall by running into debt, which she repays over the rest of her life cycle.

myplot <- ggplot(data = consumption) + 
  geom_line(aes(x=year, y=a), color="darkblue", linewidth=1) +
  coord_cartesian(xlim=c(1, T), ylim=c(-5, 1)) + 
  scale_x_continuous(breaks=seq(0, T, 10), expand=c(0, 0)) +
  labs(x = "Year t",
       y = "Individual Wealth") +
  theme_bw()

# print the plot
print(myplot)

The marginal propensity to consume out of permanent income shock

Now let us think about the marginal propensity to consume out of different shocks. We first consider a permanent shock to income starting at period \(t = 11\) and lasting for the entire life cycle. Since the income increase is permanent, the consumer revises his permanent income expectations upward. The entire permanent income increase is then directly mirrored in the consumption path. Consequently, the marginal propensity to consume out of a permanent income increase is \(MPC = 1\) or 100%.

# date at which shock happens
t_beg = 11

# simulate shock
consumption <- income_shock(T, t_beg, T, 1)

# calculate MPC
lab  <- paste("MPC = ", format(round((consumption$c[t_beg]/consumption$c_base[t_beg]-1)*100, 2), nsmall=2), "%")

# Plot GDP and its components
myplot <- ggplot(data = consumption) + 
  geom_line(aes(x=year, y=c_base, color="1"), color=myblue, linewidth=1) +
  geom_line(aes(x=year, y=c, color="2"), color=mygreen, linewidth=1) +
  coord_cartesian(xlim=c(1, T), ylim=c(0, 2.5)) + 
  scale_x_continuous(breaks=seq(0, T, 10), expand=c(0, 0)) +
  geom_label(aes(x = 5, y = 2.5, label = lab), 
             hjust = 0, vjust = 1, label.r = unit(0, "lines"), label.padding = unit(0.35, "lines")) +
  labs(x = "Year t",
       y = "Consumption") +
  scale_color_manual(breaks = c("1", "2"),
                     labels = c("Consumption (Baseline)", "Consumption (Permanent Shock)"),
                     values = c(mygreen, myblue)) +
  theme_bw() + 
  theme(legend.position="bottom")

# print the plot
print(myplot)

The marginal propensity to consume out of transitory income shock

In contrast, let us assume that the positive income shock only lasts for one period. The impact on permanent income expectations is therefore much smaller, and so is the reaction in consumption. In fact, the consumer revises her income expectations upwards by only an amount of \(\Delta y_p = \frac{1}{70} = 0.0143\). And hence, the marginal propensity to consume out of this income shock is only \(MPC = 0.0143\) or 1.43%.

# date at which shock happens
t_beg = 11

# simulate shock
consumption <- income_shock(T, t_beg, t_beg, 1)

# calculate MPC
lab  <- paste("MPC = ", format(round((consumption$c[t_beg]/consumption$c_base[t_beg]-1)*100, 2), nsmall=2), "%")

# Plot GDP and its components
myplot <- ggplot(data = consumption) + 
  geom_line(aes(x=year, y=c_base, color="1"), color=myblue, linewidth=1) +
  geom_line(aes(x=year, y=c, color="2"), color=mygreen, linewidth=1) +
  coord_cartesian(xlim=c(1, T), ylim=c(0, 2.5)) + 
  scale_x_continuous(breaks=seq(0, T, 10), expand=c(0, 0)) +
  geom_label(aes(x = 5, y = 2.5, label = lab), 
             hjust = 0, vjust = 1, label.r = unit(0, "lines"), label.padding = unit(0.35, "lines")) +
  labs(x = "Year t",
       y = "Consumption") +
  scale_color_manual(breaks = c("1", "2"),
                     labels = c("Consumption (Baseline)", "Consumption (Permanent Shock)"),
                     values = c(mygreen, myblue)) +
  theme_bw() + 
  theme(legend.position="bottom")

# print the plot
print(myplot)

Testing random walk hypothesis in macro data

We now want to test the random walk hypothesis in macro data. For this analysis, we have to use more detailed data than the Penn World Tables can provide. Such data can be found in the Federal Reserve Economic Database (FRED). All data series available in FRED can be investigated at
https://fred.stlouisfed.org
In order to be able to download data from FRED through R, you have to go to
https://fred.stlouisfed.org/docs/api/api_key.html

and create an API key. To do so, create an account and request an API key for downloading data. Then uncomment the statement fredr_set_key("type-you-key") and insert your personal API key. Afterwards, you can run the next statements to download the relevant data from FRED.

We pick three different series:

The downloaded data contain more information than we actually need to run regressions. The only information we require is the date as well as the corresponding value. We turn these values into time series using the xts function. This function allows us to take a series of values, e.g. cons_real$value, and attach date values to this series using the order.by statement. Using this time series constructs is required when we want to run regressions that use lag-operators.

#fredr_set_key("type-you-key")

# extract real personal consumption expenditures (quarterly)
cons_real <- fredr(series_id = "PCECC96",
                   observation_start = as.Date("1960-01-01"),
                   observation_end = as.Date("2020-01-01")
)

# extract real disposable personal income (quarterly)
inc_real  <- fredr(series_id = "DPIC96",
                   observation_start = as.Date("1960-01-01"),
                   observation_end = as.Date("2020-01-01")
)

# extract total share prices (growth rates, quarterly)
stock_price <- fredr(series_id = "SPASTT01USQ657N",
                    observation_start = as.Date("1960-01-01"),
                    observation_end = as.Date("2020-01-01")
)

# create time series from consumption data
cons <- xts(x = cons_real$value, order.by = as.Date(cons_real$date))

# create time series from income data
inc  <- xts(x = inc_real$value, order.by = as.Date(inc_real$date))

# create time series from share price data
stock <- xts(x = stock_price$value, order.by = as.Date(stock_price$date))


We first regress the change in consumption expenditure cons - stats::lag(cons) on lagged consumption and income. Note that we have to specify, which lag function to use here, as there are multiple packages we use that provide such a function. The correct one that will help us here is stats::lag. We find no correlation of the change in consumption expenditure on lagged consumption or income. This may suggest that the random walk hypothesis is probably a valid assumption.

# TEST 1: consumption on lags of consumption and income
res1 <- lm(cons - stats::lag(cons) ~ stats::lag(cons) + stats::lag(inc))
summary(res1)
## 
## Call:
## lm(formula = cons - stats::lag(cons) ~ stats::lag(cons) + stats::lag(inc))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -273.629  -19.295    3.023   23.530   89.530 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      25.178710   7.280014   3.459 0.000644 ***
## stats::lag(cons)  0.014153   0.020296   0.697 0.486283    
## stats::lag(inc)  -0.009812   0.018647  -0.526 0.599225    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 41.11 on 237 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.07674,    Adjusted R-squared:  0.06895 
## F-statistic: 9.849 on 2 and 237 DF,  p-value: 7.78e-05


The results however become less clear cut, when we include multiple income lags into the regression. The coefficient on lagged consumption now turns positive and significant.

# TEST 2: consumption on consumption and multiple lags of income
res2 <- lm(cons - stats::lag(cons) ~ stats::lag(cons, k=1) + stats::lag(inc, k=1) + stats::lag(inc, k=2) + stats::lag(inc, k=3) + stats::lag(inc, k=4))
summary(res2)
## 
## Call:
## lm(formula = cons - stats::lag(cons) ~ stats::lag(cons, k = 1) + 
##     stats::lag(inc, k = 1) + stats::lag(inc, k = 2) + stats::lag(inc, 
##     k = 3) + stats::lag(inc, k = 4))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -257.623  -18.143    0.497   23.334   81.450 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             27.04524    7.13674   3.790 0.000193 ***
## stats::lag(cons, k = 1)  0.04349    0.02017   2.157 0.032077 *  
## stats::lag(inc, k = 1)   0.12266    0.03778   3.247 0.001339 ** 
## stats::lag(inc, k = 2)  -0.05542    0.04657  -1.190 0.235202    
## stats::lag(inc, k = 3)  -0.01759    0.04634  -0.380 0.704597    
## stats::lag(inc, k = 4)  -0.08834    0.03683  -2.398 0.017258 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 39.23 on 231 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.1707, Adjusted R-squared:  0.1528 
## F-statistic: 9.512 on 5 and 231 DF,  p-value: 2.897e-08


The same is true when we employ multiple lags of consumption.

# TEST 3: consumption on multiple lags of consumption
res3 <- lm(cons - stats::lag(cons) ~ stats::lag(cons, k=1) + stats::lag(cons, k=2) + stats::lag(cons, k=3) + stats::lag(cons, k=4) + stats::lag(cons, k=5))
summary(res3)
## 
## Call:
## lm(formula = cons - stats::lag(cons) ~ stats::lag(cons, k = 1) + 
##     stats::lag(cons, k = 2) + stats::lag(cons, k = 3) + stats::lag(cons, 
##     k = 4) + stats::lag(cons, k = 5))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -286.20  -16.04   -0.57   19.82  107.54 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)   
## (Intercept)             12.82398    5.75425   2.229  0.02681 * 
## stats::lag(cons, k = 1)  0.24249    0.07638   3.175  0.00171 **
## stats::lag(cons, k = 2) -0.08168    0.11980  -0.682  0.49605   
## stats::lag(cons, k = 3)  0.07035    0.11995   0.587  0.55811   
## stats::lag(cons, k = 4) -0.24678    0.11989  -2.058  0.04068 * 
## stats::lag(cons, k = 5)  0.01632    0.07666   0.213  0.83161   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 37.63 on 230 degrees of freedom
##   (5 observations deleted due to missingness)
## Multiple R-squared:  0.2361, Adjusted R-squared:  0.2195 
## F-statistic: 14.22 on 5 and 230 DF,  p-value: 3.968e-12


Finally, lagged stock price changes also have the ability to predict future consumption changes. Hence, we conclude that the evidence for the random walk hypothesis in macro data is quite weak.

# TEST 4: consumption on lags of consumption and share price
res4 <- lm(cons - stats::lag(cons) ~ stats::lag(cons) + stats::lag(stock))
summary(res4)
## 
## Call:
## lm(formula = cons - stats::lag(cons) ~ stats::lag(cons) + stats::lag(stock))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -280.190  -19.196    2.138   21.519  100.580 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       2.047e+01  5.762e+00   3.553 0.000460 ***
## stats::lag(cons)  3.470e-03  7.713e-04   4.499 1.07e-05 ***
## stats::lag(stock) 1.469e+00  4.271e-01   3.441 0.000685 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 40.15 on 237 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.1196, Adjusted R-squared:  0.1122 
## F-statistic:  16.1 on 2 and 237 DF,  p-value: 2.769e-07