t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA マージソートの実装と図解

VBA

前回はトランプを使ってマージソートを説明した。
thom.hateblo.jp

今回は実際にVBAでマージソートを書いてみる。

目次

準備

まずはソートの対象を用意しないといけないので、配列を作ることにした。

Sub MStart()
    '配列Arrの準備
    Dim Arr() As Long
    Const Min = 1, Max = 10
    ReDim Arr(Min To Max)
End Sub

後から配列の数を変更できるように動的配列として、ReDimにMinとMaxの定数を与える方式とした。

次に、配列にランダムな数を格納していく。
このとき、同時にイミディエイトウィンドウに出力するようにした。

Sub MStart()
    '配列Arrの準備
    Dim Arr() As Long
    Const Min = 1, Max = 10
    ReDim Arr(Min To Max)

    '配列Arrにランダム数を格納しながら出力
    For i = LBound(Arr) To UBound(Arr)
        Const LowerBound = 1, UpperBound = 100
        Arr(i) = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        Debug.Print i; ":"; Arr(i)
    Next
End Sub

ランダム値の上限と下限は定数で決めておく。
Rnd関数のヘルプに次の表記があるので、これをそのまま使用している。

任意の範囲の整数の乱数を生成するには、次の式を使ってください。
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

出力結果の例はこちら

 1 : 71 
 2 : 54 
 3 : 58 
 4 : 29 
 5 : 31 
 6 : 78 
 7 : 2 
 8 : 77 
 9 : 82 
 10 : 71


次に結果表示のコードを書く。
これはArrの中身を出力するだけ。
初回の結果と区切るために、String関数で区切り線(ハイフン20個)を出力している。

Sub MStart()
    '配列Arrの準備
    Dim Arr() As Long
    Const Min = 1, Max = 10
    ReDim Arr(Min To Max)
    
    '配列Arrにランダム数を格納しながら出力
    For i = LBound(Arr) To UBound(Arr)
        Const LowerBound = 1, UpperBound = 100
        Arr(i) = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        Debug.Print i; ":"; Arr(i)
    Next
    Debug.Print String(20, "-")
    
    '■ここにソートのコードを書く
    
    'ソート結果表示
    For i = LBound(Arr) To UBound(Arr)
        Debug.Print i; ":"; Arr(i)
    Next
End Sub

この時点ではまだ何もソートしていないので、初回に出力されたランダム数がそのままもう一度出力される。

さて、次にソートのコードを書いていく。
前回のトランプのソートを図で表すと、次のようになる。赤が分割、緑がマージである。
f:id:t-hom:20160321102446p:plain

これは再帰的な構造になっている。

分割するコード

さて、ではまず分割の部分を再帰で書いてみよう。
分割といっても配列を本当に2つに分けるわけではなく、添え字の開始値と終了値を設定することで特定範囲を表す。

次のコードは配列(Arr)と、添え字の開始値(Top)、添え字の終了値(Bottom)を受け取り、Middleを求めてさらに左と右に分けてMergeSortを呼び出す再帰コードである。

Sub MergeSort(Arr, Top, Bottom)
    '分割点Middleを求める
    Dim Middle As Long
    Middle = (Top + Bottom) \ 2
    
    Debug.Print Top; "-"; Bottom
    
    '値が複数個あれば、さらにソートを呼び出す
    If Top <> Bottom Then
        Call MergeSort(Arr, Top, Middle)    '左側のソート
        Call MergeSort(Arr, Middle + 1, Bottom) '右側のソート
    End If
End Sub

途中でわかりやすいようにTopからBottomを出力させている。
TopとBottomが一致したら、それは範囲が1つになったということで、再帰を停止する。
すると呼び出し元に戻り、今度は右側のソートに入る。

ちょうど以前に書いたフォルダの階層を辿るサンプルと似た動きをする。
thom.hateblo.jp

今回分を図示するとこんな感じ。
f:id:t-hom:20160321111140p:plain
左、左、左、左、戻る、右、戻る、戻る、右、戻る、戻る、右、左、戻る、右、戻る、戻る、戻る、右、以下略

実際にMStartから呼び出してみる。
MStart自体の出力はコメント化しておいた。

