Automating update of the Christiano, Motto and Rostagno (2014) database for the Euro Area

The aim of this post is to automatically update a database as the one used in Christiano et al. (2014), but for the Euro area, on the basis of the Smets and Wouters (2003) database.

Four financial series are originally used in Christiano et al. (2014) :

  • Loans to non-financial corporations
  • Bank lending rates
  • Entrepreneurial networth
  • Long-term interest rates

To those series we add 2 series :

  • House prices
  • Loans to households

The sources we use here are :

  • the Area-Wide Model (AWM), originally constructed by @Faga01
  • International Finance Statistics (IMF)
  • Bank of International Settlements
  • European Central Bank

We take data directly from DBnomics. The DBnomics API can be accessed through R thanks to the RSDMX package written by Blondel (2016). All the following code is written in R, thanks to the [@RCT16] and the RStudioTeam (2016).

Loans to non-financial corporations and to households

We download loans series from the Bank of International Settlements.

url_dbnomics <- "https://api.db.nomics.world/api/v1/sdmx"

# List of available countries in BIS data
EAtot_code <- c("DE", "FI", "FR", "IT", "PT", "AT", 
                "GR", "IE", "NL", "BE", "ES", "XM")
url_country <- paste0(EAtot_code, collapse = "+")
url <- paste0(url_dbnomics,"/BIS/data/CNFS/Q.",url_country,".N+H.A.M.XDC.A")

# N or H: Borrowing sector : NFC or Households
# A: Lending sector : All
# M: Valuation method : Market value
# XDC: Unit type: Domestic currency
# A: Adjustment : Adjustment for breaks

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

loans <- df   %>% 
  select(TIME_PERIOD, WIDUKIND_ID, OBS_VALUE, `BORROWERS-COUNTRY`, WIDUKIND_NAME) %>%
  rename(time = TIME_PERIOD,
         var = WIDUKIND_ID,
         values = OBS_VALUE,
         country = `BORROWERS-COUNTRY`) %>%
  mutate(time=as.Date(as.yearqtr(gsub("Q","",time))),
         values=ifelse(values=="",NA,values),
         values = as.numeric(values)) %>%
  na.omit() %>%
  filter(year(time)>=1980) %>%
  arrange(var, time)

loans_nfc <- loans %>% 
  filter(substr(var,6,6)=="N") %>% 
  mutate(var="loans_nfc")

varname_nfc <- unique(as.character(filter(loans_nfc,country == "XM")$WIDUKIND_NAME))
loans_nfc %<>% select(-WIDUKIND_NAME)

loans_hh <- loans %>% 
  filter(substr(var,6,6)=="H") %>% 
  mutate(var=as.factor("loans_hh"))

varname_hh <- unique(as.character(filter(loans_hh,country == "XM")$WIDUKIND_NAME))
loans_hh %<>% select(-WIDUKIND_NAME)

We can check the first date available for loans to non-financial corporations and to households (XM stands for Euro area).

loans_nfc %>% 
  group_by(country) %>% 
  summarize(firstdate = min(time)) %>% 
  arrange(firstdate) %>% 
  ungroup()
## # A tibble: 12 x 2
##    country  firstdate
##     <fctr>     <date>
##  1      DE 1980-01-01
##  2      FI 1980-01-01
##  3      FR 1980-01-01
##  4      IT 1980-01-01
##  5      PT 1980-01-01
##  6      BE 1980-10-01
##  7      ES 1980-10-01
##  8      NL 1990-10-01
##  9      GR 1994-10-01
## 10      AT 1995-10-01
## 11      XM 1997-10-01
## 12      IE 2002-01-01
loans_hh %>% 
  group_by(country) %>% 
  summarize(firstdate = min(time)) %>% 
  arrange(firstdate) %>% 
  ungroup()
## # A tibble: 12 x 2
##    country  firstdate
##     <fctr>     <date>
##  1      DE 1980-01-01
##  2      FI 1980-01-01
##  3      FR 1980-01-01
##  4      IT 1980-01-01
##  5      PT 1980-01-01
##  6      BE 1980-10-01
##  7      ES 1980-10-01
##  8      NL 1990-10-01
##  9      GR 1994-10-01
## 10      AT 1995-10-01
## 11      XM 1999-01-01
## 12      IE 2002-01-01

We decide to retain only countries which are available before 1990 to compute the aggregated series.

