knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE)
library(Rblpapi)
library(tidyverse)
library(tidymas)
library(lubridate)
library(xlsx)
blpConnect()
gov_caps <- read.csv("countries_cap_gov.csv", header = TRUE, colClasses = c("character", "numeric")) %>%
  mutate(cap = ifelse(is.na(cap), 1, cap))

ilb_caps <- read.csv("countries_cap_ilb.csv", header = TRUE, colClasses = c("character", "numeric")) %>%
  mutate(cap = ifelse(is.na(cap), 1, cap))

ratings <- get_bm_ratings(per = 12) %>%
  dplyr::filter(country %in% gov_caps$country | country %in% ilb_caps$country)
plot_credit_ratings(ratings)
# Get MV of countries
mv <- read.csv("sf_mv.csv", header = TRUE, skip = 7, colClasses = c("character", "numeric", "numeric")) %>%
  .[1:head(which(str_detect(.[,1], "^Disclaimer")), 1)-1, c(1,2,3)] %>%
  stats::setNames(c("country", "DM_GOV", "DM_ILB")) %>%
  dplyr::filter(country != "" & country != "Total")

# Set appropriate caps in countries_cap_XXX.csv
gov_caps_mv <- gov_caps %>%
  left_join(mv, by = "country") 

gov <- gov_caps_mv %>% 
  dplyr::filter(!is.na(DM_GOV)) 

ilb_caps_mv <- ilb_caps %>%
  left_join(mv, by = "country") 

ilb <- ilb_caps_mv %>% 
  dplyr::filter(!is.na(DM_ILB)) 

sf_gov <- market_capping(gov$DM_GOV, gov$cap) %>%
  cbind(country = gov[,"country"])

sf_ilb <- market_capping(ilb$DM_ILB, ilb$cap) %>%
  cbind(country = ilb[,"country"])

Scaling factors for Gov

# Check date
f <- file("sf_mv.csv")
inp <- readLines(f)
close(f)

dat <-  inp %>%
  .[str_detect(., "As Of")] %>%
  str_match("(?<=As Of : )[0-9/]+") %>%
  .[1,1] %>%
  lubridate::mdy()

exp_date <- data.frame(date = seq(today() - day(today())-5, today() - day(today()), by = 1)) %>% 
  mutate(weekdays = weekdays(date)) %>% 
  filter(! weekdays %in% c("Saturday", "Sunday")) %>% 
  tail(1) %>% 
  .$date

Date of market values: r dat

r if (exp_date != dat) {paste("Warning: expected date is", exp_date)}

exp_cap <- function(rating_num) {
  if (rating_num >= 10) {  # BBB- and worse
    return(0)
  } else if (rating_num >= 8) {  # BBB+ and worse
    return(0.05)
  } else if (rating_num >= 5) {  # A+ and worse
    return(0.1)
  } else {  # AA- and better
    return(1)
  }
}

# Get latest ratings
latest_ratings <- ratings %>% 
  ungroup %>% 
  filter(date == max(date)) %>%
  select(country, mas_rating, mas_median_num) 

# Check if any errors for gov scaling factors
gov_show <- sf_gov %>%
  left_join(latest_ratings, by = "country") %>%
  mutate(exp_cap = map_dbl(mas_median_num, exp_cap)) %>%
  select(country,mas_rating, rescaled_sf, capped_mv_wts, capped_wts, exp_cap) %>%
  mutate(error = !(capped_wts == exp_cap))

error_msg_gov <- NA
if (sum(gov_show$error) > 0) {
  error_countries_gov <- filter(gov_show, error)$country
  error_msg_gov <- paste("!!! WARNING: caps are different from expected caps for", paste(error_countries_gov, collapse = ", "))
}

ilb_show <- sf_ilb %>%
  left_join(latest_ratings, by = "country") %>%
  mutate(exp_cap = map_dbl(mas_median_num, exp_cap)) %>%
  select(country,mas_rating, rescaled_sf, capped_mv_wts, capped_wts, exp_cap) %>%
  mutate(error = !(capped_wts == exp_cap))

error_msg_ilb <- NA
if (sum(ilb_show$error) > 0) {
  error_countries_ilb <- filter(ilb_show, error)$country
  error_msg_ilb <- paste("!!! WARNING: caps are different from expected caps for", paste(error_countries_ilb, collapse = ", "))
}

r if (!is.na(error_msg_gov)) error_msg_gov

