VBScript でソートする (unibon)

2000年03月05日: 新規作成。
2001年02月21日: ヒープソート、シェルソート、マージソートおよび計数ソートを追加。
2001年04月01日: VB に移植したコードを追加。
VBScript でソート(sort)します。
VBScript にはソートの機能が標準では備わっていないので、自前でソートを実装した例です。汎用性を持たせるために VBScript のバージョン 5 以上から備わった、Class の機能を使っています。基本としては「比較関数」として compareTo というメソッドを備えたクラスを定義して使います。

ソートのアルゴリズムには各種ありますが、ここでは、

の 4 種類を実装しました。それぞれに得意・不得意があるので、用途に合わせて、適宜使い分けてください。
最近は、各種アルゴリズムの解説は Web で容易に得られます。検索サービスで上記のソートのアルゴリズム名を検索されると良いでしょう。

プログラムとしては、サーバサイド(ASP)でも、クライアントサイド(IE)でもどちらでも動きます。ただし、Class を使っているので、VBScript のバージョンは 5 以上が必要となります。クライアントサイドにおける VBScript のバージョンの管理が難しい場合は、ソートは JavaScript でおこなうほうが良いでしょう。
VBScript ではなく VB(Visual Basic) にも移植できると思いますが、試してはいません。(その後、VB 用に移植したものを追加しました。)


ソートのコア機能:
Sub swap(ByRef x, ByRef y) ' 汎用の交換用(すべてのアルゴリズムで使う)
    Dim d
    Set d = x
    Set x = y
    Set y = d
End Sub

Sub sortBubble(ByRef a) ' バブルソート
    Dim i
    For i = 0 To UBound(a) - 1
        Dim j
        For j = i + 1 To UBound(a)
            If a(j).compareTo(a(i)) < 0 Then
                Call swap(a(i), a(j))
            End If
        Next
    Next
End Sub

Sub sortInsertion(ByRef a) ' 挿入ソート
    Dim i
    For i = 1 To UBound(a)
        Dim j
        For j = i To 1 Step -1
            If a(j).compareTo(a(j - 1)) < 0 Then
                Call swap(a(j), a(j - 1))
            Else
                Exit For
            End If
        Next
    Next
End Sub

Sub sortSelection(ByRef a) ' 選択ソート
    Dim i
    For i = 0 To UBound(a) - 1
        Dim k
        k = i
        Dim j
        For j = i + 1 To UBound(a)
            If a(j).compareTo(a(k)) < 0 Then
                k = j
            End If
        Next
        Call swap(a(i), a(k))
    Next
End Sub

Sub sortQuickSub(ByRef a, ByVal p, ByVal q) ' クイックソート(内部ルーチン)
    Dim i
    i = p
    Dim j
    j = q
    Dim x
    Set x = a(p)
    Do
        Do While a(i).compareTo(x) < 0
            i = i + 1
        Loop
        Do while x.compareTo(a(j)) < 0
            j = j - 1
        Loop

        If i >= j Then
            Exit Do
        End If

        Call swap(a(i), a(j))

        i = i + 1
        j = j - 1
    Loop

    If p < i - 1 Then
        Call sortQuickSub(a, p, i - 1)
    End If

    If j + 1 < q Then
        Call sortQuickSub(a, j + 1, q)
    End If
End Sub

Sub sortQuick(ByRef a) ' クイックソート
    If 0 < UBound(a) Then
        Call sortQuickSub(a, 0, UBound(a))
    End If
End Sub

呼び出し例(年齢と名前の2つのフィールドを持ち、年齢をキーとしてソートする例):
Class PersonClass
    Dim intAge ' 年齢
    Dim strName ' 名前
    Function compareTo(ByRef o)
        If intAge < o.intAge Then
            compareTo = -1
        ElseIf intAge > o.intAge Then
            compareTo = 1
        Else ' 年齢が同じ場合は名前でソートする
            If strName < o.strName Then
                compareTo = -1
            ElseIf strName > o.strName Then
                compareTo = 1
            Else
                compareTo = 0
            End If
        End If
    End Function
End Class 

