【VBScript】1次元配列を短時間で並び替える(クイックソート)

Windows PC

こんにちは、ふみです。みなさんは VBScript で1次元配列を並び替えようと思ったことはありますか?

私はプログラムで1次元配列を並び替えるときはクイックソートを良く使います。
クイックソートは1万件を超えるような配列のデータでも、ソート(データの並び替え)が速いので便利です。

今回は「クイックソート」を使って1次元配列をソートする方法ついて紹介します。

クイックソートのしくみ

クイックソートの動作のしくみは次のとおりです。

1.
配列の添字(Index)の中央値の要素を基準値にする。

2.
配列のソートする範囲の各要素を基準値と比較し、基準値より小さい要素を添字の若番側の配列、基準値より大きい要素を添字の老番側の配列に振り分ける。

3.
添字の若番側の配列と添字の老番側の配列をそれぞれ1.から始まる手順でソートする。

この手順をプログラム用に効率化したものがクイックソートのプログラムです。

クイックソートは同じ値を含む配列をソートした時に順番が入れ替える可能性があるソートです。(安定ソートではない)
しかし、1次元配列は同じ値の順番が入れ替わっても同じデータになるので、安定ソートでなくても問題がありません

1次元配列を昇順に並び替える

1次元配列を昇順に並び替えるプログラムは次のとおりです。

サンプルコード

Option Explicit Dim varArray, sngTime, lngN  ReDim varArray(49999) For lngN = LBound(varArray) To UBound(varArray)     varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10) Next sngTime = Timer Call QuickSort1D(varArray, LBound(varArray), UBound(varArray)) MsgBox ConfirmationTextForArray1D(varArray), , _     "Time:" & Round(Timer - sngTime, 3) & "s" WScript.Quit   '****************************************************************************** '1次元配列varArray1DのlngLowerからlngUpperまでの範囲をクイックソート(昇順) Sub QuickSort1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)     Dim varMid, varSwap, lngI, lngJ          varMid = varArray1D(Int((lngUpper + lngLower) / 2)) '添字の中央値の要素     lngJ = lngUpper     For lngI = lngLower To lngUpper         If varArray1D(lngI)>= varMid Then
            Do Until varArray1D(lngJ) <= varMid                 lngJ = lngJ - 1             Loop             If lngI>= lngJ Then
                Exit For
            Else
                varSwap = varArray1D(lngI)
                varArray1D(lngI) = varArray1D(lngJ)
                varArray1D(lngJ) = varSwap
                lngJ = lngJ - 1
            End If
        End If
    Next
    If lngLower < lngI - 1 Then
        Call QuickSort1D(varArray1D, lngLower, lngI - 1)
    End If
    If lngJ + 1  LBound(strArray1D) Then
            strTemp = strTemp & vbCrLf '改行の追加
        End If
        If c_intI >= 1 And intN >= c_intI + LBound(strArray1D) Then '上限超過時
            strTemp = strTemp & "他" & UBound(strArray1D) - (c_intI - 1)
            Exit For
        Else
            strTemp = strTemp & "配列(" & intN & ") = " & strArray1D(intN)
        End If
    Next
    ConfirmationTextForArray1D = strTemp
End Function

上記のコードを Windows 10 のアクセサリから開いたメモ帳へコピー&ペースト後、文字コードを「ANSI」に設定し、適当なファイル名に拡張子「.vbs」をつけてデスクトップ等に保存すると、すぐに動作確認できます。
保存した vbsファイルをダブルクリックすると、要素数50,000の配列をランダムの整数値で作成後、クイックソートが行われ、昇順でソートされた配列データの若番10件と配列のソート時間(秒)がメッセージで表示されます。

解説

4~7行目は要素数50,000の配列を1~499,999の範囲のランダムの整数値で作成しています。

8行目は Timer関数でソート前の基準の秒数を取得しています。

9行目は15行目のアスタリスク(*)以下に記載しているプロシージャを使って配列varArray を昇順でソートしています。

10~11行目は44行目のアスタリスク(*)以下に記載している1次元配列のデータをメッセージ表示用の文字列で返すファンクションを使ってソート後の配列を表示すると同時に、Timer関数を使ってソート時間を表示しています。

17~43行目はクイックソートのプロシージャです。

20行目は添字の中央値の要素を基準値として取り出しています。クイックソートは基準値を要素の中央値にするのが最も効率が良く、ソート済みの配列は添字の中央値に要素の中央値が入る為、添字の中央値の要素を基準値にしています。