gov_show %>%
  select(-error) %>%
  mutate(rescaled_sf = scales::percent(rescaled_sf, 0.01), 
         capped_mv_wts = scales::percent(capped_mv_wts, 0.01),
         capped_wts = scales::percent(capped_wts, 1),
         exp_cap = scales::percent(exp_cap, 1)) %>%
  knitr::kable()

Scaling factors ILB

r if (!is.na(error_msg_ilb)) error_msg_ilb

ilb_show %>%
  select(-error) %>%
  mutate(rescaled_sf = scales::percent(rescaled_sf, 0.01), 
         capped_mv_wts = scales::percent(capped_mv_wts, 0.01),
         capped_wts = scales::percent(capped_wts, 1),
         exp_cap = scales::percent(exp_cap, 1)) %>%
  knitr::kable()
# Input
gov_xl_disp <- select(gov_show, country, mas_rating, rescaled_sf, capped_mv_wts, capped_wts) 
ilb_xl_disp <- select(ilb_show, country, mas_rating, rescaled_sf, capped_mv_wts, capped_wts)

# create a new workbook for outputs
wb <- createWorkbook(type="xlsx")

# Define some cell styles
TITLE_STYLE <- CellStyle(wb)+ Font(wb,  heightInPoints=16, isBold=TRUE, underline = 1)
SUB_TITLE_STYLE <- CellStyle(wb) + 
                    Font(wb,  heightInPoints=12, 
                          isBold=TRUE)

DATE_STYLE <- CellStyle(wb, dataFormat = DataFormat("dd-mmm-yy"))
PERCENT_STYLE <- CellStyle(wb, dataFormat = DataFormat("0.00%"))

# Styles for the data table row/column names
TABLE_ROWNAMES_STYLE <- CellStyle(wb) + Font(wb, isBold = TRUE)
TABLE_COLNAMES_STYLE <- CellStyle(wb) + Font(wb, isBold = TRUE) +
    Alignment(wrapText = TRUE, horizontal = "ALIGN_CENTER") +
    Border(color = "black", position = c("TOP", "BOTTOM"), 
           pen = c("BORDER_THIN", "BORDER_THICK")) 

# Create a new sheet in the workbook
sheet <- createSheet(wb, sheetName = "sf")

# Add title
rows <- createRow(sheet, rowIndex = 1:5)
cells <- createCell(rows, colIndex = 1:7)
setCellValue(cells[[1, 1]], "Scaling Factor Report")
setCellStyle(cells[[1, 1]], TITLE_STYLE)

# Add run and MV date
disp_dates <- data.frame(col = c("Run date", "MV as of date"), date = c(today(), dat))
addDataFrame(disp_dates, sheet, startRow = 2, startColumn = 1,
             row.names = FALSE, col.names = FALSE, 
             colStyle = list('2' = DATE_STYLE))

# Add subtitle
setCellValue(cells[[5, 1]], "Nominal Govt")
setCellStyle(cells[[5, 1]], SUB_TITLE_STYLE)

setCellValue(cells[[5, 7]], "Inflation Linked Bonds")
setCellStyle(cells[[5, 7]], SUB_TITLE_STYLE)

# Add scaling factor tables
addDataFrame(gov_xl_disp, sheet, startRow = 6, startColumn = 1, 
             colnamesStyle = TABLE_COLNAMES_STYLE,
             rownamesStyle = TABLE_ROWNAMES_STYLE, row.names = FALSE,
             colStyle = list('3' = PERCENT_STYLE, '4' = PERCENT_STYLE, '5' = PERCENT_STYLE))

addDataFrame(ilb_xl_disp, sheet, startRow = 6, startColumn = 7, 
             colnamesStyle = TABLE_COLNAMES_STYLE,
             rownamesStyle = TABLE_ROWNAMES_STYLE, row.names = FALSE,
             colStyle = list('3' = PERCENT_STYLE, '4' = PERCENT_STYLE, '5' = PERCENT_STYLE))

# Change column width
setColumnWidth(sheet, colIndex = 1:11, colWidth = 11)
setColumnWidth(sheet, colIndex = c(1, 7), colWidth = 18)

# Save the workbook to a file
xlsx_file <- sprintf("scaling_factor_%s.xlsx", format(dat, "%Y%m%d"))
saveWorkbook(wb, xlsx_file)

Output saved to r file.path(getwd(), xlsx_file)



yunching/tidymas documentation built on Feb. 5, 2023, 1:42 p.m.