available_country <- filter(loans_nfc,time=="1990-10-01")$country

loans_nfc_countries <- 
  loans_nfc %>% 
  filter(country %in% available_country)
loans_nfc_EA <- 
  loans_nfc %>% 
  filter(country=="XM",
         time>="1999-01-01") %>% 
  mutate(country = "EA")

ggplot(bind_rows(loans_nfc_countries,loans_nfc_EA),aes(time,values))+
  geom_line(colour=blueObsMacro)+
  facet_wrap(~country,ncol=3,scales = "free_y")+
  theme + xlab(NULL) + ylab(NULL)+
  ggtitle("Loans to Non-Financial Corporations (billions of euro)")

plot of chunk unnamed-chunk-4

loans_hh_countries <- 
  loans_hh %>% 
  filter(country %in% available_country)
loans_hh_EA <- loans_hh %>% 
  filter(country=="XM") %>% 
  mutate(country = "EA")

ggplot(bind_rows(loans_hh_countries,loans_hh_EA),aes(time,values))+
  geom_line(colour=blueObsMacro)+
  facet_wrap(~country,ncol=3,scales = "free_y")+
  theme + xlab(NULL) + ylab(NULL)+
  ggtitle("Loans to Households and NPISHs (billions of euro)")

plot of chunk unnamed-chunk-4

Now we compare raw sum of countries, chained sum of countries and EA series

loans_nfc_countries %<>% 
  select(-var) %>% 
  mutate(var=country)
loans_nfc_sumAll <-
  loans_nfc_countries %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")
loans_nfc_sumNoNL <-
  loans_nfc_countries %>% 
  filter(! var == "NL") %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")
loans_nfc_sumNoNLESBE <-
  loans_nfc_countries %>% 
  filter(! var %in% c("NL","ES","BE")) %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")

loans_nfc_chainedNL <-
  chain(to_rebase = loans_nfc_sumNoNL, 
        basis = loans_nfc_sumAll, 
        date_chain = "1990-10-01")
loans_nfc_chained <-
  chain(to_rebase = loans_nfc_sumNoNLESBE, 
        basis = loans_nfc_chainedNL, 
        date_chain = "1980-10-01") %>% 
  mutate(var="chained")

loans_nfc_EA %<>% select(-country) %>% mutate(var="EA")

ggplot(bind_rows(loans_nfc_sumAll, loans_nfc_EA, loans_nfc_chained), aes(time, values,colour=var))+
  geom_line()+
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("Loans to Non-Financial Corporations (billions of euro) [1]")

plot of chunk unnamed-chunk-5

varname_nfc
## [1] "Quarterly - Euro area - Non-financial corporations - All sectors - Market value - Domestic currency (incl. conversion to current currency made using a fix parity) - Adjusted for breaks"
loans_hh_countries %<>% 
  select(-var) %>% 
  mutate(var=country)
loans_hh_sumAll <-
  loans_hh_countries %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")
loans_hh_sumNoNL <-
  loans_hh_countries %>% 
  filter(! var == "NL") %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")
loans_hh_sumNoNLESBE <-
  loans_hh_countries %>% 
  filter(! var %in% c("NL","ES","BE")) %>%
  group_by(time) %>% 
  summarize(values=sum(values)) %>% 
  mutate(var="sum")

loans_hh_chainedNL <-
  chain(to_rebase = loans_hh_sumNoNL, 
        basis = loans_hh_sumAll, 
        date_chain = "1990-10-01")
loans_hh_chained <-
  chain(to_rebase = loans_hh_sumNoNLESBE, 
        basis = loans_hh_chainedNL, 
        date_chain = "1980-10-01") %>% 
  mutate(var="chained")

loans_hh_EA %<>% select(-country) %>% mutate(var="EA")

ggplot(bind_rows(loans_hh_sumAll, loans_hh_EA, loans_hh_chained), aes(time, values,colour=var))+
  geom_line()+
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("Loans to Households and NPISHs (billions of euro) [1]")

plot of chunk unnamed-chunk-7

varname_hh
## [1] "Quarterly - Euro area - Households & NPISHs - All sectors - Market value - Domestic currency (incl. conversion to current currency made using a fix parity) - Adjusted for breaks"

Eventually, we use EA series in levels after 1999, and the growth rates of the sum of loans for available countries to complete the series for historical data.

