In hs97/MPHM:

knitr::opts_chunk$set(echo = TRUE, warning=FALSE, message = FALSE)
library(MPHM)
library(dplyr)
library(tidyr)
library(knitr)
library(purrr)
library(readxl)
library(zoo)
library(readr)

dates <- read_csv('../data/dates.csv')
nhc <- read_excel('../data/HouseCredit_data.xlsx', sheet = "HouseCredit_NTcurr") %>%
    rename(date = 1) %>%
    mutate(date = as.Date(as.yearqtr(date, format = "%Y-%m-%d")))
nhc[nhc == 0] <- NA
ngdp <- read_excel('../data/ngdp.xlsx', sheet = "ngdp") %>%
    rename(date = 1) %>%
    mutate(date = as.Date(as.yearqtr(date, format = "%Y-%m-%d")))
country_list <- colnames(nhc)[colnames(nhc) != "date"]
ratio = lapply(country_list, calculate_ratio, nhc = nhc, ngdp = ngdp) %>%
  reduce(full_join, by = "date") %>%
  apply(X = dates, 1, reduce_coverage, dat = . ) %>%
  Filter(Negate(is.null), .) %>%
  reduce(full_join, by = "date")

cpi <- read_cpi(x = "../data/cp1904.xlsx", y = "../data/MacroVar.xlsx")
pp <- read_pp(pps = "../data/pp_selected.xlsx", ppl = "../data/pp_long.xlsx", 
              pp_saar = "../data/HousePrices_SA&AR.xlsx", country_list = country_list, cpi = cpi) %>%
  apply(X = dates, 1, reduce_coverage, dat = . ) %>%
  Filter(Negate(is.null), .) %>%
  reduce(full_join, by = "date") 
country_list <- colnames(ratio)[colnames(ratio) != "date"]

# The list of all actions. We can choose from this list what actions we want to look at
indicators <- c("Housing_FX_limit", "Housing_LLprovisioning", "Housing_LTV", 
                "Housing_OtherCapital", "Housing_RiskWeights", "Housing_tax",
                "Housing_CCYB", 'Housing_DSTI', 'Housing_DTI_LTI', 'Housing_Exposure_limit',
                "Housing_credGr_limit")
mp <- lapply(indicators, read_mp, path = "../data/MacroprudentialIndicators.xlsx") %>%
  reduce(full_join, by = "date")
mp <- apply(dates, 1, reduce_coverage, dat = mp) %>%
  Filter(Negate(is.null), .) %>%
  reduce(full_join, by = "date")

ks_dat_ratio <- sapply(country_list, ks_ratio_growth_hp, x = ratio, 
                    lambda = 0, minphase = 4,
                    lambda_hp = 1600 * 40, logged = FALSE, simplify = FALSE,  USE.NAMES = TRUE)
ks_dat_pp <- sapply(country_list, ks_ratio_growth_hp, x = pp, 
                    lambda = 0, minphase = 4,
                    lambda_hp = 1600 * 40, logged = TRUE, simplify = FALSE,  USE.NAMES = TRUE)

countries_with_enough_actions <- read_csv("../data/avail_mp.csv") %>%
  select(sum, country) %>%
  filter(sum >= 6) %>%
  .$country

There are a total of r length(countries_with_enough_actions) countries with more than 6 macroprudential actions. For the contingency tables, the vertical axis records business cycle identification from property price data, and the horizontal one records that from nominal credit to GDP ratio.

for (country in countries_with_enough_actions) {
  intersect_scores <- score_card(ks_dat = ks_dat_pp, mp = mp, country = country, ks_dat_2 = ks_dat_ratio, intersect = TRUE)
  print(kable(intersect_scores$hp, caption = paste('Interection Score for ', country)))
}

hs97/MPHM documentation built on Aug. 29, 2019, 4:10 p.m.