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

今回はコムソートCombSort

順番に

gogowaten.hatenablog.com

エクセルVBAでバブルソート ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14787146.html

↓

gogowaten.hatenablog.com

エクセルVBAでシェーカーソート ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14790656.html

↓

今回の記事

コムソート - Wikipedia
https://ja.wikipedia.org/wiki/%E3%82%B3%E3%83%A0%E3%82%BD%E3%83%BC%E3%83%88

バブルソートやシェーカーソートでは左右の隣り合った数値を比較していた

コムソートは最初は離れたところと比較してから、だんだん近くのものと比較して最後に隣と比較する

1ループごとに比較する場所を近づけるわけで、この間隔は要素の個数÷1.3の小数点以下切り捨てた数値とある

最終的に隣(間隔1)と比較していって交換が発生しなくなったら整列完了

少ししか関係ないこと、Combの発音はコムに近いみたいだけど見た目からだと昆布だよなあ「ｂ」はどこに行ったんだＹＯ

Combの意味は昆布じゃなくて櫛なのね、髪の毛を梳かすときに最初から目の細かい櫛を使うと苦労するけど、目の粗い櫛から目の細かい櫛へ変えていくとラクに梳けるところが似ているから名前を付けたらしい、洒落ているなあ、でも昆布

それに梳かすとか梳くなんて漢字あったんだねえ

昆布と櫛は昆布と鰹節に似ているかも、どうでもいいNE

閑話休題

8個の数値を整列する場合

バブルソート

1ループ目

0番と1番を比較→1番と2番を比較→2番と3番を比較→...6番と7番を比較

2ループ目

0番と1番を比較→1番と2番を比較→2番と3番を比較→...5番と6番を比較

コムソート

1ループ目は8÷1.3=6.1=6個離れたところと比較

0番と6番を比較→1番と7番を比較

2ループ目は6÷1.3=4.6=4個離れたところと比較

0番と4番を比較→1番と5番を比較→2番と6番を比較→3番と7番を比較

3ループ目は4÷1.3=3.0=3個離れたところと比較

0番と3番→1番と4番→...

f:id:gogowaten:20191031095853p:plain

これをVBAで書くときは

ループする回数は決まっていない？のでDo～Loopを使うのが良さそうなんだけど条件設定間違えてよく無限ループになるんだよなあ

Do～Loopでループし続ける条件は

間隔が1より大きい

前回のループ中に交換が発生していた

このどちらかでも真Trueのとき

逆に言うとループを終了する条件は、間隔が1以下で前回のループで1回も交換が発生していなかったとき

これで書いたのがtestComb2

'testBubble2を改変してコムソート
Public Function testComb2(v As Variant) As Variant
    Dim i As Long
    Dim tmp As Variant
    Dim f As Boolean: f = False '交換フラグ
    Dim h As Long '間隔用
    h = UBound(v) - LBound(v) + 1 '最初は要素数、ループに入ってから1.3で割る
   '間隔が1になるか交換が発生しなくなるまでループ
    Do While h > 1 Or f
        f = False 'フラグリセット
        If h > 1 Then '間隔が1を超えていたら縮める
            h = WorksheetFunction.Quotient(h, 1.3)
        End If
        For i = LBound(v) To UBound(v) - h
           '左側数値が大きかったら交換
            If v(i) > v(i + h) Then
                tmp = v(i)
                v(i) = v(i + h)
                v(i + h) = tmp
                f = True
            End If
        Next
    Loop
    testComb2 = v
End Function

間隔を求めているQuotient関数は

h = WorksheetFunction.Quotient(h, 1.3)

割られる数値と割る数値を渡すと小数点以下切り捨てた値を返してくれる関数、こんな関数も用意されたいたんだねえ、便利

小数点と言えばRounDUpやRounDDownだと思っていた

h = WorksheetFunction.RoundDown(h / 1.3, 0)

これで1万件の並べ替え時間計測

0.0625秒、速い！

本当に並べ替えしているのか疑うレベル

バブルソートやシェーカーソートの100倍だからねえ

