dtf_inflation %<>% pivot_longer(cols = -any_of("date"),
names_to = "variable",
values_to = "value")
vars <- c("CPILFESL", "CPIAUCSL", "PCETRIM12M159SFRBDAL")
linev <- c(create_linev(vars), "solid")
legv <- c(create_legv(vars), "black")
legs <- c("CPI Urban Core", "CPI Urban All Goods", "Trimmed Mean PCE", "Inflation Target")
plot <- ggplot(dtf_inflation %>%
filter(variable %in% vars,
date >= as.Date("2018-01-01"),
date <= as.Date("2021-07-01")) %>%
mutate(variable = as.factor(variable)),
aes(x = date, y = value)) +
geom_hline(aes(col = "Inflation Target",
linetype = "Inflation Target"),
yintercept = 2, size = line_size) +
geom_line(aes(col = variable, linetype = variable),
size = line_size) +
scale_y_continuous(labels = function(x) paste(x, "%"), limits = c(-1, 6), breaks = seq(0, 6, by = 1)) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
scale_linetype_manual(values = linev, labels = legs) +
scale_colour_manual(values = legv, labels = legs) +
theme(legend.position = c(0.5,0.9)) +
guides(linetype = guide_legend(keywidth = 7, keyheight = 1))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_15_a.pdf"), plot)
dtf_households <- read_xlsx("./Data/US/2_Michigan.xlsx", sheet = "Michigan", skip = 2)
dtf_households %<>% rename(date = Date) %>%
mutate(date = as.Date(date),
year = year(date),
quarter = quarter(date)) %>%
group_by(year, quarter) %>%
summarise(date = first(date),
across(starts_with("pie_michigan"), mean),
.groups = "drop") %>%
# skew is Pearson's 2nd nonparametric skew coefficient
mutate(pie_michigan_sd_1y = 3*(pie_michigan_mean_1y -pie_michigan_median_1y) / pie_michigan_skew_1y,
pie_michigan_sd_5y = 3*(pie_michigan_mean_5y -pie_michigan_median_5y) / pie_michigan_skew_5y)
# read and clean SPF one-year ahead forecast
dtf_nonhouseholds <- read_xlsx("./Data/US/Individual_CPI.xlsx")
dtf_nonhouseholds %<>%
rename_with(tolower) %>%
rename(pie_people_1y = cpi6) %>%
mutate(date = year + ((quarter - 1)/4),
date = zoo::as.Date(zoo::as.yearqtr(date))) %>%
select(date, year, quarter, id, industry, pie_people_1y) %>%
filter(date >= as.Date("2018-01-01")) %>%
mutate(pie_people_1y = ifelse(pie_people_1y == "#N/A", NA, pie_people_1y),
pie_people_1y = as.numeric(pie_people_1y),
industry = as.factor(industry))
levels(dtf_nonhouseholds$industry) <- c("fin", "bus", "unknown")
dtf_nonhouseholds_all <- dtf_nonhouseholds %>%
group_by(year, quarter) %>%
summarise(date = first(date),
pie_people_1y_all_mean = mean(pie_people_1y, na.rm = TRUE),
pie_people_1y_all_sd = sd(pie_people_1y, na.rm = TRUE),
pie_people_1y_all_median = median(pie_people_1y, na.rm = TRUE),
pie_people_1y_all_interq = IQR(pie_people_1y, na.rm = TRUE),
pie_people_1y_all_skew = moments::skewness(pie_people_1y, na.rm = TRUE),
.groups = "drop") %>%
select(-c(year, quarter))
dtf_nonhouseholds_fin <- dtf_nonhouseholds %>%
filter(as.integer(industry) == 1) %>%
group_by(year, quarter) %>%
summarise(date = first(date),
pie_people_1y_fin_mean = mean(pie_people_1y, na.rm = TRUE),
pie_people_1y_fin_sd = sd(pie_people_1y, na.rm = TRUE),
pie_people_1y_fin_median = median(pie_people_1y, na.rm = TRUE),
pie_people_1y_fin_interq = IQR(pie_people_1y, na.rm = TRUE),
pie_people_1y_fin_skew = moments::skewness(pie_people_1y, na.rm = TRUE),
.groups = "drop") %>%
select(-c(year, quarter))
dtf_nonhouseholds_bus <- dtf_nonhouseholds %>%
filter(as.integer(industry) == 2) %>%
group_by(year, quarter) %>%
summarise(date = first(date),
pie_people_1y_bus_mean = mean(pie_people_1y, na.rm = TRUE),
pie_people_1y_bus_sd = sd(pie_people_1y, na.rm = TRUE),
pie_people_1y_bus_median = median(pie_people_1y, na.rm = TRUE),
pie_people_1y_bus_interq = IQR(pie_people_1y, na.rm = TRUE),
pie_people_1y_bus_skew = moments::skewness(pie_people_1y, na.rm = TRUE),
.groups = "drop") %>%
select(-c(year, quarter))
dtf_nonhouseholds_all %<>%
left_join(dtf_nonhouseholds_fin, by = "date") %>%
left_join(dtf_nonhouseholds_bus, by = "date")
# join with Household Survey (Michigan survey of Consumers)
dtf_modern <- left_join(dtf_nonhouseholds_all, dtf_households, by = "date")
dtf_modern %<>% left_join(dtf_macro %>% select(date, T10YIE), by = "date")
dtf_modern %<>%
pivot_longer(cols = -date,
names_to = "variable",
values_to = "value")
vars <- c("pie_michigan_mean_1y", "pie_michigan_mean_5y", "pie_people_1y_all_mean", "T10YIE")
linev <- create_linev(vars)
legv <- create_legv(vars)
legs <- c("People: Michigan 1 Year", "People: Michigan 5 Years", "Traders: SPF 1 Year", "Market: 10 year Breakeven Inflation Rate")
plot <- ggplot(dtf_modern %>%
filter(variable %in% vars) %>%
mutate(variable = as.factor(variable)),
aes(x = date, y = value)) +
geom_line(aes(col = variable, linetype = variable),
size = line_size) +
scale_y_continuous(labels = function(x) paste(x, "%")) +
scale_linetype_manual(breaks = vars, values = linev, labels = legs) +
scale_colour_manual(breaks = vars, values = legv, labels = legs) +
theme(legend.position = c(0.5,0.7)) +
guides(linetype = guide_legend(keywidth = 5, keyheight = 1))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_15_b.pdf"), plot)
vars_left <- c("pie_michigan_skew_1y")
vars_right <- c("pie_michigan_sd_1y")
vars <- c(vars_right, vars_left)
legv <- c('red', 'blue')
linev <- c('solid', 'longdash')
legs <- c("Standard deviation (right axis)", "Skewness (left axis)")
plot <- ggplot(dtf_modern %>%
filter(variable %in% vars_left) %>%
mutate(variable = as.factor(variable)),
aes(x = date, y = value)) +
geom_line(aes(col = variable, linetype = variable),
size = line_size) +
geom_line(data = dtf_modern %>%
filter(variable %in% vars_right) %>%
mutate(variable = as.factor(variable)),
aes(x = date, y = value / 4, col = variable, linetype = variable),
size = line_size) +
scale_y_continuous(sec.axis = sec_axis(trans = ~ . * 4)) +
scale_linetype_manual(breaks = vars, values = linev, labels = legs) +
scale_colour_manual(breaks = vars, values = legv, labels = legs) +
theme(legend.position = c(0.3,0.8)) +
guides(linetype = guide_legend(keywidth = 5, keyheight = 1))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_15_c.pdf"), plot)
# Build monthly histogram of Household Inflation Expectation
dtf_histogram <- read_xlsx("./Data/US/2_Michigan.xlsx", sheet = "Next year", skip = 2)
dtf_histogram %<>%
rename_with(tolower) %>%
select(year, month, down, same, starts_with("up"), starts_with("dk")) %>%
mutate(inf_lowerbound = 0, # fix tails
inf_upperbound = 0) %>%
rename(inf_down = down,
inf_0 = same,
inf_1to2 = `up by 1-2%`,
inf_3to4 = `up by 3-4%`,
inf_5 = `up by 5%`,
inf_6to9 = `up by 6-9%`,
inf_10to14 = `up by 10-14%`,
inf_15plus = `up by 15%+`,
inf_dontknowup = `up; dk how much`,
inf_dontknow = `dk; na`
) %>%
mutate(mean_positive = (1.5*inf_1to2 + 3.5*inf_3to4 + 5*inf_5 + 7.5*inf_6to9 + 12*inf_10to14 + 17*inf_15plus)/(inf_1to2 + inf_3to4 + inf_5 + inf_6to9 + inf_10to14 + inf_15plus)) %>% # deal with "dontknowup"
select(-inf_dontknow) %>% # use common distribution as prior for "dontknow"
pivot_longer(cols = starts_with("inf"),
names_to = "x",
values_to = "freq") %>%
mutate(x = as.numeric(recode(x,
inf_lowerbound = "-5",
inf_down = "-2",
inf_0 = "0",
inf_1to2 = "1.5",
inf_3to4 = "3.5",
inf_5 = "5",
inf_6to9 = "7.5",
inf_10to14 = "12",
inf_15plus = "17",
inf_upperbound = "20",
inf_dontknowup = as.character(mean_positive)))) %>%
select(-mean_positive) %>%
# turn frequencies into probabilities
group_by(year, month) %>%
mutate(sum = sum(freq),
y = freq /sum) %>%
select(-c(sum, freq)) %>%
mutate(date = year + ((month - 1)/12),
date = zoo::as.Date(zoo::yearmon(date)),
group = 0,
group = ifelse(year == 2020 & month == 1, 1, group),
group = ifelse(year == 2020 & month == 9, 2, group),
group = ifelse(year == 2021 & month == 6, 3, group))
linev <- c("solid", "dashed", "dotted")
legv <- c('red', 'blue', 'green4')
legs <- c("2020 January", "2020 September", "2021 June")
breaks = c(1, 2, 3)
plot <- ggplot(dtf_histogram %>%
filter(group %in% breaks) %>%
mutate(group = as.factor(group)),
aes(x = x, y = y, col = group)) +
stat_density(aes(x = x, weight = y,
colour = group, linetype = group),
inherit.aes = FALSE,
geom = "line",
position = "identity",
size = line_size,
bw = 1.3) +
scale_x_discrete(limits = c(0, 1.5, 3.5, 5, 7.5, 12)) +
scale_colour_manual(breaks = breaks, values = legv, labels = legs) +
scale_linetype_manual(breaks = breaks, values = linev, labels = legs) +
theme(legend.position = c(0.6, 0.7)) +
guides(col = guide_legend(keywidth = 5, keyheight = 1))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_15_d.pdf"), plot)
#----------------------------------------------------------------
# Initiation
#----------------------------------------------------------------
rm(list = ls())
# clean console
cat("\014")
#### PLEASE CHOOSE #####
# print and save plots?
bSavePlots <- 1   # 0: no
# 1: yes
# Expectations at T = T-h or T+h?
# will shift by 12 periods (monthly), be careful for e.g. quarterly data
bAdjustPeriodTiming <- 0   # 0: T+h
# 1: T-h
####  CHOICE END   #####
# BEWARE ONLY VARIABLES USED ARE ADJUSTED
# IF YOU WANT TO USE OTHER VARIABLES
# PLEASE ADD THEM BELOW WHEN THE ADJUSTMENT
# IS MADE
# packages
# list of libraries
packages <- c("tidyverse"   # data analysis
,"knitr"      # markdown
,"haven"      # read .dta files
,"readxl"     # read excel files
,"lubridate"  # dates
,"tinytex"    # for markdown
,"ks"         # kernel estimation
,"magrittr"   # pie operator
)
# install them if needed
new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
if (length(new_packages) > 0){ #installs them
install.packages(new_packages, dependencies = TRUE)
}
# load libraries
lapply(packages, require, character.only = TRUE)
# ggplot2 options
# size of figures for saving and displaying (disp will be adjusted)
# figure size in cm (for inches divide by 0.393700787)
fig_h <- 2.5 * 8.4375* 0.393700787 # width
fig_w <- 2.5 * 15 * 0.393700787    # height
fig_disp_adj <- 1                  # adjustment for figure display
# Convert from mm to internal units used in grid ggplot
tfont <- function(x) return(.pt*x)        # this way no res problems
tlwd  <- function(x) return(.stroke*x)
# ggplot2 options
# plot definitions
legend_text_size <- 7.5
axis_text_size   <- 7
legend_key_width <- 20 # mm
# size of line for plots
line_sizee <- tlwd(1)
theme_set(
theme_minimal() +
theme(panel.background = element_blank(),
plot.title = element_text(face = "plain", size = tfont(6)),
plot.subtitle = element_text(face = "italic"),
panel.grid.minor.x = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(),
legend.background = element_rect(colour="black",
fill = NA, size = 0.5),
legend.box.background = element_blank(),
legend.title = element_blank(),
legend.position = c(0.25,0.8),
legend.key = element_rect(colour = NA,
fill = NA),
legend.key.width = unit(legend_key_width, "mm"),
legend.text = element_text(size = tfont(legend_text_size)),
axis.text  = element_text(size = tfont(axis_text_size)),
axis.title = element_blank()
)
)
# functions to create colour/line scheme
create_legv <- function(x) {
#colours to be used in plots
y <- c('red','blue','green4','orange3',"purple2")
n <- length(x)
y <- y[1:n]
names(y) <- x
return(y)
}
create_linev <- function(x) {
# linetypes to be used in plots
y <- c('solid','dotted','dashed',"dotdash",'longdash')
n <- length(x)
y <- y[1:n]
names(y) <- x
return(y)
}
create_plot <- function(df,
vars,
legs = NULL,
date_lb = as.Date("2008-01-01"),
date_ub = as.Date("2017-12-31"),
perc = 1,
scales = 1,
line_size = line_sizee) {
# date bounds
date_lb <- as.Date(date_lb)
date_ub <- as.Date(date_ub)
# colours/linetypes
legv <- create_legv(vars)
linev <- create_linev(vars)
df <- df %>%
filter(date >= date_lb & date <= date_ub &
variable %in% vars & !is.na(value)) %>%
mutate(variable = factor(variable, levels = vars))
plot <- ggplot(df, aes(x = date, y = value)) +
geom_line(aes(colour = variable, linetype = variable),
size = line_size) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y")
if (scales) plot <- plot +
scale_linetype_manual(breaks = vars, values= linev, labels = legs) +
scale_colour_manual(breaks = vars, values = legv, labels = legs)
if (perc) plot <- plot +
scale_y_continuous(labels = scales::percent_format(accuracy = 1))
return(plot)
}
my_ggsave <- function(.filename, .plot,
.device = "pdf", .width = fig_w,
.height = fig_h, .units = "in", .dpi = 300, ...) {
ggsave(filename = .filename, plot = .plot,
device = .device,
width = .width, height = .height,
units = .units, dpi = .dpi, ...)
}
# directory
directory <- getwd()
directory <- gsub("/Code", "", directory)
opts_knit$set(root.dir = directory)
path_figure_out <- "./Figures/"
# default chunk options
opts_chunk$set(message = FALSE, warning = FALSE, results = 'asis', echo = TRUE,
fig.width = fig_disp_adj * fig_w, fig.height = fig_disp_adj * fig_h,
fig.retina = 1) # figure options
# Start Inf data
# --------------
# read data
dtf <- read_dta("Data/Brazil/startinf_brazil_m.dta", encoding = "latin1")
# labels of each variable
dtf_labels <- unlist(lapply(dtf, attr, which = "label"))
# remove labels
dtf <- as.data.frame(lapply(dtf, c))
# Notice that for a given frequency,
# the data begins at the start of the period
# it reports to (for example, monthly data's date is on the 1st of
# each month)
# fix date
datelookup <- seq.Date(from = as.Date("2005-01-01"),
to = as.Date("2021-12-01"),
by = "month")
dtf$date <- datelookup[dtf$date - abs(min(dtf$date)) + 1]
# order by date
dtf <- arrange(dtf, date)
# correct magnitude of certain variables
dtf <- dtf %>% mutate_at(vars(-date, -contains("_skew")),
~ ./100 )
# create max-min
dtf$IPCA12_max_minus_min <- dtf$IPCA12_max - dtf$IPCA12_min
# Create breakeven rates
# ----------------------
for (n0 in 1:(10-1)) {
var0 <- paste0("breakeven", n0)
for (nf in (n0+1):10) {
varf <- paste0("breakeven", nf)
var1 <- paste(sep = "_","breakeven_f", n0, nf)
# forward rate
dtf[,var1] <- ( (1 + dtf[,varf])^nf ) / ( (1 + dtf[,var0])^n0 )
dtf[,var1] <- exp( (1/(nf-n0)) * log(dtf[,var1])) - 1
# if desired, forwards are lagged so that
# their value at time t corresponds to
# the expectation of the tn-t0 rate at t-tn
if (bAdjustPeriodTiming) dtf[, var1] <- lag(dtf[, var1], nf-1)
}
}
# adjustment of lead data
# -----------------------
# be careful. If you use more than one year horizons, you have
# to adjust the lagging
if (bAdjustPeriodTiming) {
dtf <- dtf %>%
mutate_at(vars(starts_with("IPCA12_"), fgv_ibre_exp, matches("breakeven(\\d+)") # no forwards
), ~ lag(.,12-1) # monthly date
) %>%
# -1 because data has date 01mmyyyy, refers to previous period
mutate_at(vars(starts_with("fgv_md_")),
~ lag(.,12) #monthly date
) %>%
mutate(EIPCA_1y_median = lag(EIPCA_1y_median, 12),
EIPCA_2y_median = lag(EIPCA_2y_median, 12*2),
EIPCA_3y_median = lag(EIPCA_3y_median, 12*3)
)
# no "-1" because this data is end of month
}
# lag as it is realized inflation that one needs
dtf <- dtf %>% mutate_at(vars(IGPM, core_IPC, IPCA),
~ lag(., 12-1))
# notice the -1 since every data point is plotted at the start of the
# respective period (monthly freq <=> beginning of month)
# pivot data to long format for plotting
dtf_long <- pivot_longer(dtf, !date,
names_to = "variable",
values_to = "value",
values_transform = as.numeric)
# actual and expected inflation
target    <- 0.045
target_ub <- 0.065
# vertical line width
vline_w <- 0.6 #mm
legs <- c("Consumer Price Inflation",
"Consumer price inflation - admin prices",
"Consumer price inflation - free prices",
"Inflation Target",
"Upper Bound")
legv <- c("red", "blue", "orange3", "green4", "black")
linev <- c("solid", "dotted", "dotdash", "longdash", "solid")
labs <- c(0, 0.025, 0.045, 0.065, seq(0.1, 0.18, 0.04))
plot <- create_plot(dtf_long,
vars = c("IPCA", "IPCA_admin", "IPCA_free"),
scales = 0) +
geom_hline(aes(yintercept = target_ub, colour = "Upper Bound", linetype = "Upper Bound"),
size = tfont(vline_w)) +
geom_hline(aes(yintercept = target, colour = "Target", linetype = "Target"),
size = tfont(vline_w)) +
scale_linetype_manual(values = linev, labels = legs) +
scale_colour_manual(values = legv, labels = legs) +
scale_y_continuous(breaks = labs, labels = scales::percent(labs)) +
scale_y_continuous(limits = c(0, 0.20), breaks = labs, labels = scales::percent(labs))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_11_a.pdf"), plot)
# key indicators for paper
print(mean(dtf$IPCA[dtf$date >= as.Date("2012-01-01") &
dtf$date <= as.Date("2016-12-31")], na.rm = TRUE
)
)
# vertical line width
vline_w <- 0.6 #mm
vars <- c("breakeven1",
"IPCA12_median",
"fgv_ibre_exp")
breakss <- c(vars, "Target", "Upper Bound")
legs <- c("Market-price implied",
"Survey of Professionals",
"Survey of Households",
"Inflation Target",
"Upper Bound")
legv <- c("red", "blue", "orange3", "green4", "black")
linev <- c("solid", "dotted", "dotdash", "longdash", "solid")
plot <- create_plot(dtf_long,
vars = vars,
scales = 0) +
geom_hline(aes(yintercept = target, colour = "Target", linetype = "Target"),
size = tfont(vline_w)) +
geom_hline(aes(yintercept = target_ub, colour = "Upper Bound", linetype = "Upper Bound"),
size = tfont(vline_w)) +
scale_linetype_manual(breaks = breakss, values= linev, labels = legs) +
scale_colour_manual(breaks = breakss, values = legv, labels = legs) +
scale_y_continuous(limits = c(0, 0.12), breaks = labs, labels = scales::percent(labs))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_11_b.pdf"), plot)
# now using max-min instead of max and min
vars1 <- c("fgv_md_skew_100")
vars2 <- c("fgv_md_sd_100")
vars <- c(vars1, vars2)
legss <- c("Cross-sectional survey skewness (lhs)",
"Cross-sectional survey standard deviation (rhs)")
legv <- c("red", "blue")
linev <- c("solid", 'dotdash')
transf_b <- 90 # for secondary axis
transf_a <- 0
plot <- create_plot(dtf_long,
vars = vars1,
perc = 0, scales = 0) +
theme(legend.position = c(0.3,0.88)) +
geom_line(data = dtf_long %>%
filter(date >= as.Date("2008-01-01") &
date <= as.Date("2017-12-31") &
variable %in% vars2 & !is.na(value)),
aes(x = date, y = (value * transf_b) - transf_a,
colour = variable, linetype = variable),
size = line_sizee) +
scale_y_continuous(limits = c(0, 7.5),
sec.axis = sec_axis( trans = ~ (. + transf_a) / transf_b,
labels = scales::percent_format(accuracy = 0.1))
) +
scale_linetype_manual(breaks = vars, values = linev, labels = legss) +
scale_colour_manual(breaks  = vars, values = legv, labels = legss)
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_11_c.pdf"), plot)
# read data
dtf_micro <- read.csv("Data/Brazil/fgv_household_density.csv", encoding = "latin1")
dtf_micro %<>% mutate(year = as.factor(year))
# line
linev <- c('dotdash', 'dotted', 'solid')
legv <- c('red', 'blue', 'green4')
plot <- ggplot(dtf_micro, aes(x = fgv_md_EIPCA)) +
geom_line(aes(x = x, y = y,
colour = year, linetype = year),
size = line_sizee, geom = "line", position = "identity") +
scale_linetype_manual(values = linev) +
scale_colour_manual(values = legv) +
scale_x_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.25)) +
# truncated at 25%!
theme(legend.position = c(0.1,0.8))
print(plot)
if (bSavePlots) my_ggsave(paste0(path_figure_out, "figure_11_d.pdf"), plot)
?tlwd
