Correlation beetwen WIG index and other assets

If any issues, questions or suggestions feel free to reach me out via e-mail wieczynskipawel@gmail.com or Linkedin. You can also visit my Github.

if(!require(pacman)) install.packages('pacman')
pacman::p_load(PolishStock, dplyr, corrplot, lubridate, tidyr, ggplot2, stringr, ggrepel)

We will check Pearson correlation beetwen monthly log-returns of the following assets:
- WIG index
- yield of 10-years Polish bonds
- S&P500 index
- DAX index
- iShares MSCI Emerging Markets ETF
- USDPLN
- EURPLN
- Gold price (XAUUSD)
- Eurozone Manufacturing PMI.

We use PolishStock package to download the above data from the website stooq.pl. Monthly data for period June 2010 - February 2022 consists of 138 observations.

tickers <- c('WIG', '10PLY.B', '^SPX', '^DAX', 'EEM.US'
             ,'USDPLN', 'EURPLN', 'XAUUSD', 'PMMNEU.M')

# for (ticker in tickers) {
#   stooq_download(ticker
#                  ,start_date = 20100101
#                  ,end_date = 20222502
#                  ,interval = 'm'
#                  ,destination = paste0(getwd(), '/datasets/'))
# }

close_prices <- df_prices(paste0(tickers, '.csv')
                          ,source = 'datasets/')

returns <- data.frame(
  Date = close_prices$Date[-1]
  ,sapply(select(close_prices, -Date)
         ,FUN = function(x) diff(log(x), lag = 1))
)

colnames(returns) <- c('Date', 'WIG', '10Y Yield', 'S&P', 'DAX'
                       ,'EM', 'USDPLN', 'EURPLN', 'Gold', 'Euro PMI')
  

Pearson correlation coefficient shows linear relationships \(Y = aX +b\). When calculating it and making inferences, be aware of some pitfalls:
- if distribution of \(X\) and \(Y\) is far from bivariate normal then Pearson coefficient could exhibit linear relationship where in fact such relationship doesn’t exists; and remember that normality of marginal distributions don’t guarantee normality of joint distribution
- outliers in the dataset can influence interpretability of Pearson coefficient
- in the correlation context there is no sense in distiction beetwen dependent and independent variable; theoretically we don’t know if there is equation either \(Y = aX +b\) or equation \(X = a^{-1} (Y - b)\); if there really exists dependence beetwen variables, Pearson coefficient won’t tell us about it
- if there exists unknown factor \(Z\) which positively affects \(X\) and negatively affects \(Y\) then Pearson coefficient will be negative
- if \(X\) and \(Y\) are independent then Pearson coefficient is equal 0, but the reverse ain’t true
- Pearson coefficient doesn’t show proportion, e.g. we can’t say that correlation of \(0.6\) is \(2\) times higher than correlation of \(0.3\); however determination coefficient \(R^2\) which is in fact Pearson correlation squared shows us proportions.

Below we can see positive correlation beetwen WIG and DAX, S&P500, Emerging Markets. We can also see negative correlation beetwen WIG and USDPLN, EURPLN. There is no correlation beetwen WIG and 10Y Polish bonds yield and Eurozone Manufacturing PMI.

corr_matrix <- cor(select_if(returns, is.numeric)) %>%
  round(2)

corrplot(corr_matrix
         ,title = 'Pearson Correlation'
         ,mar = c(1,0,1,0)
         ,method = 'color'
         ,type = 'lower'
         ,order = 'alphabet'
         ,tl.col = 'black'
         ,tl.cex = 0.8
         ,tl.srt = 0
         ,addCoef.col = 'black'
         ,diag = FALSE
) 

However, above we calculated correlation for ~11 years time horizon. Now we calculate and visualize moving correlation for \(t = 1, \dots, 11\) years.

returns <- returns %>%
  mutate(Year = year(returns$Date))

moving_correlation <- data.frame(
  Index = names(select(returns, -Date, -Year))
)

for (i in 1:floor(nrow(returns) / 12)) {
  
  temp_corr_matrix <- returns %>%
    slice_tail(n = i * 12) %>%
    select(-Date, -Year) %>%
    cor() %>%
    round(2) %>%
    as.data.frame() %>%
    mutate(Index = row.names(.))
    
  moving_correlation <- moving_correlation %>%
    left_join(select(temp_corr_matrix, WIG, Index)
              ,by = c('Index' = 'Index'))
  
  colnames(moving_correlation)[i+1] <- paste0(i, '-years')
  
}

ggplot(moving_correlation %>%
  pivot_longer(cols = 2:ncol(moving_correlation)
               ,names_to = 'Variable'
               ,values_to = 'Value') %>%
    filter(Index != 'WIG') %>%
    mutate(Year = str_extract(Variable, '[0-9]*') %>%
             as.numeric()
           ,Label = if_else(Year == 8
                            ,as.character(Index)
                            ,NA_character_))) +
  geom_line(aes(x = reorder(Variable, -Year)
                ,y = Value
                ,group = Index
                ,color = Index)
            ,size = 1) +
  geom_label_repel(aes(x = reorder(Variable, -Year)
                       ,y = Value
                       ,label = Label
                       ,color = Index),
                  nudge_x = 1,
                  na.rm = TRUE
                  ,min.segment.length = 5) + 
  theme_bw() +
  theme(legend.position = 'none') +
  labs(x = '', y = '', title = 'Moving Correlation of WIG index')