読者です 読者をやめる 読者になる 読者になる

Collectionのソート

VBA

t-homさんの記事 thom.hateblo.jp に言及されていた以下の記事にコメントを書きました。 kantoku.hatenablog.com

「コレクションのソートが面白そうなので考えてみたい。」という趣旨のコメントで、一応作ってはみたのですが、Collectionを使ったことがなかったこともあって満足できるものは出来ませんでした。なんというか、キーの扱いをどうしていいかわかりません。

・ソートロジックを新たに書かず、Collectionから配列に出力して配列をソート。
・その配列からソート済みCollectionを生成する。つまり元のCollectionはそのまま。
・全体的にVBAHaskellの既存機能を使う。

こういう方針なので気合がまったく入っていません。 メリットといえば、VBAHaskellで実現している「任意の比較ロジックを与えられる」くらいです。


まずはコレクションから1次元配列を生成する関数。
工夫した点はコレクションのItem(インデックス)メソッドが要素のコピーを出力するようなので、代入ではなくswapVariantを使っていることくらいです。
これによって要素がオブジェクト型かそうでないかによる条件分岐は不要になります。

' コレクションから1次元配列を作成
Function collection2vec(ByVal c As Collection) As Variant
    Dim vec As Variant
    vec = makeM(c.count)
    Dim i As Long
    For i = 1 To c.count Step 1
        swapVariant vec(i - 1), c.Item(i)
    Next i
    swapVariant collection2vec, vec
End Function


次に1次元配列からコレクションを生成する関数。
第1引数は対象配列、第2引数にはオプショナルで順序を指定する配列です。なければ対象配列をそのままの順序で、あれば指定された順序で要素を取っていってコレクションにAddします。
配列を実際にソートしなくても、ソートインデックスを与えれれればソート済みコレクションが作れるので効率的です。

' 1次元配列からコレクションを作成
Function vec2collection(ByRef v As Variant, Optional ByRef ord As Variant) As Collection
    Set vec2collection = New Collection
    Dim i As Long
    With vec2collection
        If IsMissing(ord) Then
            For i = LBound(v) To UBound(v) Step 1
                .Add v(i)
            Next i
        Else
            For i = LBound(ord) To UBound(ord) Step 1
                .Add v(ord(i))
            Next i
        End If
    End With
End Function


ソート済コレクションを生成する関数。
第2引数に比較関数が指定できます。オプショナル引数となっており、なければ昇順ソート。 上で定義した関数vec2collectionを使っています。

' コレクションの要素をソート
Function collectionSort(ByVal c As Collection, Optional ByRef comp As Variant) As Collection
    Dim v As Variant, si As Variant
    v = collection2vec(c)
    If IsMissing(comp) Then
        si = sortIndex(v)
    Else
        si = sortIndex_pred(v, comp)
    End If
    Set collectionSort = vec2collection(v, si)
End Function


ついでにコレクションをインディエイトウィンドウに表示するプロシージャ。
オブジェクト型や配列は考慮していますが、EmptyやNullの処理は省略。

' コレクションの要素を表示
Sub showCollection(ByVal c As Collection, Optional ByRef z As Variant)
    For Each z In c
        If IsObject(z) Then
            Debug.Print " " & TypeName(z) & " ";
        ElseIf IsArray(z) Then
            Debug.Print " [ ] ";
        Else
            Debug.Print z;
        End If
    Next z
    Debug.Print
End Sub


最後にテスト関数です。
数を並び替えて可能な最大数を返すという問題で、ここではランダムな 17 個の整数を使っています。
たとえば "3", "82", "525" という3つの数の場合は、"825253"が正解となります。一見、文字列としての大小関係で降順に並べて結合すればいいように思えますが、コメントにあるように "9" と "991" では "9" < "991" が成り立つにもかかわらず、"9919" < "9991" なのでその方法ではだめです。
どうすればいいかというと、ふたつの数字列abを実際に並べてみてabbaのどちらが大きいかを確かめるだけです。
VBAの文法で書くと、CLng(x & y) > CLng(y & x)のようになりますが、VBAHaskell の関数オブジェクトとして表現するとコード中のcompになります。

' コレクションソートのテスト
Sub test_collectionSort()
    Dim c As New Collection
    Dim i As Long
    For i = 1 To 15 Step 1
        c.Add uniform_int_dist(0, 0, 999)
    Next i
    c.Add 991
    c.Add 9
    ' "9" < "991" であるが "9919" < "9991" であることに注意
    Debug.Print "ランダム列:"
    showCollection c
    Dim comp As Variant
    ' 比較関数はこれ ↓
    comp = p_greater(p_CLng(p_str_cat(yield_1, yield_2)), p_CLng(p_str_cat(yield_2, yield_1)))
    Dim c2 As Collection
    Set c2 = collectionSort(c, comp)
    Debug.Print "最大数:"
    showCollection c2
    Set c2 = Nothing
    Set c = Nothing
