Reproduce economic indicators from ‘The Economist’

[This article was first published on Macroeconomic Observatory - R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Economic data (% change on year ago)
Gross domestic product
Industrial production
Consumer prices
Unemployment rate, %
latest quarter* 2019 2020 latest latest 2019 latest
United States +2.1 Q3 +2.1 +2.4 +2.1 -1.1 Oct +1.8 Oct +1.8 +3.6 Oct
China +0.1 Q3 +0.2 +6.1 +5.8 +5.4 Nov +3.8 Oct +2.3 +3.6 Q3
Japan +1.4 Q3 +0.2 +0.9 +0.5 -6.0 Oct +0.2 Oct +1.0 +2.4 Oct
Britain +1.0 Q3 +1.2 +1.2 +1.4 -1.4 Sep +1.5 Oct +1.8 +3.8 Aug
Canada +1.7 Q3 +1.3 +1.5 +1.8 -1.8 Sep +1.9 Oct +2.0 +5.5 Oct
Euro area +1.2 Q3 +0.9 +1.2 +1.4 -1.9 Sep +0.7 Oct +1.2 +7.5 Oct
Austria +1.5 Q3 +0.5 +1.6 +1.7 +0.3 Aug +1.1 Oct +1.5 +4.6 Oct
Belgium +1.6 Q3 +1.7 +1.2 +1.3 +6.0 Sep +0.4 Nov +1.5 +5.6 Oct
France +1.4 Q3 +1.1 +1.2 +1.3 +0.1 Sep +0.8 Oct +1.2 +8.5 Oct
Germany +0.5 Q3 +0.3 +0.5 +1.2 -5.1 Sep +1.1 Oct +1.5 +3.1 Oct
Greece +1.9 Q2 +3.4 +2.0 +2.2 +0.8 Sep -0.7 Oct +0.6 +16.7 Aug
Italy +0.3 Q3 +0.2 +0.0 +0.5 -2.1 Sep +0.2 Oct +0.7 +9.7 Oct
Netherlands +1.8 Q3 +1.8 +1.8 +1.6 +0.3 Sep +2.7 Oct +2.5 +3.5 Oct
Spain +2.0 Q3 +1.7 +2.2 +1.8 +0.8 Sep +0.1 Oct +0.7 +14.2 Oct
Czech Republic +2.5 Q3 +1.5 +2.5 +2.6 +0.1 Aug +2.7 Oct +2.6 +2.2 Oct
Denmark +2.2 Q3 +1.3 +1.7 +1.9 +4.2 Sep +0.6 Oct +1.3 +5.3 Oct
Norway +0.6 Q3 +0.1 +1.9 +2.4 -8.0 Sep +1.8 Oct +2.3 +3.9 Sep
Poland +4.0 Q3 +5.3 +4.0 +3.1 +3.5 Oct +2.5 Oct +2.4 +3.2 Oct
Russia +0.8 Q2 +0.6 +1.1 +1.9 +2.6 Sep +3.8 Oct +4.7 +4.6 Q3
Sweden +1.7 Q3 +1.1 +0.9 +1.5 +1.6 Sep +1.6 Oct +1.7 +6.6 Oct
Switzerland +1.0 Q3 +1.6 +0.8 +1.3 +5.4 Q4 -0.3 Oct +0.6 +2.4 May
Turkey +0.5 Q3 +1.7 +0.2 +3.0 +2.8 Sep +8.6 Oct +15.7 +14.2 Aug
Australia +1.7 Q3 +1.8 +1.7 +2.3 +2.7 Q3 +1.7 Q3 +1.6 +5.3 Oct
Hong Kong +0.5 Q2 -1.7 +0.3 +1.5 +0.4 Q2 +3.3 Sep +3.0 +2.8 Q1
India +4.7 Q3 +4.3 +6.1 +7.0 +2.6 Dec +7.6 Oct +3.4 +2.6 Year
Indonesia +5.1 Q3 +5.0 +5.0 +5.1 -3.7 Apr +3.0 Nov +3.2 +4.6 Q3
Malaysia +4.7 Q4 +14.7 +4.5 +4.4 +3.1 Mar +1.5 Aug +1.0 +3.3 Q1
Pakistan +5.5 Year NA +3.3 +2.4 -7.0 Aug +8.2 Feb +7.3 +4.4 Q2
Philippines +6.1 Q4 +6.4 +5.7 +6.2 -8.2 Jul +3.3 Mar +2.5 +2.2 Q4
Singapore +3.9 Q2 +7.8 +0.5 +1.0 +0.1 Sep +0.4 Oct +0.7 +3.0 Q1
South Korea +2.0 Q3 +1.6 +2.0 +2.2 -2.6 Oct -0.4 Sep +0.5 +3.5 Oct
Taiwan +2.9 Q3 NA +2.0 +1.9 NA +0.4 Q3 +0.8 +3.7 Q2
Thailand +2.3 Q2 +2.4 +2.9 +3.0 -1.2 Q1 +0.1 Oct +0.9 +0.7 Q4
Argentina -0.0 Q2 -0.0 -3.1 -1.3 +4.4 Q3§ +50.5 Oct +54.4 +9.8 Q1
Brazil +1.2 Q3 +2.5 +0.9 +2.0 +0.6 Sep +2.5 Oct +3.8 +8.0 Nov
Chile +2.8 Q3 +3.0 +2.5 +3.0 -3.7 Oct +2.7 Oct +2.2 +6.9 Aug
Colombia +3.3 Q3 +2.3 +3.4 +3.6 -1.1 Dec +3.9 Oct +3.6 +10.7 Sep
Mexico -0.2 Q3 +0.1 +0.4 +1.3 -2.9 Jun +3.0 Oct +3.8 +3.6 Oct
Peru +2.1 Q1§ -16.9 +2.6 +3.6 +20.3 Apr +2.2 Mar +2.2 +6.2 Q2
Egypt +5.3 Year NA +5.5 +5.9 +6.2 Mar +15.7 Nov +13.9 +11.8 Q4§
Israel +3.3 Q3 +4.1 +3.1 +3.1 +4.4 Sep +0.4 Oct +1.0 +3.7 Sep
Saudi Arabia +0.5 Q2 -10.4 +0.2 +2.2 +1.6 Q3§ -0.3 Oct -1.1 +6.0 Year
South Africa +1.0 Q2 +3.1 +0.7 +1.1 +1.3 Aug +3.7 Oct +4.4 +28.8 Q3
Source: DBnomics (Eurostat, ILO, IMF, OECD and national sources). Click on the figures in the `latest` columns to see the full time series.
* % change on previous quarter, annual rate IMF estimation/forecast 2018 § 2017

The aim of this blog post is to reproduce part of the economic indicators table from ‘The Economist’ using only free tools. We take data directly from DBnomics. The DBnomics API can be accessed through R with the rdbnomics package. All the following code is written in R, thanks to the RCoreTeam (2016) and the RStudioTeam (2016). To update the table, just download the code here and re-run it.

if (!"pacman" %in% installed.packages()[,"Package"]) install.packages("pacman", repos='http://cran.r-project.org')
pacman::p_load(tidyverse,rdbnomics,magrittr,zoo,lubridate,knitr,kableExtra,formattable)

opts_chunk$set(fig.align="center", message=FALSE, warning=FALSE)

currentyear <- year(Sys.Date())
lastyear <- currentyear-1
beforelastyear <- currentyear-2
CountryList <- c("United States","China","Japan","Britain","Canada",
                 "Euro area","Austria","Belgium","France","Germany","Greece","Italy","Netherlands","Spain",
                 "Czech Republic","Denmark","Norway","Poland","Russia","Sweden","Switzerland","Turkey",
                 "Australia","Hong Kong","India","Indonesia","Malaysia","Pakistan","Philippines","Singapore","South Korea","Taiwan","Thailand",
                 "Argentina","Brazil","Chile","Colombia","Mexico","Peru",
                 "Egypt","Israel","Saudi Arabia","South Africa")

Download

gdp <- rdb("OECD","MEI",ids=".NAEXKP01.GPSA+GYSA.Q")
hongkong_philippines_thailand_gdp <- 
  rdb("IMF","IFS",mask="Q.HK+PH+TH.NGDP_R_PC_CP_A_SA_PT+NGDP_R_PC_PP_SA_PT") %>% 
  rename(Country=`Reference Area`) %>% 
  mutate(Country=case_when(Country=="Hong Kong, China" ~ "Hong Kong",
                           TRUE ~ Country),
         MEASURE=case_when(INDICATOR=="NGDP_R_PC_CP_A_SA_PT" ~ "GYSA",
                           INDICATOR=="NGDP_R_PC_PP_SA_PT" ~ "GPSA"))
malaysia_peru_saudi_singapore_gdp <- 
  rdb("IMF","IFS",mask="Q.MY+PE+SA+SG.NGDP_R_PC_CP_A_PT+NGDP_R_PC_PP_PT") %>% 
  rename(Country=`Reference Area`) %>% 
  mutate(MEASURE=case_when(INDICATOR=="NGDP_R_PC_CP_A_PT" ~ "GYSA",
                           INDICATOR=="NGDP_R_PC_PP_PT" ~ "GPSA"))
taiwan_gdp <- 
  rdb("BI/TABEL9_1/17.Q") %>% 
  mutate(Country="Taiwan",
         MEASURE="GYSA")
egypt_pakistan_gdp <-
  rdb("IMF","WEO",mask="EGY+PAK.NGDP_RPCH") %>% 
  rename(Country=`WEO Country`) %>% 
  mutate(MEASURE="GYSA") %>% 
  filter(year(period)<currentyear)
china_gdp_level <- 
  rdb(ids="OECD/MEI/CHN.NAEXCP01.STSA.Q")
gdp_qoq_china <-
  china_gdp_level %>% 
  arrange(period) %>% 
  mutate(value=value/lag(value)-1,
         MEASURE="GPSA")
gdp_yoy_china <-
  china_gdp_level %>% 
  arrange(period) %>% 
  mutate(quarter=quarter(period)) %>% 
  group_by(quarter) %>% 
  mutate(value=value/lag(value)-1,
         MEASURE="GYSA")
argentina_gdp_level <-
  rdb(ids="Eurostat/naidq_10_gdp/Q.SCA.KP_I10.B1GQ.AR") %>% 
  rename(Country=`Geopolitical entity (reporting)`)
gdp_qoq_argentina <-
  argentina_gdp_level %>% 
  arrange(period) %>% 
  mutate(value=value/lag(value)-1,
         MEASURE="GPSA")
gdp_yoy_argentina <-
  argentina_gdp_level %>% 
  arrange(period) %>% 
  mutate(quarter=quarter(period)) %>% 
  group_by(quarter) %>% 
  mutate(value=value/lag(value)-1,
         MEASURE="GYSA")
gdp <- bind_rows(gdp,hongkong_philippines_thailand_gdp,malaysia_peru_saudi_singapore_gdp,taiwan_gdp,egypt_pakistan_gdp,gdp_yoy_china,gdp_qoq_china,gdp_yoy_argentina,gdp_qoq_argentina)

indprod <- rdb("OECD","MEI",ids=".PRINTO01.GYSA.M")
australia_swiss_indprod <- rdb("OECD","MEI","AUS+CHE.PRINTO01.GYSA.Q")
china_egypt_mexico_malaysia_indprod <-
  rdb("IMF","IFS",mask="M.CN+EG+MX+MY.AIP_PC_CP_A_PT") %>% 
  rename(Country=`Reference Area`)
indonesia_pakistan_peru_philippines_singapore_southafrica_indprod <-
  rdb("IMF","IFS",mask="M.ID+PK+PE+PH+SG+ZA.AIPMA_PC_CP_A_PT") %>% 
  rename(Country=`Reference Area`)
argentina_hongkong_saudiarabia_thailand_indprod <- 
  rdb("IMF","IFS",mask="Q.AR+HK+SA+TH.AIPMA_PC_CP_A_PT") %>% 
  rename(Country=`Reference Area`) %>% 
  mutate(Country=case_when(Country=="Hong Kong, China" ~ "Hong Kong",
                           TRUE ~ Country))
indprod <- bind_rows(indprod,australia_swiss_indprod,china_egypt_mexico_malaysia_indprod,indonesia_pakistan_peru_philippines_singapore_southafrica_indprod,argentina_hongkong_saudiarabia_thailand_indprod)

cpi <- rdb("OECD","MEI",ids=".CPALTT01.GY.M")
australia_cpi <- rdb("OECD","MEI",ids="AUS.CPALTT01.GY.Q")
taiwan_cpi <- 
  rdb("BI/TABEL9_2/17.Q") %>% 
  mutate(Country="Taiwan")
other_cpi <- 
  rdb("IMF","IFS",mask="M.EG+HK+MY+PE+PH+PK+SG+TH.PCPI_PC_CP_A_PT") %>% 
  rename(Country=`Reference Area`) %>% 
  mutate(Country=case_when(Country=="Hong Kong, China" ~ "Hong Kong",
                           TRUE ~ Country))
cpi <- bind_rows(cpi,australia_cpi,taiwan_cpi,other_cpi)

unemp <- rdb("OECD","MEI",ids=".LRHUTTTT.STSA.M")
swiss_unemp <- rdb("OECD","MEI",mask="CHE.LMUNRRTT.STSA.M")
brazil_unemp <- rdb("OECD","MEI",mask="BRA.LRUNTTTT.STSA.M")
southafrica_russia_unemp <- rdb("OECD","MEI",mask="ZAF+RUS.LRUNTTTT.STSA.Q")
china_unemp <- 
  rdb(ids="BUBA/BBXL3/Q.CN.N.UNEH.TOTAL0.NAT.URAR.RAT.I00") %>% 
  mutate(Country="China")
saudiarabia_unemp <-
  rdb(ids="ILO/UNE_DEAP_SEX_AGE_RT/SAU.BA_627.AGE_AGGREGATE_TOTAL.SEX_T.A") %>%
  rename(Country=`Reference area`) %>%
  filter(year(period)<currentyear)
india_unemp <-
  rdb(ids="ILO/UNE_2EAP_NOC_RT/IND.XA_1976.A") %>%
  rename(Country=`Reference area`) %>%
  filter(year(period)<currentyear)
indonesia_pakistan_unemp <-
  rdb("ILO","UNE_DEAP_SEX_AGE_EDU_RT",mask="IDN+PAK..AGE_AGGREGATE_TOTAL.EDU_AGGREGATE_TOTAL.SEX_T.Q") %>% 
  rename(Country=`Reference area`)
other_unemp <-
  rdb("ILO","UNE_DEA1_SEX_AGE_RT",mask="ARG+EGY+HKG+MYS+PER+PHL+SGP+THA+TWN..AGE_YTHADULT_YGE15.SEX_T.Q") %>%
  rename(Country=`Reference area`) %>%
  mutate(Country=case_when(Country=="Hong Kong, China" ~ "Hong Kong",
                           Country=="Taiwan, China" ~ "Taiwan",
                           TRUE ~ Country))
unemp <- bind_rows(unemp,brazil_unemp,southafrica_russia_unemp,swiss_unemp,china_unemp,saudiarabia_unemp,india_unemp,indonesia_pakistan_unemp,other_unemp)

forecast_gdp_cpi_ea <- 
  rdb("IMF","WEOAGG",mask="163.NGDP_RPCH+PCPIPCH") %>% 
  rename(`WEO Country`=`WEO Countries group`)
forecast_gdp_cpi <- 
  rdb("IMF","WEO",mask=".NGDP_RPCH+PCPIPCH") %>% 
  bind_rows(forecast_gdp_cpi_ea) %>% 
  transmute(Country=`WEO Country`,
            var=`WEO Subject`,
            value,
            period) %>% 
  mutate(Country=str_trim(Country),
         var=str_trim(var)) %>% 
  mutate(Country=case_when(Country=="United Kingdom" ~ "Britain",
                           Country=="Hong Kong SAR" ~ "Hong Kong",
                           Country=="Korea" ~ "South Korea",
                           Country=="Taiwan Province of China" ~ "Taiwan",
                           TRUE ~ Country),
         var=case_when(var=="Gross domestic product, constant prices - Percent change" ~ "GDP",
                       var=="Inflation, average consumer prices - Percent change" ~ "CPI",
                       TRUE ~ var))
forecast_gdp_cpi <- left_join(data.frame(Country=CountryList),forecast_gdp_cpi,by="Country")

Transform

gdp_yoy_latest_period <-
  gdp %>% 
  filter(MEASURE=="GYSA") %>% 
  filter(!is.na(value)) %>% 
  group_by(Country) %>% 
  summarise(period=max(period))
gdp_yoy_latest <-
  gdp %>% 
  filter(MEASURE=="GYSA") %>% 
  inner_join(gdp_yoy_latest_period) %>% 
  mutate(var="GDP",measure="latest")

gdp_qoq_latest_period <-
  gdp %>% 
  filter(MEASURE=="GPSA") %>% 
  filter(!is.na(value)) %>% 
  group_by(Country) %>% 
  summarise(period=max(period))
gdp_qoq_latest <-
  gdp %>% 
  filter(MEASURE=="GPSA") %>% 
  inner_join(gdp_qoq_latest_period) %>% 
  mutate(value=((1+value/100)^4-1)*100,
         var="GDP",
         measure="quarter")

gdp_2019_2020 <-
  forecast_gdp_cpi %>% 
  filter(var=="GDP" & (period=="2019-01-01" | period=="2020-01-01")) %>% 
  mutate(measure=as.character(year(period)))

indprod_latest_period <-
  indprod %>% 
  filter(!is.na(value)) %>% 
  group_by(Country) %>% 
  summarise(period=max(period))
indprod_latest <-
  indprod %>% 
  inner_join(indprod_latest_period) %>% 
  mutate(var="indprod",measure="latest")

cpi_latest_period <-
  cpi %>% 
  filter(!is.na(value)) %>% 
  group_by(Country) %>% 
  summarise(period=max(period))
cpi_latest <-
  cpi %>% 
  inner_join(cpi_latest_period) %>% 
  mutate(var="CPI",measure="latest")

cpi_2019 <-
  forecast_gdp_cpi %>% 
  filter(var=="CPI" & period=="2019-01-01") %>% 
  mutate(measure="2019")

unemp_latest_period <-
  unemp %>% 
  filter(!is.na(value)) %>% 
  group_by(Country) %>% 
  summarise(period=max(period))
unemp_latest <- 
  unemp %>% 
  inner_join(unemp_latest_period) %>% 
  mutate(var="unemp",measure="latest")

Merge

df_all <- 
  bind_rows(gdp_yoy_latest,gdp_qoq_latest,gdp_2019_2020,indprod_latest,cpi_latest,cpi_2019,unemp_latest) %>% 
  mutate(value=ifelse(value>=0,
                      paste0("+",sprintf("%.1f",round(value,1))),
                      sprintf("%.1f",round(value,1)))) %>% 
  unite(measure,c(var,measure))

df_latest <- 
  df_all %>% 
  filter(measure %in% c("GDP_latest","indprod_latest","CPI_latest","unemp_latest")) %>% 
  mutate(value=case_when(`@frequency`=="quarterly" ~ paste(value," Q",quarter(period),sep=""),
                         `@frequency`=="monthly" ~ paste(value," ",month(period,label = TRUE, abbr = TRUE, locale = "en_US.utf8"),sep=""),
                         `@frequency`=="annual" ~ paste(value," Year",sep=""),
                         TRUE ~ value)) %>% 
  mutate(value=text_spec(ifelse(year(period)==lastyear,paste0(value,footnote_marker_symbol(3)),
                                ifelse(year(period)==beforelastyear,paste0(value,footnote_marker_symbol(4)),value)),
                         link = paste("https://db.nomics.world",provider_code,dataset_code,series_code,sep = "/"), 
                         color = "#333333",escape = F,extra_css="text-decoration:none"))

df_final <- 
  df_all %>% 
  filter(measure %in% c("GDP_quarter","GDP_2019","GDP_2020","CPI_2019")) %>% 
  bind_rows(df_latest) %>% 
  mutate(Country=case_when(Country=="United Kingdom" ~ "Britain",
                           Country=="Euro area (19 countries)" ~ "Euro area",
                           Country=="China (People's Republic of)" ~ "China",
                           Country=="Korea" ~ "South Korea",
                           TRUE ~ Country)) %>% 
  select(Country,value,measure) %>% 
  spread(measure,value) %>% 
  select(Country,GDP_latest,GDP_quarter,GDP_2019,GDP_2020,indprod_latest,CPI_latest,CPI_2019,unemp_latest)

df_final <- left_join(data.frame(Country=CountryList),df_final,by="Country")

Display

names(df_final)[1] <- ""
names(df_final)[2] <- "latest"
names(df_final)[3] <- paste0("quarter",footnote_marker_symbol(1))
names(df_final)[4] <- paste0("2019",footnote_marker_symbol(2))
names(df_final)[5] <- paste0("2020",footnote_marker_symbol(2))
names(df_final)[6] <- "latest"
names(df_final)[7] <- "latest"
names(df_final)[8] <- paste0("2019",footnote_marker_symbol(2))
names(df_final)[9] <- "latest"

df_final %>% 
  kable(row.names = F,escape = F,align = c("l",rep("c",8)),caption = "Economic data (% change on year ago)") %>% 
  kable_styling(bootstrap_options = c("striped", "hover","responsive"), fixed_thead = T, font_size = 13) %>% 
  add_header_above(c(" " = 1, "Gross domestic product" = 4, "Industrial production  " = 1, "Consumer prices"= 2, "Unemployment rate, %"=1)) %>% 
  column_spec(1, bold = T) %>% 
  row_spec(seq(1,nrow(df_final),by=2), background = "#D5E4EB") %>% 
  row_spec(c(5,14,22,33,39),extra_css = "border-bottom: 1.2px solid") %>% 
  footnote(general = "DBnomics (Eurostat, ILO, IMF, OECD and national sources). Click on the figures in the `latest` columns to see the full time series.",
           general_title = "Source: ",
           footnote_as_chunk = T,
           symbol = c("% change on previous quarter, annual rate ", "IMF estimation/forecast", paste0(lastyear),paste0(beforelastyear)))

Bibliography

R Core Team.
R: A Language and Environment for Statistical Computing.
R Foundation for Statistical Computing, Vienna, Austria, 2016.
URL: https://www.R-project.org.

RStudio Team.
RStudio: Integrated Development Environment for R.
RStudio, Inc., Boston, MA, 2016.
URL: http://www.rstudio.com/.

To leave a comment for the author, please follow the link and comment on their blog: Macroeconomic Observatory - R.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)