Strategyパターンによる汎用性の高いマージソートの実装（VB6）

VB6でマージソートするクラス書いた。

ソースコードは以下のような構成（クラス図として正確かどうかは自身がない）
Javaの

ISorter

ソートアルゴリズムのインターフェース。
このインターフェースによりソートの機能を利用するコードとソートアルゴリズムの実装を分離する。
ISorterインターフェースを実装するクラスを新たに用意することで、他のソートアルゴリズムとも差し替えが可能。

Option Explicit
'
'   ソートロジックのインターフェース
'

' 比較器を受け取るプロパティ
Property Let Comparator(newComparator As IComparator)
End Property

' 入力された配列のソート結果を返す
Function Sort(source As Variant) As Variant
End Function

IComparator

ソート対象の要素を比較するインターフェース
IComparatorのインターフェースを実装したクラスを用意することで、任意のクラスのインスタンスを任意の順序でソートが可能となっている。

Option Explicit
'
'   値の比較を行うインターフェース
'

' 左側の値と右側の値を比較して、
'   左側が大きい場合は マイナスの値
'   同じ場合は、0
'   右側が大きい場合は プラスの値
' を返す
Function Compare(leftSide As Variant, rightSide As Variant) As Long
End Function

MergeSorter

ソートアルゴリズムとして、マージソートを実装したクラス。

Option Explicit
'
'  ソートロジック（マージソート）を実装したクラス
'

Implements ISorter

Private m_comparator    As IComparator

'
'   対象の比較を行うオブジェクト
'
Private Property Let ISorter_Comparator(RHS As IComparator)
    Set m_comparator = RHS
End Property


'
'   マージソート
'
Private Function ISorter_Sort(source As Variant) As Variant
    Dim i           As Long
    Dim midIndex    As Long
    Dim leftSide()  As Variant
    Dim rightSide() As Variant
    
    ' 要素数が1個以下ならソートの必要なし
    If UBound(source) <= 0 Then
        ISorter_Sort = source
        Exit Function
    End If
    
    ' 配列を分割する箇所を求める
    midIndex = UBound(source) / 2
    
    ' まずは左側の要素取り出す
    For i = 0 To midIndex
        ReDim Preserve leftSide(i)
        Set leftSide(UBound(leftSide)) = source(i)
    Next i

    ' 右側の要素取り出す
    For i = i To UBound(source)
        ReDim Preserve rightSide(i - midIndex - 1)
        Set rightSide(UBound(rightSide)) = source(i)
    Next i
    
    ' 分割された配列をそれぞれ再帰的に分割、その後マージする
    ISorter_Sort = Merge(ISorter_Sort(leftSide), ISorter_Sort(rightSide))
    
End Function


'
'   マージフェーズ
'
Private Function Merge(leftSide As Variant, rightSide As Variant) As Variant
    Dim i           As Long
    Dim lIndex      As Long
    Dim rIndex      As Long
    Dim result As Variant
    
    ReDim result(0)
    
    ' 左右を比較して大きい方を結果に詰める
    lIndex = 0
    rIndex = 0
    Do While lIndex <= UBound(leftSide) And rIndex <= UBound(rightSide)
        ReDim Preserve result(i)
        If m_comparator.Compare(leftSide(lIndex), rightSide(rIndex)) <= 0 Then
            Set result(i) = leftSide(lIndex)
            lIndex = lIndex + 1
        Else
            Set result(i) = rightSide(rIndex)
            rIndex = rIndex + 1
        End If
        i = i + 1
    Loop
    
    ' 左側の残りを詰める
    Do While lIndex <= UBound(leftSide)
        ReDim Preserve result(i)
        Set result(i) = leftSide(lIndex)
        lIndex = lIndex + 1
        i = i + 1
    Loop
        
    ' 右側の残りを詰める
    Do While rIndex <= UBound(rightSide)
        ReDim Preserve result(i)
        Set result(i) = rightSide(rIndex)
        rIndex = rIndex + 1
        i = i + 1
    Loop
        
    Merge = result
End Function

Person

ソート対象となるクラスの例（「人」を表現したクラスのつもり）

Option Explicit

'
' ソートの対象となるクラスの例
'

Public OrderIndex As String
Public Name As String
Public Note As String

PersonComparator

ソート対象のクラスのインスタンスの大小を比較するためのクラス。
IComparatorインターフェースを実装しており、この例題では MergeSorter のインスタンスに渡され、インスタンス同士の比較の役割に責任を持つ。

Option Explicit
'
'  対象クラスの大小を比較するクラス(この例ではPersonクラスのインスタンスを比較)
'

Implements IComparator

Private Function IComparator_Compare(leftSide As Variant, rightSide As Variant) As Long
    IComparator_Compare = CLng(leftSide.OrderIndex) - CLng(rightSide.OrderIndex)
End Function

テストコード

上記クラスをテストするためのコード

'
'   テストコード
'
Sub main()
    Dim people As Variant
    Dim aPerson As Variant
    
    ' テストデータとしてオブジェクトの配列を用意
    people = CreateData()
    
    ' ソート前の内容を列挙
    Debug.Print "=== SOURCE ==="
    For Each aPerson In people
        Debug.Print aPerson.OrderIndex, aPerson.Name, aPerson.Note
    Next
    
    ' マージソート実行
    Dim sorter As ISorter
    Dim sorted As Variant
    
    Set sorter = New MergeSorter
    sorter.Comparator = New PersonComparator
    sorted = sorter.Sort(people)
    
    ' ソート後の内容を列挙
    Debug.Print "*** SORTED ***"
    For Each aPerson In sorted
        Debug.Print aPerson.OrderIndex, aPerson.Name, aPerson.Note
    Next
        
End Sub

'
'   テストデータを作成する
'
Private Function CreateData() As Variant
    Dim result(9) As Variant
    
    Set result(0) = newPerson("3", "Taro", "HOGE-")
    Set result(1) = newPerson("8", "Jiro", "Piyo!!")
    Set result(2) = newPerson("1", "Kayoko", "Mokyu!!!!")
    Set result(3) = newPerson("5", "Ken", "AGHAAAA")
    Set result(4) = newPerson("2", "Mika", "MOIMOI")
    Set result(5) = newPerson("3", "Fumihiko", "UMUMIUII")
    Set result(6) = newPerson("10", "Junichiro", "OISSU")
    Set result(7) = newPerson("21", "Ryo", "HHHHHAAAA")
    Set result(8) = newPerson("7", "Daisuke", "DODODOD")
    Set result(9) = newPerson("9", "Yuriko", "Yuuuuuuu")
    
    CreateData = result

End Function

Private Function newPerson(idx, Name, Note) As Person
    Set newPerson = New Person
    newPerson.OrderIndex = idx
    newPerson.Name = Name
    newPerson.Note = Note
End Function