Mathematicaでグラフ理論 を使い関係を推定する
Mathematicaでグラフ理論 を使い関係を推定する
松田裕幸
Mathematica14.0
参考関数:
Graph
UndirectedEdge
VertexList
VertexLabels
EdgeShapeFunction
FindGraphCommunities
CommunityGraphPlot
VertexCount
VertexDegree
BetweennessCentrality
NeighborhoodGraph
AdjacencyList
Correlation
AdjacencyGraph
FindClique
MorphologicalGraph
VertexCoordinates
PathGraph
HighlightGraph
Mathematica14.0
参考関数:
Graph
UndirectedEdge
VertexList
VertexLabels
EdgeShapeFunction
FindGraphCommunities
CommunityGraphPlot
VertexCount
VertexDegree
BetweennessCentrality
NeighborhoodGraph
AdjacencyList
Correlation
AdjacencyGraph
FindClique
MorphologicalGraph
VertexCoordinates
PathGraph
HighlightGraph
リアルネットワーク上の人間関係を推定する
リアルネットワーク上の人間関係を推定する
発言順に関し、たとえば A が発言し、Bが発言し、ついでAが発言した場合、AとBとの間に何らかの近しい関係があると仮定できます。シェイクスピアの戯曲「アントニオとクレオパトラ」を参考に、アントニオを巡る人々とクレオパトラを巡る人々の関係の強さをグラフ理論を使い推定してみます。
発言リストは以下のようなExcelデータとして用意されています。〚1〛はSheetの1枚目を指します。
In[]:=
SetDirectory[NotebookDirectory[]];AntonyAndCleopatra=Import["AntonyAndCleopatra.xls"][[1]];
戯曲「アントニオとクレパトラ」は42シーンからなっています。
In[]:=
AntonyAndCleopatra//Length
Out[]=
42
シーン1では、PHILO が最初に発言し、ついで CLEOPATRA が話し、MARK ANTONYが続いてます。
In[]:=
AntonyAndCleopatra〚1〛
Out[]=
{PHILO,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,Attendant,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,DEMETRIUS,PHILO,DEMETRIUS,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,}
データAntonyAndCleopatraから発言者がいない「” “」場合を除いたものを戯曲playとします。
In[]:=
play=DeleteCases[AntonyAndCleopatra,"",Infinity];
シーン1をscene1とします。
In[]:=
scene1=play[[1]]
Out[]=
{PHILO,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,Attendant,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,CLEOPATRA,MARK ANTONY,DEMETRIUS,PHILO,DEMETRIUS}
ここで、発言順における関係の強さに関する距離を3と仮定し、n-gramの組を求めることにします。scene1における発言者リストを3-gramに分割し、scene13gramとした場合、最初の3-gramは{PHILO, CLEOPATRA, MARK ANTONY}、二番目の3-gramは一人ずれて二人目から始まります{CLEOPATRA, MARK ANTONY, CLEOPATRA}。各gram内の発言者間には一定の親しさがあると仮定します。
In[]:=
scene13gram=Partition[scene1,3,1]
Out[]=
{{PHILO,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,CLEOPATRA},{MARK ANTONY,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,Attendant},{MARK ANTONY,Attendant,MARK ANTONY},{Attendant,MARK ANTONY,CLEOPATRA},{MARK ANTONY,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,CLEOPATRA},{MARK ANTONY,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,CLEOPATRA},{MARK ANTONY,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,CLEOPATRA},{MARK ANTONY,CLEOPATRA,MARK ANTONY},{CLEOPATRA,MARK ANTONY,DEMETRIUS},{MARK ANTONY,DEMETRIUS,PHILO},{DEMETRIUS,PHILO,DEMETRIUS}}
全シーンplayに対し(/@)、n-gramを計算し、各 n-gram s に関し、全二項組み合わせ(Permutation)を求め、同一発言者のペア({a_, a_})を DeleteCases によって削除し、全体を発言ペアからなる一次元のリスト S3gramを作ります。
In[]:=
S3gram=Join@@(Join@@Table[DeleteCases[Permutations[s,{2}],{a_,a_}],{s,Partition[#,3,1]}]&/@play);Length[S3gram]
Out[]=
3578
たとえば最初の4ペアを求めると次のようになります。
In[]:=
{S3gram[[1]],S3gram[[2]],S3gram[[3]],S3gram[[4]]}
Out[]=
{{PHILO,CLEOPATRA},{PHILO,MARK ANTONY},{CLEOPATRA,PHILO},{CLEOPATRA,MARK ANTONY}}
つぎに発言者ペアが何回登場するか調べると、ペアの個数が多いほど、直近で会話している回数が多い(互いに近しいと想像できる)ことがわかります。なお、SortはTallyを求めるために使用しています。
In[]:=
TS3gram=Tally[Sort/@S3gram];
ここでペアの登場回数の例を挙げると CLEOPATRA と PHILO との間ではわずか2回しか会話が交わされていないのに対し、CLEOPATRA と MARK ANTONY との間では262回も会話があったことがわかります。
In[]:=
{TS3gram[[1]],TS3gram[[2]],TS3gram[[3]]}
Out[]=
{{{CLEOPATRA,PHILO},2},{{MARK ANTONY,PHILO},4},{{CLEOPATRA,MARK ANTONY},262}}
二項関係は、各項を頂点 vertex とし、関係を辺 edge としてグラフとして表すことができます。本来グラフは頂点リストと辺リストを必要としますが
In[]:=
vertexList={1,2,3};edgeList={12,13};(*ue無向辺*)Graph[vertexList,edgeList,VertexLabels->"Name"]
Out[]=
孤立頂点(どの頂点ともつながっていない)がなければ辺のリストのみからグラフを構成できます。その際、無向辺リストは次の式で作れます。
In[]:=
UndirectedEdge@@@(First/@TS3gram)//Short
Out[]//Short=
{CLEOPATRAPHILO,MARK ANTONYPHILO,189,DOLABELLASecond Guard,First GuardOCTAVIUS CAESAR}
In[]:=
g=Graph[UndirectedEdge@@@(First/@TS3gram)]
Out[]=
以上で発言順から推定される関係グラフ g が得られたのですが、発言の重みを可視化したグラフ(発言力の高さに応じて頂点サイズを大きくする)を作ってみます。まず最初に各頂点(発言者)に発言回数に応じた重み vertex[v1], vertex[v2] を分配します。
In[]:=
Do[vertex[v]=0,{v,VertexList[g]}];Do[{{v1,v2},w}=e;vertex[v1]=vertex[v1]+w/2;vertex[v2]=vertex[v2]+w/2,{e,TS3gram}];
最後に各頂点の大きさ VertexSize を vertex[#]で置き換える作業を行い、辺の描画透明度をOpacity[0.2]と決め、その他オプションすべてを SetProperty によってグラフ g の属性として再設定します 。
In[]:=
g2=SetProperty[g,{VertexSizeThread[VertexList[g]Normalize[vertex[#]&/@VertexList[g]]],VertexLabels"Name",EdgeShapeFunctionFunction[{ptns,e},{Opacity[0.2],Line[ptns]}],ImageSize1000}]
Out[]=
この結果から CLEOPATRA、MARK ANTONY を中心に、DOMITIUS ENOBARBUS(アントニオの友人)、OCTAVIUS CAESAR らが中心人物となっていることがわかります。
一方、同じグラフをコミュニティという概念で分割することができます。
最後の{SILIUS,VENTIDIUS}を除くと5つのコミュニティに分割されます。
ただし CommunityGraphPlot を使うと各コミュニティの中心人物がハイライトされます:CLEOPATRA、MARK ANTONY、DOMITIUS ENOBARBUS、OCTAVIUS CAESAR に加え、CHARMAN(巫女)が新しく加わります。
Internet
Internet
次のヒストグラムは戯曲 play で描かれたコミュニティにおいて、横軸は頂点次数 VertexDegree(つながり)の大きさを、縦軸は当該次数に対応する人数を表します。たとえば多くの人が3人のつながりなのに対し、18人のつながりを持つ人はわずか2人だというのがわかります。
一方、MathematicaがExampleDataに用意するミニインターネットでは
全頂点22963個に対し
頂点次数が1000以上の頂点はわずか6個しかありません。逆に頂点次数(他の頂点とのつながり数)が2以下のものがほとんどだとわかります。
媒介中心性
媒介中心性
Mathematicaには様々な中心性メトリックスが提供されていますが、ここでは媒介中心性(情報媒介強度)を使い、
中心性最大の頂点4の隣接グラフを描いてみます。
媒介中心性の値が 100,000 以下となる頂点番号 8179 の近接頂点 2493, 8178, 8180 からなる隣接グラフを描いてみます。
ポートフォリオを探す
ポートフォリオを探す
クリークは完全部分グラフで、グラフ頂点同士には一定の相関があると考えられます。たとえば、この例で同期して変動する銘柄、つまり、クリークを構成する銘柄を探します。最初にダウ・ジョーンズ工業株一覧 dji を用意します。
まず,2012年初からの利益 r を得ます。
ついで、情報が欠損しているデータ位置 pos を計算し、利益 r(実値 Values) を再計算し、
あわせて dji から欠損銘柄を削除します。
最後に利益をベースに全銘柄の共分散行列 cor を求めます。
AdjacencyGraph は頂点リスト dji に対し、隣接行列で 1 が立っている頂点間を辺でつなぎます。
FindClique によって利益に関し同期して動くことが多い3つの銘柄を得ました。
変動同期に関し、累積利益グラフで確認します。
線画上に最短パスを見つける
線画上に最短パスを見つける
MorphologicalGraphは対象となる線画の結合部分をエッジ化します。ここでは迷路をエッジ化し、迷路を抜ける最短パスを見つけています。
次はもっと複雑な線画ですが、発想は迷路の場合と同じです。
グラフとした場合の座標を確認しています。
地点447番から地点5番までの最短経路を見つけ、元図にマップします。