ExcelVBAでUnion-Findクラスを作成
Union-Findクラスの作成（UnionFindClass.cls）
Option Explicit
Private n As Long '要素数
Private parents() As Variant '要素の配列
Private i As Long 'ループカウンタ
' クラスの初期化
Public Sub Initialize(ByVal c_n As Long)
n = c_n
ReDim parents(n - 1) '配列の要素数nに変更
For i = 0 To n - 1 '配列parentsを初期化
parents(i) = -1
Next
End Sub
' 要素xが属するグループと要素yが属するグループを接合する
Public Sub Union(ByVal c_x As Long, ByVal c_y As Long)
Dim x As Long
Dim y As Long
Dim wk As Long ' 作業用変数
x = find(c_x)
y = find(c_y)
If x = y Then
Exit Sub
End If
If parents(x) > parents(y) Then ' xとyを入れ替える
wk = x
x = y
y = wk
End If
parents(x) = parents(x) + parents(y)
parents(y) = x
End Sub
'要素xが属するグループの根を返す
Public Function find(ByVal c_x As Long) As Long
If parents(c_x) < 0 Then
find = c_x
Else
parents(c_x) = find(parents(c_x))
find = parents(c_x)
End If
End Function
'要素xの属するグループの大きさを返す
Public Function size(ByVal c_x As Long) As Long
size = -parents(Me.find(c_x))
End Function
'要素xと要素yが同じグループに属しているか判定する
Public Function same(ByVal c_x As Long, ByVal c_y As Long) As Boolean
If Me.find(c_x) = Me.find(c_y) Then
same = True
Else
same = False
End If
End Function
'要素xが属するグループの要素をリストで返す
Public Function members(ByVal c_x As Long) As Variant()
Dim root As Long ' 要素xが属するグループの根
Dim rtn_members() As Variant ' 戻り値の配列
root = find(c_x) ' 要素xが属するグループの根
For i = 0 To n - 1 '要素数分繰り返す
If find(i) = root Then ' 各要素が要素xが属するグループの根と同じ場合
ReDim Preserve rtn_members(i) '配列の大きさを変更、Preserveで元のデータを残す
rtn_members(i) = i '戻り値の配列に要素iを追加
End If
Next
members = rtn_members()
End Function
'その木に属するすべての根の要素をリストで返す
Public Function roots() As Variant()
Dim rtn_roots() As Variant ' 戻り値の配列
For i = 0 To n - 1 '要素数分繰り返す
If parents(i) < 0 Then ' 各要素が負の場合（=グループの根）
ReDim Preserve rtn_roots(i) '配列の大きさを変更、Preserveで元のデータを残す
rtn_roots(i) = i '戻り値の配列に要素iを追加
End If
Next
roots = rtn_roots()
End Function
'その木のグループの数を返す
Public Function group_count() As Long
group_count = UBound(roots(), 1)
End Function
' n の値を取得
Property Get get_n() As Long
get_n = n
End Property
Property Get get_parents() As Variant ' parents() の値を取得
get_parents = parents()
End Property
UnionFindClassのテスト（UnionFindTest.bas）
Option Explicit
Sub UnionFind_test()
'
' https://qiita.com/uniTM/items/77ef2412e426cae44586
' のテスト
'
Dim uf_3 As UnionFindClass
Dim uf_5 As UnionFindClass
Dim i As Long
Dim output As String ' 出力文字列
Dim parents As Variant
'
' parentsのテスト
'
Debug.Print vbCrLf & "parentsのテスト"
Set uf_3 = New UnionFindClass
Call uf_3.Initialize(3) 'UnionFindClassの初期化
Debug.Print "uf_3.parents() = ";
Print_Array (uf_3.get_parents()) ' Debug.Printで配列を一括出力
Set uf_5 = New UnionFindClass
Call uf_5.Initialize(5) 'UnionFindClassの初期化
Debug.Print vbCrLf & "uf_5.parents() = ";
Print_Array (uf_5.get_parents()) ' Debug.Printで配列を一括出力
'
' union(x, y)のテスト
'
Debug.Print vbCrLf
Debug.Print vbCrLf & "union(x, y)のテスト"
Call uf_3.Union(1, 2) 'グループの接合
Debug.Print "uf_3.parents() = ";
Print_Array (uf_3.get_parents()) ' Debug.Printで配列を一括出力
Call uf_3.Union(0, 1) 'グループの接合
Debug.Print vbCrLf & "uf_3.parents() = ";
Print_Array (uf_3.get_parents()) ' Debug.Printで配列を一括出力
Call uf_5.Union(1, 2) 'グループの接合
Debug.Print vbCrLf & "uf_5.parents() = ";
Print_Array (uf_5.get_parents()) ' Debug.Printで配列を一括出力
Call uf_5.Union(2, 4) 'グループの接合
Debug.Print vbCrLf & "uf_5.parents() = ";
Print_Array (uf_5.get_parents()) ' Debug.Printで配列を一括出力
'
' Find(x)のテスト
'
Debug.Print vbCrLf
Debug.Print vbCrLf & "Find(x)のテスト"
Debug.Print "uf_3.Find(2) = " & uf_3.find(2) ' 0とunion()したので、親は1
Debug.Print "uf_3.Find(1) = " & uf_3.find(1) ' 1の親はもちろん1
Debug.Print "uf_5.Find(3) = " & uf_5.find(3) ' 3はどれともつながっていないので、3
Debug.Print "uf_5.Find(4) = " & uf_5.find(4) ' union(1, 2)とunion(2, 4)より親は1
'
' Size(x)のテスト
'
Debug.Print vbCrLf & "Size(x)のテスト"
Debug.Print "uf_3.Size(2) = " & uf_3.size(2)
Debug.Print "uf_3.Size(1) = " & uf_3.size(1)
Debug.Print "uf_5.Size(3) = " & uf_5.size(3)
Debug.Print "uf_5.Size(4) = " & uf_5.size(4)
'
' same(x,y)のテスト
'
Debug.Print vbCrLf & "same(x,y)のテスト"
Debug.Print "uf_3.same(1, 2) = " & uf_3.same(1, 2)
Debug.Print "uf_3.same(0, 2) = " & uf_3.same(0, 2)
Debug.Print "uf_5.same(1, 4) = " & uf_5.same(1, 4)
Debug.Print "uf_5.same(1, 3) = " & uf_5.same(1, 3)
'
' members()のテスト
'
Debug.Print vbCrLf & "members()のテスト"
Debug.Print vbCrLf & "uf_3.members(0) = ";
Print_Array (uf_3.members(0)) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & "uf_3.members(1) = ";
Print_Array (uf_3.members(1)) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & "uf_5.members(1) = ";
Print_Array (uf_5.members(1)) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & "uf_5.members(3) = ";
Print_Array (uf_5.members(3)) ' Debug.Printで配列を一括出力
'
' roots()のテスト
'
Debug.Print vbCrLf
Debug.Print vbCrLf & "roots()のテスト"
Debug.Print vbCrLf & "uf_3.roots() = ";
Print_Array (uf_3.roots()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & "uf_5.roots() = ";
Print_Array (uf_5.roots()) ' Debug.Printで配列を一括出力
'
' group_count()のテスト
'
Debug.Print vbCrLf
Debug.Print vbCrLf & "group_count()のテスト"
Debug.Print "uf_3.group_count() = " & uf_3.group_count()
Debug.Print "uf_5.group_count() = " & uf_5.group_count()
End Sub
Sub UnionFind_test2()
'
' https://note.nkmk.me/python-union-find/
' のテスト
'
Dim uf_6 As UnionFindClass
Debug.Print vbCrLf & "https://note.nkmk.me/python-union-find/のテスト"
Set uf_6 = New UnionFindClass
Call uf_6.Initialize(6) 'UnionFindClassの初期化
Debug.Print vbCrLf & "uf_6の初期化"
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & vbCrLf & "グループの接合 uf_6.Union(0, 2)"
Call uf_6.Union(0, 2) 'グループの接合
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & vbCrLf & "グループの接合 uf_6.Union(1, 3)"
Call uf_6.Union(1, 3) 'グループの接合
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & vbCrLf & "グループの接合 uf_6.Union(4, 5)"
Call uf_6.Union(4, 5) 'グループの接合
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & vbCrLf & "グループの接合 uf_6.Union(1, 4)"
Call uf_6.Union(1, 4) 'グループの接合
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
Debug.Print vbCrLf & vbCrLf & "グループの根を返す"
Debug.Print "uf_6.Find(5) = " & uf_6.find(5) '要素xが属するグループの根を返す
'find()を実行すると経路圧縮により親要素が根要素に更新
Debug.Print "uf_6.parents() = ";
Print_Array (uf_6.get_parents()) ' Debug.Printで配列を一括出力
End Sub
実行結果（イミディエイトウィンドウに出力）
parentsのテスト
uf_3.parents() = -1 -1 -1
uf_5.parents() = -1 -1 -1 -1 -1
union(x, y)のテスト
uf_3.parents() = -1 -2 1
uf_3.parents() = 1 -3 1
uf_5.parents() = -1 -2 1 -1 -1
uf_5.parents() = -1 -3 1 -1 1
Find(x)のテスト
uf_3.Find(2) = 1
uf_3.Find(1) = 1
uf_5.Find(3) = 3
uf_5.Find(4) = 1
Size(x)のテスト
uf_3.Size(2) = 3
uf_3.Size(1) = 3
uf_5.Size(3) = 1
uf_5.Size(4) = 3
same(x,y)のテスト
uf_3.same(1, 2) = True
uf_3.same(0, 2) = True
uf_5.same(1, 4) = True
uf_5.same(1, 3) = False
members()のテスト
uf_3.members(0) = 0 1 2
uf_3.members(1) = 0 1 2
uf_5.members(1) = 1 2 4
uf_5.members(3) = 3
roots()のテスト
uf_3.roots() = 1
uf_5.roots() = 0 1 3
group_count()のテスト
uf_3.group_count() = 1
uf_5.group_count() = 3
https://note.nkmk.me/python-union-find/のテスト
uf_6の初期化
uf_6.parents() = -1 -1 -1 -1 -1 -1
グループの接合 uf_6.Union(0, 2)
uf_6.parents() = -2 -1 0 -1 -1 -1
グループの接合 uf_6.Union(1, 3)
uf_6.parents() = -2 -2 0 1 -1 -1
グループの接合 uf_6.Union(4, 5)
uf_6.parents() = -2 -2 0 1 -2 4
グループの接合 uf_6.Union(1, 4)
uf_6.parents() = -2 -4 0 1 1 4
グループの根を返す
uf_6.Find(5) = 1
uf_6.parents() = -2 -4 0 1 1 1
参考サイト
Algorithm | Union-FindをPython3で解説（例題あり） https://qiita.com/uniTM/items/77ef2412e426cae44586
PythonでのUnion-Find（素集合データ構造）の実装と使い方
https://note.nkmk.me/python-union-find/