R: PlotlyでSankey-diagram

## はじめに (残念ポイント)

- PlotlyのSankey-diagramは2node間で最大3本までしかlinkを引けない仕様のよう。  
labelを用いてlinkを関連付け・細分化するとあっさり3本くらいは行くため、  
ともすれば気づかない間に非表示linkが出現する、**とてもとても注意**。
- nodeのデフォソートはlinkのvalueで (主に？) 決まっているようだ、
アルファベット順にはならない。


## 例示用データ
airqualityデータを適当に加工して、それっぽいデータをでっちあげる。
イメージは30人の顧客ランク × 2or3ヶ月。
横持ちの方がやりやすいので横持ちに変換しておく。

``` r
# 使用パッケージ読み込み
library(plotly); library(tidyverse)

# 例示用データ作成
d <- airquality %>% 
  as.tibble() %>% 
  filter(Day != 31, Month %in% c(5, 7, 9)) %>% 
  mutate(Rank = as.integer(cut_interval(Wind, 3)),
         Month = paste0("m", Month)) %>%    # 横持ち変換で列名が`数字`となるのを回避
  select(ID = Day, Month, Rank) %>% 
  spread(Month, Rank)                       #  横持ちに変換

```
こんなデータです

| ID| m5| m7| m9|
|--:|--:|--:|--:|
|  1|  1|  1|  1|
|  2|  1|  2|  1|
|  3|  2|  2|  1|
|  4|  2|  2|  1|
|  5|  2|  1|  1|
|  6|  3|  2|  3|

## 単純な例 (x 2ヶ月)
最低限必要なものは4つ。
1. node label (重複は許されない)
2. link source (node labelのindexで指定、外部用なので0から始まる点に注意)
3. link target (node labelのindexで指定、外部用なので0から始まる点に注意)
4. link value

``` r
## とりあえず数えあげたのち、列名を要素にpasteして列間での要素名の重複を排除。

d1 <- d %>% 
  count(m5, m7) %>% 
  mutate(m5 = paste("m5", m5, sep = "."),
         m7 = paste("m7", m7, sep = "."))


## node_labelは各列の要素を全部まとめてユニークをとる、sortはミス防止のため。

node_label <- d1 %>% 
  select(m5, m7) %>% 
  unlist() %>% 
  unique() %>% 
  sort()


## link sourceとlink targetはfactorの特性を用いてindexを算出するのが楽。
## 最後にマイナス1するのを忘れないように。

link_source_nodeind <- d1 %>% 
  pull(m5) %>% 
  factor(levels = node_label) %>% 
  as.numeric() %>% 
  - 1

link_target_nodeind <- d1 %>% 
  pull(m7) %>% 
  factor(levels = node_label) %>% 
  as.numeric() %>% 
  - 1


## link valueは数え上げた値をそのままつっこむ

link_value <- d1$n


## 作図する

p <- plot_ly(type = "sankey", 
             domain = c(x =  c(0,1), y =  c(0,1)), 
             orientation = "h",   # 縦方向 (h) or 横方向 (v)
             node = list(label = node_label),
             link = list(source =  link_source_nodeind,
                         target = link_target_nodeind,
                         value =  link_value))

p      # 出力後、nodeの並びをお好みで変更。
```
![スクリーンショット 2018-03-06 17.33.44.png](https://qiita-image-store.s3.amazonaws.com/0/234930/8553e4c6-faa2-6305-1d38-83bf655a68ce.png)




## ちょっと複雑な例
x 3ヶ月のデータを対象に、link labelを用いて1-2ヶ月目とその下層の2-3ヶ月目を関連づける。
nodeとlinkにも色もつける (これが結構めんどい)。
関数化とか気にせず、一発こっきりなコードで記述。

なお、node数が多い場合にこのようなlinkのlabelによる関連付けを行うと、
あっという間に2node間の最大3本制限に引っかかるので注意。

``` r
## お好みで色ベクトルを作っておく
base_palette <- RColorBrewer::brewer.pal(8, "Set2")

## 色指定で楽をするために、回りくどいことをしている。
## 平たく言えば、factorのレベルを揃えている

d2.0 <- d %>% 
  select(m5, m7, m9) %>% 
  map_dfr(as.factor) %>%  # とりあえずfactor化
  fct_unify() %>%         # 全列のlevelsを統合
  bind_cols() %>%         # 上の処理でvector in list化されるので、tibbleに戻す
  imap_dfr(~ factor(.x,         # 各列間で要素名が重複しないよう、labelsを加工。
                    levels = levels(.x), 
                    labels = paste(.y, levels(.x), sep = "."))) %>% 
  count(m5, m7, m9) %>% 
  mutate(link_label = paste(m5, m7, sep = "_"),     # m5とm7のセットで関連付けたいので、pasteしてlabel作成
         link_col = base_palette[as.numeric(m5)])   # linkの色はm5に揃える


## m5-m7間用データ
## m9気にせずまとめる

d2.1 <- d2.0 %>% 
  group_by(m5, m7, link_label, link_col) %>% 
  summarize(n = sum(n)) %>% 
  ungroup() %>% 
  rename(source = m5,
         target = m7)


## m7-m9間用データ

d2.2 <- d2.0 %>% 
  rename(source = m7,
         target = m9) %>% 
  select(-m5)

d2 <- bind_rows(d2.1, d2.2)   # fct型がchr変換されるが気にしなくてOK


node_label <- d2.0 %>% 
  select(m5, m7, m9) %>% 
  map(levels) %>% 
  unlist()

node_color <- 1:(length(node_label)/3) %>%  # 各列のレベルは揃えてあるので、簡単
  rep(3) %>% 
  base_palette[.] %>% 
  alpha(0.7)


link_source_nodeind <- d2 %>% 
  pull(source) %>% 
  factor(levels = node_label) %>% 
  as.numeric() %>% 
  - 1

link_target_nodeind <- d2 %>% 
  pull(target) %>% 
  factor(levels = node_label) %>% 
  as.numeric() %>% 
  - 1

link_value <- d2$n

link_color <- d2$link_col %>% 
  alpha(0.2)

link_label <- d2$link_label

p <- plot_ly(type = "sankey", 
             domain = c(x =  c(0,1), y =  c(0,1)), 
             orientation = "h",
             node = list(label = node_label,
                         color = node_color),
             link = list(source =  link_source_nodeind,
                         target = link_target_nodeind,
                         value =  link_value,
                         color = link_color,
                         label = link_label))

p     # あとはnodeの並びをマウスでいじいじしてFINISH。
```
![スクリーンショット 2018-03-06 17.49.18.png](https://qiita-image-store.s3.amazonaws.com/0/234930/08034e3d-79fa-bc81-b490-16534b504630.png)