変数を対として組み合わせたときの，無向グラフによる相関のビジュアライズ

イントロダクション

Step 0シチュエーションの設定

いくつかの対となる組み合わせをもつ変数の相関あるいは偏相関の可視化法のひとつで，いうなれば相関行列(or偏―)をより直感的に見せるための工夫です(Figure)。一瞥したときの読み取りやすさ・伝わりやすさといった点では多くの場合表(相関行列)よりも優れます。が，あくまでも相関行列なので2変数の線形関係を訴求したりといった必要が生じる場合には力及ぶものではありません(この場合散布図行列)。

ここでは，次表のデータをもとにして，変数の組み合わせ方を網羅したうえで，枝(branch)の太さと色で相関係数を示す無向グラフをつくります。ここで枝の太さは相関係数の絶対値を，枝の色は相関係数の正負を表現するものとします。またここでは作図部分でのみVBAを使用します。

なおVBAを利用する観点から，せっかくなので，しくみとして，2つのタイプを選択的に利用できるような構造にしていきたいと思います。ここに言う「2つのタイプ」とは，具体的には，

［type1］ノード・枝と，相関係数の絶対値の目安を示す凡例からなる無向グラフ

無向グラフ｜type1｜凡例対比

［type2］ノード・枝と，枝の中点に表示される相関係数からなる無向グラフ

無向グラフ｜type2｜相関係数埋め込み

を指すものです。

仕様

「大は小を兼ねる」的な構造シートのです。ひな形として利用する場合には，最初から多くの変数を想定してシートを仕上げてしまった方が後々はかどるかもしれません。
散布図を素地にして図を描きます。ノード・枝およびラベルはそれぞれ単独の系列を消費して表示します。したがってエクセルの仕様上の系列数の上限(255)以内で図のすべての要素が描ける場合のみ正常に機能します。

免責および特記事項

このマクロはあくまでデモンストレーションを目的としたものです。コードをそのままご利用いただく場合には，お手持ちのデータで従前の方法にて作成したものと内容を照合し，おかしな点が出現しないかどうかを安全な環境で十分に確認してください。精度の不足あるいは予期しないデータ消失等のトラブルにつきまして，筆者は一切責任を負いかねます。
マクロの動作自体の検証(お使いの環境で正常に動作するか，あるいは処理にどの程度の時間がかかるかといったことの確認)には，このテストデータをExcelにコピペしてお使いいただけます。万一動作中に固まった場合は，[Ctrl]キー＋[Pause/Break]キーをお試しください。

以下，相関係数の図示を目的とした，無向グラフ作成の手続きです。

工程

準備｜シートの構成をととのえる

Step 1［準備］4つのシートの用意と相関行列の作成

「元データ」シートの他に4つのあたらしいシートを追加します。

あたらしく追加するシート名とそれらシートの単純な役割は，それぞれ次の通りです。

Regular Polygon ―円に内接する正多角形の頂点を求める
Correlation Matrix ―他シートが相関係数をひく際の参照先とする
Legend ―type1グラフでの凡例をつくる
Branch ―枝の座標を求める

以下数式・コードのなかでシートを参照する場面では，すでに上記の名称が組み込まれています。やや複雑なので基本的には推奨しませんが，他の名称を利用したい場合には，必要な個所すべてを漏らさず変更してください。

ではまず，「元データ」シートの空いている場所で相関行列を求めます。これはアドイン「分析ツール」を使うと簡単です。

相関行列を求めたら，この部分(下図強調部分)をコピーしておきます。

Step 2［準備］"Correlation Matrix"シート

「Correlation Matrix」シートに切り替え，セルA1に行列を逆にして(入れ替えて)値のみ貼り付けます(「形式を選択して貼り付け」)※。

これにより，1つ1つの枝が持つ相関係数の値を「Branch」シートにて与えます。

※Step 1において，「分析ツール」アドイン以外の方法で右上が省略されないタイプの相関行列を出力した場合には，そのまま値のみコピペでOKです。

Step 3［準備］"Legend"シート

「Legend」シートに切り替えます。これは凡例用のシートです。