loans_nfc <-
  chain(to_rebase = mutate(loans_nfc_chained,var="loans_nfc"),
        basis = mutate(loans_nfc_EA,var="loans_nfc"),
        date = "1999-01-01")

loans_hh <-
  chain(to_rebase = mutate(loans_hh_chained,var="loans_hh"),
        basis = mutate(loans_hh_EA,var="loans_hh"),
        date = "1999-01-01")

Bank lending rates

To build long series of lending rate, we use historical data from the International Finance Statistics of the IMF. Historical series will be used before 2000, because such series is available from ECB since 2000Q1. So we consider only countries among the first 12 Euro area members. Among them, four have very partial series. Eventually, we consider data only for : Belgium, Finland, France, Germany, Ireland, Italy, Netherlands and Spain. As in the methodology of AWM, we weigth the sum of the lending rates by the gross domestic product based on purchasing-power-parity (PPP) of each country in 1995, from the World Economic Outlook of the IMF.

# Download lending rates of the 8 countries from IFS
country_code <- c("BE","FR","DE","IT","NL","FI","IE","ES")
url_country <- paste0(country_code, collapse = "+")
url <- paste0(url_dbnomics,"/IMF/data/IFS/Q.",url_country,".FILR-PA")

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

lendingrate_bycountry <- df %>%
  select(`REF-AREA`,TIME_PERIOD, OBS_VALUE) %>% 
  rename(time = TIME_PERIOD,
         values = OBS_VALUE,
         country = `REF-AREA`) %>% 
  mutate(values = as.numeric(values),
         time=as.Date(as.yearqtr(gsub("Q","",time)))) %>%
  filter(year(time)>=1985)

# Download PPP GDP of the 8 countries from WEO
country_iso <- c("BEL","FRA", "DEU", "ITA", "NLD", "FIN", "IRL", "ESP")
url_country_iso <- paste0(country_iso, collapse = "+")
url <- paste0(url_dbnomics,"/IMF/data/WEO/PPPGDP.",url_country_iso,".5")

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

df_country <- data.frame(country_code,
                         country=country_iso)

pppgdp <- df %>%
  filter(TIME_PERIOD == 1995) %>% 
  select(`ISO`,OBS_VALUE) %>% 
  rename(country = `ISO`,
         values_pppgdp = OBS_VALUE) %>% 
  mutate(values_pppgdp = as.numeric(values_pppgdp)) %>% 
  left_join(df_country,by="country") %>% 
  select(-country) %>% 
  rename(country=country_code)
sum_pppgdp <- sum(pppgdp$values_pppgdp)

# Merge databases and build a weighted mean 
lendingrate_old <- 
  left_join(lendingrate_bycountry, pppgdp, by = "country") %>% 
  transmute(time = time,
            country = country,
            values = values * values_pppgdp) %>% 
  group_by(time) %>% 
  summarise(values = sum(values) / sum_pppgdp) %>% 
  mutate(var="lendingrate") %>% 
  filter(year(time)<=2002)
# Bank interest rates - loans to corporations (new business) - euro area Euro area (changing composition), Annualised agreed rate (AAR) / Narrowly defined effective rate (NDER), Credit and other institutions (MFI except MMFs and central banks) reporting sector - Loans other than revolving loans and overdrafts, convenience and extended credit card debt [A20-A2Z], Total initial rate fixation, Total amount, New business coverage, Non-Financial corporations (S.11) sector, denominated in Euro

url_series <- "/ECB/data/MIR/M.U2.B.A2A.A.R.A.2240.EUR.N"
url <- paste0(url_dbnomics, url_series)

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

varname <- unique(as.character(df$WIDUKIND_NAME))

lendingrate_recent <- df %>%
  mutate(year = substr(TIME_PERIOD,1,4),
         month = substr(TIME_PERIOD,6,7),
         time= as.Date(as.yearqtr(paste0(year,"-",month,"-","01"),format="%Y-%m-%d"))) %>%
  select(time, OBS_VALUE) %>%
  rename(values= OBS_VALUE) %>%
  mutate(values= as.numeric(values)) %>% 
  group_by(time) %>% 
  summarize(values=mean(values)) %>%
  mutate(var= "lendingrate")

dataplot <- bind_rows(data.frame(lendingrate_recent,ind="recent"),
                      data.frame(lendingrate_old,ind="old"))