Sub MStart()
    '配列Arrの準備
    Dim Arr() As Long
    Const Min = 1, Max = 10
    ReDim Arr(Min To Max)
    
    '配列Arrにランダム数を格納しながら出力
    For i = LBound(Arr) To UBound(Arr)
        Const LowerBound = 1, UpperBound = 100
        Arr(i) = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        'Debug.Print i; ":"; Arr(i)
    Next
    'Debug.Print String(20, "-")
    
    'ソート呼び出し
    Call MergeSort(Arr, LBound(Arr), UBound(Arr))
    
    'ソート結果表示
    For i = LBound(Arr) To UBound(Arr)
        'Debug.Print i; ":"; Arr(i)
    Next
End Sub

イミディエイトウインドウの出力はこうなる。

 1 - 10 
 1 - 5 
 1 - 3 
 1 - 2 
 1 - 1 
 2 - 2 
 3 - 3 
 4 - 5 
 4 - 4 
 5 - 5 
 6 - 10 
 6 - 8 
 6 - 7 
 6 - 6 
 7 - 7 
 8 - 8 
 9 - 10 
 9 - 9 
 10 - 10

出力結果を配列の範囲に当てはめると次のようになる。
f:id:t-hom:20160321112226p:plain

確かに左優先で呼び出されているのが分かる。

マージするコード

さて、これで分割部分はできたので、次にマージ部分を見ていく。
再帰から戻るときにマージが発生するので、コードは戻る部分に書いていく。

マージの各部分を見ていくと、前段階でグループ内がソート済みなので先頭から順に拾っていくだけでマージできることが分かる。
f:id:t-hom:20160321103343p:plain

交互になっているのはたまたま。
数字を替えてみると、こういうのもありえる。
f:id:t-hom:20160321103743p:plain
それでも各グループの先頭からしかとらないのは分かる。

もしこれが未ソートなら、数字を飛ばしたり戻ったりしないといけないので結局バブルソートと変わらないスピードになってしまう。
f:id:t-hom:20160321104143p:plain

さて、次は並び替え用にもう一つ配列を用意する。
ArrをそっくりそのままコピーしてArr2を用意し、Arr2からArrへ並べながら転記していく為だ。
また、左グループと右グループをマージするので、それぞれの先頭を指すカウンタ(LC、RC)と、メイン配列への転記位置を指すカウンタ(C)を準備しておく。

Sub MergeSort2(Arr, Top, Bottom)
    '分割点Middleを求める
    Dim Middle As Long
    Middle = (Top + Bottom) \ 2
    
    '値が複数個あれば、さらにソートを呼び出す
    If Top <> Bottom Then
        Call MergeSort(Arr, Top, Middle)    '左側のソート
        Call MergeSort(Arr, Middle + 1, Bottom) '右側のソート
    End If
    
    '並び替え用のコピーを確保する。
    Dim Arr2 As Variant
    Arr2 = Arr
    
    LC = Top    '左側のカウンタ
    RC = Middle + 1 '右側のカウンタ
    C = Top 'メイン配列のカウンタ
    '(2)へつづく

そして、左右のグループの先頭のどちらが小さいか比較しながら、小さい方を取得し、取得した方のカウンタとメインのカウンタを進める。

    '(2)
    '左と右の小さい方を取得しながら、コピーしたArr2からArrへ転記
    Do While LC <= Middle And RC <= Bottom
        If Arr2(LC) > Arr2(RC) Then
            Arr(C) = Arr2(RC)
            RC = RC + 1
        Else
            Arr(C) = Arr2(LC)
            LC = LC + 1
        End If
        C = C + 1
    Loop
    '(3)へ続く

これだけだと、片側のグループが空になったら転記が終わってしまうので、それぞれの残りを出力するためのループを書く。
片側しか残らないはずなので、ループは片方しか実行されない。

    '(3)
    '以下のループはどちらか片方しか実行されない。
    
    '右側の残りがあれば全て転記
    Do While RC <= Bottom
        Arr(C) = Arr2(RC)
        RC = RC + 1
        C = C + 1
    Loop
    
    '左側の残りがあれば全て転記
    Do While LC <= Middle
        Arr(C) = Arr2(LC)
        LC = LC + 1
        C = C + 1
    Loop
End Sub

