INPUTしたらOUTPUT!

忘れっぽいんでメモっとく

Rでウイスキー分析(2/3) ネットワーク分析

estrellita.hatenablog.com

の続き。

Teradata Asterと同じようなネットワーク図が描けるか試して見る。


コサイン類似度の計算

元記事ではコサイン類似度を計算している。標準のdist()では計算できないがproxyパッケージをロードすることで計算できるようになる。

library(proxy)
w.dist <- w %>%
  select(-RowID, -Distillery, -Postcode, -Latitude, -Longitude) %>%
  dist(method = "cosine")


グラフオブジェクトの作成

ネットワーク図を描くためにグラフオブジェクトを作成する。距離オブジェクトからMatrixに変換するとigraph::graph.adjacency()で変換することができる。

library(igraph)
# 隣接行列からグラフオブジェクトを作成
w.g <- w.dist %>%
  as.matrix() %>%
  graph.adjacency(mode = "undirected", weighted = TRUE)


コミュニティの検出

ネットワークのノードに色をつけたいのでコミュニティ抽出を行う。コミュニティの抽出についてはR+igraph問題「友好関係ネットワークから派閥を検出」 @kztakemoto さんによる解説記事 #R #igraph #sna|CodeIQ MAGAZINEが詳しい。引用させて頂くと以下のような方法がある。


名前 関数
Girvan-Newman法 edge.betweenness.community()
貪欲法に基づく手法 fastgreedy.community()
固有ベクトルに基づく手法 leading.eigenvector.community()
焼きなまし法に基づく手法 spinglass.community()
ランダムウォークに基づく手法 walktrap.community()


今回は検出精度が最高とされる焼きなまし法で抽出してみる。

# 焼きなまし法でコミュニティ抽出
w.com <- spinglass.community(w.g)

# 抽出されたコミュニティ
sizes(w.com)

# 各ノードのコミュニティ番号
membership(w.com)


今回のデータでは9つのコミュニティに分割された。

> sizes(w.com)
Community sizes
 1  2  3  4  5  6  7  8  9 
 8 12  9 12 14  3 11  6 11 


ネットワーク図の描画

プロットの準備ができたのでnetworkD3パッケージのforceNetwork()で描画してみる。

# グラフオブジェクトからnetworkD3オブジェクトに変換
library(networkD3)
w.g.d3 <- igraph_to_networkD3(w.g, group=membership(w.com))

# リンクの重みが消えてしまうので再設定
w.g.d3$links$value <- E(w.g)$weight

# networkD3でプロット
forceNetwork(Links = w.g.d3$links, Nodes = w.g.d3$nodes, 
             Source = 'source', Value = "value", Target = 'target', 
             NodeID = 'name', Group = 'group',
             height = 600, width = 800, zoom=TRUE)

f:id:tak95:20160414163427p:plain

hairballになった。。。orz

重みが小さいとはいえ全ノード間のリンクをプロットすると全く分からないのでコサイン類似度が0.4以上のリンクのみプロットしてみる

# 距離オブジェクトから行列に変換
w.mat <- w.dist %>%
  as.matrix()

# 下側三角行列のみにする
w.mat[upper.tri(w.mat, diag = TRUE)] <- 0

# コサイン類似度が0.4未満のリンクを削除
w.mat[which(w.mat < 0.4)] <- 0

# グラフオブジェクトに変換してプロット
w.g <- w.mat %>%
  graph.adjacency(mode = "undirected", weighted = TRUE)
w.g.d3 <- igraph_to_networkD3(w.g, group=membership(w.com))
w.g.d3$links$value <- E(w.g)$weight
forceNetwork(Links = w.g.d3$links, Nodes = w.g.d3$nodes, 
             Source = 'source', Value = "value", Target = 'target', 
             NodeID = 'name', Group = 'group',
             height = 600, width = 800, zoom=TRUE, fontSize=14)

f:id:tak95:20160414183232p:plain

それっぽくはなったけど同じグループ同士で繋がっていない。自分の力量ではAsterには及ばなかった。。。


コサイン類似度ではなく相関係数で実行してみるとコミュニティは4つになる。

# 相関係数行列の作成
w.mat <- w %>%
  select(-RowID, -Distillery, -Postcode, -Latitude, -Longitude) %>%
  t() %>%
  cor()

# コミュニティの抽出
w.com <- w.mat %>%
  graph.adjacency(mode = "undirected", weighted = TRUE) %>%
  spinglass.community()

# 下側三角行列のみ
w.mat[upper.tri(w.mat, diag = TRUE)] <- 0

# 相関係数0.7未満のリンクを削除
w.mat[which(w.mat < 0.7)] <- 0

# グラフオブジェクトに変換してプロット
w.g <- w.mat %>%
  graph.adjacency(mode = "undirected", weighted = TRUE)  
w.g.d3 <- igraph_to_networkD3(w.g, group=membership(w.com))
w.g.d3$links$value <- E(w.g)$weight
forceNetwork(Links = w.g.d3$links, Nodes = w.g.d3$nodes, 
             Source = 'source', Value = "value", Target = 'target', 
             NodeID = 'name', Group = 'group',
             height = 600, width = 800, zoom=TRUE, fontSize=14)

f:id:tak95:20160414190414p:plain

なんとなく青、灰色、オレンジの3つには分かれているように見えるがこの図からはどの銘柄が近い・遠いは分かりづらい。 ということで次は対応分析をしてみる。