午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

エクセルVBAでマージソートと再帰処理(再帰呼出し)...も難しいなあ

 
 
 
マージソート | アルゴリズムとデータ構造 | Aizu Online Judge
http://judge.u-aizu.ac.jp/onlinejudge/commentary.jsp?id=ALDS1_5_B
ここの図解がわかりやすい
 
Programming Place Plus アルゴリズムとデータ構造編【整列アルゴリズム】 第7章 マージソート
http://ppp-lab.sakura.ne.jp/ProgrammingPlacePlus/algorithm/sort/007.html
ここも具体的な流れってところが分かりやすかった
 
Mergeの意味は混合、結合、併合らしいけどマージソートの場合は統合が近いかなあって気がする
マージソートはマージするところが本体なんだけど、その前に分割する作業がある、マージなのに分割!限界まで分割
 
{4,2,3,1}っていう4つの要素を要素数1個になるまで分割する場合
{4,2}と{3,1}に分割、さらにそれぞれを分割して
{4}{2}{3}{1}ここまで分割する
 
これをVBAで書いたのがtestDivide
'配列を分割するだけのマクロ、再帰処理を使う
Function testDivide(v As Variant) As Variant
   '配列を半分に分割して配列1と配列2を作成
   '要素数1になるまで再帰処理
   '要素数が奇数のときは、3なら1:2に分ける、7だったら3:4
    Dim i As Long
    Dim vAll As Long '元の配列の要素数
    vAll = UBound(v) + 1
    Dim d1 As Long, d2 As Long '配列1と配列2の要素数用
    d1 = WorksheetFunction.Quotient(vAll, 2) '配列1の要素数
    d2 = vAll - d1 '配列2の要素数
    
   '分割配列作成
    Dim v1 As Variant, v2 As Variant
    ReDim v1(d1 - 1)
    ReDim v2(d2 - 1)
    For i = 0 To d1 - 1
        v1(i) = v(i)
    Next
    For i = 0 To d2 - 1
        v2(i) = v(i + d1)
    Next
    
   '要素数が1になるまで分割、再帰処理
    If UBound(v1) > 0 Then v1 = testDivide(v1)
    If UBound(v2) > 0 Then v2 = testDivide(v2)
End Function
 
 
↑を例えば配列{4,2,3,1}を渡すマクロ↓を実行すると
 
Sub test2()
    v = Array(4, 2, 3, 1)
    Call testDivide(v)
End Sub
 
イメージ 1
1回目の分割が終わって配列1(v1)と配列2(v2)を作成したところで一時停止
{4,2}と{3,1}に分割されている、赤色四角
 
次の処理が
'要素数が1になるまで分割、再帰処理
If UBound(v1) > 0 Then v1 = testDivide(v1)
 
配列1の要素数が1より大きかったら自分自身(testDivide)を呼び出している?こういうのが再帰処理とか再帰呼出しとか言うみたい
これで配列1の{4,2}が分割されて{4}と{2}になるはず
一時停止を解除して続行してから、次も同じところで一時停止
 
イメージ 2
OK、{4}と{2}に分割されている(赤色四角)
 
処理続行して
'要素数が1になるまで分割、再帰処理
If UBound(v1) > 0 Then v1 = testDivide(v1)
If UBound(v2) > 0 Then v2 = testDivide(v2)
今回ここは配列1も配列2も要素数1個より大きくないのでスルーになる
次の行は
End Function
になっているから、えー、ここで終わっちゃうの?最初の分割のときの配列2の{3,1}はどうなるの?分割しないの?って思ったら、続けると
イメージ 5
配列1は要素数1より大きくないのでスルー
 
イメージ 4
配列2も同様なのでスルー
 
イメージ 6
終わっちゃうよ
 
イメージ 7
え、戻った?
変数の中を見ると
イメージ 3
おお、最初の分割のところに戻っている
この時の配列2の要素は1より大きいので続行すると
イメージ 8
再帰呼び出しになるので
 
イメージ 9
分割処理されて
 
イメージ 10
{3}と{1}に分割された
 
  1. {4,2,3,1} 元の配列
  2. {4,2}、{3,1} 最初の分割
  3. {4,2} 配列1
  4. {4}、{2} 分割の分割(配列1)
  5. {3,1} 配列2
  6. {3}、{1} 分割の分割(配列2)
流れだと1.→2.→3.4.2.5.6.って感じかなあ
2番のときの{3,1}が終わっていないのを憶えていて自動で巻き戻る
次はどこから処理すればいいのか憶えている感じ
再帰処理スゴイ
スゴイだけに直感的じゃない感じでまだよくわかっていないのよね
 