これにより，座標(X1, Y1)～(X2, Y2)に線を引き，線の中点(DLX, DLY)にデータラベルを打つための情報を与えます。

ということで，セルA1からG2に，以下のように入力(or下表をコピペ。以下に同じ)します。

r	X1	X2	Y1	Y2	DLX	DLY
0.1	1.5	2	-0.8	=D2	1.75	=D2

つづいてセルA3およびD3に下表の式を入力し，これらを11行目までコピーします。

A3	=A2+0.1
D3	=D2+(0.01910A2+0.0794)

下図の定数または式をそれぞれ11行目までコピーします(セルE2～G2は必ず1列ずつコピー)。

Step 4［準備］"Regular Polygon"シート

「Regular Polygon」シートに切り替えます。

これにより，正n角形をつくるために必要な座標(X,Y)を導きます。

見出しおよびすべての変数名を次のように入力します。ここで並べた変数の順番を，後段では「序列」と呼びます。このとき，シートの上方の変数を上位，下方の変数を下位とします。

Node No.

Caption

セルA2, C2およびD2に下表の式を入力し，これらを表の最下行までコピーします。

A2	=IF(B2<>"", ROW()-1, "")
C2	=COS((2PI()A2)/COUNT(A:A))
D2	=SIN((2PI()A2)/COUNT(A:A))

Step 5［準備］"Branch"シート(1)

「Branch」シートに切り替えます。

これにより，枝を描くために必要な座標(N1X, N1Y)～(N2Y, N2Y)，あるいは枝の中点にデータラベルrを置くための座標(rX, rY)を導きます。

まず，セルA1～J1に次の見出しをつくります。

Br No.

N1X

N2X

N1Y

N2Y

次にB・C列に必要な枝の組み合わせをつくります。たとえば変数の数をnとしたとき，組み合わせの総数は_nC₂=n!/(2!(n-2)!)となります。この例示ではn=8なので，28本の枝が必要です。ただし，これをあらかじめ見積もっておくことは以下の作業に関して必須ではありません。

具体的なシート上での作業としては，B列は変数の序列の上位(ここではA)からn-1, n-2, n-3, …, 1個ずつ(変数名［「Regular Polygon」シートの"Caption"列の内容］を)埋めていきます。

C列は，B列の同じ変数の1つのブロックを基準にして，その変数でいう序列の上位と同位を弾いた残りの変数名を下位に向けて埋めていきます。たとえば，B列の変数名「E」についてなら，序列の上位と同位はABCDEなので，B列の「E」変数に対応するC列の領域には残りのFGHを入力します。

A	B
A	C
A	D
A	E
A	F
A	G
A	H
B	C
B	D
B	E
B	F
B	G
B	H
C	D
C	E
C	F
C	G
C	H
D	E
D	F
D	G
D	H
E	F
E	G
E	H
F	G
F	H
G	H

セルA2に下表の式を入力し，これを表の最下行までコピーします。

A2	=IF(B2<>"", ROW()-1, "")

Step 6［準備］"Branch"シート(2)

セルD2～G2に下表の式を入力します。入力後，これらを表の最下行までコピーします。

D2	=VLOOKUP(B2, 'Regular Polygon'!$B$2:$D$9, 2, FALSE)
E2	=VLOOKUP(C2, 'Regular Polygon'!$B$2:$D$9, 2, FALSE)
F2	=VLOOKUP(B2, 'Regular Polygon'!$B$2:$D$9, 3, FALSE)
G2	=VLOOKUP(C2, 'Regular Polygon'!$B$2:$D$9, 3, FALSE)

Step 7［準備］"Branch"シート(3)

セルH2～J2に下表の式を入力します。入力後，これらを表の最下行までコピーします。

H2	=ROUND(INDEX('Correlation Matrix'!$B$2:$I$9, MATCH(B2,'Correlation Matrix'!$A$2:$A$9,0), MATCH(C2,'Correlation Matrix'!$B$1:$I$1,0)), 2)
I2	=D2+(E2-D2)/2
J2	=F2+(G2-F2)/2

