ラグを使った為替の相関分析

前回の記事を見た経済のプロであるセンパイから経済分析するのであればラグを使ってみては、とご指摘を受けたので分析を追加します。

使うデータはもちろん前回の記事と同様みずほ銀行が作成した為替データを使います。

quote

今回の記事の趣旨はRのコードではないので、細かい説明は省きます。

#R
> library(dplyr)
> library(tidyr)
> library(lubridate)
> library(magrittr)
> q <- read.csv("quote.csv")
> q <- q %>% select(-IDR.100., -MYR, -X) 
> q[q == "*****"] <- NA
> q <- q %>% mutate(date = ymd(date))
> q[(sapply(q, class) == "factor")] %<>% lapply(as.numeric) 
> q <- q %>% mutate(KRW.100. = coalesce(KRW.100., 0) + coalesce(KRW.100..1)) %>% select(-KRW.100..1)
> q <- q %>% mutate(CNY = coalesce(CNY, 0) + coalesce(CNY.1, 0)) %>% select(-CNY.1)
> qt <- q %>% gather(currency, price, -date)
> head(qt)
        date currency  price
1 2002-04-01      USD 133.15
2 2002-04-02      USD 133.20
3 2002-04-03      USD 133.20
4 2002-04-04      USD 133.10
5 2002-04-05      USD 132.30
6 2002-04-08      USD 131.55

通貨が30種類以上ありデータサイズが大きくなりすぎてしまうため、今回は月次データで分析したいと思います。
月次の価格は月平均の価格で代表させるものとします。
そして月次なのでラグは20まではとりましょうか。
あと時系列の変化を追うときは価格の対数を取ったほうがいいって偉い人が言ってた気がするので、とりあえずそれもしておきます。

#R
> qtym <- qt %>%
   group_by(ym = floor_date(date, "month"), currency) %>%
   summarise(price = mean(price, na.rm = TRUE)) %>%
   mutate(`0` = log(price)) %>% 
   arrange(date) %>%
   group_by(currency)
> for(i in 1:20){
      qtym %<>% mutate(!!as.character(i) := lag(`0`, i))
> }
> qtym %>% ungroup %>% arrange(currency, ym) %>% head
# A tibble: 6 x 24
          ym currency    price      `0`      `1`      `2`      `3`      `4`      `5`   `6`   `7`   `8`   `9`  `10`  `11`  `12`  `13`  `14`
      <date>    <chr>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2002-04-01      AED 35.71238 3.575497       NA       NA       NA       NA       NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
2 2002-05-01      AED 34.43238 3.538997 3.575497       NA       NA       NA       NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
3 2002-06-01      AED 33.64250 3.515790 3.538997 3.575497       NA       NA       NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
4 2002-07-01      AED 32.14957 3.470399 3.515790 3.538997 3.575497       NA       NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
5 2002-08-01      AED 32.43000 3.479084 3.470399 3.515790 3.538997 3.575497       NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
6 2002-09-01      AED 32.83684 3.491551 3.479084 3.470399 3.515790 3.538997 3.575497    NA    NA    NA    NA    NA    NA    NA    NA    NA
# ... with 6 more variables: `15` <dbl>, `16` <dbl>, `17` <dbl>, `18` <dbl>, `19` <dbl>, `20` <dbl>
> qtym.lag <- qtym %>%
+    ungroup %>% 
+    select(-price) %>%
+    gather(lag, logprice, -date, -currency) %>% 
+    mutate(lag = parse_integer(lag)) %>%
+    filter(!is.na(logprice))
> qtym.lag %>% head
# A tibble: 6 x 4
          ym currency   lag logprice
      <date>    <chr> <int>    <dbl>
1 2002-04-01      AED     0 3.575497
2 2002-04-01      AUD     0 4.251938
3 2002-04-01      BHD     0 5.853131
4 2002-04-01      CAD     0 4.416796
5 2002-04-01      CHF     0 4.371140
6 2002-04-01      CNY     0 5.959654

これでlagが0-20までそろったtidyなデータが手に入りました。
前回の記事と同様の手法で相関係数を計算しましょう。

#R
> qtym.lagcor <- inner_join(qtym.lag, qtym.lag, by = "ym") %>%
        group_by(currency.x, lag.x, currency.y, lag.y) %>%
        summarise(cor = cor(logprice.x, logprice.y, use = "pairwise.complete.obs"))
> head(qtym.lagcor)
# A tibble: 6 x 5
# Groups:   currency.x, lag.x, currency.y [1]
  currency.x lag.x currency.y lag.y       cor
       <chr> <int>      <chr> <int>     <dbl>
1        AED     0        AED     0 1.0000000
2        AED     0        AED     1 0.9854835
3        AED     0        AED     2 0.9642516
4        AED     0        AED     3 0.9380021
5        AED     0        AED     4 0.9136898
6        AED     0        AED     5 0.8888009

ここのinner_joinをするために私のPCでは30分くらいかかりました。
日付をもう少し絞っても良かったのかもしれません。

どうせ正相関はドルペッグ通貨が高いのは分かりきっているので、とりあえずまた負相関のランキングを調べましょう。