分割するときのそれぞれの要素数決定
d1 = WorksheetFunction.Quotient(vAll, 2) '配列1の要素数
Quotientは割り算の商の部分を返してくれるワークシート関数
d1 = WorksheetFunction.Quotient(7, 2)
この場合d1には3が入る、7/2=3.5の商の3
だったら最初から症の部分を返す¥を使って7¥2でいいじゃんって今思った
 
素数が奇数のときは右側(配列2)を大きくするようにした
素数7を分割するときは配列1の要素数は3、配列2の要素は4
 
普通の配列は0からだけどセルから直接取り込んだ配列の添字は1から始まるので
何番から始まっていても対応できるようにtestDivideを書き換えると
 
Function testDivide2(v As Variant) As Variant
    '配列を半分に分割、要素数1になるまで分割
    '要素数が奇数のときは、3なら1:2に分ける、7だったら3:4
    Dim i As Long
    Dim lb As Long: lb = LBound(v)
    Dim vAll As Long '元の配列の要素数
    vAll = UBound(v) - lb + 1
    Dim d1 As Long, d2 As Long '配列1と配列2の要素数
    d1 = WorksheetFunction.Quotient(vAll, 2) '配列1の要素数
    d2 = vAll - d1 '配列2の要素数
 
    '分割配列作成
    Dim v1 As Variant, v2 As Variant
    ReDim v1(d1 - 1)
    ReDim v2(d2 - 1)
    For i = 0 To d1 - 1
        v1(i) = v(i + lb)
    Next
    For i = 0 To d2 - 1
        v2(i) = v(i + lb + d1)
    Next
 
    '要素数が1になるまで分割
    If UBound(v1) > 0 Then v1 = testDivide2(v1)
    If UBound(v2) > 0 Then v2 = testDivide2(v2)
End Function
 
 
これで分割はできるようになったので次はマージ部分
整列しながらマージしていく
イメージ 11
 
イメージ 12
2つの配列を1つにマージしていく
マージ用の配列を作成しておいてそこに
小さい順に入れていく
イメージ 13
マージしたもの同士を更にマージしていくと最後には完成する
比較する場所
イメージ 14
比較して残った方は何回も比較することになる
この場合は3が何回も比較されていて
3がなくならない限り次の5は比較されない
 
比較対象がなくなったとき
イメージ 15
どちらかの配列の要素がなくなったら残った方の配列の要素を
そのままの順番で入れればマージ完了になる
このマージ部分をVBAで書いたのがMergeMerge1
'2つの配列をマージして返す
Function MergeMerge1(v1 As Variant, v2 As Variant) As Variant
    Dim mm() As Variant 'マージ用配列
    ReDim mm(UBound(v1) + UBound(v2) + 1)
    Dim mc As Long '総数カウント
    Dim c1 As Long, c2 As Long 'カウント1、カウント2
   'v1v2から小さい順にmmに入れていく
   'v1v2どちらかが空になったらループ抜け
    Do
        If v1(c1) > v2(c2) Then '左(配列1)>右(配列2)の場合
            mm(mc) = v2(c2)
            c2 = c2 + 1
        ElseIf v1(c1) < v2(c2) Then '左<右の場合
            mm(mc) = v1(c1)
            c1 = c1 + 1
        Else '左=右の場合
            mm(mc) = v1(c1)
            c1 = c1 + 1
            mc = mc + 1
            mm(mc) = v2(c2)
            c2 = c2 + 1
        End If
        mc = mc + 1
    Loop While c1 <= UBound(v1) And c2 <= UBound(v2)
    
   '残った方をmmに入れる
    Dim j As Long, k As Long
    If c1 - 1 = UBound(v1) Then
        For j = c2 To UBound(v2)
            mm(mc) = v2(j)
            mc = mc + 1
        Next
    End If
    If c2 - 1 = UBound(v2) Then
        For k = c1 To UBound(v1)
            mm(mc) = v1(k)
            mc = mc + 1
        Next
    End If
    MergeMerge1 = mm
End Function
前半のDo~Loop While部分が比較してマージ用配列に順番に入れているところで
Loopの終了条件が
    Loop While c1 <= UBound(v1) And c2 <= UBound(v2)
これで
入れた数をv1とv2それぞれでカウントしていって、どちらかが配列の要素数になったらループ抜け
 
