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

先日から高校数学の学び直しとして、ＶＢＡを用いた集合の理解に挑戦している。
infoment.hatenablog.com
今日も、先日の続きから。
f:id:Infoment:20210524221721p: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 GetDifferenceSet(ByVal set_A As Variant, _
                                 ByVal set_B As Variant, _
                              Optional check_subset As Boolean = True, _
                              Optional sort_order As Excel.XlSortOrder) As Variant

        If Not IsArray(set_A) Or Not IsArray(set_B) Then Exit Function
        
        ' 配列Ａが配列Ｂに内包されているか確認。
        ' これを不問とする場合、配列Ａが配列Ｂに存在しない要素を含んでいても関係なく、
        ' 単に配列Ａと配列Ｂとに共に存在する要素を引くことになる。
        If check_subset Then
            If Not IsSubset(set_A, set_B) Then
                GetDifferenceSet = EmptySet
                Exit Function
            End If
        End If
                
    Dim a As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
        ' まず、集合Ｂの要素を全て辞書に登録する。
        ' 次いで、集合Ａの要素が辞書に存在する場合、
        ' 辞書から除去していく。
        ' 最終的に残った辞書のキーが、Ｂ－Ａとなる。
        For Each a In set_B
            ' 必要なのはkey情報のみ。item情報は不問のため、
            ' 何でもよい。今回は簡単のため「1」をセット。
            Dict(a) = 1
        Next
        
        For Each a In set_A
            If Dict.Exists(a) Then
                Dict.Remove a
            End If
        Next
        
        ' 辞書に何も登録されていない場合、差集合は存在しない。
        If Dict.Count = 0 Then
            GetDifferenceSet = EmptySet
            Exit Function
        End If

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

なお、集合Ｂが全体集合である場合、Ｂ－Ａは補集合となる（＝じゃない方？）。

' 全体集合
Public UniversalSet As Variant

' 集合Ａの補集合を取得。
' 上記差集合における集合Ｂが、特に全体集合Ｕであるとき。
' Ｕ－Ａ
' ※配列Ａと配列Ｕの次元数に関わらず、ＡまたはＵの要素全てを
' 　一次元配列に格納する。
' ※ＡまたはＵ内で重複していた要素は、この処理により重複除去される。
Public Function GetComplementarySet(ByVal set_A As Variant, _
                                 Optional sort_order As Excel.XlSortOrder) As Variant

    GetComplementarySet = GetDifferenceSet(set_A, UniversalSet, sort_order)
        
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.GetDifferenceSet(果物2, 果物1), ", ")

End Sub