#install.packages("flexdashboard")
library("flexdashboard")
#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("plotly")
library("plotly")
aba
aba{css}
.chart-shim {
overflow: auto;
}
aba
aba{r include=FALSE}
### 1.0) Data treating: --------------------------------------------------------
load(file = "F:/Macro/Call_Codes/Call_CPI/Auxiliar/R_CPI.Rda")
## 1.0.1) 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)}
# SAAR:
saar <- function(x) {100*( (1+x/100)^12 - 1)}
# YoY contributions:
c_yoy <- function(x,w,b) {
# First, we have to calculate the 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)
}
## 1.0.2) Weights matrix: ------------------------------------------------------
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]) == "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_aux$`Unsampled new and used motor vehicles` <-
W_aux$`Unsampled new and used motor vehicles` - W_aux$`Leased cars and trucks`
W <- full_join(W_partial, W_aux, by = "Dates")
## 1.1) 1st page: Main data ----------------------------------------------------
# MoM sa Variations:
mom_dt_partial <- sa_dt %>%
mutate(across(.cols = -1, .fns = pct_1))
mom_dt_partial <- mom_dt_partial[-1,]
# We want to be able to generate the table even when we'd already updated the
# weight matrix for the next release. So:
if(nrow(W) > nrow(mom_dt_partial)) {
W <- W[-nrow(W),]
W_partial <- W_partial[-nrow(W_partial),]
}
mom_aux <- cbind(mom_dt_partial[,1],
( as.matrix( W_partial[,-1] * mom_dt_partial[,-1] ) %*%
as.matrix(aux) )/W[,(ncol(W)-6):ncol(W)] ) %>%
as.tibble()
colnames(mom_aux) <- colnames(W_aux)
mom_dt <- full_join(mom_dt_partial, mom_aux, by = "Dates")
# MoM sa Contributions:
mom_c_dt <-
cbind(select(mom_dt,1),
round(mom_dt[,-1],3) * W[,-1]/100 ) %>%
as.tibble()
# YoY nsa Variations:
yoy_dt_partial <- nsa_dt %>%
mutate(across(.cols = -1, .fns = pct_12))
yoy_dt_partial <- yoy_dt_partial[-12,]
yoy_aux <- cbind(yoy_dt_partial[,1],
( as.matrix( W_partial[,-1] * yoy_dt_partial[,-1] ) %*%
as.matrix(aux) )/W[,(ncol(W)-6):ncol(W)] ) %>%
as.tibble()
colnames(mom_aux) <- colnames(W_aux)
yoy_dt <- full_join(yoy_dt_partial, yoy_aux, by = "Dates") %>%
drop_na()
# YoY nsa Contributions:
mom_nsa_dt_partial <- nsa_dt %>%
mutate(across(.cols = -1, .fns = pct_1))
mom_nsa_dt_partial <- mom_nsa_dt_partial[-1,]
mom_nsa_aux <- cbind(mom_nsa_dt_partial[,1],
( as.matrix( W_partial[,-1] * mom_nsa_dt_partial[,-1] ) %*%
as.matrix(aux) )/W[,(ncol(W)-6):ncol(W)] ) %>%
as.tibble()
colnames(mom_nsa_aux) <- colnames(W_aux)
mom_nsa_dt <- full_join(mom_nsa_dt_partial, mom_nsa_aux, by = "Dates")
yoy_c_dt <- c_yoy(mom_nsa_dt, W, nsa_dt$`All Items`)
# 1.1.1) 1st table: MoM sa overview --------------------------------------------
idx_table <- c("Dates", "All Items","Food", "Food at home", "Food away from home",
"Energy", "Energy goods", "Gasoline", "Energy services",
"Electricity", "Core CPI", "Core goods",
"Household furnishings and supplies", "Apparel",
"Transportation goods", "New vehicles", "Used cars and trucks",
"Medical care goods", "Recreation goods",
"Education and communication goods", "Alcoholic beverages",
"Other goods", "Core services", "Shelter",
"Medical care services", "Water and sewer and trash collection",
"Household operations", "Transportation services",
"Airline fares", "Education and communication services",
"Recreation services", "Other personal services")
Tab_1.1_mom <- mom_dt %>%
select(idx_table) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
Tab_1.1_mom_c <- mom_c_dt %>%
select(idx_table) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,2)))
Dif_mom = round(10*(Tab_1.1_mom[,4] - Tab_1.1_mom[,3]),0)
colnames(Dif_mom) = "bps"
Tab_1.1 <- cbind(Tab_1.1_mom, Dif_mom) %>%
full_join(Tab_1.1_mom_c, by = "name")
names_tab <- format((tail(nsa_dt$Dates,3)), "%b/%y")
colnames(Tab_1.1) = c("Items", "m1", "m2", "m3", "bps_m","m1_c","m2_c","m3_c")
y <- substr(tail(colnames(BLS),1),1,4)
m <- as.numeric( substr(tail(colnames(BLS),1),6,7)) + 1
Month_idx <- c("January","February","March","April","May","June","July",
"August","September","October","November","December")
# 1.1.2) 2nd table: YoY nsa overview -------------------------------------------
Tab_1.2_yoy <- yoy_dt %>%
select(idx_table) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
Tab_1.2_yoy_c <- yoy_c_dt %>%
select(idx_table) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,2)))
Dif_yoy = round(10*(Tab_1.2_yoy[,4] - Tab_1.2_yoy[,3]),0)
colnames(Dif_yoy) = "bps"
Tab_1.2 <- cbind(Tab_1.2_yoy, Dif_yoy) %>%
full_join(Tab_1.2_yoy_c, by = "name")
colnames(Tab_1.2) = c("Items", "y1", "y2", "y3", "bps_y","y1_c","y2_c","y3_c")
# 1.1.3) Food data: ------------------------------------------------------------
idx_F = c( 1, BLS$`Food dummy`,rep(0,7) )
# MoM sa:
# Variations:
Tab_1.3_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.3_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Food,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.3_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.3_m <- Tab_1.3_mom %>%
full_join(Tab_1.3_mom_c_g, by = "name") %>%
full_join(Tab_1.3_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.3_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.3_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.3_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Food,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.3_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_F == 1])) %>%
select(-c("Food at home", "Cereals and bakery", "Alcoholic beverages",
"Alcoholic beverages at home", "Alcoholic beverages away from home",
"Nonalcoholic beverages and beverage materials")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.3_y <- Tab_1.3_yoy %>%
full_join(Tab_1.3_yoy_c_g, by = "name") %>%
full_join(Tab_1.3_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.3_yoy))) %>%
select(type,1:10)
Tab_1.3 <- as.tibble( rbind(Tab_1.3_m,Tab_1.3_y) )
new_idx_m <- rev( order(Tab_1.3[2:19,8]) ) + 1
new_idx_y <- rev( order(Tab_1.3[21:38,8]) ) + 20
Tab_1.3 <- Tab_1.3[c(1,new_idx_m,20,new_idx_y),]
colnames(Tab_1.3) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.4) Housing data: ---------------------------------------------------------
idx_H = c( 1, BLS$`Housing dummy`,1, rep(0,6) )
# MoM sa:
# Variations:
Tab_1.4_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.4_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Housing,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.4_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.4_m <- Tab_1.4_mom %>%
full_join(Tab_1.4_mom_c_g, by = "name") %>%
full_join(Tab_1.4_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.4_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.4_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.4_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Housing,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.4_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_H == 1])) %>%
select(-c("Shelter","Energy services", "Water and sewerage maintenance",
"Garbage and trash collection", "Household furnishings and operations",
"Household furnishings and supplies")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.4_y <- Tab_1.4_yoy %>%
full_join(Tab_1.4_yoy_c_g, by = "name") %>%
full_join(Tab_1.4_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.4_yoy))) %>%
select(type,1:10)
Tab_1.4 <- as.tibble( rbind(Tab_1.4_m,Tab_1.4_y) )
new_idx_m <- rev( order(Tab_1.4[2:18,8]) ) + 1
new_idx_y <- rev( order(Tab_1.4[20:36,8]) ) + 19
Tab_1.4 <- Tab_1.4[c(1,new_idx_m,19,new_idx_y),]
colnames(Tab_1.4) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.5) Apparel data: ---------------------------------------------------------
idx_A = c( 1, BLS$`Apparel dummy`, rep(0,7) )
# MoM sa:
# Variations:
Tab_1.5_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.5_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Apparel,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.5_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.5_m <- Tab_1.5_mom %>%
full_join(Tab_1.5_mom_c_g, by = "name") %>%
full_join(Tab_1.5_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.5_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.5_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.5_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Apparel,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.5_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_A == 1])) %>%
select(-c("Men's and boys' apparel")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.5_y <- Tab_1.5_yoy %>%
full_join(Tab_1.5_yoy_c_g, by = "name") %>%
full_join(Tab_1.5_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.5_yoy))) %>%
select(type,1:10)
Tab_1.5 <- as.tibble( rbind(Tab_1.5_m,Tab_1.5_y) )
new_idx_m <- rev( order(Tab_1.5[2:8,8]) ) + 1
new_idx_y <- rev( order(Tab_1.5[10:16,8]) ) + 9
Tab_1.5 <- Tab_1.5[c(1,new_idx_m,9,new_idx_y),]
colnames(Tab_1.5) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.6) Transportation data: --------------------------------------------------
idx_T = c( 1, BLS$`Transportation dummy`, 0, 1, 1, rep(0,4) )
# MoM sa:
# Variations:
Tab_1.6_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.6_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Transportation,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.6_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.6_m <- Tab_1.6_mom %>%
full_join(Tab_1.6_mom_c_g, by = "name") %>%
full_join(Tab_1.6_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.6_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.6_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.6_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$Transportation,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.6_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_T == 1])) %>%
select(-c("Public transportation", "Transportation goods",
"New and used motor vehicles", "Gasoline", "Airline fares")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.6_y <- Tab_1.6_yoy %>%
full_join(Tab_1.6_yoy_c_g, by = "name") %>%
full_join(Tab_1.6_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.6_yoy))) %>%
select(type,1:10)
Tab_1.6 <- as.tibble( rbind(Tab_1.6_m,Tab_1.6_y) )
new_idx_m <- rev( order(Tab_1.6[2:12,8]) ) + 1
new_idx_y <- rev( order(Tab_1.6[14:24,8]) ) + 13
Tab_1.6 <- Tab_1.6[c(1,new_idx_m,13,new_idx_y),]
colnames(Tab_1.6) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.7) Medical care data: ----------------------------------------------------
idx_M = c( 1, BLS$`Medical dummy`, rep(0,7) )
# MoM sa:
# Variations:
Tab_1.7_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.7_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Medical care`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.7_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.7_m <- Tab_1.7_mom %>%
full_join(Tab_1.7_mom_c_g, by = "name") %>%
full_join(Tab_1.7_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.7_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.7_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.7_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Medical care`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.7_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_M == 1])) %>%
select(-c("Medical care goods", "Medical care services")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.7_y <- Tab_1.7_yoy %>%
full_join(Tab_1.7_yoy_c_g, by = "name") %>%
full_join(Tab_1.7_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.7_yoy))) %>%
select(type,1:10)
Tab_1.7 <- as.tibble( rbind(Tab_1.7_m,Tab_1.7_y) )
new_idx_m <- rev( order(Tab_1.7[2:6,8]) ) + 1
new_idx_y <- rev( order(Tab_1.7[8:12,8]) ) + 7
Tab_1.7 <- Tab_1.7[c(1,new_idx_m,7,new_idx_y),]
colnames(Tab_1.7) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.8) Recreation data: ------------------------------------------------------
idx_R = c( 1, BLS$`Recreation dummy`, 0, 0, 0, 1, 1, 1, 0)
# MoM sa:
# Variations:
Tab_1.8_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.8_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Recreation`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.8_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.8_m <- Tab_1.8_mom %>%
full_join(Tab_1.8_mom_c_g, by = "name") %>%
full_join(Tab_1.8_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.8_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.8_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.8_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Recreation`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.8_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_R == 1])) %>%
select(-c("Recreation goods", "Recreation services", "Televisions",
"Cable and satellite television service" ,
"Other video equipment", "Video discs and other media",
"Audio equipment", "Recorded music and music subscriptions",
"Pets and pet products", "Pet services including veterinary",
"Photographic equipment and supplies",
"Photographers and photo processing", "Toys",
"Sewing machines, fabric and supplies",
"Music instruments and accessories", "Admissions",
"Fees for lessons or instructions")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.8_y <- Tab_1.8_yoy %>%
full_join(Tab_1.8_yoy_c_g, by = "name") %>%
full_join(Tab_1.8_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.8_yoy))) %>%
select(type,1:10)
Tab_1.8 <- as.tibble( rbind(Tab_1.8_m,Tab_1.8_y) )
new_idx_m <- rev( order(Tab_1.8[2:12,8]) ) + 1
new_idx_y <- rev( order(Tab_1.8[14:24,8]) ) + 13
Tab_1.8 <- Tab_1.8[c(1,new_idx_m,13,new_idx_y),]
colnames(Tab_1.8) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.9) Education and Communication data: -------------------------------------
idx_E = c( 1, BLS$`Education dummy`, rep(0,6), 1)
# MoM sa:
# Variations:
Tab_1.9_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.9_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Education and communication`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.9_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.9_m <- Tab_1.9_mom %>%
full_join(Tab_1.9_mom_c_g, by = "name") %>%
full_join(Tab_1.9_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.9_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.9_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.9_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Education and communication`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.9_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_E == 1])) %>%
select(-c("Education and communication goods",
"Education and communication services", "Postage",
"Delivery services", "Computers and peripherals",
"Computer software and accessories",
"Internet services and electronic information providers",
"Telephone hardware and other consumer information items",
"Unsampled information")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.9_y <- Tab_1.9_yoy %>%
full_join(Tab_1.9_yoy_c_g, by = "name") %>%
full_join(Tab_1.9_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.9_yoy))) %>%
select(type,1:10)
Tab_1.9 <- as.tibble( rbind(Tab_1.9_m,Tab_1.9_y) )
new_idx_m <- rev( order(Tab_1.9[2:6,8]) ) + 1
new_idx_y <- rev( order(Tab_1.9[8:12,8]) ) + 7
Tab_1.9 <- Tab_1.9[c(1,new_idx_m,7,new_idx_y),]
colnames(Tab_1.9) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.10) Other goods and services data: ----------------------------------------
idx_O = c( 1, BLS$`Others dummy`,rep(0,7) )
# MoM sa:
# Variations:
Tab_1.10_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.10_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Other goods and services`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.10_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.10_m <- Tab_1.10_mom %>%
full_join(Tab_1.10_mom_c_g, by = "name") %>%
full_join(Tab_1.10_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.10_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.10_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.10_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Other goods and services`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.10_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_O == 1])) %>%
select(-c("Other goods", "Other personal services", "Personal care")) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.10_y <- Tab_1.10_yoy %>%
full_join(Tab_1.10_yoy_c_g, by = "name") %>%
full_join(Tab_1.10_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.10_yoy))) %>%
select(type,1:10)
Tab_1.10 <- as.tibble( rbind(Tab_1.10_m,Tab_1.10_y) )
new_idx_m <- rev( order(Tab_1.10[2:6,8]) ) + 1
new_idx_y <- rev( order(Tab_1.10[8:12,8]) ) + 7
Tab_1.10 <- Tab_1.10[c(1,new_idx_m,7,new_idx_y),]
colnames(Tab_1.10) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.11) Energy data: ---------------------------------------------------------
idx_En = rep(0, ncol(mom_dt))
idx_En[c(1,132,35,66,37,38)] = 1
# MoM sa:
# Variations:
Tab_1.11_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.11_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Energy`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.11_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.11_m <- Tab_1.11_mom %>%
full_join(Tab_1.11_mom_c_g, by = "name") %>%
full_join(Tab_1.11_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.11_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.11_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.11_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Energy`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.11_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_En == 1])) %>%
select(1, sum(idx_En), 2:(sum(idx_En)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.11_y <- Tab_1.11_yoy %>%
full_join(Tab_1.11_yoy_c_g, by = "name") %>%
full_join(Tab_1.11_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.11_yoy))) %>%
select(type,1:10)
Tab_1.11 <- as.tibble( rbind(Tab_1.11_m,Tab_1.11_y) )
new_idx_m <- rev( order(Tab_1.11[2:5,8]) ) + 1
new_idx_y <- rev( order(Tab_1.11[7:10,8]) ) + 6
Tab_1.11 <- Tab_1.11[c(1,new_idx_m,6,new_idx_y),]
colnames(Tab_1.11) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.11) Goods data: ----------------------------------------------------------
idx_Go = rep(0, ncol(mom_dt))
idx_Go[c(1,139,2,24,35,66,50,43,61,75,83,109,123)] = 1
# MoM sa:
# Variations:
Tab_1.12_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.12_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Goods`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.12_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.12_m <- Tab_1.12_mom %>%
full_join(Tab_1.12_mom_c_g, by = "name") %>%
full_join(Tab_1.12_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.12_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.12_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.12_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Goods`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.12_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_Go == 1])) %>%
select(1, sum(idx_Go), 2:(sum(idx_Go)-1)) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.12_y <- Tab_1.12_yoy %>%
full_join(Tab_1.12_yoy_c_g, by = "name") %>%
full_join(Tab_1.12_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.12_yoy))) %>%
select(type,1:10)
Tab_1.12 <- as.tibble( rbind(Tab_1.12_m,Tab_1.12_y) )
new_idx_m <- rev( order(Tab_1.12[2:12,8]) ) + 1
new_idx_y <- rev( order(Tab_1.12[14:24,8]) ) + 13
Tab_1.12 <- Tab_1.12[c(1,new_idx_m,13,new_idx_y),]
colnames(Tab_1.12) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.12) Services data: -------------------------------------------------------
idx_Se = rep(0, ncol(mom_dt))
idx_Se[c(1,145,37,38,29,30,33,34,39,150,76,149,84,110,124)] = 1
# MoM sa:
# Variations:
Tab_1.13_mom <- mom_dt %>%
select(colnames(mom_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.13_mom_c_g <- mom_c_dt %>%
select(colnames(mom_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Goods`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.13_mom_c_all <- mom_c_dt %>%
select(colnames(mom_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.13_m <- Tab_1.13_mom %>%
full_join(Tab_1.13_mom_c_g, by = "name") %>%
full_join(Tab_1.13_mom_c_all, by = "name") %>%
mutate(type = rep("MoM sa",nrow(Tab_1.13_mom))) %>%
select(type,1:10)
# YoY nsa:
# Variations:
Tab_1.13_yoy <- yoy_dt %>%
select(colnames(yoy_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,1)))
# Contribution to Group:
Tab_1.13_yoy_c_g <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x*100/tail(W$`Goods`,3))) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Contribution to CPI:
Tab_1.13_yoy_c_all <- yoy_c_dt %>%
select(colnames(yoy_dt[,idx_Se == 1])) %>%
select(1, 13, 2:12, 14:15) %>%
filter(Dates >= tail(Dates, 3)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:4,.fns = ~.x)) %>%
mutate(across(.cols = 2:4,.fns = ~round(.x,3)))
# Joining:
Tab_1.13_y <- Tab_1.13_yoy %>%
full_join(Tab_1.13_yoy_c_g, by = "name") %>%
full_join(Tab_1.13_yoy_c_all, by = "name") %>%
mutate(type = rep("YoY nsa",nrow(Tab_1.13_yoy))) %>%
select(type,1:10)
Tab_1.13 <- as.tibble( rbind(Tab_1.13_m,Tab_1.13_y) )
new_idx_m <- rev( order(Tab_1.13[2:14,8]) ) + 1
new_idx_y <- rev( order(Tab_1.13[16:28,8]) ) + 15
Tab_1.13 <- Tab_1.13[c(1,new_idx_m,15,new_idx_y),]
colnames(Tab_1.13) <- c("Type", "Items", "m1", "m2", "m3", "cg_1","cg_2","cg_3",
"ca_1", "ca_2", "ca_3")
# 1.1.13) 1st graph: Head and Core YoY ----------------------------------------
t <- list(
family = "Calibri",
size = 18,
color = "midnightblue")
P_1.1 = plot_ly(yoy_dt, x = ~as.Date(Dates)) %>%
add_lines(y = round(yoy_dt$`All Items`,2), name = "CPI",
line = list(color = "#000000")) %>%
add_lines(y = round(yoy_dt$`Core CPI`,2), name = "Core",
line = list(color = "#BAA65B")) %>%
layout(title = list(text = "<b> Head and Core - YoY <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.1.14) 2nd graph: Head and Core SAAR ---------------------------------------
mom_dt_mm3 <- mom_dt %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 3 , .align = "right"))) %>%
mutate(across(.cols = -1, .fns = saar)) %>%
drop_na()
P_1.2 = plot_ly(mom_dt_mm3, x = ~as.Date(Dates)) %>%
add_lines(y = round(mom_dt_mm3$`All Items`,2), name = "CPI",
line = list(color = "#000000")) %>%
add_lines(y = round(mom_dt_mm3$`Core CPI`,2), name = "Core",
line = list(color = "#BAA65B")) %>%
layout(title = list(text = "<b> Head and Core - SAAR MM3 <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
## 1.2) 2nd page: Core data ----------------------------------------------------
# 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")
# 1.2.1) 1st table: MoM Core measures ------------------------------------------
l_2.1 = 24
Tab_2.1 <- mom_dt %>%
select("Dates", "Core CPI", "Core services", "Core goods",
"Core less shelter", "Core less shelter and used cars",
"All items less food", "All items less energy",
"All items less shelter", "Durables", "Nondurables",
"Nondurables less food") %>%
left_join(Auto_cores, by = "Dates") %>%
filter(Dates >= tail(Dates, l_2.1)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:(l_2.1+1),.fns = ~round(.x,2)))
colnames(Tab_2.1) <- c( "Items", paste0("m_",1:l_2.1) )
# 1.2.2) 2nd table: YoY Core measures ------------------------------------------
Tab_2.2 <- yoy_dt %>%
select("Dates", "Core CPI", "Core services", "Core goods",
"Core less shelter", "Core less shelter and used cars",
"All items less food", "All items less energy",
"All items less shelter", "Durables", "Nondurables",
"Nondurables less food") %>%
left_join(Auto_cores, by = "Dates") %>%
mutate(across(.cols = -c(1:12), .fns = ~tstools::acum_p(.x,12))) %>%
filter(Dates >= tail(Dates, l_2.1)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:(l_2.1+1),.fns = ~round(.x,2)))
colnames(Tab_2.2) <- c( "Items", paste0("m_",1:l_2.1) )
# 1.2.3) 3rd table: SAAR Core measures -----------------------------------------
saar_dt <- mom_dt %>%
left_join(Auto_cores, by = "Dates") %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 3 , .align = "right"))) %>%
mutate(across(.cols = -1, .fns = saar)) %>%
drop_na()
Tab_2.3 <- saar_dt %>%
select("Dates", "Core CPI", "Core services", "Core goods",
"Core less shelter", "Core less shelter and used cars",
"All items less food", "All items less energy",
"All items less shelter", "Durables", "Nondurables",
"Nondurables less food", "Double weighting", "Trimmed Mean", "P50") %>%
filter(Dates >= tail(Dates, l_2.1)[1]) %>%
pivot_longer(-Dates) %>%
pivot_wider(id_cols = name,
names_from = Dates,
values_from = value) %>%
mutate(across(.cols = 2:(l_2.1+1),.fns = ~round(.x,2)))
colnames(Tab_2.3) <- c( "Items", paste0("m_",1:l_2.1) )
# 1.2.4) 1st graph: Core CPI SAAR and YOY --------------------------------------
Cores_yoy <- Auto_cores %>%
mutate(across(.cols = -1, .fns = ~tstools::acum_p(.x,12))) %>%
right_join(yoy_dt, by = "Dates") %>%
select("Dates", "Core CPI", "Core services", "Core goods",
"Core less shelter", "Core less shelter and used cars", "All Items",
"All items less food", "All items less energy",
"All items less shelter", "Durables", "Nondurables",
"Nondurables less food", "Double weighting", "Trimmed Mean", "P50")
Cores_saar <- Auto_cores %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 3 , .align = "right"))) %>%
mutate(across(.cols = -1, .fns = saar)) %>%
right_join(mom_dt_mm3, by = "Dates") %>%
select("Dates", "Core CPI", "Core services", "Core goods",
"Core less shelter", "Core less shelter and used cars", "All Items",
"All items less food", "All items less energy",
"All items less shelter", "Durables", "Nondurables",
"Nondurables less food", "Double weighting", "Trimmed Mean", "P50")
Pdata_2.1 <- select(Cores_saar, "Dates", "Core CPI", "All Items") %>%
left_join(select(Cores_yoy, "Dates", "Core CPI", "All Items"), by = "Dates")
P_2.1 = plot_ly(Pdata_2.1, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.1$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.1$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.1$`Core CPI.y`,2), name = "Core YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.1$`Core CPI.x`,2), name = "Core SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Core <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.5) 2nd graph: Core Services SAAR and YOY ---------------------------------
Pdata_2.2 <- select(Cores_saar, "Dates", "Core services", "All Items") %>%
left_join(select(Cores_yoy, "Dates", "Core services", "All Items"), by = "Dates")
P_2.2 = plot_ly(Pdata_2.2, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.2$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.2$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.2$`Core services.y`,2), name = "Core services YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.2$`Core services.x`,2), name = "Core services SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Core services <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.6) 3rd graph: Core Goods SAAR and YOY ------------------------------------
Pdata_2.3 <- select(Cores_saar, "Dates", "Core goods", "All Items") %>%
left_join(select(Cores_yoy, "Dates", "Core goods", "All Items"), by = "Dates")
P_2.3 = plot_ly(Pdata_2.3, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.3$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.3$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.3$`Core goods.y`,2), name = "Core goods YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.3$`Core goods.x`,2), name = "Core goods SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Core goods <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.7) 4th graph: Core less shelter SAAR and YOY ------------------------------------
Pdata_2.4 <- select(Cores_saar, "Dates", "Core less shelter", "All Items") %>%
left_join(select(Cores_yoy, "Dates", "Core less shelter", "All Items"), by = "Dates")
P_2.4 = plot_ly(Pdata_2.4, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.4$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.4$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.4$`Core less shelter.y`,2), name = "Core ex-shelter YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.4$`Core less shelter.x`,2), name = "Core ex-shelter SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Core less shelter <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.8) 5th graph: Core less shelter and used cars SAAR and YOY ---------------
Pdata_2.5 <- select(Cores_saar, "Dates", "Core less shelter and used cars",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Core less shelter and used cars",
"All Items"), by = "Dates")
P_2.5 = plot_ly(Pdata_2.5, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.5$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.5$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.5$`Core less shelter and used cars.y`,2),
name = "Core ex-shelter and used cars YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.5$`Core less shelter and used cars.x`,2),
name = "Core ex-shelter and used cars SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Core less shelter and used cars <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.9) 6th graph: All items less food SAAR and YOY ---------------------------
Pdata_2.6 <- select(Cores_saar, "Dates", "All items less food",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "All items less food",
"All Items"), by = "Dates")
P_2.6 = plot_ly(Pdata_2.6, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.6$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.6$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.6$`All items less food.y`,2),
name = "CPI ex-food YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.6$`All items less food.x`,2),
name = "CPI ex-food SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and All items less food <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.10) 7th graph: All items less energy SAAR and YOY ------------------------
Pdata_2.7 <- select(Cores_saar, "Dates", "All items less energy",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "All items less energy",
"All Items"), by = "Dates")
P_2.7 = plot_ly(Pdata_2.7, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.7$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.7$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.7$`All items less energy.y`,2),
name = "CPI ex-energy YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.7$`All items less energy.x`,2),
name = "CPI ex-energy SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and All items less energy <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.11) 8th graph: Double weighting SAAR and YOY -----------------------------
Pdata_2.8 <- select(Cores_saar, "Dates", "Double weighting",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Double weighting",
"All Items"), by = "Dates")
P_2.8 = plot_ly(Pdata_2.8, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.8$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.8$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.8$`Double weighting.y`,2),
name = "Double weighting YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.8$`Double weighting.x`,2),
name = "Double weighting SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Double weighting <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.12) 9th graph: Trimmed Mean SAAR and YOY ---------------------------------
Pdata_2.9 <- select(Cores_saar, "Dates", "Trimmed Mean",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Trimmed Mean",
"All Items"), by = "Dates")
P_2.9 = plot_ly(Pdata_2.9, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.9$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.9$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.9$`Trimmed Mean.y`,2),
name = "Trimmed mean YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.9$`Trimmed Mean.x`,2),
name = "Trimmed mean SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Trimmed mean <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.13) 10th graph: P50 SAAR and YOY -----------------------------------------
Pdata_2.10 <- select(Cores_saar, "Dates", "P50",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "P50",
"All Items"), by = "Dates")
P_2.10 = plot_ly(Pdata_2.10, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.10$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.10$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.10$`P50.y`,2),
name = "P50 YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.10$`P50.x`,2),
name = "P50 SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and P50 <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.14) 11th graph: Durables SAAR and YOY ------------------------------------
Pdata_2.11 <- select(Cores_saar, "Dates", "Durables",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Durables",
"All Items"), by = "Dates")
P_2.11 = plot_ly(Pdata_2.11, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.11$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.11$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.11$`Durables.y`,2),
name = "Durables YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.11$`Durables.x`,2),
name = "Durables SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Durables <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.15) 12th graph: Nondurables SAAR and YOY ---------------------------------
Pdata_2.12 <- select(Cores_saar, "Dates", "Nondurables",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Nondurables",
"All Items"), by = "Dates")
P_2.12 = plot_ly(Pdata_2.12, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.12$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.12$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.12$`Nondurables.y`,2),
name = "Nondurables YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.12$`Nondurables.x`,2),
name = "Nondurables SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Nondurables <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.16) 13th graph: Nondurables less food SAAR and YOY -----------------------
Pdata_2.13 <- select(Cores_saar, "Dates", "Nondurables less food",
"All Items") %>%
left_join(select(Cores_yoy, "Dates", "Nondurables less food",
"All Items"), by = "Dates")
P_2.13 = plot_ly(Pdata_2.13, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.13$`All Items.y`,2), name = "CPI YoY",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.13$`All Items.x`,2), name = "CPI SAAR",
line = list(color = "#000000", dash = "dot")) %>%
add_lines(y = round(Pdata_2.13$`Nondurables less food.y`,2),
name = "Nondurables less food YoY",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.13$`Nondurables less food.x`,2),
name = "Nondurables less food SAAR",
line = list(color = "#BAA65B", dash = "dot")) %>%
layout(title = list(text = "<b> Head and Nondurables less food <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.17) 14st graph: Core, P50, TM, DW YoY ------------------------------------
Pdata_2.14 <- select(Cores_yoy, "Dates", "Core CPI", "P50", "Trimmed Mean",
"Double weighting", "All Items")
P_2.14 = plot_ly(Pdata_2.14, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.14$`All Items`,2), name = "CPI",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.14$`Core CPI`,2), name = "Core CPI",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.14$`P50`,2), name = "P50",
line = list(color = "#8C8B8B")) %>%
add_lines(y = round(Pdata_2.14$`Trimmed Mean`,2), name = "Trimmed mean",
line = list(color = "#4A908E")) %>%
add_lines(y = round(Pdata_2.14$`Double weighting`,2), name = "Double weighting",
line = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Head and Core measures - YoY <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.2.18) 15st graph: Core, P55, TM, DW SAAR ------------------------------------
Pdata_2.15 <- select(Cores_saar, "Dates", "Core CPI", "P50", "Trimmed Mean",
"Double weighting", "All Items")
P_2.15 = plot_ly(Pdata_2.15, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_2.15$`All Items`,2), name = "CPI",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_2.15$`Core CPI`,2), name = "Core CPI",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_2.15$`P50`,2), name = "P50",
line = list(color = "#8C8B8B")) %>%
add_lines(y = round(Pdata_2.15$`Trimmed Mean`,2), name = "Trimmed mean",
line = list(color = "#4A908E")) %>%
add_lines(y = round(Pdata_2.15$`Double weighting`,2), name = "Double weighting",
line = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Head and Core measures - SAAR MM3 <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
## 1.3) 3rd page: Contribution YoY data ----------------------------------------
# 1.3.1) 1st graph: Food, energy, Core goods and Core services -----------------
P_3.1 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Food`,2), name = "Food", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Energy`,2), name = "Energy", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(yoy_c_dt$`Core services`,2), name = "Core services", marker = list(color = "#C5C399")) %>%
add_bars(y = round(yoy_c_dt$`Core goods`,2), name = "Core goods", marker = list(color = "#4A908E")) %>%
add_lines(y = round(yoy_c_dt$`All Items`,2), name = "CPI", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> CPI decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.3.2) 2nd graph: Inside food ------------------------------------------------
P_3.2 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Food at home`,2), name = "Food at home", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Food away from home`,2), name = "Food away from home", marker = list(color = "#8C8B8B")) %>%
add_lines(y = round(yoy_c_dt$`Food`,2), name = "Food", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Food decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.3.3) 3rd graph: Inside Energy ----------------------------------------------
P_3.3 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Energy goods`,2), name = "Energy goods", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Energy services`,2), name = "Energy services", marker = list(color = "#8C8B8B")) %>%
add_lines(y = round(yoy_c_dt$`Energy`,2), name = "Energy", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Energy decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.3.4) 4th graph: Inside Core goods ------------------------------------------
P_3.4 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Household furnishings and supplies`,2),
name = "Housing", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Apparel`,2), name = "Apparel", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(yoy_c_dt$`Transportation goods`,2), name = "Transportation", marker = list(color = "#C5C399")) %>%
add_bars(y = round(yoy_c_dt$`Medical care goods`,2), name = "Medical care", marker = list(color = "#4A908E")) %>%
add_bars(y = round(yoy_c_dt$`Core goods` - yoy_c_dt$`Household furnishings and supplies` -
yoy_c_dt$`Apparel` - yoy_c_dt$`Transportation goods` -
yoy_c_dt$`Medical care goods`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(yoy_c_dt$`Core goods`,2), name = "Core goods", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Core CPI decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.3.5) 5th graph: Inside Core services ---------------------------------------
P_3.5 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Shelter`,2),
name = "Shelter", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Water and sewer and trash collection`,2),
name = "Utilites", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(yoy_c_dt$`Transportation services`,2), name = "Transportation", marker = list(color = "#C5C399")) %>%
add_bars(y = round(yoy_c_dt$`Medical care services`,2), name = "Medical care", marker = list(color = "#4A908E")) %>%
add_bars(y = round(yoy_c_dt$`Core services` - yoy_c_dt$`Shelter` -
yoy_c_dt$`Water and sewer and trash collection` - yoy_c_dt$`Transportation services` -
yoy_c_dt$`Medical care services`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(yoy_c_dt$`Core services`,2), name = "Core services", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Core services decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.3.6) 6th graph: Food, Energy, Shelter, Used cars and others ----------------
P_3.6 = plot_ly(yoy_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(yoy_c_dt$`Food`,2),
name = "Food", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(yoy_c_dt$`Energy`,2), name = "Energy", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(yoy_c_dt$`Shelter`,2), name = "Shelter", marker = list(color = "#C5C399")) %>%
add_bars(y = round(yoy_c_dt$`Used cars and trucks`,2), name = "Used cars", marker = list(color = "#4A908E")) %>%
add_bars(y = round(yoy_c_dt$`Core less shelter and used cars`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(yoy_c_dt$`All Items`,2), name = "CPI", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> CPI decomposition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""))
## 1.4) 4th page: Contribution MoM data ----------------------------------------
# 1.4.1) 1st graph: Food, energy, Core goods and Core services -----------------
P_4.1 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Food`,2), name = "Food", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Energy`,2), name = "Energy", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(mom_c_dt$`Core services`,2), name = "Core services", marker = list(color = "#C5C399")) %>%
add_bars(y = round(mom_c_dt$`Core goods`,2), name = "Core goods", marker = list(color = "#4A908E")) %>%
add_lines(y = round(mom_c_dt$`All Items`,2), name = "CPI", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> CPI decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.4.2) 2nd graph: Inside food ------------------------------------------------
P_4.2 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Food at home`,2), name = "Food at home", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Food away from home`,2), name = "Food away from home", marker = list(color = "#8C8B8B")) %>%
add_lines(y = round(mom_c_dt$`Food`,2), name = "Food", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Food decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.4.3) 3rd graph: Inside Energy ----------------------------------------------
P_4.3 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Energy goods`,2), name = "Energy goods", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Energy services`,2), name = "Energy services", marker = list(color = "#8C8B8B")) %>%
add_lines(y = round(mom_c_dt$`Energy`,2), name = "Energy", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Energy CPI decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.4.4) 4th graph: Inside Core goods ------------------------------------------
P_4.4 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Household furnishings and supplies`,2),
name = "Housing", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Apparel`,2), name = "Apparel", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(mom_c_dt$`Transportation goods`,2), name = "Transportation", marker = list(color = "#C5C399")) %>%
add_bars(y = round(mom_c_dt$`Medical care goods`,2), name = "Medical care", marker = list(color = "#4A908E")) %>%
add_bars(y = round(mom_c_dt$`Core goods` - mom_c_dt$`Household furnishings and supplies` -
mom_c_dt$`Apparel` - mom_c_dt$`Transportation goods` -
mom_c_dt$`Medical care goods`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(mom_c_dt$`Core goods`,2), name = "Core goods", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Core goods decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.4.5) 5th graph: Inside Core services ---------------------------------------
P_4.5 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Shelter`,2),
name = "Shelter", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Water and sewer and trash collection`,2),
name = "Utilites", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(mom_c_dt$`Transportation services`,2), name = "Transportation", marker = list(color = "#C5C399")) %>%
add_bars(y = round(mom_c_dt$`Medical care services`,2), name = "Medical care", marker = list(color = "#4A908E")) %>%
add_bars(y = round(mom_c_dt$`Core services` - mom_c_dt$`Shelter` -
mom_c_dt$`Water and sewer and trash collection` - mom_c_dt$`Transportation services` -
mom_c_dt$`Medical care services`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(mom_c_dt$`Core services`,2), name = "Core services", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> Core services decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.4.6) 6th graph: Food, Energy, Shelter, Used cars and others ----------------
P_4.6 = plot_ly(mom_c_dt, x = ~as.Date(Dates)) %>%
add_bars(y = round(mom_c_dt$`Food`,2),
name = "Food", marker = list(color = "#BAA65B")) %>%
add_bars(y = round(mom_c_dt$`Energy`,2), name = "Energy", marker = list(color = "#8C8B8B")) %>%
add_bars(y = round(mom_c_dt$`Shelter`,2), name = "Shelter", marker = list(color = "#C5C399")) %>%
add_bars(y = round(mom_c_dt$`Used cars and trucks`,2), name = "Used cars", marker = list(color = "#4A908E")) %>%
add_bars(y = round(mom_c_dt$`Core less shelter and used cars`,2), name = "Others", marker = list(color = "#9ACEBD")) %>%
add_lines(y = round(mom_c_dt$`All Items`,2), name = "CPI", line = list(color = "#000000")) %>%
layout(title = list(text = "<b> CPI decomposition - MoM <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
## 1.5) 5th page: Diffusion data -----------------------------------------------
# MoM nsa
# Over 0% diffusion
D_simple <- ( select(mom_seas,-1) > 0 ) %>%
apply(1,sum)*100 / ( ncol(mom_seas) - 1 )
D_weighted <- apply(( select(mom_seas,-1) > 0 ) * select(W_seas,-1),1,sum)
# MoM SAAR
mom_seas_saar <- mom_seas %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 3 , .align = "right"))) %>%
mutate(across(.cols = -1, .fns = saar)) %>%
drop_na()
W_seas_mm3 <- W_seas %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 3 , .align = "right"))) %>%
drop_na()
# Over 0% diffusion
D_saar_simple <- ( select(mom_seas_saar,-1) > 0 ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D_saar_weighted <- apply(( select(mom_seas_saar,-1) > 0 ) * select(W_seas_mm3,-1),1,sum)
# Under 0% diffusion
D0_saar_simple <- ( select(mom_seas_saar,-1) < 0 ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D0_saar_weighted <- apply(( select(mom_seas_saar,-1) < 0 ) * select(W_seas_mm3,-1),1,sum)
# 0%~2% diffusion
D02_saar_simple <- ( (select(mom_seas_saar,-1) >= 0) & (select(mom_seas_saar,-1) < 2) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D02_saar_weighted <- apply(( (select(mom_seas_saar,-1) >= 0) & (select(mom_seas_saar,-1) < 2) ) *
select(W_seas_mm3,-1),1,sum)
# 2%~4% diffusion
D24_saar_simple <- ( (select(mom_seas_saar,-1) >= 2) & (select(mom_seas_saar,-1) < 4) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D24_saar_weighted <- apply(( (select(mom_seas_saar,-1) >= 2) & (select(mom_seas_saar,-1) < 4) ) *
select(W_seas_mm3,-1),1,sum)
# 4%~6% diffusion
D46_saar_simple <- ( (select(mom_seas_saar,-1) >= 4) & (select(mom_seas_saar,-1) < 6) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D46_saar_weighted <- apply(( (select(mom_seas_saar,-1) >= 4) & (select(mom_seas_saar,-1) < 6) ) *
select(W_seas_mm3,-1),1,sum)
# Over 6% diffusion
D6_saar_simple <- ( select(mom_seas_saar,-1) >= 6 ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D6_saar_weighted <- apply(( select(mom_seas_saar,-1) >= 6 ) * select(W_seas_mm3,-1),1,sum)
# Over 1Y
Avg_1Y <- lag(mom_seas_saar,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 12 , .align = "right"))) %>%
drop_na()
W_1Y <-W_seas_mm3 %>%
filter(Dates %in% Avg_1Y$Dates)
mom_seas_saar_1Y <-mom_seas_saar %>%
filter(Dates %in% Avg_1Y$Dates)
D1Y_m_simple <- ( (select(mom_seas_saar_1Y,-1) > select(Avg_1Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D1Y_m_weighted <- apply(( (select(mom_seas_saar_1Y,-1) > select(Avg_1Y,-1)) ) * select(W_1Y,-1),1,sum)
# Over 2Y
Avg_2Y <- lag(mom_seas_saar,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 24 , .align = "right"))) %>%
drop_na()
W_2Y <-W_seas_mm3 %>%
filter(Dates %in% Avg_2Y$Dates)
mom_seas_saar_2Y <-mom_seas_saar %>%
filter(Dates %in% Avg_2Y$Dates)
D2Y_m_simple <- ( (select(mom_seas_saar_2Y,-1) > select(Avg_2Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D2Y_m_weighted <- apply(( (select(mom_seas_saar_2Y,-1) > select(Avg_2Y,-1)) ) * select(W_2Y,-1),1,sum)
# Over 3Y
Avg_3Y <- lag(mom_seas_saar,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 36 , .align = "right"))) %>%
drop_na()
W_3Y <-W_seas_mm3 %>%
filter(Dates %in% Avg_3Y$Dates)
mom_seas_saar_3Y <-mom_seas_saar %>%
filter(Dates %in% Avg_3Y$Dates)
D3Y_m_simple <- ( (select(mom_seas_saar_3Y,-1) > select(Avg_3Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D3Y_m_weighted <- apply(( (select(mom_seas_saar_3Y,-1) > select(Avg_3Y,-1)) ) * select(W_3Y,-1),1,sum)
# Over 4Y
Avg_4Y <- lag(mom_seas_saar,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 48 , .align = "right"))) %>%
drop_na()
W_4Y <-W_seas_mm3 %>%
filter(Dates %in% Avg_4Y$Dates)
mom_seas_saar_4Y <-mom_seas_saar %>%
filter(Dates %in% Avg_4Y$Dates)
D4Y_m_simple <- ( (select(mom_seas_saar_4Y,-1) > select(Avg_4Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D4Y_m_weighted <- apply(( (select(mom_seas_saar_4Y,-1) > select(Avg_4Y,-1)) ) * select(W_4Y,-1),1,sum)
# Over 5Y
Avg_5Y <- lag(mom_seas_saar,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 60 , .align = "right"))) %>%
drop_na()
W_5Y <-W_seas_mm3 %>%
filter(Dates %in% Avg_5Y$Dates)
mom_seas_saar_5Y <-mom_seas_saar %>%
filter(Dates %in% Avg_5Y$Dates)
D5Y_m_simple <- ( (select(mom_seas_saar_5Y,-1) > select(Avg_5Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(mom_seas_saar) - 1 )
D5Y_m_weighted <- apply(( (select(mom_seas_saar_5Y,-1) > select(Avg_5Y,-1)) ) * select(W_5Y,-1),1,sum)
# YoY nsa
yoy_seas <- yoy_dt %>%
select(colnames(yoy_dt[,idx_seas == 1]))
W_seas <- W %>%
select(colnames(W[,idx_seas == 1]))
W_y <- lag(W,11) %>%
select(colnames(W[,idx_seas == 1])) %>%
drop_na()
# Over 0% diffusion
D_y_simple <- ( select(yoy_seas,-1) > 0 ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D_y_weighted <- apply(( select(yoy_seas,-1) > 0 ) * select(W_y,-1),1,sum)
# Under 0% diffusion
D0_y_simple <- ( select(yoy_seas,-1) < 0 ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D0_y_weighted <- apply(( select(yoy_seas,-1) < 0 ) * select(W_y,-1),1,sum)
# 0%~2% diffusion
D02_y_simple <- ( (select(yoy_seas,-1) >= 0) & (select(yoy_seas,-1) < 2) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D02_y_weighted <- apply(( (select(yoy_seas,-1) >= 0) & (select(yoy_seas,-1) < 2) ) *
select(W_y,-1),1,sum)
# 2%~4% diffusion
D24_y_simple <- ( (select(yoy_seas,-1) >= 2) & (select(yoy_seas,-1) < 4) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D24_y_weighted <- apply(( (select(yoy_seas,-1) >= 2) & (select(yoy_seas,-1) < 4) ) *
select(W_y,-1),1,sum)
# 4%~6% diffusion
D46_y_simple <- ( (select(yoy_seas,-1) >= 4) & (select(yoy_seas,-1) < 6) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D46_y_weighted <- apply(( (select(yoy_seas,-1) >= 4) & (select(yoy_seas,-1) < 6) ) *
select(W_y,-1),1,sum)
# Over 6% diffusion
D6_y_simple <- ( select(yoy_seas,-1) >= 6 ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D6_y_weighted <- apply(( select(yoy_seas,-1) >= 6 ) * select(W_y,-1),1,sum)
# Over 1Y
Avg_1Y <- lag(yoy_seas,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 12 , .align = "right"))) %>%
drop_na()
yoy_seas_1Y <-yoy_seas %>%
filter(Dates %in% Avg_1Y$Dates)
W_1Y <-W_y %>%
filter(Dates %in% Avg_1Y$Dates)
D1Y_y_simple <- ( (select(yoy_seas_1Y,-1) > select(Avg_1Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D1Y_y_weighted <- apply(( (select(yoy_seas_1Y,-1) > select(Avg_1Y,-1)) ) * select(W_1Y,-1),1,sum)
# Over 2Y
Avg_2Y <- lag(yoy_seas,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 24 , .align = "right"))) %>%
drop_na()
yoy_seas_2Y <-yoy_seas %>%
filter(Dates %in% Avg_2Y$Dates)
W_2Y <-W_y %>%
filter(Dates %in% Avg_2Y$Dates)
D2Y_y_simple <- ( (select(yoy_seas_2Y,-1) > select(Avg_2Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D2Y_y_weighted <- apply(( (select(yoy_seas_2Y,-1) > select(Avg_2Y,-1)) ) * select(W_2Y,-1),1,sum)
# Over 3Y
Avg_3Y <- lag(yoy_seas,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 36 , .align = "right"))) %>%
drop_na()
yoy_seas_3Y <-yoy_seas %>%
filter(Dates %in% Avg_3Y$Dates)
W_3Y <-W_y %>%
filter(Dates %in% Avg_3Y$Dates)
D3Y_y_simple <- ( (select(yoy_seas_3Y,-1) > select(Avg_3Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D3Y_y_weighted <- apply(( (select(yoy_seas_3Y,-1) > select(Avg_3Y,-1)) ) * select(W_3Y,-1),1,sum)
# Over 4Y
Avg_4Y <- lag(yoy_seas,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 48 , .align = "right"))) %>%
drop_na()
W_4Y <-W_y %>%
filter(Dates %in% Avg_4Y$Dates)
yoy_seas_4Y <-yoy_seas %>%
filter(Dates %in% Avg_4Y$Dates)
D4Y_y_simple <- ( (select(yoy_seas_4Y,-1) > select(Avg_4Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D4Y_y_weighted <- apply(( (select(yoy_seas_4Y,-1) > select(Avg_4Y,-1)) ) * select(W_4Y,-1),1,sum)
# Over 5Y
Avg_5Y <- lag(yoy_seas,1) %>%
mutate(across(.cols = -1,
.fns = slidify(.f = mean, .period = 60 , .align = "right"))) %>%
drop_na()
W_5Y <-W_y %>%
filter(Dates %in% Avg_5Y$Dates)
yoy_seas_5Y <-yoy_seas %>%
filter(Dates %in% Avg_5Y$Dates)
D5Y_y_simple <- ( (select(yoy_seas_5Y,-1) > select(Avg_5Y,-1)) ) %>%
apply(1,sum)*100 / ( ncol(yoy_seas) - 1 )
D5Y_y_weighted <- apply(( (select(yoy_seas_5Y,-1) > select(Avg_5Y,-1)) ) * select(W_5Y,-1),1,sum)
# 1.5.1) 1st table: Several SAAR diffusion measures ----------------------------
l_5.1 <- 24
Tab_5.1_names <- c("Simple", "Under 0%", "Between 0% and 2%", "Between 2% and 4%",
"Between 4% and 6%", "Over 6%", "Over 1 year average",
"Over 2 year average", "Over 3 year average",
"Over 4 year average", "Over 5 year average")
Tab_5.1_type <- c(rep("Simple",11), rep("Weighted",11))
Tab_5.1_simple <- t( cbind(tail(D_simple,l_5.1), tail(D0_saar_simple,l_5.1),
tail(D02_saar_simple,l_5.1), tail(D24_saar_simple,l_5.1),
tail(D46_saar_simple,l_5.1), tail(D6_saar_simple,l_5.1),
tail(D1Y_m_simple,l_5.1), tail(D2Y_m_simple,l_5.1),
tail(D3Y_m_simple,l_5.1), tail(D4Y_m_simple,l_5.1),
tail(D5Y_m_simple,l_5.1)) ) %>%
as_tibble() %>%
mutate(Items = Tab_5.1_names) %>%
select(l_5.1+1,1:l_5.1)
Tab_5.1_weighted <- t( cbind(tail(D_weighted,l_5.1), tail(D0_saar_weighted,l_5.1),
tail(D02_saar_weighted,l_5.1), tail(D24_saar_weighted,l_5.1),
tail(D46_saar_weighted,l_5.1), tail(D6_saar_weighted,l_5.1),
tail(D1Y_m_weighted,l_5.1), tail(D2Y_m_weighted,l_5.1),
tail(D3Y_m_weighted,l_5.1), tail(D4Y_m_weighted,l_5.1),
tail(D5Y_m_weighted,l_5.1)) ) %>%
as_tibble() %>%
mutate(Items = Tab_5.1_names) %>%
select(l_5.1+1, 1:l_5.1) %>%
mutate(across(.cols = 2:(l_5.1+1),.fns = ~round(.x,2)))
Tab_5.1 <- cbind( Tab_5.1_type, rbind(Tab_5.1_simple, Tab_5.1_weighted) )
colnames(Tab_5.1) <- c("Type", "Items", paste0("m_",1:l_5.1) )
# 1.5.2) 2nd table: Several YoY diffusion measures -----------------------------
Tab_5.2_type <- c(rep("Simple",10), rep("Weighted",10))
Tab_5.2_simple <- t( cbind(tail(D0_y_simple,l_5.1),
tail(D02_y_simple,l_5.1), tail(D24_y_simple,l_5.1),
tail(D46_y_simple,l_5.1), tail(D6_y_simple,l_5.1),
tail(D1Y_y_simple,l_5.1), tail(D2Y_y_simple,l_5.1),
tail(D3Y_y_simple,l_5.1), tail(D4Y_y_simple,l_5.1),
tail(D5Y_y_simple,l_5.1)) ) %>%
as_tibble() %>%
mutate(Items = Tab_5.1_names[-1]) %>%
select(l_5.1+1,1:l_5.1)
Tab_5.2_weighted <- t( cbind(tail(D0_y_weighted,l_5.1),
tail(D02_y_weighted,l_5.1), tail(D24_y_weighted,l_5.1),
tail(D46_y_weighted,l_5.1), tail(D6_y_weighted,l_5.1),
tail(D1Y_y_weighted,l_5.1), tail(D2Y_y_weighted,l_5.1),
tail(D3Y_y_weighted,l_5.1), tail(D4Y_y_weighted,l_5.1),
tail(D5Y_y_weighted,l_5.1)) ) %>%
as_tibble() %>%
mutate(Items = Tab_5.1_names[-1]) %>%
select(l_5.1+1, 1:l_5.1) %>%
mutate(across(.cols = 2:(l_5.1+1),.fns = ~round(.x,2)))
Tab_5.2 <- cbind( Tab_5.2_type, rbind(Tab_5.2_simple, Tab_5.2_weighted) )
colnames(Tab_5.2) <- colnames(Tab_5.1)
# 1.5.2) 1st graph: Diffusion composition SAAR Simple --------------------------
Pdata_5.1 <- cbind(D0_saar_simple, D02_saar_simple, D24_saar_simple,
D46_saar_simple, D6_saar_simple) %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar$Dates) %>%
select(6,1:5)
P_5.1 = plot_ly(Pdata_5.1, x = ~as.Date(Dates)) %>%
add_bars(y = Pdata_5.1$D0_saar_simple, name = "Under 0%", marker = list(color = "#BAA65B")) %>%
add_bars(y = Pdata_5.1$D02_saar_simple, name = "Between 0% and 2%", marker = list(color = "#8C8B8B")) %>%
add_bars(y = Pdata_5.1$D24_saar_simple, name = "Between 2% and 4%", marker = list(color = "#C5C399")) %>%
add_bars(y = Pdata_5.1$D46_saar_simple, name = "Between 4% and 6%", marker = list(color = "#4A908E")) %>%
add_bars(y = Pdata_5.1$D6_saar_simple, name = "Over 6%", marker = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Unweighted diffusion composition - SAAR <b>",
font = list(color = "midnightblue")),
barmode = 'relative', yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.5.3) 2nd graph: Diffusion Composition YoY Simple ---------------------------
Pdata_5.2 <- cbind(D0_y_simple, D02_y_simple, D24_y_simple,
D46_y_simple, D6_y_simple) %>%
as.tibble() %>%
mutate(Dates = yoy_seas$Dates) %>%
select(6,1:5)
P_5.2 = plot_ly(Pdata_5.2, x = ~as.Date(Dates)) %>%
add_bars(y = Pdata_5.2$D0_y_simple, name = "Under 0%", marker = list(color = "#BAA65B")) %>%
add_bars(y = Pdata_5.2$D02_y_simple, name = "Between 0% and 2%", marker = list(color = "#8C8B8B")) %>%
add_bars(y = Pdata_5.2$D24_y_simple, name = "Between 2% and 4%", marker = list(color = "#C5C399")) %>%
add_bars(y = Pdata_5.2$D46_y_simple, name = "Between 4% and 6%", marker = list(color = "#4A908E")) %>%
add_bars(y = Pdata_5.2$D6_y_simple, name = "Over 6%", marker = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Unweighted diffusion composition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative',yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.5.4) 3rd graph: Diffusion composition SAAR Weighted ------------------------
Pdata_5.3 <- cbind(D0_saar_weighted, D02_saar_weighted, D24_saar_weighted,
D46_saar_weighted, D6_saar_weighted) %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar$Dates) %>%
select(6,1:5)
P_5.3 = plot_ly(Pdata_5.3, x = ~as.Date(Dates)) %>%
add_bars(y = Pdata_5.3$D0_saar_weighted, name = "Under 0%", marker = list(color = "#BAA65B")) %>%
add_bars(y = Pdata_5.3$D02_saar_weighted, name = "Between 0% and 2%", marker = list(color = "#8C8B8B")) %>%
add_bars(y = Pdata_5.3$D24_saar_weighted, name = "Between 2% and 4%", marker = list(color = "#C5C399")) %>%
add_bars(y = Pdata_5.3$D46_saar_weighted, name = "Between 4% and 6%", marker = list(color = "#4A908E")) %>%
add_bars(y = Pdata_5.3$D6_saar_weighted, name = "Over 6%", marker = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Weighted diffusion composition - SAAR <b>",
font = list(color = "midnightblue")),
barmode = 'relative',yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.5.5) 4th graph: Diffusion Composition YoY Weighted -------------------------
Pdata_5.4 <- cbind(D0_y_weighted, D02_y_weighted, D24_y_weighted,
D46_y_weighted, D6_y_weighted) %>%
as.tibble() %>%
mutate(Dates = yoy_seas$Dates) %>%
select(6,1:5)
P_5.4 = plot_ly(Pdata_5.4, x = ~as.Date(Dates)) %>%
add_bars(y = Pdata_5.4$D0_y_weighted, name = "Under 0%", marker = list(color = "#BAA65B")) %>%
add_bars(y = Pdata_5.4$D02_y_weighted, name = "Between 0% and 2%", marker = list(color = "#8C8B8B")) %>%
add_bars(y = Pdata_5.4$D24_y_weighted, name = "Between 2% and 4%", marker = list(color = "#C5C399")) %>%
add_bars(y = Pdata_5.4$D46_y_weighted, name = "Between 4% and 6%", marker = list(color = "#4A908E")) %>%
add_bars(y = Pdata_5.4$D6_y_weighted, name = "Over 6%", marker = list(color = "#9ACEBD")) %>%
layout(title = list(text = "<b> Weighted diffusion composition - YoY <b>",
font = list(color = "midnightblue")),
barmode = 'relative',yaxis = list(title = "(%)"),xaxis = list(title = ""),
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.5.6) 5th graph: Several SAAR diffusion measures ----------------------------
D1Y_P5.5 <- D1Y_m_simple %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar_1Y$Dates) %>%
select(2,1)
D2Y_P5.5 <- D2Y_m_simple %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar_2Y$Dates) %>%
select(2,1)
D3Y_P5.5 <- D3Y_m_simple %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar_3Y$Dates) %>%
select(2,1)
D4Y_P5.5 <- D4Y_m_simple %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar_4Y$Dates) %>%
select(2,1)
D5Y_P5.5 <- D5Y_m_simple %>%
as.tibble() %>%
mutate(Dates = mom_seas_saar_5Y$Dates) %>%
select(2,1)
Pdata_5.5 <- D1Y_P5.5 %>%
right_join(D2Y_P5.5, by = "Dates") %>%
right_join(D3Y_P5.5, by = "Dates") %>%
right_join(D4Y_P5.5, by = "Dates") %>%
right_join(D5Y_P5.5, by = "Dates")
colnames(Pdata_5.5) <- c("Dates", "1Y", "2Y", "3Y", "4Y", "5Y")
P_5.5 = plot_ly(Pdata_5.5, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_5.5$`1Y`,2), name = "Over 1Y average",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_5.5$`2Y`,2), name = "Over 2Y average",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_5.5$`3Y`,2), name = "Over 3Y average",
line = list(color = "#8C8B8B")) %>%
add_lines(y = round(Pdata_5.5$`4Y`,2), name = "Over 4Y average",
line = list(color = "#C5C399")) %>%
add_lines(y = round(Pdata_5.5$`5Y`,2), name = "Over 5Y average",
line = list(color = "#4A908E")) %>%
layout(title = list(text = "<b> Diffusion by historical averages - SAAR <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
# 1.5.7) 6th graph: Several YoY diffusion measures -----------------------------
D1Y_P5.6 <- D1Y_y_simple %>%
as.tibble() %>%
mutate(Dates = yoy_seas_1Y$Dates) %>%
select(2,1)
D2Y_P5.6 <- D2Y_y_simple %>%
as.tibble() %>%
mutate(Dates = yoy_seas_2Y$Dates) %>%
select(2,1)
D3Y_P5.6 <- D3Y_y_simple %>%
as.tibble() %>%
mutate(Dates = yoy_seas_3Y$Dates) %>%
select(2,1)
D4Y_P5.6 <- D4Y_y_simple %>%
as.tibble() %>%
mutate(Dates = yoy_seas_4Y$Dates) %>%
select(2,1)
D5Y_P5.6 <- D5Y_y_simple %>%
as.tibble() %>%
mutate(Dates = yoy_seas_5Y$Dates) %>%
select(2,1)
Pdata_5.6 <- D1Y_P5.6 %>%
right_join(D2Y_P5.6, by = "Dates") %>%
right_join(D3Y_P5.6, by = "Dates") %>%
right_join(D4Y_P5.6, by = "Dates") %>%
right_join(D5Y_P5.6, by = "Dates")
colnames(Pdata_5.6) <- c("Dates", "1Y", "2Y", "3Y", "4Y", "5Y")
P_5.6 = plot_ly(Pdata_5.6, x = ~as.Date(Dates)) %>%
add_lines(y = round(Pdata_5.6$`1Y`,2), name = "Over 1Y average",
line = list(color = "#000000")) %>%
add_lines(y = round(Pdata_5.6$`2Y`,2), name = "Over 2Y average",
line = list(color = "#BAA65B")) %>%
add_lines(y = round(Pdata_5.6$`3Y`,2), name = "Over 3Y average",
line = list(color = "#8C8B8B")) %>%
add_lines(y = round(Pdata_5.6$`4Y`,2), name = "Over 4Y average",
line = list(color = "#C5C399")) %>%
add_lines(y = round(Pdata_5.6$`5Y`,2), name = "Over 5Y average",
line = list(color = "#4A908E")) %>%
layout(title = list(text = "<b> Diffusion by historical averages - YoY <b>",
font = list(color = "midnightblue")),
yaxis = list(title = "(%)", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"),
xaxis = list(title = "", gridcolor = "#EDEDED",
zerolinecolor = "#EDEDED"), hovermode = "x unified",
legend = list(orientation = "h",xanchor = "center", x = 0.5))
aba
Main {data-icon="fa-chevron-right"}
=====================================
Column {.sidebar}
-----------------------------------------------------------------------
###
aba{r}
month <- month(tail(mom_dt$Dates,1))
cpi_year <- mom_dt %>%
select("Dates","All Items") %>%
mutate(across(.cols = -1, .fns = ~tstools::acum_p(.x,month))) %>%
tail(1) %>%
select(2) %>%
round(1)
core_year <- mom_dt %>%
select("Dates","Core CPI") %>%
mutate(across(.cols = -1, .fns = ~tstools::acum_p(.x,month))) %>%
tail(1) %>%
select(2) %>%
round(1)
texto1 <- c("MoM","MoM","MoM","MoM","YoY","YoY","YoY","YoY","Ytd","Ytd")
texto2 <- c("Head", "Consensus", "Core", "Consensus", "Head",
"Consensus", "Core", "Consensus", "Head","Core")
valor <- c(round(tail(mom_dt$`All Items`,1),1),
0.2,
round(tail(mom_dt$`Core CPI`,1),1),
0.3,
round(tail(yoy_dt$`All Items`,1),1),
3.2,
round(tail(yoy_dt$`Core CPI`,1),1),
3.8,
as.numeric(cpi_year),
as.numeric(core_year))
Tab_test <- tibble(texto1,texto2,valor)
gt_side <- gt(Tab_test, groupname_col = "texto1", rowname_col = "texto2") %>%
# Title:
tab_header(title = format(tail(mom_dt$Dates,1), "%B %Y") ) %>%
tab_options(heading.align = "left", heading.title.font.size = px(20),
table.border.top.color = "#DEE5EA") %>%
tab_style( style = list( cell_text(color = "#DEE5EA") ),
locations = cells_column_labels() ) %>%
# General options:
tab_options(
column_labels.font.size = px(0),
heading.border.bottom.color = "#DEE5EA",
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.color = "#DEE5EA",
column_labels.border.top.color = "#DEE5EA",
column_labels.border.bottom.width = px(3),
column_labels.border.bottom.color = "black",
table.border.bottom.color = "black",
table_body.hlines.color = "#DEE5EA",
table.border.bottom.width = px(3),
table.font.size = 25,
table.background.color = "#DEE5EA") %>%
tab_style(locations = cells_body(rows = c(1,3,5,7,9,10)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(locations = cells_stub(rows = c(1,3,5,7,9,10)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(locations = cells_body(rows = c(2,4,6,8)),
style = list(cell_text(size = px(18), style = "italic"))) %>%
tab_style(locations = cells_stub(rows = c(2,4,6,8)),
style = list(cell_text(size = px(18), style = "italic"))) %>%
tab_style(style = cell_text(style = "italic", weight = "bold"),
locations = list(cells_row_groups(),cells_column_labels(everything()))) %>%
tab_style(locations = cells_body(rows = 1),
style = list(cell_text(color =
ifelse(valor[1]>valor[2],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_stub(rows = 1),
style = list(cell_text(color =
ifelse(valor[1]>valor[2],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_body(rows = 3),
style = list(cell_text(color =
ifelse(valor[3]>valor[4],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_stub(rows = 3),
style = list(cell_text(color =
ifelse(valor[3]>valor[4],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_body(rows = 5),
style = list(cell_text(color =
ifelse(valor[5]>valor[6],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_stub(rows = 5),
style = list(cell_text(color =
ifelse(valor[5]>valor[6],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_body(rows = 7),
style = list(cell_text(color =
ifelse(valor[7]>valor[8],"#D3293D","#3B9C28")))) %>%
tab_style(locations = cells_stub(rows = 7),
style = list(cell_text(color =
ifelse(valor[7]>valor[8],"#D3293D","#3B9C28"))))
gt_side
aba
Column {.tabset}
-----------------------------------------------------------------------
### Overview MoM
aba{r}
gt(Tab_1.1) %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_style( style = list( cell_text(color = "#FFFFFF") ),
locations = cells_column_labels(5) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
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:8,align = "right") %>%
cols_width(`Items` ~ px(280), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`bps_m` ~ px(40), `m1_c` ~ px(60),`m2_c` ~ px(60),
`m3_c` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(4,8)),
style = list(cell_text(weight = "bold"))) %>%
# Spanners:
tab_spanner(label = "MoM sa", columns = 2:4) %>%
tab_spanner(label = "MoM Contribuitions", columns = 6:8) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`m1_c` = names_tab[1], `m2_c` = names_tab[2],
`m3_c` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,2,5,10)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor 1 rows:
tab_style(locations = cells_body(rows = c(3,4,6,8,11,22)),
style = list(cell_fill(color = "#F5F5F5"))) %>%
tab_style(locations = cells_body(rows = c(3,4,6,8,11,22), columns = 1),
style = list(cell_text(indent = px(10)))) %>%
# Minor 2 rows:
tab_style(locations = cells_body(rows = c(7,9,12,13,14,17,18,19,20,21,
23,24,25,26,27,29,30,31),
columns = 1),
style = list(cell_text(indent = px(20)))) %>%
# Minor 3 rows:
tab_style(locations = cells_body(rows = c(15,16,28), columns = 1),
style = list(cell_text(indent = px(30)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS")) %>%
gt_fa_rank_change(column = 5, palette = c("#D42940", "grey","#1b7837"),
font_color = "match", fa_type = "caret")
aba
### Overview YoY
aba{r}
gt(Tab_1.2) %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_style( style = list( cell_text(color = "#FFFFFF") ),
locations = cells_column_labels(5) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
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:8,align = "right") %>%
cols_width(`Items` ~ px(280), `y1` ~ px(60),`y2` ~ px(60),`y3` ~ px(60),
`bps_y` ~ px(40), `y1_c` ~ px(60),`y2_c` ~ px(60),
`y3_c` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(4,8)),
style = list(cell_text(weight = "bold"))) %>%
# Spanners:
tab_spanner(label = "YoY nsa", columns = 2:4) %>%
tab_spanner(label = "YoY Contribuitions", columns = 6:8) %>%
cols_label(`y1` = names_tab[1], `y2` = names_tab[2],
`y3` = names_tab[3], `y1_c` = names_tab[1], `y2_c` = names_tab[2],
`y3_c` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,2,5,10)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor 1 rows:
tab_style(locations = cells_body(rows = c(3,4,6,8,11,22)),
style = list(cell_fill(color = "#F5F5F5"))) %>%
tab_style(locations = cells_body(rows = c(3,4,6,8,11,22), columns = 1),
style = list(cell_text(indent = px(10)))) %>%
# Minor 2 rows:
tab_style(locations = cells_body(rows = c(7,9,12,13,14,17,18,19,20,21,
23,24,25,26,27,29,30,31),
columns = 1),
style = list(cell_text(indent = px(20)))) %>%
# Minor 3 rows:
tab_style(locations = cells_body(rows = c(15,16,28), columns = 1),
style = list(cell_text(indent = px(30)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS")) %>%
gt_fa_rank_change(column = 5, palette = c("#D42940", "grey","#1b7837"),
font_color = "match", fa_type = "caret")
aba
### Food
aba{r}
d1 <- nrow(Tab_1.3_m)
d2 <- nrow(Tab_1.3)
rbPal <- colorRampPalette(c("#3EB342","#E9E961", "#E45B5B"))
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.3$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.3$cg_3[(d1+2):d2], breaks = 100))]
gt_1.3 <- gt(Tab_1.3, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.3),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.3)/2)){
gt_1.3 <- tab_style(gt_1.3, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.3 <- tab_style(gt_1.3, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.3)/2) ))
}
gt_1.3
aba
### Housing
aba{r}
d1 <- nrow(Tab_1.4_m)
d2 <- nrow(Tab_1.4)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.4$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.4$cg_3[(d1+2):d2], breaks = 100))]
gt_1.4 <- gt(Tab_1.4, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.4),align = "right") %>%
cols_width(`Items` ~ px(310), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.4)/2)){
gt_1.4 <- tab_style(gt_1.4, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.4 <- tab_style(gt_1.4, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.4)/2) ))
}
gt_1.4
aba
### Apparel
aba{r}
d1 <- nrow(Tab_1.5_m)
d2 <- nrow(Tab_1.5)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.5$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.5$cg_3[(d1+2):d2], breaks = 100))]
gt_1.5 <- gt(Tab_1.5, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.5),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.5)/2)){
gt_1.5 <- tab_style(gt_1.5, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.5 <- tab_style(gt_1.5, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.5)/2) ))
}
gt_1.5
aba
### Transportation
aba{r}
d1 <- nrow(Tab_1.6_m)
d2 <- nrow(Tab_1.6)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.6$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.6$cg_3[(d1+2):d2], breaks = 100))]
gt_1.6 <- gt(Tab_1.6, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.6),align = "right") %>%
cols_width(`Items` ~ px(310), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.6)/2)){
gt_1.6 <- tab_style(gt_1.6, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.6 <- tab_style(gt_1.6, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.6)/2) ))
}
gt_1.6
aba
### Medical care
aba{r}
d1 <- nrow(Tab_1.7_m)
d2 <- nrow(Tab_1.7)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.7$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.7$cg_3[(d1+2):d2], breaks = 100))]
gt_1.7 <- gt(Tab_1.7, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.7),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.7)/2)){
gt_1.7 <- tab_style(gt_1.7, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.7 <- tab_style(gt_1.7, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.7)/2) ))
}
gt_1.7
aba
### Recreation
aba{r}
d1 <- nrow(Tab_1.8_m)
d2 <- nrow(Tab_1.8)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.8$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.8$cg_3[(d1+2):d2], breaks = 100))]
gt_1.8 <- gt(Tab_1.8, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.8),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.8)/2)){
gt_1.8 <- tab_style(gt_1.8, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.8 <- tab_style(gt_1.8, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.8)/2) ))
}
gt_1.8
aba
### Education and Comm.
aba{r}
d1 <- nrow(Tab_1.9_m)
d2 <- nrow(Tab_1.9)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.9$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.9$cg_3[(d1+2):d2], breaks = 100))]
gt_1.9 <- gt(Tab_1.9, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.9),align = "right") %>%
cols_width(`Items` ~ px(310), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.9)/2)){
gt_1.9 <- tab_style(gt_1.9, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.9 <- tab_style(gt_1.9, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.9)/2) ))
}
gt_1.9
aba
### Other goods and services
aba{r}
d1 <- nrow(Tab_1.10_m)
d2 <- nrow(Tab_1.10)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.10$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.10$cg_3[(d1+2):d2], breaks = 100))]
gt_1.10 <- gt(Tab_1.10, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.10),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.10)/2)){
gt_1.10 <- tab_style(gt_1.10, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.10 <- tab_style(gt_1.10, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.10)/2) ))
}
gt_1.10
aba
### Energy
aba{r}
d1 <- nrow(Tab_1.11_m)
d2 <- nrow(Tab_1.11)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.11$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.11$cg_3[(d1+2):d2], breaks = 100))]
gt_1.11 <- gt(Tab_1.11, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.11),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.11)/2)){
gt_1.11 <- tab_style(gt_1.11, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.11 <- tab_style(gt_1.11, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.11)/2) ))
}
gt_1.11
aba
### Goods
aba{r}
d1 <- nrow(Tab_1.12_m)
d2 <- nrow(Tab_1.12)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.12$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.12$cg_3[(d1+2):d2], breaks = 100))]
gt_1.12 <- gt(Tab_1.12, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.12),align = "right") %>%
cols_width(`Items` ~ px(250), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.12)/2)){
gt_1.12 <- tab_style(gt_1.12, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.12 <- tab_style(gt_1.12, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.12)/2) ))
}
gt_1.12
aba
### Services
aba{r}
d1 <- nrow(Tab_1.13_m)
d2 <- nrow(Tab_1.13)
heat_color <- rbPal(100)[as.numeric(cut(Tab_1.13$cg_3[2:d1], breaks = 100))]
heat_color2 <- rbPal(100)[as.numeric(cut(Tab_1.13$cg_3[(d1+2):d2], breaks = 100))]
gt_1.13 <- gt(Tab_1.13, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_1.13),align = "right") %>%
cols_width(`Items` ~ px(310), `m1` ~ px(60), `m2` ~ px(60), `m3` ~ px(60),
`cg_1` ~ px(60), `cg_2` ~ px(60),`cg_3` ~ px(60),`ca_1` ~ px(60),
`ca_2` ~ px(60),`ca_3` ~ px(60)) %>%
tab_style(locations = cells_body(columns = c(5,8,11)),
style = list(cell_text(weight = "bold"))) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Spanners:
tab_spanner(label = "Price change", columns = 3:5) %>%
tab_spanner(label = "Group Impact", columns = 6:8) %>%
tab_spanner(label = "CPI Impact", columns = 9:11) %>%
cols_label(`m1` = names_tab[1], `m2` = names_tab[2], `m3` = names_tab[3],
`cg_1` = names_tab[1], `cg_2` = names_tab[2],
`cg_3` = names_tab[3], `ca_1` = names_tab[1],
`ca_2` = names_tab[2], `ca_3` = names_tab[3]) %>%
tab_style(locations = cells_column_spanners(everything()),
style = list(cell_text(weight = "bold"))) %>%
# Main rows:
tab_style(locations = cells_body(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
tab_style(locations = cells_stub(rows = c(1,d1+1)),
style = list(cell_text(weight = "bold"),
cell_fill(color = "#E5E5E2"))) %>%
# Minor rows:
tab_style(locations = cells_stub(rows = c(2:d1,(d1+2):d2)),
style = list(cell_text(indent = px(10)))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
# Heatmap
for(i in 2:(nrow(Tab_1.13)/2)){
gt_1.13 <- tab_style(gt_1.13, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color[i-1])),
locations = cells_body(columns = 8, rows = i))
gt_1.13 <- tab_style(gt_1.13, style = list(cell_text(weight = "bold"), cell_fill(color = heat_color2[i-1])),
locations = cells_body(columns = 8, rows = i + (nrow(Tab_1.13)/2) ))
}
gt_1.13
aba
###
aba{r}
P_1.1
aba
###
aba{r}
P_1.2
aba
Core {data-icon="fa-chevron-right"}
=====================================
Column {.sidebar}
-----------------------------------------------------------------------
###
aba{r}
gt_side
aba
Column {.tabset}
-----------------------------------------------------------------------
### Overview - MoM sa
aba{r}
heat_color <- list()
for(i in 1:nrow(Tab_2.1)){
heat_color[[i]] <- rbPal(100)[cut(as.numeric(Tab_2.1[i,-1]),
breaks = 100)]
}
colnames(Tab_2.1) <- c(" ",
format(tail(mom_dt$Dates,ncol(Tab_2.2)-1), "%b/%y") )
gt_2.1 <- gt(Tab_2.1) %>%
# Title:
tab_header( title = md("**US CPI core measures - MoM sa**"),
subtitle = format(tail(mom_dt$Dates,1), "%b/%y") ) %>%
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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_2.1),align = "right") %>%
cols_width(everything() ~ px(50)) %>%
cols_width(1 ~ px(250)) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
for(j in 1:nrow(Tab_2.1)){
for(i in 2:ncol(Tab_2.1)){
gt_2.1 <- tab_style(gt_2.1,
style = list(cell_text(weight = "bold"),
cell_fill(color = heat_color[[j]][i-1])),
locations = cells_body(columns = i, rows = j))
}
}
gt_2.1
aba
### Overview - YoY
aba{r}
heat_color <- list()
for(i in 1:nrow(Tab_2.2)){
heat_color[[i]] <- rbPal(100)[cut(as.numeric(Tab_2.2[i,-1]),
breaks = 100)]
}
colnames(Tab_2.2) <- c(" ",
format(tail(mom_dt$Dates,ncol(Tab_2.2)-1), "%b/%y") )
gt_2.2 <- gt(Tab_2.2) %>%
# Title:
tab_header( title = md("**US CPI core measures - YoY nsa**"),
subtitle = format(tail(mom_dt$Dates,1), "%b/%y") ) %>%
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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_2.2),align = "right") %>%
cols_width(everything() ~ px(50)) %>%
cols_width(1 ~ px(250)) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
for(j in 1:nrow(Tab_2.2)){
for(i in 2:ncol(Tab_2.2)){
gt_2.2 <- tab_style(gt_2.2,
style = list(cell_text(weight = "bold"),
cell_fill(color = heat_color[[j]][i-1])),
locations = cells_body(columns = i, rows = j))
}
}
gt_2.2
aba
### Overview - SAAR
aba{r}
heat_color <- list()
for(i in 1:nrow(Tab_2.3)){
heat_color[[i]] <- rbPal(100)[cut(as.numeric(Tab_2.3[i,-1]),
breaks = 100)]
}
colnames(Tab_2.3) <- c(" ",
format(tail(mom_dt$Dates,ncol(Tab_2.3)-1), "%b/%y") )
gt_2.3 <- gt(Tab_2.3) %>%
# Title:
tab_header( title = md("**US CPI core measures - SAAR MM3**"),
subtitle = format(tail(mom_dt$Dates,1), "%b/%y") ) %>%
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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_2.3),align = "right") %>%
cols_width(everything() ~ px(50)) %>%
cols_width(1 ~ px(250)) %>%
tab_style(
style = cell_text(color = "black", weight = "bold"),
locations = list(
cells_row_groups(),
cells_column_labels(everything()))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
for(j in 1:nrow(Tab_2.3)){
for(i in 2:ncol(Tab_2.3)){
gt_2.3 <- tab_style(gt_2.3,
style = list(cell_text(weight = "bold"),
cell_fill(color = heat_color[[j]][i-1])),
locations = cells_body(columns = i, rows = j))
}
}
gt_2.3
aba
### Core CPI
aba{r}
P_2.1
aba
### Core Services
aba{r}
P_2.2
aba
### Core Goods
aba{r}
P_2.3
aba
### Core less shelter
aba{r}
P_2.4
aba
### Core less shelter and used cars
aba{r}
P_2.5
aba
### CPI ex-food
aba{r}
P_2.6
aba
### CPI ex-energy
aba{r}
P_2.7
aba
### Double weighting
aba{r}
P_2.8
aba
### Trimmed mean
aba{r}
P_2.9
aba
### P50
aba{r}
P_2.10
aba
### Durables
aba{r}
P_2.11
aba
### Nondurables
aba{r}
P_2.12
aba
### Nondurables less food
aba{r}
P_2.13
aba
###
aba{r}
P_2.14
aba
###
aba{r}
P_2.15
aba
YoY Contribution {data-icon="fa-chevron-right"}
=====================================
Column {.sidebar}
-----------------------------------------------------------------------
###
aba{r}
gt_side
aba
Column {.tabset}
-----------------------------------------------------------------------
### CPI 1
aba{r}
P_3.1
aba
### Food
aba{r}
P_3.2
aba
### Energy
aba{r}
P_3.3
aba
### Core goods
aba{r}
P_3.4
aba
### Core services
aba{r}
P_3.5
aba
### CPI 2
aba{r}
P_3.6
aba
MoM Contribution {data-icon="fa-chevron-right"}
=====================================
Column {.sidebar}
-----------------------------------------------------------------------
###
aba{r}
gt_side
aba
Column {.tabset}
-----------------------------------------------------------------------
### Main CPI composition
aba{r}
P_4.1
aba
### Food
aba{r}
P_4.2
aba
### Energy
aba{r}
P_4.3
aba
### Core goods
aba{r}
P_4.4
aba
### Core services
aba{r}
P_4.5
aba
### Alternative CPI composition
aba{r}
P_4.6
aba
Diffusion {data-icon="fa-chevron-right"}
=====================================
Column {.sidebar}
-----------------------------------------------------------------------
###
aba{r}
gt_side
aba
Column {.tabset}
-----------------------------------------------------------------------
### Overview SAAR
aba{r}
heat_color <- list()
for(i in 1:nrow(Tab_5.1)){
heat_color[[i]] <- rbPal(100)[cut(as.numeric(Tab_5.1[i,-c(1:2)]),
breaks = 100)]
}
colnames(Tab_5.1) <- c("Type", "Items",
format(tail(mom_dt$Dates,ncol(Tab_5.1)-2), "%b/%y") )
gt_5.1 <- gt(Tab_5.1, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_5.1),align = "right") %>%
cols_width(everything() ~ px(50)) %>%
cols_width(`Items` ~ px(200)) %>%
tab_style(style = cell_text(weight = "bold"), locations =
list(cells_row_groups(),cells_column_labels(everything()))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
for(j in 1:nrow(Tab_5.1)){
for(i in 3:ncol(Tab_5.1)){
gt_5.1 <- tab_style(gt_5.1,
style = list(cell_text(weight = "bold"),
cell_fill(color = heat_color[[j]][i-2])),
locations = cells_body(columns = i, rows = j))
}
}
gt_5.1
aba
### Overview YoY
aba{r}
heat_color <- list()
for(i in 1:nrow(Tab_5.2)){
heat_color[[i]] <- rbPal(100)[cut(as.numeric(Tab_5.2[i,-c(1:2)]),
breaks = 100)]
}
colnames(Tab_5.2) <- c("Type", "Items",
format(tail(mom_dt$Dates,ncol(Tab_5.2)-2), "%b/%y") )
gt_5.2 <- gt(Tab_5.2, groupname_col = "Type", rowname_col = "Items") %>%
# Title:
tab_style( style = list( cell_text(weight = "bold") ),
locations = cells_column_labels(everything()) ) %>%
tab_options(heading.align = "left", table.border.top.color = "white",
table.border.top.width = px(3)) %>%
# General options:
tab_options(
stub.border.width = px(0),
row_group.border.top.color = "black",
row_group.border.bottom.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(3:ncol(Tab_5.2),align = "right") %>%
cols_width(everything() ~ px(50)) %>%
cols_width(`Items` ~ px(200)) %>%
tab_style(style = cell_text(weight = "bold"), locations =
list(cells_row_groups(),cells_column_labels(everything()))) %>%
# Footnote:
tab_source_note(md("**Table**: ARX Macro | **Data**: BLS"))
for(j in 1:nrow(Tab_5.2)){
for(i in 3:ncol(Tab_5.2)){
gt_5.2 <- tab_style(gt_5.2,
style = list(cell_text(weight = "bold"),
cell_fill(color = heat_color[[j]][i-2])),
locations = cells_body(columns = i, rows = j))
}
}
gt_5.2
aba
### SAAR Composition
aba{r}
P_5.1
aba
### YoY Composition
aba{r}
P_5.2
aba
### SAAR Weighted Composition
aba{r}
P_5.3
aba
### YoY Weighted Composition
aba{r}
P_5.4
aba
### SAAR Historical averages
aba{r}
P_5.5
aba
### YoY Historical averages
aba{r}
P_5.6
aba
aba