【VBScript】１次元配列を並び替える（挿入ソート）

Windows PC
2021.04.15

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

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

しかし、今回はデータ数が少ないときにソートがとても速い「挿入ソート」を使って1次元配列をソートする方法ついて紹介します。

データ数が多くてもソートがとても速い記事はこちら：
【VBScript】１次元配列を短時間で並び替える（クイックソート）
【VBScript】２次元配列を短時間で並び替える（安定ソート）

挿入ソートのしくみ

挿入ソートの動作のしくみは次のとおりです。

１．
配列の添字の若番（0番）の要素と次（1番）の要素を比較し、入れ替える。

２．
その次（2番）の要素と、左側の配列（０～1番）の要素を比較し、順番になる位置に要素を挿入する。さらに次（3番）の要素と、左側の配列（０～2番）の要素を比較…
これを配列の最後になるまで、要素の比較と挿入を繰り返す。

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

挿入ソートはデータ数が少ないときにマージソートよりも高速で並び替えができるのが特徴です。
アルゴリズムが単純でバブルソートよりも処理が速いのですが、2000件を超える大きなデータの並び替えになると、並び替え処理にかかる時間が目立つようになります。
既存のプログラムで2000件を超えるデータの並び替えに挿入ソートを使っているものがあった場合、ソートアルゴリズムをマージソート等に交換することで処理時間を大幅に短縮することができます。

挿入ソートは重複する値を含む（排他的でない）配列をソートした時に順番が入れ替わらないソートです。（安定ソート）

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

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

サンプルコード

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

解説

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

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

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

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

17～29行目は挿入ソートのプロシージャです。

20～28行目の For ～ Next は添字の最小値 + 1から最大値までループします。自身より左側の配列に「挿入する要素」の添字を決定します。

21行目の変数varTemp は挿入する要素を一時保管変数に代入します。

22～26行目の For ～ Next は挿入する要素の添字 – 1から添字の最小値までループします。要素を挿入する要素の「前の要素」の添字を暫定的に決定します。

23行目は「前の要素」が「挿入する要素」以下の時、ループを抜けます。

25行目は「前の要素」が「挿入する要素」より大きい時、前の要素を後ろに1つずらします。

27行目は「挿入する要素」を、「前の要素」の後ろに挿入します。

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

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

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

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

サンプルコード

Option Explicit
Dim varArray, sngTime, lngN

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


'******************************************************************************
'1次元配列varArray1DのlngLowererからlngUpperまでの範囲を挿入ソート（昇順）
Sub InsertionReverse1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)
    Dim lngI, lngJ, varTemp
    
    For lngI = lngLower + 1 To lngUpper
        varTemp = varArray1D(lngI) '挿入する要素
        For lngJ = lngI - 1 To lngLower Step -1
            If varArray1D(lngJ) >= varTemp Then Exit For
            
            varArray1D(lngJ + 1) = varArray1D(lngJ) '前の要素を後ろに1つずらす
        Next
        varArray1D(lngJ + 1) = varTemp '要素を挿入
    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

解説

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

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

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

まとめ

  • 挿入ソートはデータ数が少ないときにマージソートよりも並び替えが速い
  • 既存のプログラムで2000件を超えるデータの並び替えに挿入ソートを使っているものがあった場合、ソートアルゴリズムをマージソート等に交換することで処理時間を大幅に短縮することができる
  • 挿入ソートは重複する値を含む（排他的でない）配列をソートした時に順番が入れ替わらないソート（安定ソート）

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

データ数が多くてもソートがとても速い記事はこちら：
【VBScript】１次元配列を短時間で並び替える（クイックソート）
【VBScript】２次元配列を短時間で並び替える（安定ソート）

スポンサーリンク

コメント

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