以上でマージソートのコードが完成。

完成コードの全体

ソートの呼び出しコード

Sub MStart()
    '配列Arrの準備
    Dim Arr() As Long
    Const Min = 1, Max = 10
    ReDim Arr(Min To Max)
    
    '配列Arrにランダム数を格納しながら出力
    For i = LBound(Arr) To UBound(Arr)
        Const LowerBound = 1, UpperBound = 100
        Arr(i) = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        Debug.Print i; ":"; Arr(i)
    Next
    Debug.Print String(20, "-")
    
    'ソート呼び出し
    Call MergeSort(Arr, LBound(Arr), UBound(Arr))
    
    'ソート結果表示
    For i = LBound(Arr) To UBound(Arr)
        Debug.Print i; ":"; Arr(i)
    Next
End Sub

マージソート本体

Sub MergeSort(Arr, Top, Bottom)
    '分割点Middleを求める
    Dim Middle As Long
    Middle = (Top + Bottom) \ 2
    
    '値が複数個あれば、さらにソートを呼び出す
    If Top <> Bottom Then
        Call MergeSort(Arr, Top, Middle)    '左側のソート
        Call MergeSort(Arr, Middle + 1, Bottom) '右側のソート
    End If
    
    '並び替え用のコピーを確保する。
    Dim Arr2 As Variant
    Arr2 = Arr
    
    LC = Top    '左側のカウンタ
    RC = Middle + 1 '右側のカウンタ
    C = Top 'メイン配列のカウンタ
    
    '左と右の小さい方を取得しながら、コピーしたArr2からArrへ転記
    Do While LC <= Middle And RC <= Bottom
        If Arr2(LC) > Arr2(RC) Then
            Arr(C) = Arr2(RC)
            RC = RC + 1
        Else
            Arr(C) = Arr2(LC)
            LC = LC + 1
        End If
        C = C + 1
    Loop
    
    '以下のループはどちらか片方しか実行されない。
    
    '右側の残りがあれば全て転記
    Do While RC <= Bottom
        Arr(C) = Arr2(RC)
        RC = RC + 1
        C = C + 1
    Loop
    
    '左側の残りがあれば全て転記
    Do While LC <= Middle
        Arr(C) = Arr2(LC)
        LC = LC + 1
        C = C + 1
    Loop
End Sub

ソートのテストコード

Arrが正しくソートされていない場合は中断モードに入るようなテストを書いてみた。

Sub TestSorted(Arr)
    For i = LBound(Arr) To UBound(Arr) - 1
        Debug.Assert Arr(i) <= Arr(i + 1)
    Next
End Sub

MStartの最後に呼び出すとちゃんとソートされているか分かるので便利。

マージソートの存在意義

実装が簡単なバブルソート、最も高速なクイックソート。
最初は、これ以外に何が必要なんだろうかと思っていた。

マージソートの存在意義を理解するのは、ソートの安定性という概念である。
例えば、Excelの表を氏名で並び替えた後に都道府県で並び替えると、都道府県順で並び、各都道府県の中身は氏名順に並んでいる。
これが安定ソートだ。

クイックソートは確かに早いが、不安定ソートである。
もしExcelの並び替えがクイックソートで実装されていたら、都道府県順に並び替えたときに氏名の順は無視され、バラバラになってしまう。
安定版のクイックソートというのもあるにはあるけれど、複雑になり、あまりクイックじゃなくなってしまう。

バブルソートは安定ソートである。実装も簡単だ。しかし、データ量が増えると致命的に遅い。

マージソートは、安定かつそこそこ早いソートなのである。
デメリットとしてはややメモリを食うこと。

理由はコレだ。

    '並び替え用のコピーを確保する。
    Dim Arr2 As Variant
    Arr2 = Arr

都度破棄されるので、大した量ではないが、元の配列が相当に大きい場合は気にする必要が出てくるかもしれない。

まぁ、なんでも自前主義というのは良くないので、普段は素直にExcelのソート機能を使えば良いけれど、プログラミングのスキルアップにはちょうど良いので興味のある方は自分の得意な言語で実装してみると良いと思う。

それにVBAだと、オブジェクトのコレクションをソートするような場合は自分で実装する必要があるので全く無駄ということもない。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。