ＶＢＡを用いた集合の理解　④ 和集合と積集合 - Infomentのブログ～Excel VBA奮闘記～

先日から高校数学の学び直しとして、ＶＢＡを用いた集合の理解に挑戦している。
infoment.hatenablog.com
今日も、先日の続きから。
f:id:Infoment:20210520225637p:plain

今日は、和集合と積集合について考えてみる。
例えば、以下のグループがあるとする。

Ａグループ：りんご、みかん、ばなな
Ｂグループ：ぶどう、みかん、なし

この時、和集合と積集合は次のようになる。

和集合Ａ∪Ｂ　ＡとＢのどちらかにいる
　⇒ りんご、みかん、ばなな、ぶどう、なし
積集合Ａ∩Ｂ　必ずＡとＢの両方にいる
　⇒ みかん

ＡとＢを配列とした場合、次の作戦で和集合と積集合を求めてみる。

和集合の場合Ａ∪Ｂ

両グループの果物を全部一まとめにして、重複があれば更に一まとめにする。
今回は、キーの重複登録ができない「辞書（連想配列）」を活用してみよう。
折角なので、和集合の中身を並び替えるオプションもつけてみよう。

Public Function SortArray(ByVal source_array As Variant, _
                       Optional sort_order As Excel.XlSortOrder = xlAscending) As Variant
                       
    Dim aryList As Object
    Set aryList = CreateObject("System.Collections.ArrayList")
    Dim s As Variant
    
        For Each s In source_array
            Call aryList.Add(s)
        Next
    
        Select Case sort_order
            Case xlAscending
                ' 昇順でソート。
                Call aryList.Sort
            Case xlDescending
                ' 昇順でソートののち、降順へ反転。
                Call aryList.Sort
                Call aryList.Reverse
        End Select
    
        SortArray = aryList.ToArray
        
End Function

' 集合Ａと集合Ｂの和集合を取得。
' Ａ ∪ Ｂ
' ※配列Ａと配列Ｂの次元数に関わらず、ＡまたはＢの要素全てを
' 　一次元配列に格納する。
' ※ＡまたはＢ内で重複していた要素は、この処理により重複除去される。
Public Function GetUnionSet(ByVal set_A As Variant, _
                            ByVal set_B As Variant, _
                         Optional sort_order As Excel.XlSortOrder) As Variant

        If Not IsArray(set_A) Or Not IsArray(set_B) Then Exit Function
    
    Dim a As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        
        ' 連想配列の「キーの重複を認めない」仕様を利用して、重複除去している。
        ' 従ってキーに対応するアイテムは不問であり、今回はキーそのものをセットしている。
    Dim arr As Variant
        For Each arr In Array(set_A, set_B)
            For Each a In arr
                Dict(a) = a
            Next
        Next
        
        arr = Dict.keys
        If sort_order <> 0 Then
            arr = SortArray(arr, sort_order)
        End If
        
        GetUnionSet = arr

End Function

積集合の場合Ａ∩Ｂ

Ａの各要素について、Ｂに存在するものだけを辞書に登録する。
存在するか否かは、先日作成したIsElementを利用する。

' 指定文字列が、ある集合の要素であるか否かを返す。
' a ∈ Ａ：ａは集合Ａの要素である。
Public Function IsElement(ByVal element As Variant, _
                          ByVal target_set As Variant, _
                       Optional LookAt As XlLookAt = xlWhole) As Boolean
        
    ' 集合ではないものが指定された場合、Falseを返す。
        If Not IsArray(target_set) Then Exit Function
    
    ' 配列内の値と順にelementを照合し、同じものがある時点でTrueを返す。
    ' 従って、この関数はtarget_set内で複数の同じ値が含まれる場合を除外しない。
    Dim a As Variant
        If LookAt = xlPart Then element = "*" & element & "*"
    
        For Each a In target_set
            If a Like element Then
                IsElement = True
                Exit Function
            End If
        Next
        
End Function

' 集合Ａと集合Ｂの積集合を取得。
' Ａ ∩ Ｂ
' ※配列Ａと配列Ｂの次元数に関わらず、ＡまたはＢの要素全てを
' 　一次元配列に格納する。
' ※ＡまたはＢ内で重複していた要素は、この処理により重複除去される。
Public Function GetIntersectionSet(ByVal set_A As Variant, _
                                   ByVal set_B As Variant, _
                                Optional sort_order As Excel.XlSortOrder) As Variant

        If Not IsArray(set_A) Or Not IsArray(set_B) Then Exit Function
        
        ' ＡとＢのどちらか一方でも空集合の場合、積集合は空集合となる。
        If UBound(set_A) = -1 Or UBound(set_B) = -1 Then
            GetIntersectionSet = EmptySet
            Exit Function
        End If
    
    Dim a As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        
        ' 連想配列の「キーの重複を認めない」仕様を利用して、重複除去している。
        ' 従ってキーに対応するアイテムは不問であり、今回はキーそのものをセットしている。
        For Each a In set_A
            If IsElement(a, set_B) Then
                Dict(a) = a
            End If
        Next
        
        ' 辞書に何も登録されていない場合、積集合は存在しない。
        If Dict.Count = 0 Then
            GetIntersectionSet = EmptySet
            Exit Function
        End If

    Dim arr As Variant
        arr = Dict.keys
        If sort_order <> 0 Then
            arr = SortArray(arr, sort_order)
        End If
        
        GetIntersectionSet = arr

End Function

結果の確認

それでは、簡単なテストを一つ。

Sub test()

    Dim MS As VBAProject.MathSet
    Set MS = New VBAProject.MathSet
        
    Dim 果物1 As Variant
        果物1 = Array("りんご", "みかん", "ばなな")
    Dim 果物2 As Variant
        果物2 = Array("ぶどう", "みかん", "なし")
                
        Debug.Print Join(MS.GetUnionSet(果物1, 果物2), ", ")
        Debug.Print Join(MS.GetIntersectionSet(果物1, 果物2), ", ")

End Sub