【VBScript】1次元配列を並び替える(バブルソート)

Windows PC

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

私はプログラムで1次元配列を並び替えるときはクイックソート、2次元配列を並び替える時はマージソートと挿入ソートを組み合わせたものを使います。
クイックソートとマージソートは1万件を超えるような配列のデータでも、ソート(データの並び替え)が速いので便利です。

しかし、今回はソートがとても遅い「バブルソート」を使って1次元配列をソートする方法ついて紹介します。

ソートがとても速い記事はこちら:
【VBScript】1次元配列を短時間で並び替える(クイックソート)
【VBScript】2次元配列を短時間で並び替える(安定ソート)

バブルソートのしくみ

バブルソートの動作のしくみは次のとおりです。

1.
配列の添字0番と1番を比較して2つの要素を順番に並べる。添字1番と2番を比較して2つの要素を順番に並べる。添字2番と3番を比較…
これを最後の添字まで繰り返すと最後の添字の要素が最大(最小)値として確定する。

2.
配列の添字0番と1番を比較して2つの要素を順番に並べる。添字1番と2番を比較して2つの要素を順番に並べる。添字2番と3番を比較…
これを最後の添字の1つ前まで繰り返すと最後の添字の1つ前の要素が2番目に大きい(小さい)値として確定する。

3.
配列の添字0番と1番を比較して2つの要素を順番に並べる。添字1番と2番を比較して2つの要素を順番に並べる。添字2番と3番を比較…
これを最後の添字の2つ前まで繰り返すと最後の添字の2つ前の要素が3番目に大きい(小さい)値として確定する。

4.
以降、同様の手順で配列要素の全ての順番が確定するまで続ける。

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

バブルソートの並び替え処理の時間はデータ数の2乗にほぼ比例するので、1000件を超える大きなデータの並び替えになると、並び替え処理にかかる時間が目立つようになります。
既存のプログラムで1000件を超えるデータの並び替えにバブルソートを使っているものがあった場合、ソートアルゴリズムをクイックソートやマージソート等に交換することで処理時間を大幅に短縮することができます

バブルソートは重複する値を含む(排他的でない)配列をソートした時に順番が入れ替わらないソートです。(安定ソート)
2次元配列のソートにバブルソートが使われていた場合、クイックソート(不安定ソート)に交換すると並び替えに不具合が発生する可能性があるので注意しましょう。

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

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

サンプルコード

Option Explicit
Dim varArray, sngTime, lngN
ReDim varArray(999)
For lngN = Lbound(varArray) To Ubound(varArray)
    varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10)
Next
sngTime = Timer
Call BubbleSort1D(varArray, Lbound(varArray), Ubound(varArray))
MsgBox ConfirmationTextForArray1D(varArray), , _
    "並び替え処理の時間(秒):" & Round(Timer - sngTime, 3)
WScript.Quit
'******************************************************************************
'1次元配列varArray1DのlngLowerからlngUpperまでの範囲をバブルソート(昇順)
Sub BubbleSort1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)
    Dim lngI, lngJ, varSwap
    
    For lngI = lngUpper To lngLower + 1 Step -1
        For lngJ = lngLower + 1 To lngI
            If varArray1D(lngJ)  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ファイルをダブルクリックすると、要素数1,000の配列をランダムの整数値で作成後、バブルソートが行われ、昇順でソートされた配列データの若番10件と配列のソート時間(秒)がメッセージで表示されます。

解説

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

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

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

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

17~29行目はバブルソートのプロシージャです。

20~28行目の For ~ Next は添字の最大値から最小値 + 1まで1つずつ減らしながらループします。比較範囲の最大値の添字を決定します。

21~27行目の For ~ Next は添字の最小値 + 1 から比較範囲の最大値までループします。要素を比較する添字の老番(右側)を決定します。

22行目は21行目で決定した添字の老番の要素と隣接する若番(左側)の要素を比較し、老番の要素が若番の要素より小さいとき、要素の交換処理に移行します。

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

このバブルソートのプロシージャはExcel等の VBAでも動作します。

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

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

サンプルコード

Option Explicit
Dim varArray, sngTime, lngN

ReDim varArray(999)
For lngN = Lbound(varArray) To Ubound(varArray)
    varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10)
Next
sngTime = Timer
Call BubbleReverse1D(varArray, Lbound(varArray), Ubound(varArray))
MsgBox ConfirmationTextForArray1D(varArray), , _
    "並び替え処理の時間(秒):" & Round(Timer - sngTime, 3)
WScript.Quit


'******************************************************************************
'1次元配列varArray1DのlngLowerからlngUpperまでの範囲をバブルソート(降順)
Sub BubbleReverse1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)
    Dim lngI, lngJ, varSwap
    
    For lngI = lngUpper To lngLower + 1 Step -1
        For lngJ = lngLower + 1 To lngI
            If varArray1D(lngJ) > varArray1D(lngJ - 1) Then
                varSwap = varArray1D(lngJ - 1)
                varArray1D(lngJ - 1) = varArray1D(lngJ)
                varArray1D(lngJ) = varSwap
            End If
        Next
    Next
End Sub
'******************************************************************************
'処  理:1次元配列のデータをメッセージ表示用の文字列で返す
'
'戻 り 値:メッセージ表示用の文字列
'
'引  数:strArray1D - 1次元配列
'
'備  考:配列の要素数が表示させる個数の上限を超えた分は残りを省略
'
Function ConfirmationTextForArray1D(ByRef strArray1D)
    Dim intN, strTemp
    Const c_intI = 10 '表示させる個数の上限
    
    For intN = LBound(strArray1D) To UBound(strArray1D)
        If intN > 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ファイルをダブルクリックすると、要素数1,000の配列をランダムの整数値で作成後、バブルソートが行われ、降順でソートされた配列データの若番10件と配列のソート時間(秒)がメッセージで表示されます。

解説

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

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

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

まとめ

  • バブルソートはとても遅いので、別のソートアルゴリズムを使ったほうがよい
  • 既存のプログラムが1000件を超えるデータの並び替えにバブルソートを使っていた場合、クイックソートやマージソート等に交換することで処理時間を大幅に短縮することができる
  • 2次元配列のソートにバブルソートが使われていた場合、クイックソート等の不安定ソートに交換すると並び替えに不具合が発生する可能性がある

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

ソートがとても速い記事はこちら:
【VBScript】1次元配列を短時間で並び替える(クイックソート)
【VBScript】2次元配列を短時間で並び替える(安定ソート)

コメント

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