念のため，下図は上の操作の直後の状態を示します(サンプルのデータによるもの)。

Step 8［準備］"Regular Polygon"シート―元図の用意

「Regular Polygon」シートに切り替えます。

このシートの下の範囲のデータを使って，散布図を作成しておきます。

この散布図のマーカーを任意の大きさに設定し，変数名でデータラベルをつくります。なおデフォルトでの枝の最大幅は16ptとしています(変更は直接コードの「初期値設定」から)。したがって，マーカーの大きさは少なくともそれ以上が必要です。筆者個人の嗜好からは，40pt前後がバランス的によさげなように感じます。

また，このあと扱うマクロはアクティブにしたグラフに対してのみ処理を重ねていく仕様です。あれこれ試行したい場合に，すぐ上で作ったようなプレーンなグラフを都度用意していくのも面倒なので，元の図を“ひな形”として利用する(つまり手を加えない)ことを想定した方式を採りました。したがってマクロの運用のしかたとしては，まず“ひな形”を複製し，その複製した方に対して適用していくことをオススメします。

描画｜コードを導入し，実行する

Step 9［描画］コードの組み込み

下のコードをVBEから標準モジュールを追加して組み込みます。

Sub UNDIRECTEDGRAPH_type1()

' *** 無向グラフ[type1] v16.0301
' *** bdastyle.net/tools/scatterplot/undirected-graph.html
' *** by hawcas 2016

Dim N As Long
Dim LW As Double
Dim ser_CP As String ' 系列caption
Dim ser_X As String ' 系列X
Dim ser_Y As String ' 系列Y
Dim TARGET As String ' データ範囲
Dim sCounter As Long ' 系列の数のカウンタ
Dim y As Long ' カウンタ
Dim tmp As String

' 初期値設定
tmp = "'Branch'!A:A"
N = Application.WorksheetFunction.Count(Range(tmp)) ' 線(branch)の数
LW = 16 ' 線(branch)幅の基準値(相関係数のときの線の太さ:pt)
' 初期値設定 ここまで

' 線の描画
sCounter = 1

For y = 1 To N
    ser_CP = "" ' 系列名の作成
    ser_CP = "Branch_" & Sheets("Branch").Range("A1").Offset(y, 0).Value
    ser_X = "" ' X範囲の作成
    ser_X = "'Branch'!" & Range("A1").Offset(y, 3).Address & _
                ",'Branch'!" & Range("A1").Offset(y, 4).Address
    ser_Y = "" ' Y範囲の作成
    ser_Y = "'Branch'!" & Range("A1").Offset(y, 5).Address & _
                ",'Branch'!" & Range("A1").Offset(y, 6).Address
    With ActiveChart ' 系列の作成
        .SeriesCollection.NewSeries
        .FullSeriesCollection(y + 1).Name = ser_CP
        .FullSeriesCollection(y + 1).XValues = ser_X
        .FullSeriesCollection(y + 1).Values = ser_Y
        .FullSeriesCollection(y + 1).Select
    End With

    With Selection
        .Format.Line.Visible = msoTrue
        .Format.Line.Weight = LW * Abs(Sheets("Branch").Range("A1").Offset(y, 7).Value) ' rに応じた線の幅を設定
            Select Case Sheets("Branch").Range("A1").Offset(y, 7).Value
            Case Is < 0
                .Format.Line.ForeColor.RGB = RGB(222, 233, 239) ' 負の相関のときの彩色
            Case Is > 0
                .Format.Line.ForeColor.RGB = RGB(239, 222, 223) ' 正の相関のときの彩色
            Case 0
                .Format.Line.ForeColor.RGB = RGB(255, 255, 255) ' 無相関のときの彩色
            End Select
        .MarkerStyle = -4142
    End With
Next

sCounter = sCounter + N