ggplot(dataplot,aes(time,values, colour=ind)) + 
  geom_line() +
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("Bank lending rate (%)")

plot of chunk unnamed-chunk-11

lendingrate <- chain(basis = lendingrate_recent,
                     to_rebase = lendingrate_old,
                     date_chain = "2000-01-01")

More precisely, the recent bank lending rates come from the ECB and are described as

varname
## [1] "Euro area (changing composition), Annualised agreed rate (AAR) / Narrowly defined effective rate (NDER), Credit and other institutions (MFI except MMFs and central banks) reporting sector - Loans other than revolving loans and overdrafts, convenience and extended credit card debt, Total initial rate fixation, Total amount, New business coverage, Non-Financial corporations (S.11) sector, denominated in Euro"

Long-term interest rates

The historical long-term interest rates come from the AWM database. The recent are taken from the ECB.

link_to_awm <- "http://www.eabcn.org/sites/default/files/awm19up15.csv"

if (! "awm19up15.csv" %in% list.files()) {
  download.file(link_to_awm,
                destfile = "awm19up15.csv",
                method = "auto")
}

awm <- read.csv("awm19up15.csv", sep=",")
longrate_old <-
  awm %>% 
  transmute(longrate = LTN, # Long-Term Interest Rate (Nominal)
            time = as.Date(as.yearqtr(X))) %>%
  gather(var, values, -time, convert = TRUE) %>% 
  filter(year(time)>=1980)

# Long term interest rate Euro area 19 (fixed composition), Long-term interest rate for convergence purposes - Unspecified rate type, Debt security issued, 10 years maturity, New business coverage, denominated in Euro - Unspecified counterpart sector

url_series <- "/ECB/data/IRS/M.I8.L.L40.CI.0000.EUR.N.Z"
url <- paste0(url_dbnomics, url_series)

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

varname <- unique(as.character(df$WIDUKIND_NAME))

longrate_recent <- df %>%
  mutate(year = substr(TIME_PERIOD,1,4),
         month = substr(TIME_PERIOD,6,7),
         time= as.Date(as.yearqtr(paste0(year,"-",month,"-","01"),format="%Y-%m-%d"))) %>%
  select(time, OBS_VALUE) %>%
  rename(values= OBS_VALUE) %>%
  mutate(values= as.numeric(values)) %>% 
  select(values, time) %>% 
  group_by(time) %>% 
  summarize(values=mean(values)) %>%
  mutate(var= "longrate")

dataplot <- bind_rows(data.frame(longrate_recent,ind="recent"),
                      data.frame(longrate_old,ind="old"))

ggplot(dataplot,aes(time,values, colour=ind)) + 
  geom_line() +
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("Long-term interest rate (%)")

plot of chunk unnamed-chunk-13

longrate <- chain(basis = longrate_recent,
                  to_rebase = longrate_old,
                  date_chain = "2001-01-01")

More precisely, the recent long-term interest rates come from the ECB and are described as

varname
## [1] "Euro area 19 (fixed composition) as of 1 January 2015, Long-term interest rate for convergence purposes - Unspecified rate type, Debt security issued, 10 years maturity, New business coverage, denominated in Euro - Unspecified counterpart sector"

Entrepreunarial networth

The entrepreunarial networth is approximated through the Dow Jones index for the Euro area, in a similar spirit of what is chosen by Christiano et al. (2014) in the US database.

# Dow Jones euro Euro area (changing composition) - Equity/index - Dow Jones Euro Stoxx Price Index - Historical close, average of observations through period - Euro

url_series <- "/ECB/data/FM/Q.U2.EUR.DS.EI.DJEURST.HSTA"
url <- paste0(url_dbnomics, url_series)

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

varname <- unique(as.character(df$WIDUKIND_NAME))

networth <- df %>%
  select(OBS_VALUE, TIME_PERIOD) %>%
  rename(time= TIME_PERIOD,
         values= OBS_VALUE) %>%
  mutate(time=as.Date(as.yearqtr(gsub("Q","",time))),
         values= as.numeric(values),
         var = as.factor("networth"))

ggplot(networth,aes(time,values)) + 
  geom_line(colour=blueObsMacro) +
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("Entrepreunarial networth (index)")

plot of chunk unnamed-chunk-15

More precisely, the index come from the ECB and is desdcribed as

