2012-09-27

Cohesive blocking of graph

Rのigraphパッケージにcohesive blockingというのをやってくれる関数 cohesive.blocks()というのがある
- Cohesive blockingのサイト
Cohesiveとは粘着性のある、凝集性のある、という意味
論文は社会における人のネットワークについてのもの
グラフの中のまとまりのよいサブグラフを塊として認識しようということ
詳細は未確認だが、グラフの中にある、まとまりのよさの認識を階層性を持って実行するようだ
やってみる

- 左上は、凝集性を加えていない「木」
- 右上は、その「木」に対するcohesive blockの図示(cohesiveでない)
- 左下は、凝集を加えた状態のプロット
- 右下はそのcohesive blockの様子の図示
- 階層性のあるブロック(下記のB-iがブロック。それに階層性が付与された形式で示されている)が出力される

Cohesive block structure:
B-1            c 2, n 27
'- B-2         c 3, n 10   ooooooooo. ....o..... ....... 
   '- B-5      c 4, n  8   .ooooo.oo. ....o..... ....... 
'- B-3         c 3, n 10   .o.......o oooooooo.. ....... 
   '- B-6      c 4, n  9   .o.......o oo.ooooo.. ....... 
      '- B-7   c 5, n  6   .........o o...oooo.. ....... 
'- B-4         c 3, n 11   .o........ ....o...oo ooooooo 
   '- B-8      c 4, n  5   .......... ....o...oo o....o. 
[[1]]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

[[2]]
 [1]  1  2  3  4  5  6  7  8  9 15

[[3]]
 [1]  2 10 11 12 13 14 15 16 17 18

[[4]]
 [1]  2 15 19 20 21 22 23 24 25 26 27

[[5]]
[1]  2  3  4  5  6  8  9 15

[[6]]
[1]  2 10 11 12 14 15 16 17 18

[[7]]
[1] 10 11 15 16 17 18

[[8]]
[1] 15 19 20 21 26

[1] 2 3 3 3 4 4 5 4

上記のソース

library(igraph)
library(ape)
# 階層性のあるグラフを作る
# 距離行列を積み上げ式に作って階層性を持たせることとする
# 階層の階数
n.steps <- 3
# 階層ごとに「引き離す程度」
v.steps <- (1:n.steps)^2
# 各階層の理想的距離行列を納める容器
U <- list()
# 各階層ごとに相互に均等にk群に分かれるものとする
k <- 3
# 一番小さいユニットはk*pサンプルでスタート
p <- 1
# 最小ユニットの距離行列は、全サンプルが相互に均等距離
U[[1]] <- matrix(v.steps[1],k*p,k*p)
diag(U[[1]]) <- 0
# 階を上げていく
for(i in 2:n.steps){
	tmp.dim <- length(U[[i-1]][1,])
	U[[i]] <- matrix(v.steps[i],tmp.dim*k,tmp.dim*k)
	for(j in 1:k){
		U[[i]][(1+tmp.dim*(j-1)):(tmp.dim*j),(1+tmp.dim*(j-1)):(tmp.dim*j)] <- U[[i-1]]
	}
# 理想的距離から少しずらす
	d <- jitter(U[[i]])
# 最小全域木を得る
	H <- mst(d)
H2 <- H
# グラフに「凝集性」を与えるために、最小全域木でつながっている程度の近さのノードとは連結させる
for(i in 1:length(d[,1])){
	tmp <- max(d[i,which(H[i,]==1)])
	H2[i,which(d[i,] <= tmp)] <-1
	H2[which(d[i,] <= tmp),i] <-1
}
diag(H2)<-0
#plot(H2)
# 最小全域木とそれに凝集性を加えた２つのグラフを作る
g1 <- graph.adjacency(H*d,mode="undirected",weighted = TRUE)
g2 <- graph.adjacency(H2*d,mode="undirected",weighted = TRUE)
# プロットする
par(mfcol=c(2,2))
#plot(g1,layout=layout.kamada.kawai(g1))
#par(ask=FALSE)
#plot(g2,layout=layout.kamada.kawai(g2))
plot(g1)
plot(g2)
# グラフが大きいとcohesion blockingは重いので、ある程度までのノード数のときだけcohesion blockingを計算する
if(length(d[1,])< 50){
	#g3 <- graph.adjacency(d)
	mwBlocks1 <- cohesive.blocks(g1)
	mwBlocks2 <- cohesive.blocks(g2)
	#mwBlocks3 <- cohesive.blocks(g3)

# Inspect block membership and cohesion
	mwBlocks1
	blocks(mwBlocks1)
	cohesion(mwBlocks1)
	print(mwBlocks2)
	print(blocks(mwBlocks2))
	print(cohesion(mwBlocks2))
	#mwBlocks3
	#blocks(mwBlocks3)
	#cohesion(mwBlocks3)


	## End(Not run)
	# Plot the results
	if (interactive()) {
	  plot(mwBlocks1, g1)
	  plot(mwBlocks2, g2)
	  #plot(mwBlocks3, g3)
	}

}


par(ask=TRUE)
}