' 凡例の描画(bar)
For y = 1 To 10
    ser_CP = "" ' 系列名の作成
        ser_CP = "LegendBar_" & Sheets("Legend").Range("A1").Offset(y, 0).Value
    ser_X = "" ' X範囲の作成
    ser_X = "'Legend'!" & Range("A1").Offset(y, 1).Address & _
                ",'Legend'!" & Range("A1").Offset(y, 2).Address
    ser_Y = "" ' Y範囲の作成
    ser_Y = "'Legend'!" & Range("A1").Offset(y, 3).Address & _
                ",'Legend'!" & Range("A1").Offset(y, 4).Address
    With ActiveChart
        .SeriesCollection.NewSeries
        .FullSeriesCollection(sCounter + y).Name = ser_CP
        .FullSeriesCollection(sCounter + y).XValues = ser_X
        .FullSeriesCollection(sCounter + y).Values = ser_Y
        .FullSeriesCollection(sCounter + y).Select
    End With

    With Selection
        .Format.Line.Visible = msoTrue
        .Format.Line.Weight = LW * Abs(y / 10) ' rに応じた線の幅を設定
        .Format.Line.ForeColor.RGB = RGB(216, 216, 216) ' 凡例バーの彩色
        .MarkerStyle = -4142
    End With
Next

sCounter = sCounter + 10

' 凡例の描画(値)
For y = 1 To 10
    ser_CP = "" ' 系列名の作成
        ser_CP = "LegendDL_" & Sheets("Legend").Range("A1").Offset(y, 0).Value
    ser_X = "" ' X範囲の作成
    ser_X = "'Legend'!" & Range("A1").Offset(y, 5).Address
    ser_Y = "" ' Y範囲の作成
    ser_Y = "'Legend'!" & Range("A1").Offset(y, 6).Address
    With ActiveChart
        .SeriesCollection.NewSeries
        .FullSeriesCollection(sCounter + y).Name = ser_CP
        .FullSeriesCollection(sCounter + y).XValues = ser_X
        .FullSeriesCollection(sCounter + y).Values = ser_Y
        .FullSeriesCollection(sCounter + y).Select
    End With

    With Selection
        .MarkerStyle = -4142
    End With

    TARGET = "'Legend'!" & Range("A1").Offset(y, 0).Address ' ラベル参照先
    ActiveSheet.ChartObjects(ActiveChart.Parent.Index).Chart. _
                SeriesCollection(sCounter + y).HasDataLabels = True ' データラベルON
    ActiveChart.FullSeriesCollection(sCounter + y).DataLabels.Select
    ActiveChart.SeriesCollection(sCounter + y).DataLabels.Format.TextFrame2.TextRange. _
                InsertChartField msoChartFieldRange, TARGET, 0
     With Selection
        .ShowRange = True
        .ShowValue = False
        .Position = xlLabelPositionCenter ' データラベルを不可視マーカーの中央に
        .Font.Name = "Consolas" ' データラベルのフォントを指定
    End With
Next

End Sub

Sub UNDIRECTEDGRAPH_type2()

' *** 無向グラフ[type2] ver.1.0.0
' *** http://bdastyle.net/tools/scatterplot/undirected-graph.html
' *** by hawcas 2016

Dim N As Long
Dim LW As Double
Dim ser_CP As String ' 系列caption
Dim ser_X As String ' 系列X
Dim ser_Y As String ' 系列Y
Dim TARGET As String ' データ範囲
Dim sCounter As Long ' 系列の数のカウンタ
Dim y As Long ' カウンタ
Dim tmp As String

' 初期値設定
tmp = "'Branch'!A:A"
N = Application.WorksheetFunction.Count(Range(tmp)) ' 線(branch)の数
LW = 16 ' 線(branch)幅の基準値(相関係数のときの線の太さ:pt)
' 初期値設定 ここまで

' 線の描画
sCounter = 1

