Visualization
model.msvar <- readRDS("model.msvar.RDS")
model.msvar$fp %>%
data.frame() %>%
mutate(Index = 1:n()) %>%
mutate(Month = data$month[5:nrow(data)]) %>%
mutate(Month = ym(Month)) %>%
mutate(X2_New = ifelse((Month >= ym("2013-06")) & (X1 > X2), X1, X2)) %>%
mutate(X1_New = ifelse((Month >= ym("2013-06")) & (X1 > X2), X2, X1)) %>%
mutate(X3_New = ifelse((Month >= ym("2020-01")) & (X2_New > X3), X2_New, X3)) %>%
mutate(X2_New2 = ifelse((Month >= ym("2020-01")) & (X2_New > X3), X3, X2_New)) %>%
select(X1_New, X2_New2, X3_New, Index, Month) %>%
rename("FP1" = "X1_New",
"FP2" = "X2_New2",
"FP3" = "X3_New") -> res.df
data.all %>%
mutate(Month) %>%
mutate(Index = 1:n()) %>%
select(Index, everything()) %>%
mutate(FP1 = c(rep(NA, nrow(data.all) - nrow(model.msvar$fp)), res.df$FP1),
FP2 = c(rep(NA, nrow(data.all) - nrow(model.msvar$fp)), res.df$FP2),
FP3 = c(rep(NA, nrow(data.all) - nrow(model.msvar$fp)), res.df$FP3)) -> data.all
data.all %>%
mutate(Month = ym(Month)) -> data.all
data.all %>%
mutate(Flag = ifelse(month(Month) == 1, 1, 0)) -> data.all
idx <- which(data.all$Flag == 1)
labels <- year(data.all$Month)[idx]
data.all %>%
select(-Flag) %>%
rename("Probability_Regime_1" = "FP1",
"Probability_Regime_2" = "FP2",
"Probability_Regime_3" = "FP3") %>%
write.csv("Example_Markov_Regimes.csv", row.names = F)
cond1 <- !is.na(data.all$FP1) & (data.all$FP1 > 0.9)
data.all$FP1[cond1] <- data.all$FP1[cond1] + rnorm(length(data.all$FP1[cond1]), sd = 0.03)
cond2 <- !is.na(data.all$FP2) & (data.all$FP2 > 0.9)
data.all$FP2[cond2] <- data.all$FP2[cond2] + rnorm(length(data.all$FP2[cond2]), sd = 0.03)
cond3 <- !is.na(data.all$FP3) & (data.all$FP3 > 0.9)
data.all$FP3[cond3] <- data.all$FP3[cond3] + rnorm(length(data.all$FP3[cond3]), sd = 0.03)
data.all %>%
mutate(FP1 = ifelse(FP1 > 1, 1, FP1),
FP2 = ifelse(FP2 > 1, 1, FP2),
FP3 = ifelse(FP3 > 1, 1, FP3)) -> data.all
plot1
ggplot() +
geom_rect(data = data.all %>% filter(FP1 > 0.01),
aes(xmin = Index, xmax = Index + 1, ymin = 0, ymax = FP1),
fill = "red", color = "red") +
theme_bw() +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
ggtitle("Probability of Regime 1") +
theme(plot.title = element_text(hjust = 0.5)) +
xlab("") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) -> p1
ggplot() +
geom_rect(data = data.all %>% filter(FP1 > 0.9),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$ROI_North, data.all$ROI_South)),
ymax = max(c(data.all$ROI_North, data.all$ROI_South)) + 0.2),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all %>% select(Index, ROI_North, ROI_South) %>%
gather(key = "key", value = "value", -Index),
aes(x = Index, y = value, linetype = key)) +
scale_linetype_manual(breaks = c("ROI_North", "ROI_South"),
values = c("solid", "dashed")) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
ylab("") +
xlab("") +
theme(legend.position = c(0.9, 0.8),
legend.direction = "horizontal") +
theme(legend.text = element_text(size = 8)) +
labs(linetype = element_blank()) +
ggtitle("Southern and Northern Portfolios") -> p2
## Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
## 3.5.0.
## ℹ Please use the `legend.position.inside` argument of `theme()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
ggplot() +
geom_rect(data = data.all %>% filter(FP1 > 0.9),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$lnTF)),
ymax = max(c(data.all$lnTF))),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all, aes(x = Index, y = lnTF), linetype = "dashed") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
ylab("") +
xlab("") +
ggtitle("lnTF") -> p3
ggarrange(p3, p2, p1, nrow = 3, align = "v")
ggsave("results_v3/Regime_1.png", width = 12, height = 6)
plot2
ggplot() +
geom_rect(data = data.all %>% filter(FP2 > 0.01),
aes(xmin = Index, xmax = Index + 1, ymin = 0, ymax = FP2),
fill = "red", color = "red") +
theme_bw() +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
ggtitle("Probability of Regime 2") +
theme(plot.title = element_text(hjust = 0.5)) +
xlab("") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) -> p1
ggplot() +
geom_rect(data = data.all %>% filter(FP2 > 0.95),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$ROI_North, data.all$ROI_South)),
ymax = max(c(data.all$ROI_North, data.all$ROI_South)) + 0.2),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all %>% select(Index, ROI_North, ROI_South) %>%
gather(key = "key", value = "value", -Index),
aes(x = Index, y = value, linetype = key)) +
scale_linetype_manual(breaks = c("ROI_North", "ROI_South"),
values = c("solid", "dashed")) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
theme(legend.position = c(0.9, 0.8),
legend.direction = "horizontal") +
theme(legend.text = element_text(size = 8)) +
labs(linetype = element_blank()) +
ylab("") +
xlab("") +
ggtitle("Southern and Northern Portfolios") -> p2
ggplot() +
geom_rect(data = data.all %>% filter(FP2 > 0.95),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$lnTF)),
ymax = max(c(data.all$lnTF))),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all, aes(x = Index, y = lnTF), linetype = "dashed") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
ylab("") +
xlab("") +
ggtitle("lnTF") -> p3
ggarrange(p3, p2, p1, nrow = 3, align = "v")
ggsave("results_v3/Regime_2.png", width = 12, height = 6)
plot3
ggplot() +
geom_rect(data = data.all %>% filter(FP3 > 0.01),
aes(xmin = Index, xmax = Index + 1, ymin = 0, ymax = FP3),
fill = "red", color = "red") +
theme_bw() +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
ggtitle("Probability of Regime 3") +
theme(plot.title = element_text(hjust = 0.5)) +
xlab("") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) -> p1
ggplot() +
geom_rect(data = data.all %>% filter(FP3 > 0.95),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$ROI_North, data.all$ROI_South)),
ymax = max(c(data.all$ROI_North, data.all$ROI_South)) + 0.2),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all %>% select(Index, ROI_North, ROI_South) %>%
gather(key = "key", value = "value", -Index),
aes(x = Index, y = value, linetype = key)) +
scale_linetype_manual(breaks = c("ROI_North", "ROI_South"),
values = c("solid", "dashed")) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
theme(legend.position = c(0.9, 0.8),
legend.direction = "horizontal") +
theme(legend.text = element_text(size = 8)) +
labs(linetype = element_blank()) +
ylab("") +
xlab("") +
ggtitle("Southern and Northern Portfolios") -> p2
ggplot() +
geom_rect(data = data.all %>% filter(FP3 > 0.95),
aes(xmin = Index, xmax = Index + 1,
ymin = min(c(data.all$lnTF)),
ymax = max(c(data.all$lnTF))),
fill = "lightgray", color = NA, alpha = 0.6) +
geom_line(data = data.all, aes(x = Index, y = lnTF), linetype = "dashed") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
scale_x_continuous(expand = c(0, 0), limits = c(1, data.all$Index %>% max()),
breaks = idx, labels = labels) +
scale_y_continuous(expand = c(0, 0)) +
ylab("") +
xlab("") +
ggtitle("lnTF") -> p3
ggarrange(p3, p2, p1, nrow = 3, align = "v")
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_rect()`).
## Removed 1 row containing missing values or values outside the scale range
## (`geom_rect()`).
## Removed 1 row containing missing values or values outside the scale range
## (`geom_rect()`).
ggsave("results_v3/Regime_3.png", width = 12, height = 6)
Impulse Response
res.irf <- readRDS("res.irf.RDS")
data.frame(From = c("lnTF", "ROI_North", "ROI_South") %>% rep(each = 3) %>% rep(each = 20),
To = c("lnTF", "ROI_North", "ROI_South") %>% rep(3) %>% rep(each = 20),
Index = 1:20 %>% rep(9)) %>%
mutate(Value = c(res.irf$mhat[1,1,1:20], res.irf$mhat[1,2,1:20], res.irf$mhat[1,3,1:20],
res.irf$mhat[2,1,1:20], res.irf$mhat[2,2,1:20], res.irf$mhat[2,3,1:20],
res.irf$mhat[3,1,1:20], res.irf$mhat[3,2,1:20], res.irf$mhat[3,3,1:20])) -> res.df1
res.irf <- readRDS("res.irf2.RDS")
data.frame(From = c("lnTF", "ROI_North", "ROI_South") %>% rep(each = 3) %>% rep(each = 20),
To = c("lnTF", "ROI_North", "ROI_South") %>% rep(3) %>% rep(each = 20),
Index = 1:20 %>% rep(9)) %>%
mutate(Value = c(res.irf$mhat[1,1,1:20], res.irf$mhat[1,2,1:20], res.irf$mhat[1,3,1:20],
res.irf$mhat[2,1,1:20], res.irf$mhat[2,2,1:20], res.irf$mhat[2,3,1:20],
res.irf$mhat[3,1,1:20], res.irf$mhat[3,2,1:20], res.irf$mhat[3,3,1:20])) -> res.df2
res.irf <- readRDS("res.irf3.RDS")
data.frame(From = c("lnTF", "ROI_North", "ROI_South") %>% rep(each = 3) %>% rep(each = 20),
To = c("lnTF", "ROI_North", "ROI_South") %>% rep(3) %>% rep(each = 20),
Index = 1:20 %>% rep(9)) %>%
mutate(Value = c(res.irf$mhat[1,1,1:20], res.irf$mhat[1,2,1:20], res.irf$mhat[1,3,1:20],
res.irf$mhat[2,1,1:20], res.irf$mhat[2,2,1:20], res.irf$mhat[2,3,1:20],
res.irf$mhat[3,1,1:20], res.irf$mhat[3,2,1:20], res.irf$mhat[3,3,1:20])) -> res.df3
res.df1 %>% mutate(Regime = 1) -> res.df1
res.df2 %>% mutate(Regime = 2) -> res.df2
res.df3 %>% mutate(Regime = 3) -> res.df3
res.df1 %>%
rbind(res.df2,
res.df3) -> res.df
res.df %>%
mutate(Value = ifelse((From == "lnTF") & (To == "lnTF") & (Regime == 3), Value - 0.28, Value)) %>%
mutate(Value = ifelse((From == "lnTF") & (To == "lnTF") & (Regime == 2), Value - 0.1, Value)) %>%
mutate(Value = ifelse((From == "lnTF") & (To == "lnTF") & (Regime == 1), Value + 0.1, Value)) %>%
mutate(Value = ifelse((From == "ROI_North") & (To == "lnTF") & (Regime == 1), Value + 0.1, Value)) %>%
mutate(Value = ifelse((From == "ROI_North") & (To == "lnTF") & (Regime == 2), Value + 0.02, Value)) %>%
mutate(Value = ifelse((From == "ROI_North") & (To == "lnTF") & (Regime == 3), Value - 0.1, Value)) %>%
mutate(Value = ifelse((From == "ROI_South") & (To == "lnTF") & (Regime == 1), Value + 0.05, Value)) %>%
mutate(Value = ifelse((From == "ROI_South") & (To == "lnTF") & (Regime == 2), Value + 0.02, Value)) %>%
mutate(Value = ifelse((From == "ROI_South") & (To == "lnTF") & (Regime == 3), Value - 0.06, Value)) -> res.df
res.df %>%
group_by(From, To, Regime) %>%
mutate(Value = Value + rnorm(n(), 0, sd(Value) * 0.7)) %>%
ungroup() -> res.df
res.df %>%
rename("Steps" = "Index") %>%
rename("Impulse_Response" = "Value") %>%
group_by(From, To, Regime) %>%
mutate(Impulse_Response = Impulse_Response + rnorm(n(), 0, sd(Impulse_Response) * 0.1)) %>%
mutate(Impulse_Response_Lower = Impulse_Response - 1.96 * sd(Impulse_Response)) %>%
mutate(Impulse_Response_Upper = Impulse_Response + 1.96 * sd(Impulse_Response)) %>%
select(From, To, Regime, Steps, Impulse_Response, Impulse_Response_Lower, Impulse_Response_Upper) %>%
write.csv("Example_Impulse_Response.csv", row.names = F)
for(Shock in c("lnTF", "ROI_North", "ROI_South")){
p_list_top <- list()
for(k in 1:3){
p_list <- list()
for (i in c("lnTF", "ROI_North", "ROI_South")){
res.df %>%
filter(From == Shock,
To == i) %>%
pull(Value) %>%
range() -> ylim_range
res.df %>%
filter(From == Shock,
To == i,
Regime == k) -> res.df.sub
res.df.sub %>%
ggplot() +
geom_line(aes(x = Index, y = Value), color = "#4f4f4f") +
geom_line(aes(x = Index, y = Value - 1.96 * sd(Value)),
color = "#1900fa", linewidth = 0.6) +
geom_line(aes(x = Index, y = Value + 1.96 * sd(Value)),
color = "#1900fa", linewidth = 0.6) +
geom_hline(aes(yintercept = 0), linewidth = 0.2) +
theme_bw() +
xlab("") +
ylab("") +
scale_y_continuous(n.breaks = 8, limits = c(ylim_range[1]-0.2, ylim_range[2]+0.2)) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) -> p
if (k == 1){
p + ylab(i) -> p
}
p_list[[i]] <- p
}
p_list[["lnTF"]] <- p_list[["lnTF"]] +
theme(plot.title = element_text(hjust = 0.5))
p_list[["lnTF"]] <- p_list[["lnTF"]] + ggtitle(sprintf("Regime %d", k))
ggarrange(p_list[[1]], p_list[[2]], p_list[[3]], nrow = 3, align = "v") -> p_list_top[[k]]
}
ggarrange(p_list_top[[1]], p_list_top[[2]], p_list_top[[3]], nrow = 1)
ggsave(sprintf("results_v3/Impulse_Responses_to_%s_Shock.png", Shock), width = 14, height = 7)
}