BDAstyle

ビジネスデータ分析ツールの作成 with Excel

無向グラフの作成 with Excel(変数を対として組み合わせたときの相関のビジュアライズ)

1.イントロダクション

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

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

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

初期データ

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

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

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

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

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

を指すものです。

仕様

免責および特記事項

以下,相関を図示するために利用する,無向グラフの具体的な作成の手続きです。


2.準備|シートの構成をととのえる

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

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

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

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

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

相関行列を求めたら,この部分をコピーしておきます。

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.019*10*A2+0.0794)

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

Step 4[準備]"Regular Polygon"シート

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

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

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

Node No. Caption X Y

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

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

Step 5[準備]"Branch"シート(1)

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

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

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

Br No. N1 N2 N1X N2X N1Y N2Y r rX rY

次にB・C列に必要な枝の組み合わせをつくります。たとえば変数の数をnとしたとき,組み合わせの総数はnC2=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前後がバランス的によさげなように感じます。

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

3.描画|コードを導入し,実行する

Step 9[描画]コードの組み込み

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

Sub UNDIRECTEDGRAPH_type1()

' ***無向グラフ[type1] 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

' 凡例の描画(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 0type1グラフを,「UNDIRECTEDGRAPH_type2」はStep 0type2グラフを作成します。

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

Step 11無向グラフの完成

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

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

(相関のビジュアライズに関する)無向グラフが出力可能なexcelアドインソフト

その他の参照