インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

バブルソートのしくみをみつつ 原因究明中

同じ値の時に反転が起こることがあるので,ソートの仕組みとにらめっこをしていました。

昇順の時と,降順の時で,ループの方向を変えないといけないのかな。

バブルソートが安定ソートなためには その方向性が重要な気がする。

でもな,2つめのキーでまたループの方向を変えるとかはできない。

昇順なら入れ替わらない,降順なら入れ替わる のような挙動がある気がするなぁ。
f:id:chemiphys:20170111235720p:plain
こんな感じの入れ替わり
うーん うーん ・・・


評価するすべてのキーが同じとき,IDで強制的に評価するようにしてみた。
IDで降順に並べるというときには真っ向から対立している。

でも,まず自分の用途に対してID降順は無いのでいいかなぁ。

Sub CSort(Col As Collection, Key1 As String, Key1昇順 As Boolean, Optional Key2 As String, Optional Key2昇順 As Boolean)
    Dim p1 As person, p2 As person
    Dim p1k1 As Variant, p2k1 As Variant, p1k2 As Variant, p2k2 As Variant
    'バブルソート
    Dim i As Long, j As Long
    For i = 1 To Col.Count
        For j = Col.Count To i Step -1
            Set p1 = Col(i)
            Set p2 = Col(j)
            
            If IsNumeric(Key1) Then
                p1k1 = CallByName(p1, "GetParameter", VbMethod, Key1)
                p2k1 = CallByName(p2, "GetParameter", VbMethod, Key1)
            Else
                p1k1 = CallByName(p1, Key1, VbGet)
                p2k1 = CallByName(p2, Key1, VbGet)
            End If
            
            Dim flag As Boolean: flag = False
            If Key2 = "" Then
                If IsGreater(Key1昇順, p1k1, p2k1) Then
                    flag = Not flag
                ElseIf p1k1 = p2k1 Then
                    If p1.ID > p2.ID Then flag = Not flag
                End If
            Else
                If IsGreater(Key1昇順, p1k1, p2k1) Then
                    flag = Not flag
                ElseIf p1k1 = p2k1 Then
                    If IsGreater(Key2昇順, p1k2, p2k2) Then
                        flag = Not flag
                    ElseIf p1k2 = p2k2 Then
                        If p1.ID > p2.ID Then flag = Not flag
                    End If
                End If
            End If
            If flag Then CollectionSwap Col, i, j
        Next j
    Next i

End Sub
Function IsGreater(which, A, B) As Boolean
    Select Case which
    Case True: IsGreater = A > B
    Case False: IsGreater = A < B
    End Select
End Function

中途半端ですがネマス(゚▽゚*)