################################################################################
# Call Code: US CPI #
################################################################################
setwd("F:/Macro/Call_Codes/Call_CPI")
## 1) Packages: ----------------------------------------------------------------
#install.packages("readxl")
library("readxl")
#install.packages("dplyr")
library("dplyr")
#install.packages("gt")
library("gt")
#install.packages("gtExtras")
library("gtExtras")
#install.packages("tictoc")
library("tictoc")
#install.packages("scales")
library("scales")
#install.packages("zoo")
library("zoo")
#install.packages("tidyverse")
library("tidyverse")
#install.packages("lubridate")
library("lubridate")
#install.packages("timetk")
library("timetk")
#install.packages("data.table")
library("data.table")
#install.packages("blsAPI")
library("blsAPI")
#install.packages("blsR")
library("blsR")
#install.packages("writexl")
library("writexl")
#install.packages("RDCOMClient")
#devtools::install_github("omegahat/RDCOMClient")
library("RDCOMClient")
#install.packages("ggpubr")
library("ggpubr")
#install.packages("webshot2")
library("webshot2")
tic()
## 2) Functions: ---------------------------------------------------------------
# MoM percentual variation:
pct_1 <- function(x) {100*(x / lag(x,1) - 1)}
# YoY percentual variation:
pct_12 <- function(x) {100*(x / lag(x,12) - 1)}
acum_p <- function(data, n){
factor <- (1+(data/100))
prod <- RcppRoll::roll_prodr(factor, n = n)
final <- (prod-1)*100
return(final)
}
# YoY contributions:
c_yoy <- function(x,w,b) {
# x is a MoM database with a series of dates as its first column;
# w is a weights database with the same first column as x;
# b is the series that is used as the normalization in the contribution. For
# instance, if we are calculating the contribution to the All items index,
# b is the All items series.
# OBS: We can't calculate YoY contributions through the normal way
# (base period weights x YoY variations). The odd years' december weights
# don't have connections with the previous weights, so we have to break the
# calculations by months.
# First, we have to calculate de MoM contributions:
x_c_chg1 <- cbind( x[,1], round(x[,-1],3) * w[,-1]/100 ) %>%
as.tibble()
# Second, we have to calculate a matrix with All items CPI cumulative
# variations:
all_aux <- matrix(NA, nrow(x), 12)
for(i in 1:12){
pct <- (b[-length(b)] / lag(b[-length(b)],i-1))
all_aux[1:(nrow(x) - (i-1)),i] <- pct[!is.na(pct)]
}
all_aux = as.tibble(all_aux) %>%
drop_na()
x_c_chg12_partial <- matrix(NA,nrow(all_aux),ncol(x_c_chg1[,-1]))
for(i in 1:nrow(all_aux)){
x_c_chg12_partial[i,] <- as.matrix(all_aux[i,]) %*%
as.matrix(x_c_chg1[i:(i+11),-1])
}
# Now we have the contributions:
x_c_chg12 <- cbind( x_c_chg1$Dates[-c(1:11)], as.tibble(x_c_chg12_partial) )
colnames(x_c_chg12) <- colnames(x_c_chg1)
return(x_c_chg12)
}
## 3) Very Fast table: ---------------------------------------------------------
# Items that will be used here:
main_items <- c(130,1,131,132,139,42,49,60,62,63,145,27,75,148,72,28,32)
load(file = "Auxiliar/R_CPI.Rda")
W_partial <- BLS %>%
select(-c(2:15)) %>%
pivot_longer(-Items) %>%
pivot_wider(id_cols = name, names_from = Items, values_from = value) %>%
rename(Dates = name) %>%
mutate(across(.cols = 1, .fns = as.yearmon))
NR <- nrow(W_partial)
W_fast <- W_partial[(NR-2):NR,c(1,main_items + 1)]
W_fast$`Other goods` <- W_fast$`Core goods` -
W_fast$`Household furnishings and supplies` -
W_fast$Apparel - W_fast$`Transportation goods`
W_fast$`Other services` <- W_fast$`Core services` -
W_fast$Shelter - W_fast$`Medical care services` -
W_fast$`Transportation services`
try_blsR <- suppressWarnings(try(get_series_tables(series_id = BLS$`BLS Code sa`[main_items],
api_key = 'e832f23711694639971ec8028247ddbd',
start_year = 2024, end_year = 2025), silent = T))
last_date <- 0
target_date <- "May 2025"
while(last_date != target_date){
if (!inherits(try_blsR, "try-error")) {
# With seasonal adjustment (1st method):
sa_dt <- try_blsR[[1]] %>% mutate(period = str_remove(period, pattern = "M")) %>%
mutate(Dates = as.yearmon(paste0(year,"-",period,"-01"))) %>% select(Dates)
sa_dt <- sa_dt[order(nrow(sa_dt):1),]
for(i in 1:length(try_blsR)){
x <- try_blsR[[i]]
x <- x[order(nrow(x):1),] %>% select(value) %>% pct_1()
colnames(x) <- BLS$`Items`[main_items[i]]
sa_dt <- cbind(sa_dt,x) }
mom_dt <- tail(sa_dt,3)
last_date <- tail(sa_dt$Dates,1)
} else {
# With seasonal adjustment (2nd method):
par_sa <- list('seriesid' = BLS$`BLS Code sa`[main_items],
'startyear' = year( as.yearmon(tail(colnames(BLS),1)) ) - 1,
'endyear'= year( as.yearmon(tail(colnames(BLS),1)) +1/12 ),
'registrationKey' = 'e832f23711694639971ec8028247ddbd')
sa_dt <- blsAPI(par_sa, 2, return_data_frame = T) %>%
mutate(period = str_remove(period, pattern = "M")) %>%
mutate(date = as.yearmon(paste0(year,"-",period,"-01"))) %>%
mutate(value = as.numeric(value)) %>%
select(-c(year, period, periodName)) %>%
pivot_wider(id_cols = date, names_from = seriesID, values_from = value) %>%
arrange(date)
colnames(sa_dt) <- c("Dates",BLS$Items[main_items])
# MoM variations:
mom_dt <- sa_dt %>%
mutate(across(.cols = -1, .fns = pct_1))
mom_dt <- tail(mom_dt,3)
last_date <- tail(sa_dt$Dates,1)
}
if (last_date != target_date){print("Try again!!")}
}
tail(mom_dt$`All Items`,1)
tail(mom_dt$`Core CPI`,1)
if(nrow(W_fast) > nrow(mom_dt)) {
W_fast <- W_fast[-nrow(W_fast),]
}
mom_dt$`Other goods` <- ( mom_dt$`Core goods`*W_fast$`Core goods` -
mom_dt$`Household furnishings and supplies`*W_fast$`Household furnishings and supplies` -
mom_dt$Apparel*W_fast$Apparel -
mom_dt$`Transportation goods`*W_fast$`Transportation goods` )/W_fast$`Other goods`
mom_dt$`Other services` <- ( mom_dt$`Core services`*W_fast$`Core services` -
mom_dt$Shelter*W_fast$Shelter -
mom_dt$`Medical care services`*W_fast$`Medical care services` -
mom_dt$`Transportation services`*W_fast$`Transportation services` )/W_fast$`Other services`
mom_dt$`Core services less shelter` <- ( mom_dt$`Core services`*W_fast$`Core services` -
mom_dt$Shelter*W_fast$Shelter )/( W_fast$`Core services` - W_fast$Shelter)
mom_dt$`Powell Supercore` <- ( mom_dt$`Core services`*W_fast$`Core services` -
mom_dt$`Rent of primary residence`*W_fast$`Rent of primary residence` -
mom_dt$`Owners' equivalent rent of residence`*W_fast$`Owners' equivalent rent of residence` )/
( W_fast$`Core services` - W_fast$`Rent of primary residence` - W_fast$`Owners' equivalent rent of residence` )
mom_dt <- select(mom_dt,c(1:11,19,12:16,20,21,22))
W_tab <- select(tail(W_fast,1),c(2:11,19,12:16,20,17,18))
# MoM Expectations:
expec <- matrix(NA, ncol(mom_dt)-1, 11)
expec[,1] <- round(c(as_vector(select(W_tab,-c(ncol(W_tab)-1,ncol(W_tab)))),(W_tab$`Core services` - W_tab$Shelter),(W_tab$`Core services` - W_tab$`Owners' equivalent rent of residence` - W_tab$`Rent of primary residence`)),1)
expec[,2:4] <- round(t(mom_dt[,-1]),2)
rownames(expec) <- colnames(mom_dt[,-1])
colnames(expec) <- c("Share",as.character(mom_dt$Dates),"BBG","Itau","UBS","Citi","MS","Nomura","Houses avg")
# BBG Itaú UBS Citi MS Nomura Houses avg
# All Items
expec[1,5:11] <- c("-", 0.17, "-", "-", "-", "-", 0.15)
# Food
expec[2,5:11] <- c( "-", 0.3, "-", "-", "-", "-", "-")
# Energy
expec[3,5:11] <- c( "-", -1.30, "-", "-", "-", "-", "-")
# Core CPI
expec[4,5:11] <- c( "-", 0.27, "-", "-", "-", "-", "-")
# Core goods
expec[5,5:11] <- c( "-", 0.19, "-", "-", "-", "-", "-")
# Household furnishings and supplies
expec[6,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# Apparel
expec[7,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# Transportation goods
expec[8,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# New vehicles
expec[9,5:11] <- c( "-", 0.00, "-", "-", "-", "-", "-")
# Used cars and trucks
expec[10,5:11] <- c( "-", -0.60, "-", "-", "-", "-", "-")
# Other goods
expec[11,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# Core services
expec[12,5:11] <- c( "-", 0.29, "-", "-", "-", "-", "-")
# Shelter
expec[13,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# Medical care services
expec[14,5:11] <- c( "-", 0.31, "-", "-", "-", "-", "-")
# Transportation services
expec[15,5:11] <- c( "-", -0.30, "-", "-", "-", "-", "-")
# Airline fares
expec[16,5:11] <- c( "-", -2.80, "-", "-", "-", "-", "-")
# Other services
expec[17,5:11] <- c( "-", "-", "-", "-", "-", "-", "-")
# Core services less shelter
expec[18,5:11] <- c( "-", 0.22, "-", "-", "-", "-", "-")
# Powell Supercore
expec[19,5:11] <- c( "-", 0.21, "-", "-", "-", "-", "-")
View(expec)
tab_fast <- as_tibble(expec) %>%
mutate(Items = rownames(expec)) %>%
select(12,1:11) %>%
mutate(across(.cols = -1, .fns = ~format(.x,nsmall = 2)))
colnames(tab_fast) = c("Items","Share","month_1","month_2","month_3","BBG",
"Itau","UBS","Citi","MS","Nomura","Houses avg")
Tab_fast <- gt(tab_fast) %>%
# Title:
tab_header( title = md("**US CPI - MoM**"),
subtitle = format(tail(mom_dt$Dates,1), "%B %Y")) %>%
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
# General options:
tab_options(
heading.align = "left",
table.border.top.color = "white",
column_labels.border.top.color = "black",
column_labels.border.top.width = px(3),
column_labels.border.bottom.color = "black",
table.border.bottom.color = "white",
table_body.hlines.color = "white",
table.border.bottom.width = px(3),
table.font.size = "small",
heading.title.font.size = 20,
heading.subtitle.font.size = 12,
data_row.padding = px(2) ) %>%
cols_align(2:ncol(tab_fast),align = "right") %>%
cols_width(`Items` ~ px(260), `Share` ~ px(60), `month_1` ~ px(60),
`month_2` ~ px(60), `month_3` ~ px(60), `BBG` ~ px(60),
`Itau` ~ px(60), `UBS` ~ px(60), `Citi` ~ px(60), `MS` ~ px(60),
`Nomura` ~ px(60), `Houses avg` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5)),
style = list(cell_text(weight = "bold", color = "darkred"))) %>%
tab_style(locations = cells_body(columns = c(6:12)),
style = list(cell_text(color = "#1855B2"))) %>%
tab_style(locations = cells_body(columns = 2),
style = list(cell_text(style = "italic"))) %>%
# Spanners:
tab_spanner(label = "MoM sa", columns = 3:5) %>%
tab_spanner(label = "Expectations", columns = 6:12) %>%
cols_label(`Items` = "Items",`Share` = "Share",`month_1` = colnames(expec)[2],
`month_2` = colnames(expec)[3], `month_3` = colnames(expec)[4],
`BBG` = "BBG",`Itau` = "Itau",`UBS` = "UBS",`Citi` = "Citi",
`MS` = "MS",`Nomura` = "Nomura",`Houses avg` = "Houses avg") %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,4)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor 1 rows:
tab_style(locations = cells_body(rows = c(5,12)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#F5F5F5"))) %>%
# Minor 2 rows:
tab_style(locations = cells_body(rows = c(18,19)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#F5F5F5"))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
Tab_fast
toc()
## 3) Getting the whole database: ----------------------------------------------
#rm(list = ls()) #comando para esvaziar as tabelas e recomecar todo mes
#
## 3.1) Getting the Rda file with BLS codes and weights: ------------------------
#load(file = "Auxiliar/R_CPI.Rda")
#
#W_partial <- BLS %>%
# select(-c(2:15)) %>%
# pivot_longer(-Items) %>%
# pivot_wider(id_cols = name, names_from = Items, values_from = value) %>%
# rename(Dates = name) %>%
# mutate(across(.cols = 1, .fns = as.yearmon))
#
## We have to create variables that are not published regularly by BLS:
#
## Household operations:
#aux_house <- (colnames(W_partial[,-1]) == "Household furnishings and operations") -
# (colnames(W_partial[,-1]) == "Household furnishings and supplies")
#
## Leased cars and trucks:
#aux_leased <- (colnames(W_partial[,-1]) == "Transportation services") -
# (colnames(W_partial[,-1]) == "Car and truck rental") -
# (colnames(W_partial[,-1]) == "Motor vehicle maintenance and repair") -
# (colnames(W_partial[,-1]) == "Motor vehicle insurance") -
# (colnames(W_partial[,-1]) == "Motor vehicle fees") -
# (colnames(W_partial[,-1]) == "Public transportation")
#
## Unsampled new and used motor vehicles:
#aux_vehicles <- (colnames(W_partial[,-1]) == "New and used motor vehicles") -
# (colnames(W_partial[,-1]) == "New vehicles") -
# (colnames(W_partial[,-1]) == "Used cars and trucks") -
# (colnames(W_partial[,-1]) == "Leased cars and trucks") -
# (colnames(W_partial[,-1]) == "Car and truck rental")
#
## Unsampled video and audio:
#aux_video <- (colnames(W_partial[,-1]) == "Video and audio") -
# (colnames(W_partial[,-1]) == "Televisions") -
# (colnames(W_partial[,-1]) == "Cable, satellite and live streaming television service") -
# (colnames(W_partial[,-1]) == "Other video equipment") -
# (colnames(W_partial[,-1]) == "Purchase, subscription and rental of video") -
# (colnames(W_partial[,-1]) == "Audio equipment") -
# (colnames(W_partial[,-1]) == "Recorded music and music subscriptions")
#
## Unsampled recreation goods:
#aux_goods <- (colnames(W_partial[,-1]) == "Other recreational goods") -
# (colnames(W_partial[,-1]) == "Toys") -
# (colnames(W_partial[,-1]) == "Sewing machines, fabric and supplies") -
# (colnames(W_partial[,-1]) == "Music instruments and accessories")
#
## Unsampled recreation services:
#aux_services <- (colnames(W_partial[,-1]) == "Other recreation services") -
# (colnames(W_partial[,-1]) == "Club membership") -
# (colnames(W_partial[,-1]) == "Admissions") -
# (colnames(W_partial[,-1]) == "Fees for lessons or instructions")
#
## Unsampled information:
#aux_information <- (colnames(W_partial[,-1]) == "Information technology") -
# (colnames(W_partial[,-1]) == "Computers and peripherals") -
# (colnames(W_partial[,-1]) == "Computer software and accessories") -
# (colnames(W_partial[,-1]) ==
# "Internet services and electronic information providers") -
# (colnames(W_partial[,-1]) ==
# "Telephone hardware and other consumer information items")
#
#aux <- tibble(aux_house, aux_leased, aux_vehicles, aux_video, aux_goods,
# aux_services, aux_information)
#
#W_aux <- as.tibble( cbind(W_partial[,1],
# as.matrix(select(W_partial,-1)) %*% as.matrix(aux)) )
#colnames(W_aux) <- c("Dates", "Household operations", "Leased cars and trucks",
# "Unsampled new and used motor vehicles",
# "Unsampled video and audio", "Unsampled recreation goods",
# "Unsampled recreation services", "Unsampled information")
#
#W <- full_join(W_partial, W_aux, by = "Dates")
#
## OBS 1: In March/20, the weight and the price index for
## "Fees for lessons or instructions" are not available. I don't know yet how
## to deal with it properly. So I did what follows:
## 1) Considered that the price index is the same for February/20;
## 2) Updated the weight using the price index obtained in the 1st step.
## I need to do this because I can't recover it from aggregate indexes. In its
## same expenditure class we have an unsampled item and I already use the recover
## procedure for it.
#
## OBS 2: I didn't consider the item "Unsampled photography". Its weight is 0.000 and
## its inclusion would complicate the calculation. So I use 80 (and not 81) items
## to compound the SA All Items.
#
## 3.2) Getting the data using the BLS API: -------------------------------------
#
## Ideally, I would use the fread function to get the data directly from
## BLS website. But BLS have blocked me and now we have to use the standard
## API. It is slower and we can only download 50 series per command.
#
## With seasonal adjustment:
#par_1 <- list('seriesid' = BLS$`BLS Code sa`[1:50], 'startyear' = 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#dt_cpi <- blsAPI(par_1, 2, return_data_frame = T)
#
#par_2 <- list('seriesid' = BLS$`BLS Code sa`[51:100], 'startyear'= 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#dt_cpi <- rbind(dt_cpi, blsAPI(par_2, 2, return_data_frame = T))
#
#par_3 <- list('seriesid' = BLS$`BLS Code sa`[101:148], 'startyear'= 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#sa_dt <- rbind(dt_cpi, blsAPI(par_3, 2, return_data_frame = T)) %>%
# mutate(period = str_remove(period, pattern = "M")) %>%
# mutate(date = as.yearmon(paste0(year,"-",period,"-01"))) %>%
# mutate(value = as.numeric(value)) %>%
# select(-c(year, period, periodName)) %>%
# pivot_wider(id_cols = date, names_from = seriesID, values_from = value) %>%
# arrange(date)
#
#colnames(sa_dt) <- c("Dates",BLS$`Items`)
#sa_dt <- sa_dt[-1,]
#
## Without seasonal adjustment:
#par_1 <- list('seriesid' = BLS$`BLS Code nsa`[1:50], 'startyear' = 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#dt_cpi <- blsAPI(par_1, 2, return_data_frame = T)
#
#par_2 <- list('seriesid' = BLS$`BLS Code nsa`[51:100], 'startyear' = 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#dt_cpi <- rbind(dt_cpi, blsAPI(par_2, 2, return_data_frame = T))
#
#par_3 <- list('seriesid' = BLS$`BLS Code nsa`[101:148], 'startyear' = 2012,
# 'endyear'= year( as.yearmon(tail(colnames(BLS),1)) + 1/12 ),
# 'registrationKey' = '39c1674d67d14e86aec228b29c0917e3')
#
#nsa_dt <- rbind(dt_cpi, blsAPI(par_3, 2, return_data_frame = T)) %>%
# mutate(period = str_remove(period, pattern = "M")) %>%
# mutate(date = as.yearmon(paste0(year,"-",period,"-01"))) %>%
# mutate(value = as.numeric(value)) %>%
# select(-c(year, period, periodName)) %>%
# pivot_wider(id_cols = date, names_from = seriesID, values_from = value) %>%
# arrange(date)
#
#colnames(nsa_dt) <- c("Dates",BLS$`Items`)
#nsa_dt <- nsa_dt[-1,]
#
## We have to complete NA value in "Fees for lessons or instructions":
#idx_fees <- which(is.na(nsa_dt$`Fees for lessons or instructions`))
#nsa_dt$`Fees for lessons or instructions`[idx_fees] <-
# nsa_dt$`Fees for lessons or instructions`[idx_fees-1]
#
#sa_dt$`Fees for lessons or instructions`[idx_fees] <-
# nsa_dt$`Fees for lessons or instructions`[idx_fees]
#
## 3.3) Updating weights for the next release: ----------------------------------
#idx <- nsa_dt %>%
# filter(Dates >= tail(Dates, 2)[1]) %>%
# select(-1)
#
## Updating:
#new_w <- round( BLS[,ncol(BLS)] *
# t( (idx[2,]/idx[1,]) / (idx$`All Items`[2]/idx$`All Items`[1]) ), 3)
#
## Biding:
#BLS <- cbind(BLS, new_w)
#
#colnames(BLS) <- c( colnames(BLS[,-ncol(BLS)]),
# format(tail(nsa_dt$Dates, 1), "%Y-%m-%d") )
#
### 4) Saving CPI Indexes for Dashboard usage: ----------------------------------
#sa_dt <- na.locf(sa_dt)
#nsa_dt <- na.locf(nsa_dt)
#
#save(BLS, nsa_dt, sa_dt, file = "Auxiliar/R_CPI.Rda")
#
## Some weights can present approximation errors when compared to BLS official
## data. So its desirable to get correct it:
#
#y <- substr(tail(colnames(BLS),1),1,4)
#m <- as.character( as.numeric( substr(tail(colnames(BLS),1),6,7)) )
#
#W_official <- read_excel("C:/Users/xbbpcga/Downloads/cpi-u-202505.xlsx",
# col_names = FALSE, sheet = "US", range = "C8:C394")
#BLS[,ncol(BLS)] <- W_official[BLS$`Weights indexes`,]
#
## OBS: In the publication of the CPI for january, we have to get
## the weight data from the BLS website!
#
### 5) Updating the Dashboard: --------------------------------------------------
#rmarkdown::render("F:/ARX/Public/Dashboard/Inflacao/Dashboard_CPI.Rmd")
#
### 6) Creating the e-mail message: ---------------------------------------------
#tf <- tempfile(fileext = ".png")
#
## Saving the table as png:
#gtsave(Tab_fast, filename = tf, expand = 50, vwidth = 2000, vheight = 500)
#
## Starting the connection with Outlook:
#Outlook = RDCOMClient:::COMCreate("Outlook.Application")
#Email = Outlook$CreateItem(0)
#
##"Macro@bnymellon.com.br"
## Choosing e-mail' recipient and subject:
#Email[["To"]] = "Beatriz.Ribeiro@arxinvestimentos.com.br"
#Email[["subject"]] = paste0("US CPI (",
# format(tail(sa_dt$Dates,1), "%B/%y"), ")")
#
## Setting the e-mail body:
#Body = md(paste0("<html> <strong> Para maiores detalhes acessar nosso ",
# "dashboard: </strong> http://ds15drl004002.ams.bnymellon.net:",
# "5000/Dashboard/Inflacao/Dashboard_CPI.html",
# "<br> <br> <html>"))
#
#Body2 = md(paste0("<html> <strong> CPI MoM: </strong>",
# format(round(tail(mom_dt$`All Items`,1),2),nsmall = 2), "% (Consenso: ",
# expec[1,1], "%) <br> <html>"))
#
#Body3 = md(paste0("<html> <strong> CPI Core MoM: </strong>",
# format(round(tail(yoy_dt$`Core CPI`,1),2),nsmall = 2), "% (Consenso: ",
# expec[8,1], "%) <br> <html>"))
#
#Body4 = md(paste0("<html> <strong> CPI YoY: </strong>",
# format(round(tail(yoy_dt$`All Items`,1),2),nsmall = 2), "% (Consenso: ",
# expec_yoy, "%) <br> <html>"))
#
#Body5 = md(paste0("<html> <strong> CPI Core YoY: </strong>",
# format(round(tail(yoy_dt$`Core CPI`,1),2),nsmall = 2), "% (Consenso: ",
# expec_yoy_core, "%) <br> <html>"))
#
#
#Email[["Attachments"]]$Add(tf)
#
#inline1 = paste0( "<img src='cid:", basename(tf),
# "' width = '1700' height = '1010'>")
#
#Email[["HTMLBody"]] = paste0(Body, Body2, Body3, Body4, Body5, " ", inline1)
#
#Email$Send()
#
#unlink(tf)
#
### 10) Creating the excel file: ------------------------------------------------
#
## Double weighted
#idx_seas <- c(1, BLS$`Seasonal components`, 0, rep(1,6))
#
#mom_seas <- mom_dt %>%
# select(colnames(mom_dt[,idx_seas == 1]))
#
#W_sd <- as.tibble( cbind(mom_seas[,1], mom_seas[,-1] - mom_dt$`All Items`) ) %>%
# mutate(across(.cols = -1, .fns = lag)) %>%
# mutate(across(.cols = -1,
# .fns = slidify(.f = sd,.period = 36, .align = "right"))) %>%
# .^(-1)
#
#W_seas <- W %>%
# select(colnames(W[,idx_seas == 1]))
#
#W_dw <- cbind(W_seas[,1], 100*W_seas[,-1]*(W_sd[,-1]/apply(W_sd[,-1],1,sum))) %>%
# as.tibble() %>%
# mutate(across(.cols = -1,.fns = ~round(.x,3)))
#
#DW <- cbind(mom_seas[,1], apply(mom_seas[,-1]*W_dw[,-1],1,sum)
# / apply(W_dw[,-1],1,sum)) %>%
# as.tibble()
#colnames(DW) = c("Dates","DW")
#
## Trimmed Mean 16%
#idx_TM <- mom_seas %>%
# select(-1) %>%
# t() %>%
# as.tibble() %>%
# mutate(across(everything(), .fns = order)) %>%
# t()
#
#mom_order <- matrix(NA, nrow(idx_TM), ncol(idx_TM))
#W_order <- mom_order
#W_acum <- mom_order
#
#for (i in 1:nrow(idx_TM)){
# mom_order[i,] <- as.matrix( select(mom_seas,-1) )[i,idx_TM[i,]]
# W_order[i,] <- as.matrix( select(W_seas,-1) )[i,idx_TM[i,]]
# W_acum[i,] <- cumsum( W_order[i,] )
# new_W <- W_order * ((W_acum >= 8) * (W_acum <= 92) )
#
# i_f = first(which(new_W[i,] > 0))
# new_W[i,i_f] = W_acum[i,i_f] - 8
# i_l = last(which(new_W[i,] > 0))
# new_W[i,i_l+1] = 92 - W_acum[i,i_l]
#}
#
#TM <- cbind(mom_seas[,1], apply(mom_order*new_W,1,sum)
# / apply(new_W,1,sum)) %>%
# as.tibble()
#colnames(DW) = c("Dates","TM")
#
## Median CPI
#Med = matrix(NA, nrow(idx_TM), 1)
#for (i in 1:nrow(idx_TM)){
# i_50 = first(which(W_acum[i,] >= 50))
# Med[i,] = mom_order[i,i_50]
#}
#
#Med <- cbind(mom_seas[,1], Med) %>%
# as.tibble()
#colnames(DW) = c("Dates","Median")
#
#Auto_cores <- full_join(DW,TM, by = "Dates") %>%
# full_join(Med,by = "Dates")
#
#colnames(Auto_cores) = c("Dates","Double weighting","Trimmed Mean","P50")
#
#
#mom_x <- left_join(mom_dt,Auto_cores, by = "Dates")
#cpi_tbl <- as_tibble( cbind(1:(ncol(mom_x)-1) , t(mom_x[,-1])) ) # CPI MoM sa
#colnames(cpi_tbl) <- c("Items", as.character(mom_x$Dates))
#
#cpi_nsa_tbl <- as_tibble( cbind(1:(ncol(mom_nsa_dt)-1) , t(mom_nsa_dt[,-1])) ) # CPI MoM nsa
#colnames(cpi_nsa_tbl) <- c("Items", as.character(mom_nsa_dt$Dates))
#
#cpi_p_tbl <- as_tibble( cbind(1:(ncol(W)-1) , t(W[,-1])) ) # CPI Weights
#colnames(cpi_p_tbl) <- c("Items", as.character(W$Dates))
#
#Auto_cores_yoy <- Auto_cores %>%
# mutate(across(.cols = -1, .fns = ~acum_p(.x,12)))
#
#yoy_x <- left_join(yoy_dt,Auto_cores_yoy, by = "Dates")
#cpi_yoy_tbl <- as_tibble( cbind(1:(ncol(yoy_x)-1) , t(yoy_x[,-1])) ) # CPI YoY
#colnames(cpi_yoy_tbl) <- c("Items", as.character(yoy_x$Dates))
#
#cpi_mom_c_tbl <- as_tibble( cbind(1:(ncol(mom_c_dt)-1) , t(mom_c_dt[,-1])) ) # MoM Contribution
#colnames(cpi_mom_c_tbl) <- c("Items", as.character(mom_c_dt$Dates))
#
#cpi_yoy_c_tbl <- as_tibble( cbind(1:(ncol(yoy_c_dt)-1) , t(yoy_c_dt[,-1])) ) # YoY Contribution
#colnames(cpi_yoy_c_tbl) <- c("Items", as.character(yoy_c_dt$Dates))
#
## Translate codes:
#Itens <- c( colnames(mom_dt[,-1]), colnames(Auto_cores[,-1]) )
#
#Codigos <- rownames(cpi_tbl)
#
#legend <- data.frame(Itens,Codigos)
#
#sheets <- list( "CPI MoM sa" = cpi_tbl,
# "CPI MoM nsa" = cpi_nsa_tbl,
# "CPI weights" = cpi_p_tbl, "CPI YoY" = cpi_yoy_tbl,
# "CPI MoM Contributions" = cpi_mom_c_tbl,
# "CPI YoY Contributions" = cpi_yoy_c_tbl, "Legenda" = legend )
#
## Writing the excel file:
#write_xlsx(sheets, "F:/Macro/Macro_Internacional/EUA/Inflation/CPI_BASE.xlsx",
# col_names = T, format_headers = T)
#
#
#