前回の記事ではたくさんの系列に対してまとめて相関係数を計算する方法を示しました。
Rの関数corをデータフレームに対して使う方法ですが、これは簡単ではありますが望ましくはないと思います。
なぜならばcorに与えるデータフレームはすべての要素が数値でなければならないという厳しい制約条件があり、前回の記事の例で言えば、日付のフィールドを落とさなければならなかったのです。
これではたとえば相関係数の時間的変動を追いかけるなどといった複雑な相関分析ができません。
よってこのようなニーズに答えることのできる相関分析方法を示します。
データは前回の記事と同様みずほ銀行が作成した為替データを使います。
#R
> library(dplyr)
> library(lubridate)
> library(magrittr)
> q <- read.csv("quote.csv")
> q %<>% select(-IDR.100., -MYR, -X)
> q[q == "*****"] <- NA
> q %<>% mutate(date = ymd(date))
> q[(sapply(q, class) == "factor")] %<>% lapply(as.numeric)
> q %<>% mutate(KRW.100. = coalesce(KRW.100., 0) + coalesce(KRW.100..1)) %>% select(-KRW.100..1)
%>% mutate(CNY = coalesce(CNY, 0) + coalesce(CNY.1, 0)) %>% select(-CNY.1)
date USD GBP EUR CAD CHF SEK DKK
Min. :2002-04-01 Min. : 75.76 Min. :117.5 Min. : 94.23 Min. : 70.45 Min. : 76.16 Min. :10.43 Min. :12.67
1st Qu.:2006-02-26 1st Qu.: 94.88 1st Qu.:141.4 1st Qu.:119.85 1st Qu.: 82.02 1st Qu.: 86.29 1st Qu.:12.62 1st Qu.:16.11
Median :2010-01-27 Median :107.78 Median :174.3 Median :131.92 Median : 86.64 Median : 91.66 Median :14.21 Median :17.72
Mean :2010-01-25 Mean :104.80 Mean :172.4 Mean :130.97 Mean : 89.45 Mean : 96.81 Mean :14.10 Mean :17.59
3rd Qu.:2013-12-21 3rd Qu.:116.80 3rd Qu.:197.8 3rd Qu.:138.72 3rd Qu.: 96.20 3rd Qu.:106.57 3rd Qu.:15.18 3rd Qu.:18.62
Max. :2017-11-27 Max. :133.20 Max. :250.6 Max. :169.62 Max. :124.98 Max. :136.89 Max. :18.49 Max. :22.75
NOK AUD NZD ZAR BHD CNY HKD INR
Min. :11.81 Min. : 56.56 Min. :45.28 Min. : 6.62 Min. :201.2 Min. : 2.0 Min. : 9.76 Min. :1.400
1st Qu.:14.17 1st Qu.: 79.09 1st Qu.:64.76 1st Qu.: 9.66 1st Qu.:252.1 1st Qu.:116.0 1st Qu.:12.24 1st Qu.:1.720
Median :15.87 Median : 84.19 Median :74.39 Median :11.76 Median :286.4 Median :215.5 Median :13.84 Median :1.940
Mean :15.96 Mean : 84.59 Mean :73.34 Mean :12.41 Mean :278.5 Mean :208.9 Mean :13.48 Mean :2.095
3rd Qu.:17.06 3rd Qu.: 91.52 3rd Qu.:81.15 3rd Qu.:15.99 3rd Qu.:310.7 3rd Qu.:288.0 3rd Qu.:15.02 3rd Qu.:2.500
Max. :21.80 Max. :107.66 Max. :97.61 Max. :19.69 Max. :353.8 Max. :479.0 Max. :17.08 Max. :3.070
PHP SGD KRW.100. THB KWD SAR AED MXN
Min. :1.740 Min. :58.14 Min. : 2.0 Min. :2.420 Min. :274.6 Min. :20.21 Min. :20.63 Min. : 5.050
1st Qu.:1.950 1st Qu.:64.71 1st Qu.:180.0 1st Qu.:2.720 1st Qu.:332.8 1st Qu.:25.31 1st Qu.:25.85 1st Qu.: 6.740
Median :2.210 Median :70.41 Median :402.0 Median :2.910 Median :369.5 Median :28.75 Median :29.35 Median : 7.850
Mean :2.197 Mean :72.26 Mean :366.1 Mean :3.003 Mean :362.2 Mean :27.96 Mean :28.54 Mean : 8.423
3rd Qu.:2.362 3rd Qu.:79.25 3rd Qu.:578.0 3rd Qu.:3.230 3rd Qu.:399.0 3rd Qu.:31.17 3rd Qu.:31.81 3rd Qu.:10.310
Max. :2.810 Max. :92.58 Max. :666.0 Max. :4.130 Max. :436.6 Max. :35.53 Max. :36.27 Max. :14.810
NA's :471
PGK HUF CZK PLN RUB TRY IDR.100..1 MYR.1
Min. : 2.0 Min. : 2.00 Min. : 2.0 Min. : 2 Min. :1.410 Min. :28.26 Min. :0.760 Min. : 2.0
1st Qu.: 344.0 1st Qu.:11.00 1st Qu.: 204.0 1st Qu.: 384 1st Qu.:1.920 1st Qu.:39.17 1st Qu.:0.870 1st Qu.: 233.0
Median : 610.0 Median :15.00 Median : 437.0 Median : 650 Median :2.500 Median :45.27 Median :0.960 Median : 412.0
Mean : 638.1 Mean :17.31 Mean : 467.3 Mean : 669 Mean :2.404 Mean :44.00 Mean :1.047 Mean : 464.8
3rd Qu.: 928.8 3rd Qu.:20.00 3rd Qu.: 627.0 3rd Qu.: 907 3rd Qu.:2.870 3rd Qu.:49.49 3rd Qu.:1.230 3rd Qu.: 709.0
Max. :1324.0 Max. :45.00 Max. :1266.0 Max. :1453 Max. :3.300 Max. :58.52 Max. :1.470 Max. :1034.0
NA's :450 NA's :1006 NA's :1006 NA's :1006 NA's :2089 NA's :2089 NA's :471
TWD
Min. :2.510
1st Qu.:2.947
Median :3.390
Mean :3.296
3rd Qu.:3.570
Max. :4.050
前回の記事と同様の前処理をしました。
このままの形は神Hadleyが言うところのtidy dataではないので縦持ちにしてやりましょう。
#R
> library(tidyr)
> 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
我々がやりたいのは相関分析なのですから、すべてのcurrencyの組み合わせを作らなければなりません。
SQLをやる人はすぐに思いつくのでしょうが、自分とのjoinによりこれを実現します。
#R
> qt.comb <- inner_join(qt, qt, by = "date")
> head(qt.comb)
date currency.x price.x currency.y price.y
1 2002-04-01 USD 133.15 USD 133.15
2 2002-04-01 USD 133.15 GBP 189.79
3 2002-04-01 USD 133.15 EUR 116.12
4 2002-04-01 USD 133.15 CAD 83.48
5 2002-04-01 USD 133.15 CHF 79.28
6 2002-04-01 USD 133.15 SEK 12.87
> nrow(qt)
[1] 130696
> nrow(qt.comb)
[1] 4443664
すべての通貨の組み合わせですので、各日付ごとにデータの行数が通貨の種類数(34)マイナス１の33倍になっています。
もしある組み合わせのデータが必要であれば、currency.xとcurrency.yとを指定すれば通貨のペアが得られます。
ここからすべての組み合わせについて相関係数を計算するためには下記のようにやります。
#R
> qt.comb %>%
group_by(currency.x, currency.y) %>%
summarise(cor = cor(price.x, price.y, use = "pairwise.complete.obs")) %>%
filter(currency.x > currency.y) %>%
arrange(desc(cor))
# A tibble: 561 x 3
# Groups: currency.x [33]
currency.x currency.y cor
<chr> <chr> <dbl>
1 USD AED 0.9999964
2 SAR AED 0.9999874
3 USD SAR 0.9999840
4 SAR BHD 0.9999622
5 BHD AED 0.9999592
6 USD BHD 0.9999528
7 EUR DKK 0.9999236
8 USD HKD 0.9997775
9 HKD AED 0.9997723
10 SAR HKD 0.9997542
# ... with 551 more rows
これで昨日と同じ結果が得られました。
さて、この手法では日付列を残しているので相関係数の時間変化を追うことができます。
それは次のように実現します。
> qt.cor <- qt.comb %>%
mutate(year = year(date)) %>%
group_by(year, currency.x, currency.y) %>%
summarise(cor = cor(price.x, price.y, use = "pairwise.complete.obs")) %>%
filter(currency.x > currency.y) %>%
arrange(desc(cor))
> qt.cor
# A tibble: 8,976 x 4
# Groups: year, currency.x [528]
year currency.x currency.y cor
<dbl> <chr> <chr> <dbl>
1 2014 USD AED 0.9999979
2 2016 USD AED 0.9999972
3 2014 USD SAR 0.9999962
4 2014 USD BHD 0.9999959
5 2014 SAR AED 0.9999949
6 2005 USD AED 0.9999943
7 2013 USD SAR 0.9999942
8 2002 USD SAR 0.9999941
9 2014 BHD AED 0.9999940
10 2003 USD AED 0.9999932
# ... with 8,966 more rows
2014年の米ドルとUAEディルハム(AED)との相関係数99.99979%、どこかのシステムの稼働率みたいな数字で、完璧なドルペッグのオペレーションがお見事です。
トップ１０に2015年USD.AEDが出てこないところを見ると、この年はうまくいかなかったのでしょうか。
チャートで確認してみましょう。
#R > library(ggplot2) > qt.cor %>% filter(currency.x == "USD", currency.y == "AED") %>% ggplot(aes(x = year, y = cor)) + geom_line()
さて、相関係数が高いかどうかも大事ですが、最近相関が高くなった通貨や、最近相関が無くなった通貨などを知ることによって我々は利益のチャンスを狙えるかもしれません。
相関係数の変動が激しい通貨はどれでしょうか？
変動の激しさは分散や標準偏差で測るのが基本です。
#R
> qt.cor %>%
group_by(currency.x, currency.y) %>%
summarise(var = var(cor, na.rm=TRUE), n = sum(!is.na(cor))) %>%
arrange(desc(var)) %>%
filter(n > 5)
# A tibble: 496 x 4
# Groups: currency.x [31]
currency.x currency.y var n
<chr> <chr> <dbl> <int>
1 THB RUB 0.3764387 8
2 RUB MYR.1 0.3729797 8
3 TWD KRW.100. 0.3689234 14
4 RUB CAD 0.3681076 8
5 SGD KRW.100. 0.3672527 14
6 ZAR TRY 0.3572152 8
7 MYR.1 KRW.100. 0.3568511 14
8 TRY RUB 0.3535817 8
9 SGD RUB 0.3519936 8
10 KRW.100. GBP 0.3496538 14
# ... with 486 more rows
変動一位はタイバーツ vs ロシアルーブルです。
そう言えばこの組み合わせは前回の記事で逆相関が最大だった組み合わせですね。
内容を調べてみましょう。
#R
> qt.cor %>%
unite(cxy, currency.x, currency.y, remove = FALSE) %>%
filter(cxy %in% c("THB_RUB", "RUB_MYR.1", "TWD_KRW.100.", "RUB_CAD", "SGD_KRW.100.")) %>%
ggplot(aes(year, cor)) + geom_line(aes(color = cxy))
なんということでしょう。負の相関だと思われていたRUB-THBは2010-2012は正相関でした。
全体で計算する危険性を感じずにいられません。
しかし気になるのはRUB-THBに限らず５つの通貨の組み合わせで似たようなトレンドを描いていること、すなわち相関が相関しているということです。
これは対象の通貨価格が変動しているのではなく、基準である日本円の価値が変動しているからではないかと推測できます。
そうでなければここまでぴったりの相関の相関（ややこしい）が起きるはずはありません。
深堀するのであればこれらの年に実際に価格が上げたのか下げたのかを見ていくのが正しいのではないかという気がします。
しかし相関分析の手法を紹介する目的から逸れそうなのでとりあえずここらあたりで一旦分析を閉めたいと思います。
こういうような見方をしてほしい、できないのか、などといったコメントやご要望があれば承りますのでどうぞ遠慮なくコメントください。
まとめます。
データフレームをそのデータフレーム自身とjoinして、group_byすれば任意のレベルで相関分析することができることがわかりました。
相関分析は多変量の探索的データ解析の基本になるので、これからも積極的に使っていきたいと思います。
Thank you for your blog post.Really thank you! Awesome.viagra cialis alcool