Collectionのソート
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" なのでその方法ではだめです。
どうすればいいかというと、ふたつの数字列a
とb
を実際に並べてみてab
とba
のどちらが大きいかを確かめるだけです。
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値でソートします。
最初の方法で、まずはシェイプの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を比較する関数は単一目的だからです。