22~36行目のFor~Nextは添字の若番から基準値以上の要素を検出するまでループします。「クイックソート」で Google検索すると Do ~ Loop 間の中で Do ~ Loop で添字の若番から基準値以上の要素を検出後、Do ~ Loop で添字の老番から基準値以下の要素を検出する、3つのループを使ったプログラムを紹介する記事が多くみられます。しかし、1つ目の Do ~ Loop と2つ目の Do ~ Loop をこのサンプルコードのように For ~ Next でまとめるとループが2つになるので、ソート時間が若干早くなります

24~26行目の Do ~ Loop は添字の老番から基準値以下の要素を検出しています。

27行目の条件、基準値以上の要素の添字lngI が基準値以下の要素の添字lngJ 以上になった時は配列の要素の振り分けが完了しているのでループを抜けます。
条件に一致しない時は、配列の添字lngI の要素と添字lngJ の要素を交換します。

38行目は基準値以下(または基準値より小さい)の要素数が2以上の時は、その範囲を指定して自身のプロシージャを呼び出しています。(再帰プロシージャ)

41行目は基準値以上(または基準値より大きい)の要素数が2以上の時は、その範囲を指定して自身のプロシージャを呼び出しています。

44行目のアスタリスク(*)以下に記載しているファンクションは【VBScript】プロシージャとファンクション(関数)の使い方で紹介したものを転用しています。

このクイックソートのプロシージャはExcel等の VBAでも動作しますが、VBA で使用するときは配列の引数「varArray1D」の記述を「varArray1D()」に変更すると、ソートの処理が高速化されます。

1次元配列を降順に並び替える

1次元配列を降順に並び替えるプログラムは次のとおりです。

サンプルコード

Option Explicit
Dim varArray, sngTime, lngN

ReDim varArray(49999)
For lngN = LBound(varArray) To UBound(varArray)
    varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10)
Next
sngTime = Timer
Call QuickReverse1D(varArray, LBound(varArray), UBound(varArray))
MsgBox ConfirmationTextForArray1D(varArray), , _
    "Time:" & Round(Timer - sngTime, 3) & "s"
WScript.Quit


'******************************************************************************
'1次元配列varArray1DのlngLowerからlngUpperまでの範囲をクイックソート(降順)
Sub QuickReverse1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)
    Dim varMid, varSwap, lngI, lngJ
    
    varMid = varArray1D(Int((lngUpper + lngLower) / 2)) '添字の中央値の要素
    lngJ = lngUpper
    For lngI = lngLower To lngUpper
        If varArray1D(lngI) <= varMid Then             Do Until varArray1D(lngJ)>= varMid
                lngJ = lngJ - 1
            Loop
            If lngI >= lngJ Then
                Exit For
            Else
                varSwap = varArray1D(lngI)
                varArray1D(lngI) = varArray1D(lngJ)
                varArray1D(lngJ) = varSwap
                lngJ = lngJ - 1
            End If
        End If
    Next
    If lngLower < lngI - 1 Then
        Call QuickReverse1D(varArray1D, lngLower, lngI - 1)
    End If
    If lngJ + 1  LBound(strArray1D) Then
            strTemp = strTemp & vbCrLf '改行の追加
        End If
        If c_intI >= 1 And intN >= c_intI + LBound(strArray1D) Then '上限超過時
            strTemp = strTemp & "他" & UBound(strArray1D) - (c_intI - 1)
            Exit For
        Else
            strTemp = strTemp & "配列(" & intN & ") = " & strArray1D(intN)
        End If
    Next
    ConfirmationTextForArray1D = strTemp
End Function

上記のコードを Windows 10 のアクセサリから開いたメモ帳へコピー&ペースト後、文字コードを「ANSI」に設定し、適当なファイル名に拡張子「.vbs」をつけてデスクトップ等に保存すると、すぐに動作確認できます。
保存した vbsファイルをダブルクリックすると、要素数50,000の配列をランダムの整数値で作成後、クイックソートが行われ、降順でソートされた配列データの若番10件と配列のソート時間(秒)がメッセージで表示されます。

解説

9行目は15行目のアスタリスク(*)以下に記載しているプロシージャを使って配列varArray を降順でソートしています。プロシージャの名前が昇順のときと変わっています。

23~24行目は不等号の向きが昇順ソートのときの逆になっています。

38行目と41行目の再帰プロシージャの名前が昇順のときと変わっています。

その他は昇順でソートするときと同じです。

まとめ

  • クイックソートは同じ値を含む配列をソートした時に順番が入れ替える可能性がある(安定ソートでない)
  • 1次元配列のソートは安定ソートでなくても問題ない
  • クイックソートはループを2つにするとソート時間が若干早くなる

ありがとうございました。

コメント

タイトルとURLをコピーしました