[VBA]コムソート(Comb sort)の実装

2020年5月4日

概要

VBAでコムソートを実装しました。O記法での計算量はO(n log n)です。データ量が1000件以下か、クイックソートが不得意なデータの並び順が発生する場合にご使用ください。アルゴリズムの説明はWikipediaより引用させて頂きました。

1. 総数 n を 1.3 で割り、小数点以下を切り捨てた数を間隔 h とする。
2. i=0 とする。
3. i 番目と i+h 番目を比べ、i+h 番目が小さい場合入れ替える。
4. i=i+1 とし、i+h>n となるまで3を繰り返す。
5. hがすでに1になっている場合は入れ替えが発生しなくなるまで上の操作を繰り返す。
6. h を 1.3 で割り、小数点以下を切り捨てた数を新たに間隔 h とし、操作を繰り返す。

Wikipedia

コード


'* @fn Public Sub CombSort(ByRef Values As Variant, Optional ByVal StartIndex As Long = -1, Optional ByVal EndIndex As Long = -1)
'* @brief 一次元配列をコムソートします。
'* @param[in,out] Values    値型の一次元配列を指定します。内部処理形式が値型のVariant型配列も指定可能です。
'* @param[in] StartIndex    第1引数Valuesの中から、ソートする範囲の開始位置をインデックスで指定します。引数を省略するか、-1を指定すると、配列の先頭が開始位置となります。
'* @param[in] EndIndex      第1引数Valuesの中から、ソートする範囲の終了位置をインデックスで指定します。引数を省略するか、-1を指定すると、配列の末尾が終了位置となります。
'* @details コムソートは不安定ソートで、実行速度は、ほぼO(n log n)です。
''*
Public Sub CombSort(ByRef Values As Variant, Optional ByVal StartIndex As Long = -1, Optional ByVal EndIndex As Long = -1)
    If (StartIndex <= -1) Then StartIndex = LBound(Values)
    If (EndIndex <= -1) Then EndIndex = UBound(Values)
    Dim i As Long
    Dim tmp As Variant
    Dim Swap As Boolean
    Dim h As Long '間隔用
    h = EndIndex - StartIndex + 1
    
    '間隔が1になるか交換が発生しなくなるまでループ
    Do While ((1 < h) Or Swap)
        
        Swap = False
        If (1 < h) Then h = Int(h * 10 / 13) '間隔が1を超えていたら縮める
        
        For i = StartIndex To EndIndex - h
        
            '左側数値が大きかったら交換
            If (Values(i) > Values(i + h)) Then
                tmp = Values(i)
                Values(i) = Values(i + h)
                Values(i + h) = tmp
                Swap = True
            End If
        Next
    Loop
End Sub


ソースコードの利用について

本ソースコードは「GPL v3.0(GNU General Public License Version 3.0)」ライセンスで利用可能です。

本ソースコードを私的に利用される方は、本ソースコードが無料で利用できると考えて差し支え御座いません。下記の著作権表示をソースコード内に表示して頂ければ幸いです。

Copyright © 2017 黒い箱の中 All Rights Reserved.(https://kuroihako.com/)

本ホームページのソースコードを利用したソフトウェアを商用利用したり、ホームページ等で一般公開する方は、本ホームページのソフトウェアまたはソースコードに適用されているライセンスをご理解頂いてからご使用ください。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。