varname
## [1] "Euro area (changing composition) - Equity/index - Dow Jones Euro Stoxx Price Index - Historical close, average of observations through period - Euro, provided by DataStream"

House prices

# House price Euro area 19 (fixed composition); Residential property prices, New and existing dwellings; Residential property in good and poor condition; Whole country; Neither  seasonally nor working day adjusted; ECB

url_series <- "/ECB/data/RPP/Q.I8.N.TD.00.3.00"
url <- paste0(url_dbnomics, url_series)

data_sdmx <- readSDMX(url)
df <- as_tibble(data_sdmx)

varname <- unique(as.character(df$WIDUKIND_NAME))

houseprice<- df %>%
  select(OBS_VALUE, TIME_PERIOD) %>%
  rename(time= TIME_PERIOD,
         values= OBS_VALUE) %>%
  mutate(time=as.Date(as.yearqtr(gsub("Q","",time))),
         values= as.numeric(values),
         var = as.factor("houseprice"))

ggplot(houseprice,aes(time,values)) + 
  geom_line(colour=blueObsMacro) +
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(legend.title=element_blank()) +
  ggtitle("House price (index)")

plot of chunk unnamed-chunk-17

More precisely, house prices come from the BIS and are desdcribed as

varname
## [1] "Euro area 19 (fixed composition); Residential property prices, New and existing dwellings; Residential property in good and poor condition; Whole country; Neither seasonally nor working day adjusted; ECB"

Final finance database for the Euro area

We build the final finance database with the 6 series described before.

EA_Finance_data <- bind_rows(loans_nfc,
                             loans_hh,
                             lendingrate,
                             longrate,
                             networth,
                             houseprice)
EA_Finance_data %<>%
  mutate(time=gsub(" ", "", as.yearqtr(time)))

We can check the last date available for each variable.

maxDate <- EA_Finance_data %>% 
  group_by(var) %>% 
  summarize(maxdate=max(time)) %>% 
  arrange(maxdate)
maxDate
## # A tibble: 6 x 2
##           var maxdate
##         <chr>   <chr>
## 1    loans_hh  2016Q4
## 2   loans_nfc  2016Q4
## 3  houseprice  2017Q1
## 4 lendingrate  2017Q2
## 5    networth  2017Q2
## 6    longrate  2017Q3
minmaxDateFinance <- min(as.yearqtr(maxDate$maxdate))
EA_Finance_data %<>% 
  filter(time <= minmaxDateFinance)

So we filter the database until 2016 Q4.

plot_df <- EA_Finance_data %>%
  mutate(time = as.Date(as.yearqtr(time)))
listVar <- list("Loans to NFC" = "loans_nfc",
                "Loans to households" = "loans_hh",
                "Bank lending rate" = "lendingrate",
                "Entrepreneurial networth" = "networth",
                "Long-term interest rate" = "longrate",
                "House price" = "houseprice")

plot_df$var <- factor(plot_df$var)
levels(plot_df$var)<-listVar

ggplot(plot_df,aes(time,values))+
  geom_line(colour=blueObsMacro)+
  facet_wrap(~var,scales = "free_y",ncol = 3)+
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL) +
  theme(strip.text=element_text(size=12),
        axis.text=element_text(size=7))

plot of chunk unnamed-chunk-22

You can download the 6 finance series directly as csv here

EA_Finance_rawdata <-
  EA_Finance_data %>% 
  spread(key = var, value = values)

EA_Finance_rawdata %>% 
  write.csv("EA_Finance_rawdata.csv", row.names=FALSE)

Final CMR database for the Euro area

We want to build eventually a database similar to the Christiano et al. (2014) database, but for the Euro area, on the basis of the Smets and Wouters (2003) database. The database will begin in 1980Q1, as the financial series are not available before. You can download all the raw series here.

#File EA_SW_rawdata.csv is created via EA_SW_data.Rmd, which can be found on obsmacro under sw03-data

# Import EA_SW_rawadata.csv in wide format
EA_SW_rawdata <- 
  read.csv("http://shiny.nomics.world/data/EA_SW_rawdata.csv") %>% 
  mutate(time = gsub(" ","",as.yearqtr(time)))

minmaxDateRaw <- max(as.yearqtr(EA_SW_rawdata$time))

