エクセルVBAでシェルソート - 午後わてんのブログ

今回は挿入ソートの改良型のシェルソート

シェルソート - Wikipedia
https://ja.wikipedia.org/wiki/%E3%82%B7%E3%82%A7%E3%83%AB%E3%82%BD%E3%83%BC%E3%83%88

挿入ソートでは常に隣と比較していたのを離れたところと比較してから、だんだん近くのものと比較していって、最終的には隣と比較するところ

たったこれだけみたい

しかもこれはバブルソートをコムソートに改良した方法とそっくり

3，４，２，6，１，５，３を整列するとき

間隔が3だった場合は

同じグループ同士で挿入ソートする

0番、3番、6番が同じグループ

1番、4番

2番、6番

グループ同士で整列完了

間隔を狭くして2だったら

0,2,4,6番のグループ

1,3,5番のグループ

それぞれを挿入ソートで

整列

次は間隔1

間隔1は隣同士だから

グループ分けなしの普通の挿入ソートで整列完了

重要なのは間隔(h)をいくつにするかみたいで、これの求め方はWikipediaを見ると...見てもよくわかんないだよなあ、数式が書いてあるんだけど見方がわからんｗけど例が書いてあって1，4，13，40，121...(3^i-1)/2ってある

どうやら「i」ってのが順番みたいで(3^i-1)/2の「i」に1から順番に整数を入れてみると

同じ数値がでてきた！

配列を渡すとシェルソートに使う間隔の配列を返すマクロ

Public Function GetH2(v As Variant) As Long()
    Dim l() As Long
    Dim vc As Long
    vc = UBound(v) - LBound(v) + 1 '要素数
    Dim i As Long: i = 1
    Do
        ReDim Preserve l(i - 1)
        l(i - 1) = ((3 ^ i) - 1) / 2
        i = i + 1
    Loop While ((3 ^ i) - 1) / 2 < vc
    GetH2 = l
End Function

これに例えば10万件の要素がある配列を渡すと

必要な間隔の配列を返す

1,4,13,40,121,364,1093,3280,9841,29524,88573

こうしてみると10万件でも11回しか変更しないんだなあ

あとは挿入ソートにこの間隔を使うだけだから前回のtestInsertion2を書き直してできたのがtestShellSort1

Public Function testShellSort1(v As Variant) As Variant
    Dim i As Long, j As Long, k As Long
    Dim tmp As Variant
    Dim hs() As Long
    hs = GetH2(v) '間隔の配列取得
    Dim h As Long '間隔用
    For k = UBound(hs) To 0 Step -1 '大きい方から使うからStep -1
        h = hs(k) '間隔
        For i = LBound(v) + h To UBound(v)
            tmp = v(i)
            For j = i - h To LBound(v) Step -h
                If v(j) > tmp Then '比較
                    v(j + h) = v(j) '右へコピー
                Else
                    Exit For 'ループ抜けしてtmpを配列に戻す
                End If
            Next
            v(j + h) = tmp 'tmpを配列に戻す
        Next
    Next
    testShellSort1 = v
End Function

9～19行目が挿入ソートなので前回とほとんど一緒、違うのは-1と+1だったのが-ｈと+ｈになっただけ

間隔の配列は小さい方から入っているけど使う順番は大きい方からだからFor～NextのStepを-1

ランダム数値1万件の並べ替えの処理時間計測

3回計測

速い、コムソート並に速い！

0.0625秒はコムソートでも計測されていた

もしかしたら今の方法ではこれ以上小さい値は計測できないのかも？

ってことで100万件で計測、コムソートと比べてみる

13秒前後なので9秒前後のコムソートよりは遅いねえ

でもかなり速い

時間計測するマクロ

Sub sortTestBubble2()
    Dim c As Long: c = 1000000
    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 = testBubble1(v) '18.90234秒
'  v = testBubble2(v) '12.27734
   'v = testBubble3(v)  '10.16406
   'v = testShaker2(v) '10.63281
   'v = testShaker3(v) '7.078125
'  v = testComb2(v) '0.0625
    v = testShellSort1(v) '0.0625
    MsgBox Timer - st & "秒"
End Sub