計測のコードは前回と同じ↓

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) = CInt(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
    MsgBox Timer - st & "秒"
End Sub

本当に正しく整列できているのか結果をセルに貼り付けてみる

A列に1万件の0から9999までのランダムな数値を入れて

これをtestComb1で整列してB列に貼り付ける

Sub bubble1000()
    Dim v() As Variant
    Dim y As Long: y = 10000
    v = WorksheetFunction.Transpose(Sheets("Sheet3").Range("a1:a" & y))
    Dim st As Single, ct As Single
    st = Timer 
    v = testComb2(v)
    ct = Timer - st
    Sheets("Sheet3").Range("b1:b" & y) = WorksheetFunction.Transpose(v)
    MsgBox "処理時間：" & ct & "秒"  
End Sub

これを実行して

整列できているっぽい

目で見て確認するのはめんどくさいのでマクロで確認

Sheet3のB列が小さい順に並んでいたらTrueを表示する1箇所でも違っていたらFalseを表示するマクロ

Sub IsSortTrue()
    v = Sheets("Sheet3").Range("b1:b10000").Value
    v = WorksheetFunction.Transpose(v)
    For i = LBound(v) To UBound(v) - 1
        If v(i) > v(i + 1) Then
            MsgBox "false" & i
            Exit Sub
        End If
    Next
    MsgBox "True"
End Sub

これを実行して

結果

正しく整列できてます！

コムソートすご～い！

更に間隔が9か10になったときに11に変更するともっと早くなるとか

'testComb2をComb Sort11へ改変
Public Function testComb3(v As Variant) As Variant
    Dim i As Long
    Dim tmp As Variant
    Dim f As Boolean: f = False '交換フラグ
    Dim h As Long '間隔用
    h = UBound(v) - LBound(v) + 1 '最初は要素数、ループに入ってから1.3で割る
   '間隔が1になるか交換が発生しなくなるまでループ
    Do While h > 1 Or f
        f = False 'フラグリセット
        If h > 1 Then '間隔が1を超えていたら縮める
            h = WorksheetFunction.Quotient(h, 1.3)
            If h = 9 Or h = 10 Then
                h = 11
            End If
        End If
        For i = LBound(v) To UBound(v) - h
           '左側数値が大きかったら交換
            If v(i) > v(i + h) Then
                tmp = v(i)
                v(i) = v(i + h)
                v(i + h) = tmp
                f = True
            End If
        Next
    Loop
    testComb3 = v
End Function

testComb2から付け足したのは13～15行目の

If h = 9 Or h = 10 Then

h = 11

End If

だけ

これのタイムは

えー、遅くなった

これは毎ループに間隔が9か10かチェックする処理が増えたからかなあ

1万件から100万件に変更して比較してみる

やっぱり遅くなるなあ、なんでだろ

書き方が良くないのかもしれないけど、わかんないなあ

あと気になるのが間隔の求め方、ループごとに間隔÷1.3の商を取っていくのがいいらしいけど、これを2にしたらどうなるんだろう、半分づつ縮めていくことになる

testComb2の

h = WorksheetFunction.Quotient(h, 1.3)

これを

h = WorksheetFunction.Quotient(h, 2)

に変えて1万件をソート

9.6秒ｗめちゃくちゃ遅くなったｗ

次は1.9

6.5859秒

お、少し早くなった

次は1.4

0.2226

速い、けど1.3よりは遅い

次は1.2

0.1171

1.3のタイムに近づく

1.25

0.0859

ほとんど1.3とほとんど同じタイム

まとめ

やっぱり1.3が最速なんだなあ、不思議だわ

いままでのまとめ

コムソート速い！

もしかして

コムソートは最終的には間隔1で隣同士の比較になるからバブルソートと全く同じ、ってことは間隔が1になった時点からバブルソートの改良型のシェーカーソートに切り替えると速くなったりするかも？

2017年3月14日追記ここから

シェーカーソートを組み合わせても変わらないか誤差程度に遅くなった

前回のtestShaker2との組み合わせ

コムソートとシェーカーソートの組み合わせ

Public Function testComb2Shaker2(v As Variant) As Variant
    Dim i As Long
    Dim tmp As Variant
    Dim h As Long '間隔用
    Dim min As Long: min = LBound(v)
    Dim max As Long: max = UBound(v)
    
    h = max - min + 1 '最初は要素数、ループに入ってから1.3で割る
   '間隔が2より大きいならループ
    Do While h > 2
       '間隔を1.3で割った整数部分にする
        h = WorksheetFunction.Quotient(h, 1.3)
        For i = min To max - h
           '左側数値が大きかったら交換
            If v(i) > v(i + h) Then
                tmp = v(i)
                v(i) = v(i + h)
                v(i + h) = tmp
            End If
        Next
    Loop
   'シェーカーソートに渡す
    v = testShaker2(v)
    testComb2Shaker2 = v
End Function