Sub sampleA()
    Dim x(3) ' 4 人分

    Dim o

    Set o = New PersonClass
    o.intAge = 33
    o.strName = "suzuki"
    Set x(0) = o

    Set o = New PersonClass
    o.intAge = 15
    o.strName = "tanaka"
    Set x(1) = o

    Set o = New PersonClass
    o.intAge = 33
    o.strName = "sato"
    Set x(2) = o

    Set o = New PersonClass
    o.intAge = 20
    o.strName = "yamada"
    Set x(3) = o

    ' ソートアルゴリズムをどれかひとつ使う
    ' Call sortBubble(x) ' バブルソート
    ' Call sortInsertion(x) '挿入ソート
    ' Call sortSelection(x) '選択ソート
    Call sortQuick(x) ' クイックソート

    Dim s
    s = ""
    Dim i
    For i = 0 To UBound(x)
        s = s & x(i).strName & ": " & x(i).intAge & vbNewLine
    Next

    Call MsgBox(s) ' クライアントサイド(IE)の場合
    ' Call Response.Write(s) ' サーバサイド(ASP)の場合
End Sub

Call sampleA()

呼び出し例(単一の値のみ持ちそれをソートする例):
Class OneField
    Dim x ' 単一の値
    Function compareTo(ByRef o)
        If x < o.x Then
            compareTo = -1
        ElseIf x > o.x Then
            compareTo = 1
        Else
            compareTo = 0
        End If
    End Function
End Class

Sub sampleB()
    Dim x(9) ' 10 個の要素

    Dim i
    For i = 0 To UBound(x)
        x(i) = CLng(Int(Rnd(1) * 100)) ' 0 以上 100 未満の整数を乱数で求める
    Next

    ' 汎用ルーチンを呼び出すためコピーする
    ReDim y(UBound(x))
    For i = 0 To UBound(x)
        Set y(i) = New OneField
        y(i).x = x(i)
    Next

    ' ソートアルゴリズムをどれかひとつ使う
    ' Call sortBubble(y) ' バブルソート
    ' Call sortInsertion(y) '挿入ソート
    ' Call sortSelection(y) '選択ソート
    Call sortQuick(y) ' クイックソート

    ' 汎用ルーチンから得られたものをコピーし直す
    For i = 0 To UBound(x)
        x(i) = y(i).x
    Next

    Call Erase(y) ' 使い終わったので消す

    Dim s
    s = ""
    For i = 0 To UBound(x)
        s = s & x(i) & vbNewLine
    Next

    Call MsgBox(s) ' クライアントサイド(IE)の場合
End Sub

Call sampleB()

その他、ヒープソート、シェルソート、マージソートおよび計数ソートを追加した例を以下に示します。

sort.txt: WSH 用のサンプルプログラムです(ダウンロード後に拡張子を .vbs に変えれば WSH 上で動きます)。動かすと要素数とソートアルゴリズムを聞いてきますので、指定してください。(キーは1から数えて)年齢を第1キー、名前を第2キーとしてソートします。したがって年齢が同じなら、名前のアルファベット順でソートされていることになります。

sort.js: 上記の JavaScript 版です。機械的に VBScript から JavaScript へ移植した感が強いです。サンプルとしての入出力は手が抜いてあるので、適宜拡張してください。なお、このコード中で「埋め込み」とあるのは、別段アルゴリズムの種別を指すのではなく、JavaScript のエンジンに埋め込まれている sort 関数を使うという意味です。これは単に各種ソートアルゴリズムの自前の実装と sort 関数との対比のために残っているだけです。


次は VB(Visual Basic) 用に移植したものです。VB 5 やそれより大きいバージョンで使えるでしょう。
unibonsort.zip
これに含まれるモジュールには genericSortModule と simpleSortModule の2つがあります。
前者は Class を使ったもので、汎用性を重視してあり、複数のソートキーに対応できます。ただし速度が犠牲になっています。
後者は Class を使わずに、文字列型や数値型の値を使います。複数のソートキーには対応できませんが、速いです。
用途により、使い分けるとよいでしょう。
なお、計数ソートの機能とソートの検証機能等は複雑なので、外してあります。
ASP の目次
ホーム
(このページ自身の絶対的な URL)