For y = 1 To N
    ser_CP = "" ' 系列名の作成
    ser_CP = "Branch_" & Sheets("Branch").Range("A1").Offset(y, 0).Value
    ser_X = "" ' X範囲の作成
    ser_X = "'Branch'!" & Range("A1").Offset(y, 3).Address & _
                ",'Branch'!" & Range("A1").Offset(y, 4).Address
    ser_Y = "" ' Y範囲の作成
    ser_Y = "'Branch'!" & Range("A1").Offset(y, 5).Address & _
                ",'Branch'!" & Range("A1").Offset(y, 6).Address
    With ActiveChart ' 系列の作成
        .SeriesCollection.NewSeries
        .FullSeriesCollection(y + 1).Name = ser_CP
        .FullSeriesCollection(y + 1).XValues = ser_X
        .FullSeriesCollection(y + 1).Values = ser_Y
        .FullSeriesCollection(y + 1).Select
    End With

    With Selection
        .Format.Line.Visible = msoTrue
        .Format.Line.Weight = LW * Abs(Sheets("Branch").Range("A1").Offset(y, 7).Value) ' rに応じた線の幅を設定
            Select Case Sheets("Branch").Range("A1").Offset(y, 7).Value
            Case Is < 0
                .Format.Line.ForeColor.RGB = RGB(222, 233, 239) ' 負の相関のときの彩色
            Case Is > 0
                .Format.Line.ForeColor.RGB = RGB(239, 222, 223) ' 正の相関のときの彩色
            Case 0
                .Format.Line.ForeColor.RGB = RGB(255, 255, 255) ' 無相関のときの彩色
            End Select
        .MarkerStyle = -4142
    End With
Next

sCounter = sCounter + N

' 相関係数の描画(Marker)
For y = 1 To N
    ser_CP = "" ' 系列名の作成
        ser_CP = "Rmarker_" & Sheets("Branch").Range("A1").Offset(y, 0).Value
    ser_X = "" ' X範囲の作成
    ser_X = "'Branch'!" & Range("A1").Offset(y, 8).Address
    ser_Y = "" ' Y範囲の作成
    ser_Y = "'Branch'!" & Range("A1").Offset(y, 9).Address
    With ActiveChart
        .SeriesCollection.NewSeries
        .FullSeriesCollection(sCounter + y).Name = ser_CP
        .FullSeriesCollection(sCounter + y).XValues = ser_X
        .FullSeriesCollection(sCounter + y).Values = ser_Y
        .FullSeriesCollection(sCounter + y).Select
    End With

    With Selection
        .MarkerStyle = -4142
    End With

    TARGET = "'Branch'!" & Range("A1").Offset(y, 7).Address ' ラベル参照先
    ActiveSheet.ChartObjects(ActiveChart.Parent.Index).Chart. _
        SeriesCollection(sCounter + y).HasDataLabels = True ' データラベルON
    ActiveChart.FullSeriesCollection(sCounter + y).DataLabels.Select
    ActiveChart.SeriesCollection(sCounter + y).DataLabels.Format.TextFrame2.TextRange. _
                InsertChartField msoChartFieldRange, TARGET, 0
    With Selection
        .ShowRange = True
        .ShowValue = False
        .Position = xlLabelPositionCenter ' データラベルを不可視マーカーの中央に
        .Font.Name = "Consolas" ' データラベルのフォントを指定
    End With

Next

End Sub

Step 10［描画］Type1 or Type2?

「Regular Polygon」シートにつくったグラフのうち，処理の対象とするグラフをアクティブ(選択)にして，「マクロ」ダイアログを呼び出します。

マクロ「UNDIRECTEDGRAPH_type1」はStep 0のtype1グラフを，「UNDIRECTEDGRAPH_type2」はStep 0のtype2グラフを作成します。

いずれかのマクロを選択し実行ボタンをクリックすると，アクティブにしたグラフに対し適宜処理が加えられていきます。

Step 11無向グラフの完成

しばらくののち，選択したマクロによって，上下いずれかの形式のグラフへと加工されます。

これに対して任意に修正あるいは書式設定を加え，下のような当初に目的としたグラフが完成です。

(相関を可視化するための)無向グラフが出力可能なExcelアドインソフト

エクセル統計 BellCurve

「基本統計・相関」「相関行列と偏相関行列」における偏相関係数のオプション

その他の参照

このサイトの関連How-toです。

メインサイト「ひとりマーケティングのためのデータ分析」の散布図に関するHow-toです。

Home

BDAstyle

Business Data Analysis & Visualization with Excel