End Sub


結果はこうなりました。

ランダム列:
 522  338  807  404  993  713  349  426  911  829  38  951  551  159  511  991  9 
最大数:
 9  993  991  951  911  829  807  713  551  522  511  426  404  38  349  338  159 

最大数は999399195191182980771355152251142640438349338159だとわかります。


追記

t-homさんから「シェイプのTopでソートする場合どうするのか」という旨の質問があったので追記。
この場合、上の例にあったように in-place で比較関数をつくるのは無理なので、外側に関数を追加することになります。方法としては2通り考えれます。

・シェイプのTopを取る関数を作って、p_less 関数と合成する。
・直接シェイプのTopで比較する関数を作る。

ネタとしてはシート上に四角形をいくつか置いて、これらをTop値でソートします。

f:id:mmYYmmdd:20170103191432p:plain


最初の方法で、まずはシェイプのTopを取る関数をVBAHaskellの作法通りに作ります。

Function get_shapeTop(ByRef a As Variant, Optional ByRef dummy As Variant) As Variant
    get_shapeTop = a.Top
End Function
    Function p_get_shapeTop(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_get_shapeTop = make_funPointer(AddressOf get_shapeTop, firstParam, secondParam)
    End Function


これを使ったソートのテストは以下の通りです。

' コレクションソートのテスト2
Sub test_collectionSort2()
    Debug.Print "コレクションソートのテスト2"
    Debug.Print "比較関数は p_less(p_get_shapeTop, p_get_shapeTop)"
    Dim c As Collection: Set c = New Collection
    Dim i As Long
    For i = 1 To activesheet.Shapes.count Step 1
        c.Add ActiveSheet.Shapes(i)
    Next i
    Debug.Print "Shape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c))
    Dim comp As Variant
    ' 比較関数はこれ ↓
    comp = p_less(p_get_shapeTop, p_get_shapeTop)
    Dim c2 As Collection
    Set c2 = collectionSort(c, comp)
    Debug.Print "ソート後のShape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c2))
    Set c2 = Nothing
    Set c = Nothing
End Sub


これを走らせるとイミディエイトウィンドウに以下のように出るので、正しくソートされています。

コレクションソートのテスト2
比較関数は p_less(p_get_shapeTop, p_get_shapeTop)
Shape.Top
  72  14.25  78.75  7.5  92.25  14.25  129  158.25  132.75  119.25  175.5  211.5  226.5  185.25
ソート後のShape.Top
  7.5  14.25  14.25  72  78.75  92.25  119.25  129  132.75  158.25  175.5  185.25  211.5  226.5


次に直接シェイプのTopで比較する関数でやってみます。
比較関数は見たままです。

Function comp_shapeTop(ByRef a As Variant, ByRef b As Variant) As Variant
    comp_shapeTop = IIf(a.Top < b.Top, 1, 0)
End Function
    Function p_comp_shapeTop(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_comp_shapeTop = make_funPointer(AddressOf comp_shapeTop, firstParam, secondParam)
    End Function


これを使ったソートのテストは以下の通りです。

' コレクションソートのテスト3
Sub test_collectionSort3()
    Debug.Print "コレクションソートのテスト3"
    Debug.Print "比較関数は p_comp_shapeTop"
    Dim c As Collection: Set c = New Collection
    Dim i As Long
    For i = 1 To activesheet.Shapes.count Step 1
        c.Add ActiveSheet.Shapes(i)
    Next i
    Debug.Print "Shape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c))
    Dim c2 As Collection
    Set c2 = collectionSort(c, p_comp_shapeTop)
    Debug.Print "ソート後のShape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c2))
    Set c2 = Nothing
    Set c = Nothing
End Sub


これを走らせると同じ結果になります。

コレクションソートのテスト3
比較関数は p_comp_shapeTop
Shape.Top
  72  14.25  78.75  7.5  92.25  14.25  129  158.25  132.75  119.25  175.5  211.5  226.5  185.25
ソート後のShape.Top
  7.5  14.25  14.25  72  78.75  92.25  119.25  129  132.75  158.25  175.5  185.25  211.5  226.5


どちらがいいかというと、
・シェイプのTopを取る関数を作って、p_less 関数と合成する。
だと思います。この関数を作っておけば、他と組み合わせていろいろできるのに対して、Topを比較する関数は単一目的だからです。