#R
> qtym.lagcor %>% filter(currency.x > currency.y) %>% arrange(cor)
A tibble: 218,736 x 5
# Groups:   currency.x, lag.x, currency.y [10,416]
   currency.x lag.x currency.y lag.y        cor
        <chr> <int>      <chr> <int>      <dbl>
 1        SGD    20        RUB     0 -0.8970955
 2        SGD    19        RUB     0 -0.8914589
 3        SGD    20        RUB     1 -0.8904492
 4        SGD    18        RUB     0 -0.8833544
 5        TWD    19        RUB     0 -0.8831986
 6        SGD    19        RUB     1 -0.8827455
 7        TWD    20        RUB     1 -0.8824938
 8        TWD    20        RUB     0 -0.8818401
 9        SGD    20        RUB     2 -0.8817780
10        THB    20        RUB     0 -0.8814176
# ... with 218,726 more rows

どうやらシンガポールドル(SGD)とRUB(ロシアルーブル)、台湾ドル(TWD)とRUBの関係が怪しい。
相関係数-0.897は相当の大きさです。
何が起こっているんだ?

#R
> qtym.lagcor %>% filter(currency.x == "SGD", currency.y == "RUB", lag.y == 0L) %>% print(n = 21)
# A tibble: 21 x 5
# Groups:   currency.x, lag.x, currency.y [21]
   currency.x lag.x currency.y lag.y        cor
        <chr> <int>      <chr> <int>      <dbl>
 1        SGD     0        RUB     0 -0.3554125
 2        SGD     1        RUB     0 -0.4057352
 3        SGD     2        RUB     0 -0.4560651
 4        SGD     3        RUB     0 -0.4975830
 5        SGD     4        RUB     0 -0.5331830
 6        SGD     5        RUB     0 -0.5669123
 7        SGD     6        RUB     0 -0.6041083
 8        SGD     7        RUB     0 -0.6393035
 9        SGD     8        RUB     0 -0.6729011
10        SGD     9        RUB     0 -0.7011215
11        SGD    10        RUB     0 -0.7250119
12        SGD    11        RUB     0 -0.7507832
13        SGD    12        RUB     0 -0.7792632
14        SGD    13        RUB     0 -0.8100726
15        SGD    14        RUB     0 -0.8362440
16        SGD    15        RUB     0 -0.8554543
17        SGD    16        RUB     0 -0.8682485
18        SGD    17        RUB     0 -0.8767819
19        SGD    18        RUB     0 -0.8833544
20        SGD    19        RUB     0 -0.8914589
21        SGD    20        RUB     0 -0.8970955

SGDのラグを取るほどRUBとの相関が大きくなっていることが見て取れました。
20まで単調増加なので、さらに大きなラグについて相関がどうなるのか調べる必要があります。

#R
> rub00 <- qtym.lag %>% filter(currency == "RUB", lag == 0L)           
> sgd.lag <- qtym.lag %>% 
        filter(currency == "SGD") 
> sgd.lag <- sgd.lag %>%       
          arrange(ym) %>%
          group_by(lag) %>%
          mutate(logprice = lag(logprice, 21)) %>%
          ungroup %>%
          mutate(lag = lag + 21) %>%
          filter(!is.na(logprice)) %>%
          bind_rows(sgd.lag)
> inner_join(sgd.lag, rub00, by = "ym") %>%
          group_by(lag.x) %>%
          summarise(cor = cor(logprice.x, logprice.y)) %>%
          ggplot(aes(lag.x, cor)) + geom_col()

ちょうどラグ20の相関が一番大きくなっています。
シンガポールドルの20ヶ月のラグがロシア・ルーブルと明確な逆相関がある、というのは直感的には信じがたいです。

#R
> sgd.lag %>%
    filter(lag == 20L) %>%
    inner_join(rub00, by = "ym") %>%
    ggplot(aes(logprice.x, logprice.y)) +
      geom_point() +
      xlab("20months lag of logprice of SGD") + ylab("logprice of RUB")

なるほど。左上のクラスタから右下のクラスタにうまく分かれています。
この移動の時間的ラグが20ヶ月あるということですね。
念の為時間経過もチェックします。

#R
> sgd.lag %>%
    filter(lag == 20L) %>%
    inner_join(rub00, by = "ym") %>%
    ggplot(aes(logprice.x, logprice.y)) +
      geom_point() +
      facet_wrap(~year(ym)) +
      xlab("20months lag of logprice of SGD") + ylab("logprice of RUB")

2013年から2016年へのシンクロした移動が見事です。
RUBへの影響が20ヶ月かけてSGDに移るということは考えにくいので、相関を仲介する何かがあり、それらを伝搬していっているのではないかと考えます。
もしくはただの偶然か。

2011年1月を1としたときのシンガポールドルとロシアルーブルの価格変化

何にせよこの仮説を受け入れるのであれば20ヶ月前(2016年4月)からロシアルーブルは上昇トレンドで2016/8から上昇しているので、シンガポールドルはこれから20ヶ月かけて下降していくと予想できますね。

【予想】
シンガポールドルは今から6ヶ月後、2018年6月以降に下降トレンドに入る。

【免責事項】
本記事はデータ分析者の妄想なので読者の投資の参考にしないようにお願いします。

コメントを残す