後半は残った方をマージ用配列に順番に入れているだけ
 
 
これでマージ部分もできたので、さっきの分割部分とこれを合わせればマージソート完成する
マージ部分を書いたMergeMerge1これはそのままで
分割部分のtestDivide2を少し書き換えてここからMergeMerge1を呼び出すことにしてマージソートにしてみたのがMergeSort2
Public Function MergeSort2(v As Variant) As Variant
   '配列を半分に分割、要素数1になるまで分割
   '要素数が奇数のときは、3なら1:2に分ける、7だったら3:4
    Dim min As Long
    min = LBound(v)
    Dim i As Long
    Dim vAll As Long '元の配列の要素数
    vAll = UBound(v) - LBound(v) + 1
    Dim d1 As Long, d2 As Long '配列1と配列2の要素数用
    d1 = WorksheetFunction.Quotient(vAll, 2) '配列1の要素数
    d2 = vAll - d1 '配列2の要素数
   '分割配列作成
    Dim v1 As Variant, v2 As Variant
    ReDim v1(d1 - 1)
    ReDim v2(d2 - 1)
    For i = 0 To d1 - 1
        v1(i) = v(i + min)
    Next
    For i = 0 To d2 - 1
        v2(i) = v(i + min + d1)
    Next
   '要素数が1になるまで分割
    If UBound(v1) > 0 Then v1 = MergeSort2(v1)
    If UBound(v2) > 0 Then v2 = MergeSort2(v2)
    
   'マージする
    Dim vv As Variant
    vv = MergeMerge1(v1, v2)
    
   'マージした配列を元の配列に上書きして返す
    For i = 0 To UBound(vv)
        v(i + min) = vv(i)
    Next
    MergeSort2 = v
End Function
 
素数が1になるまで分割して、それからMergeMerge1を呼び出している
    'マージする
    Dim vv As Variant
    vv = MergeMerge1(v1, v2)
 
最初に渡された配列の添字が0以外から始まっていたときはズレているので、修正しているのが
    'マージした配列を元の配列に上書きして返す
    For i = 0 To UBound(vv)
        v(i + min) = vv(i)
    Next
 
 
 
処理時間計測はいつもと同じこれで1万件をソート
Sub sortTestBubble2()
    Dim c As Long: c = 10000
    Dim v() As Variant
    ReDim v(c - 1)
    Randomize
    For i = 0 To c - 1
        v(i) = CLng(c * Rnd)
    Next
    Dim st As Single
    st = Timer
    v = MergeSort2(v)
    MsgBox Timer - st & "秒"
End Sub
 
結果
イメージ 16
0.2226秒、速い
けどコムソートやシェルソートの0.0625に比べると遅いなあ
マージソート速いみたいなんだけどねえ
こちらを見るとシェーカーソートよりマージソートのほうが速い
なので僕の書き方が良くないっぽいけど、これ以上は思いつかないなあ
 
それでもかなり速いことには違いないので100万件でも計測
イメージ 18
うーん
 
前回のコムソートとシェルソートと比較
イメージ 17
やっぱりコムソートとシェルソートと比べると遅いなあ
マージソートは難しかったのと期待が大きかっただけにちょっと残念
バブルソートに比べたらめちゃくちゃ速いんだけどね
 
今までのまとめ

f:id:gogowaten:20191031103714p:plain

グラフにしてみると
イメージ 20
マージソートも速いのがわかる
 
 
 
ここまで書いておいて「VBA マージソート」でぐぐってみたらあったよ
VBA マージソートの実装と図解 - t-hom’s diary
http://thom.hateblo.jp/entry/2016/03/21/120449
ここを参考にしてMergeMerge1の後半部分を書き直した
IfとFor~NextだったのをDo~Loopに変えた
  '残った方をmmに入れる
    Dim j As Long, k As Long
    Do While c1 <= UBound(v1)
        mm(mc) = v1(c1)
        c1 = c1 + 1
        mc = mc + 1
    Loop
    Do While c2 <= UBound(v2)
        mm(mc) = v2(c2)
        c2 = c2 + 1
        mc = mc + 1
    Loop
 
これで100万件ソート
イメージ 21
27秒から26秒、少し速くなった
 
 
さらに
比較した結果同じ値だったときの処理を削除して速くした
 
   Do
        If v1(c1) > v2(c2) Then '左>右の場合
            mm(mc) = v2(c2)
            c2 = c2 + 1
        Else '左<右の場合
            mm(mc) = v1(c1)
            c1 = c1 + 1
        End If
        mc = mc + 1
    Loop While c1 <= UBound(v1) And c2 <= UBound(v2)
これだと安定ソートじゃなくなるのかも?
 
結果
イメージ 22
25秒
ここまでだなあ
 
ここ!
コードをコピペして同じように計測したら
イメージ 23
16秒!スゴイ
同じマージソートでも僕が書くと25秒だったのが、上手な人が書くと16秒!これだけの差がでる、面白いねえ
 
 
 
 
関連記事

続きは2日後

gogowaten.hatenablog.com

エクセルVBAマージソートその2、再帰処理の必要がないボトムアップ方式で速くなった ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14810468.html
 
 
エクセルVBAバブルソート ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14787146.html
エクセルVBAで挿入ソート ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14799218.html
 
 
 
ソートアルゴリズムまとめ
エクセルVBAで、ソートアルゴリズムとデータの違いによるソート処理時間比較 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
https://blogs.yahoo.co.jp/gogowaten/14836198.html