SNAGeek

Sociologically Technological, and Technologically Sociological

共通の知人数でエッジを重み付けする

はじめに:構造的埋め込みについて

構造的埋め込み(structural embeddedness) とは、「ある紐帯がどれほど社会構造の中に埋め込まれているか」を表す概念です。これは「両者の間で共通の知人がどれだけいるか」によって測定されます。

愛着や相互作用の数など、直接的にノードペアの関係性の深さを観測できない時、構造的埋め込みの度合いが紐帯の強度として使用されることがあります。ネットワークの構造的特徴が、エッジの重みとして畳み込まれるわけです。

これを扱った研究としては、古典的には以下のような論文があります。こちらの論文では、共通の知人の数が、好き嫌いや過ごす時間よりも時間安定的であることが明らかにされています。

www.sciencedirect.com

この概念はグラノヴェッターの社会的埋め込み(social embeddedness)概念に由来しています。社会的埋め込みは「家族関係」「婚姻関係」などの紐帯の性質や社会的状況までカバーする概念ですが、構造的埋め込みは、社会的埋め込み概念のなかでも、特にその構造的側面に着目したものと言えます。

問題は、共通の知人数をどう計算するかです。 愚直に二重ループを回してもいいのですが、隣接行列の性質をうまく利用すると、行列計算に持ち込めるため、たいへん高速に計算することが可能です。

それは、隣接行列をn乗した行列の各成分はi-j間のn-pathの数に等しいという性質です(ループなしの無向グラフの場合)。ことn=2の時、n-pathの数はノードiとノードjが共通してつながっているノードの数と同じです。

実際にやってみる

ライブラリ読み込み

library(igraph)
library(ggnetwork)
library(tidyverse)

ランダムグラフ生成して可視化

set.seed(111)
network <- erdos.renyi.game(15,0.3)

original_layout <- layout.fruchterman.reingold(network)

gnet <- ggnetwork(network,layout = original_layout)
g <- ggplot(gnet,aes(x=x,y=y,xend=xend,yend=yend))
g <- g + geom_edges(size=0.5)
g <- g + geom_nodes(size=3)
g <- g + geom_nodelabel(aes(label = vertex.names))
g <- g + theme_blank()
g <- g + ggtitle("ORIGINAL NETWORK")
g

f:id:meana0:20190414141758p:plain

もともとの隣接行列

adjmat <- as_adjacency_matrix(network)
adjmat
15 x 15 sparse Matrix of class "dgCMatrix"
                                   
 [1,] . . 1 . . . . . . 1 1 1 . . .
 [2,] . . . . . . . . . . . . 1 1 1
 [3,] 1 . . 1 1 . . . . 1 . 1 1 1 1
 [4,] . . 1 . . . . . . . . . . 1 .
 [5,] . . 1 . . . 1 . . . 1 . 1 . .
 [6,] . . . . . . . 1 1 . . 1 1 . .
 [7,] . . . . 1 . . 1 . . . . . . .
 [8,] . . . . . 1 1 . 1 . . . . . .
 [9,] . . . . . 1 . 1 . . 1 1 . 1 1
[10,] 1 . 1 . . . . . . . 1 . . 1 .
[11,] 1 . . . 1 . . . 1 1 . . . . 1
[12,] 1 . 1 . . 1 . . 1 . . . . . .
[13,] . 1 1 . 1 1 . . . . . . . . .
[14,] . 1 1 1 . . . . 1 1 . . . . .
[15,] . 1 1 . . . . . 1 . 1 . . . .

続いてこれを自乗します。Rで行列積を計算する時は %*% 演算子を使います。

squared_adjmat <- adjmat %*% adjmat
squared_adjmat
15 x 15 sparse Matrix of class "dgCMatrix"
                                   
 [1,] 4 . 2 1 2 1 . . 2 2 1 1 1 2 2
 [2,] . 3 3 1 1 1 . . 2 1 1 . . . .
 [3,] 2 3 8 1 1 2 1 . 3 2 4 1 1 2 .
 [4,] 1 1 1 2 1 . . . 1 2 . 1 1 1 1
 [5,] 2 1 1 1 4 1 . 1 1 2 . 1 1 1 2
 [6,] 1 1 2 . 1 4 1 1 2 . 1 1 . 1 1
 [7,] . . 1 . . 1 2 . 1 . 1 . 1 . .
 [8,] . . . . 1 1 . 3 1 . 1 2 1 1 1
 [9,] 2 2 3 1 1 2 1 1 6 2 1 1 1 . 1
[10,] 2 1 2 2 2 . . . 2 4 1 2 1 1 2
[11,] 1 1 4 . . 1 1 1 1 1 5 2 1 2 1
[12,] 1 . 1 1 1 1 . 2 1 2 2 4 2 2 2
[13,] 1 . 1 1 1 . 1 1 1 1 1 2 4 2 2
[14,] 2 . 2 1 1 1 . 1 . 1 2 2 2 5 3
[15,] 2 . . 1 2 1 . 1 1 2 1 2 2 3 4

こうしてできた行列は、各成分がi-j間の相異なる2-pathの数になっています。当然ですが、対角成分は、各ノードの次数と等しくなります。

最後に、もともとエッジがあったところにだけ重み付けするため、隣接行列との要素積を計算し、最後に隣接行列との要素和を計算します。

weighted_adjmat <- squared_adjmat * adjmat + adjmat
weighted_adjmat
> weighted_adjmat
15 x 15 sparse Matrix of class "dgCMatrix"
                                   
 [1,] . . 3 . . . . . . 3 2 2 . . .
 [2,] . . . . . . . . . . . . 1 1 1
 [3,] 3 . . 2 2 . . . . 3 . 2 2 3 1
 [4,] . . 2 . . . . . . . . . . 2 .
 [5,] . . 2 . . . 1 . . . 1 . 2 . .
 [6,] . . . . . . . 2 3 . . 2 1 . .
 [7,] . . . . 1 . . 1 . . . . . . .
 [8,] . . . . . 2 1 . 2 . . . . . .
 [9,] . . . . . 3 . 2 . . 2 2 . 1 2
[10,] 3 . 3 . . . . . . . 2 . . 2 .
[11,] 2 . . . 1 . . . 2 2 . . . . 2
[12,] 2 . 2 . . 2 . . 2 . . . . . .
[13,] . 1 2 . 2 1 . . . . . . . . .
[14,] . 1 3 2 . . . . 1 2 . . . . .
[15,] . 1 1 . . . . . 2 . 2 . . . .

こうして作成した重み付き隣接行列を実際に可視化してみます。igraphでネットワークオブジェクトを作成した後に、重みから1を引きます。共通の知人がいないエッジは重みが0と表示されるようになります。

weighted_network <- graph.adjacency(weighted_adjmat,
                                    mode = "undirected",
                                    diag = FALSE,
                                    weighted = TRUE)
E(weighted_network)$weight <- E(weighted_network)$weight - 1

gnet <- ggnetwork(weighted_network,layout = original_layout)
g <- ggplot(gnet,aes(x=x,y=y,xend=xend,yend=yend))
g <- g + geom_edges(size=0.5)
g <- g + geom_nodelabel(aes(label=vertex.names))
g <- g + geom_edgelabel(aes(label=weight))
g <- g + theme_blank()
g <- g + ggtitle("WEIGHTED NETWORK")
g

f:id:meana0:20190414141755p:plain