VBA ヒープソートを実装～関数を沢山作って複雑な問題に対処する

私は長らくヒープソートというものが理解できなかったのだが、ついに今日、なんとか動くところまで実装できたので紹介しようと思う。

ヒープソートを理解しようと思ったら、実装の前にまずヒープのノードが入れ替わるイメージを理解しておく必要がある。
そこで、こちらの動画を視聴した。

ヒープソート

めっちゃわかりやすい！

ん、理屈は分かったけど、これをいったいどうやって実装すれば。。

ということでもう一本動画を視聴。

［ソート4］ヒープソート（Heap Sort）：解説

最初のほう早くて分かりにくいけど、1分10秒あたりから配列を使った実装の詳細の説明に入るのでしっかり視ておく。

さて、ヒープを配列に導入すると、親と子を指すインデックスには次の式が成り立つ。
左の子のインデックス = 親のインデックス×2＋1
右の子のインデックス = 左の子のインデックス + 1

これがメインコードに登場するとごちゃっとするので、関数化してしまおう。

Function GetRightChildIndex(parent_index) As Long
    GetRightChildIndex = GetLeftChildIndex(parent_index) + 1
End Function

Function GetLeftChildIndex(parent_index) As Long
    GetLeftChildIndex = parent_index * 2 + 1
End Function

それから、親を左の子と入れ替える処理、親を右の子と入れ替える処理というのも解説に登場したので、これもプロシージャ化する。

Sub SwapParentRightChild(arr, parent_index)
    Dim tmp: tmp = arr(parent_index)
    arr(parent_index) = arr(GetRightChildIndex(parent_index))
    arr(GetRightChildIndex(parent_index)) = tmp
End Sub

Sub SwapParentLeftChild(arr, parent_index)
    Dim tmp: tmp = arr(parent_index)
    arr(parent_index) = arr(GetLeftChildIndex(parent_index))
    arr(GetLeftChildIndex(parent_index)) = tmp
End Sub

子より親の方が小さければ、入れ替えるという処理をするが、このとき、両方の子が親より大きい場合、より大きい方を選択するという処理があった。
これ、言い換えると、親・左の子・右の子のうち、一番大きいものと親を入れ替えるということになる。親が一番なら入れ替えは発生しないが、とにかく誰が一番大きいかを判定する関数があると良い。

この関数は、列挙型定数でParent、LeftChild、RightChildのいずれかを返すようにしよう。

ということでまずは列挙型を作成。

Enum Role
    Parent
    LeftChild
    RightChild
End Enum

次にこれを返す関数を作成。

Function WhoIsBiggest(arr, parent_index, tail) As Role
    Const INIFINITESIMAL As Long = -2147483648#
    Dim p: p = arr(parent_index)
    Dim rc
    If GetRightChildIndex(parent_index) <= tail Then
        rc = arr(GetRightChildIndex(parent_index))
    Else
        rc = INIFINITESIMAL
    End If
    
    Dim lc
    If GetRightChildIndex(parent_index) <= tail Then
        lc = arr(GetLeftChildIndex(parent_index))
    Else
        lc = INIFINITESIMAL
    End If
    
    If p > lc And p > rc Then
        WhoIsBiggest = Parent
    ElseIf lc > p And lc > rc Then
        WhoIsBiggest = LeftChild
    ElseIf rc > p And rc > lc Then
        WhoIsBiggest = RightChild
    End If
End Function

INIFINITESIMALという定数の名前は英語の「無限小」をとったもの。
実際にはただのLong型の最小値である。
子のインデックスがtailを超えてしまう場合、参照エラーになったり確定値を参照してしまう危険がある。
そこでtailを超えた子より、必ず親が大きくなるように、子の値を入れる変数に無限小を代入している。
ここは力技でしのいだ感じ。

さて、あとは確定した最大値を取り除く処理だ。
これは配列の先頭と末尾を入れ替えてしまえば良いので、そのような関数を作る。
ただし毎回末尾と入れ替えてたら確定値まで動かしてしまうことになる。
したがって末尾はUboundではなく、別途変数で管理しよう。

ひとまずはtailという仮引数で末尾を受け取ることにする。
先頭は0で固定なので受け取る必要はない。

Sub SwapHeadTail(arr, tail)
    Dim tmp: tmp = arr(0)
    arr(0) = arr(tail)
    arr(tail) = tmp
End Sub

さて、役者は揃った。
あとはメインコードをガリガリ書くだけ。

Sub HeapSortMain()
    Dim heap(): heap = Array(8, 2, 7, 6, 9, 1, 4, 3, 5)
    Dim tail As Long: tail = UBound(heap)
    Do
        Do
            Dim cnt: cnt = 0
            Dim i
            For i = LBound(heap) To tail
                Select Case WhoIsBiggest(heap, i, tail)
                Case Role.Parent
                    cnt = cnt + 1
                Case Role.LeftChild
                    SwapParentLeftChild heap, i
                Case Role.RightChild
                    SwapParentRightChild heap, i
                End Select
            Next
        Loop While cnt <= tail
        SwapHeadTail heap, tail
        tail = tail - 1
    Loop While tail > 0
    
    For i = LBound(heap) To UBound(heap)
        Debug.Print heap(i)
    Next
End Sub

まずは最も内側のループからみていこう。

For i = LBound(heap) To tail
    Select Case WhoIsBiggest(heap, i, tail)
    Case Role.Parent
        cnt = cnt + 1
    Case Role.LeftChild
        SwapParentLeftChild heap, i
    Case Role.RightChild
        SwapParentRightChild heap, i
    End Select
Next