# Transform EA_SW_rawdata in long format to bind with EA_Finance_data
EA_CMR_rawdata <- 
  EA_SW_rawdata %>%
  gather(var, values, -time) %>%
  bind_rows(EA_Finance_data) %>%
  filter(time <= min(minmaxDateRaw,minmaxDateFinance),
         time >= "1980Q1") %>%
  spread(key = var, value = values) 

EA_CMR_rawdata %>% 
  write.csv("EA_CMR_rawdata.csv", row.names=FALSE)

Then data are normalized by capita and price if needed. Eventually we have 14 series : the 12 series similar to Christiano et al. (2014) plus loans to households and house price series.

EA_CMR_data <-
  EA_CMR_rawdata %>%
  transmute(time=time,
            gdp_rpc=1e+6*gdp/(pop*1000),
            conso_rpc=1e+6*conso/(pop*1000),
            inves_rpc=1e+6*inves/(pop*1000),
            defgdp = defgdp,
            wage_rph=1e+6*wage/defgdp/(hours*1000),
            hours_pc=1000*hours/(pop*1000),
            pinves_defl=definves/defgdp,
            loans_nfc_rpc=1e+9*loans_nfc/(pop*1000)/defgdp,
            loans_hh_rpc=1e+9*loans_hh/(pop*1000)/defgdp,
            houseprice_defl=houseprice/defgdp,
            networth_rpc=1e+6*networth/(pop*1000)/defgdp,
            re=shortrate/100,
            slope=(longrate - shortrate)/100,
            creditspread = (lendingrate - shortrate)/100) 

EA_CMR_data %>% 
  na.omit() %>%
  write.csv("EA_CMR_data.csv", row.names=FALSE)
plot_EA_CMR_data <- EA_CMR_data %>% 
  gather(var, values, - time)
plot_EA_CMR_data$time <- as.Date(as.yearqtr(plot_EA_CMR_data$time))
plot_EA_CMR_data$var <- as.factor(plot_EA_CMR_data$var)
levels(plot_EA_CMR_data$var)<-listVar

p <- ggplot(plot_EA_CMR_data,aes(time,values))+
  geom_line(colour=blueObsMacro)+
  facet_wrap(~var,ncol=3,scales = "free_y")+
  scale_x_date(expand = c(0.01,0.01)) +
  theme + xlab(NULL) + ylab(NULL)+
  theme(strip.text=element_text(size=10),
        axis.text=element_text(size=9))+
  ggtitle("CMR data for the Euro area")
p

plot of chunk unnamed-chunk-27

You can also download ready-to-use (normalized) data for the estimation on Dynare here.

Appendix

Chaining function

To chain two datasets, we build a chain function whose input must be two dataframes with three standard columns (time, var, values). It returns a dataframe composed of chained values, ie the dataframe “to rebase” will be chained on the “basis” dataframe.

More specifically, the function : compute the growth rates from values in the dataframe of the 1st argument multiply it with the value of reference chosen in values in the dataframe of the 2nd argument * at the date specified in the 3rd argument.

chain <- function(to_rebase, basis, date_chain) {

  date_chain <- as.Date(date_chain, "%Y-%m-%d")

  valref <- basis %>%
    filter(time == date_chain) %>%
    transmute(var, values_ref = values) 

  res <- to_rebase %>%
    filter(time <= date_chain) %>%
    arrange(desc(time)) %>%
    group_by(var) %>%
    mutate(growth_rate = c(1, values[-1]/lag(values)[-1])) %>%
    full_join(valref, by = "var") %>%
    group_by(var) %>%
    transmute(time, values = cumprod(growth_rate)*values_ref) %>%
    ungroup()

  res %<>%  
    bind_rows(filter(basis, time > date_chain)) %>% 
    arrange(time)

  return(res)

}

Bibliography

Emmanuel Blondel. rsdmx: Tools for Reading SDMX Data and Metadata. 2016. R package version 0.5-3. URL: https://CRAN.R-project.org/package=rsdmx.

L Christiano, Roberto Motto, and Massimo Rostagno. Risk shocks. American Economic Review, 104(1):27–65, 2014. URL: http://www.aeaweb.org/articles.php?doi=10.1257/aer.104.1.27, doi:10.1257/aer.104.1.27. 1 2 3 4 5

F. Smets and R. Wouters. An estimated dynamic stochastic general equilibrium model of the euro area. Journal of the European Economic Association, 2003. 1 2

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

Comments

comments powered by Disqus