エクセルVBAでマージソートその2、再帰処理の必要がないボトムアップ方式で速くなった

前回

gogowaten.hatenablog.com

エクセルVBAでマージソートと再帰処理(再帰呼出し)...も難しいなあ ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14807202.html

本当は速いはずのマージソートがシェルソートやコムソートの後塵を拝する結果になったけどマージソートにはボトムアップ方式というものがあった

Programming Place Plus
http://ppp-lab.sakura.ne.jp/index_ppp.shtml

Programming Place Plus　アルゴリズムとデータ構造編【整列アルゴリズム】　第７章　マージソート
 http://ppp-lab.sakura.ne.jp/ProgrammingPlacePlus/algorithm/sort/007.html

ここに説明されているボトムアップ方式のマージソートを参考にして書いたのが

↓のtestMerge2BU(とMergeMerge2BU)

Public Function testMerge2BU(v As Variant) As Variant
    Dim min As Long: min = LBound(v)
    Dim max As Long: max = UBound(v)
    Dim t As Long, b As Long, m As Long, k As Long, j As Long
    k = 2 'マージする要素数
    Do
        j = 0
        Do
            t = j * k + min   '範囲の頭、top
            b = t + k - 1   '範囲の最後尾、Bottom
            m = b - (k / 2) '範囲の真ん中、middle
            Call MergeMerge2BU(v, t, m, b) 'Merge部分だけコピー版
            j = j + 1 'ループカウント
       '中央位置(m)が全体配列の最後尾(max)を超えるまでループ
        Loop While (k / 2) + j * k + min <= max
        k = k * 2 '次のループの要素数を増やす
   'マージする要素数(k)が全体配列の要素数の2倍を超えるまでループ
    Loop While k < (max - min + 1) * 2
    testMerge2BU = v
End Function
'Merge部分だけコピー版、速い
Sub MergeMerge2BU(v As Variant, t As Long, m As Long, b As Long)
    Dim c1 As Long: c1 = t  'カウント、左用
    Dim c2 As Long: c2 = m + 1 'カウント、右用
    Dim c As Long: c = 0       'カウント、全体用
   '最後尾bが元の配列の最後尾を超えていたら修正
    If b > UBound(v) Then b = UBound(v)
    Dim vv() As Variant '転記用配列
    ReDim vv(b - t)
   '比較して転記
   '左カウントが真ん中を超えるか右カウントが最後尾を超えたらループ抜け
    Do
        If v(c1) > v(c2) Then     '左＞右のとき
            vv(c) = v(c2)
            c2 = c2 + 1
        ElseIf v(c1) < v(c2) Then '左＜右の場合
            vv(c) = v(c1)
            c1 = c1 + 1
        Else     '左＝右の場合
            vv(c) = v(c1)
            c1 = c1 + 1
            c = c + 1
            vv(c) = v(c2)
            c2 = c2 + 1
        End If
        c = c + 1
    Loop While c1 <= m And c2 <= b

   '残った方をそのままの順番で転記
    Do While c1 <= m
        vv(c) = v(c1)
        c = c + 1
        c1 = c1 + 1
    Loop
    Do While c2 <= b
        vv(c) = v(c2)
        c = c + 1
        c2 = c2 + 1
    Loop

   '転記用配列から元の配列へ転記
    For i = 0 To UBound(vv)
        v(i + t) = vv(i)
    Next
End Sub

これに例えば↓を実行すると

Sub testBU()

v = Array(5, 2, 4, 2, 1, 3)

v = testMerge2BU(v)

End Sub

v=(1, 2, 2, 3, 4, 5)に整列される

前回(トッブダウン方式)と違うのは分割処理がなくなったので、再帰処理もなくなったこと

前回はマージ処理するときに実際に配列を2つ渡してマージしていたけど、今回は元の配列とマージする目印を渡すだけ！なので、配列を作成する回数が減った

1回のマージ処理での配列作成は前回は3回、今回は1回

ボトムアップ方式は要素はバラバラに分割されている状態と考えてからのスタートなのでマージ処理から始まる

要素が8個ある配列をマージ処理するときの場所の変化

処理1、0番と1番をマージ

処理2、2番と3番をマージ→これを繰り返して最後尾の7まで行ったら、0番に戻って、

処理5、0から1番と2番から3番をマージ

処理6、4番から5番と6番から7番をマージ、最後尾7まで来たので戻って

処理7、0番から3番をマージ、4番から7番をマージ、全てマージしたので完了

マージ処理は前回と同じなので重要なのは、どこからどこまで(何番から何番)を処理するのかっていう場所の指定になる

場所の指定は先頭と最後尾があれば真ん中もわかるけど真ん中もあったほうが都合が良かったので、この3つを指定することにした、t, b, m

t 先頭、top

b 最後尾、Bottom

m 真ん中、middle

これで、tからmが左の配列、m+1からbまでが右の配列ってことにすればいい

処理7の場合だとt=0, b=7, m=3

処理1の場合だとt=0, b=1, m=0になればいい

t、m、bはこうなればいい

あとはこの変化をループ処理で再現

規模を大きくして要素数16にして、ループカウント(j)もしてみる

f:id:gogowaten:20191031104508p:plain

今気づいたけど処理の総数は要素数で決まるのかな、だったらさっきのコードはもう少し簡略化できるけどそれは置いといて

tの増え方を見ると最初のループでは2づつ増えている、次のループでは4づつ、次は8づつ...ってことで最初のループは2でそれ以降はループごとに2倍になっている

これ用のカウンタがk、要はマージする要素数はループごとに2倍になるってことかな

jは一番内側のループカウンタで1づつ増やす普通のカウンタ

このkとjを掛け算すればt(先頭)の値になる、これでtは解決

kがマージする要素数を表しているのでt(先頭)に足せばb(最後尾)になってbも解決

実際には-1するのは植木算みたいな感じ？

b(最後尾)からマージする要素数の半分を引き算すれば真ん中になるのでmも解決

これでどこからどこまで(何番から何番)を処理するのかっていう場所の指定ができた

Public Function testMerge2BU(v As Variant) As Variant
    Dim min As Long: min = LBound(v)
    Dim max As Long: max = UBound(v)
    Dim t As Long, b As Long, m As Long, k As Long, j As Long
    k = 2 'マージする要素数
    Do
        j = 0
        Do
            t = j * k + min '範囲の頭、top
            b = t + k - 1   '範囲の最後尾、Bottom
            m = b - (k / 2) '範囲の真ん中、middle
            Call MergeMerge2BU(v, t, m, b) 'Merge部分だけコピー版
            j = j + 1 'ループカウント
       '中央位置(m)が全体配列の最後尾(max)を超えるまでループ
        Loop While (k / 2) + j * k + min <= max
        k = k * 2 '次のループの要素数を増やす
   'マージする要素数(k)が全体配列の要素数の2倍を超えるまでループ
    Loop While k < (max + 1) * 2
    testMerge2BU = v
End Function