ｋ－近傍法を模した遊び

最近学習した「k-近傍法」を模した遊びを思いついた。やってみよう。

k-近傍法については、こちらを参照されたし。
ja.wikipedia.org

今回行うのは、ＡとＢのグループ分けだ。ＸＹ座標上に、事前に幾つかのポイントを決めて、これらをＡグループとＢグループに分けておく。こんな感じだ。

グラフに表すと、こんな感じ。
※二系列の分布図の表し方が分からず、苦し紛れにＹ座標を二系列で表示。
　結果、該当しない方の座標がＸ軸上に散らかってしまった。

青丸がＡグループで、橙丸がＢグループ。グラフ描画用のテーブル（緑）は、
データテーブル（青）を参照してＡ・Ｂの二列へ振り分けている。

さて、このデータテーブルに、ランダムな値で行を一つ追加してみる。
更に、この値はその最も近く（近傍）の点と同グループであると見なしてみる。
最も近い点は一個しかないので、ｋ＝1 となる。これを複数回繰り返してみたら、
それなりに面白い模様が描けるのではないかと思いついた訳で。

Enum 列名
    X座標 = 1
    Y座標
    グループ
    [_eLast]
End Enum

Sub AddPoint()
    ' データテーブル。
    Dim Tb As ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' 追加される点の座標は、XYともに0≦座標＜200とする。
    Dim X_add As Double
        X_add = Rnd * 200
    Dim Y_add As Double
        Y_add = Rnd * 200

    ' 既存の各座標を格納するための変数。
    Dim X_i As Double
    Dim Y_i As Double
    
    ' グループ名。
    Dim GroupName As String
    
    ' 追加された点と既存点の距離を格納する辞書。
    Dim Distance As Object
    Set Distance = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    
    ' 追加された点と既存点の距離。
    Dim L As Double
    
    ' 上記距離の中の最短距離。
    Dim L_Nearest As Double
    
    ' 最短距離の初期値。初期値は充分に大きな値にしておく。
        L_Nearest = 10 ^ 10
        
        ' 既存の各点との距離を比較。
        For i = 1 To Tb.ListRows.Count
            With Tb.ListRows(i)
                X_i = .Range(列名.X座標)
                Y_i = .Range(列名.Y座標)
                GroupName = .Range(列名.グループ)
            End With
            
            L = ((X_i - X_add) ^ 2 + (Y_i - Y_add) ^ 2) ^ 0.5
            Distance(L) = GroupName
            
            ' 最短距離の更新。
            If L_Nearest > L Then
                L_Nearest = L
            End If
        Next
    
        ' データとグループの追加。
        With Tb.ListRows.Add
            .Range(列名.X座標) = X_add
            .Range(列名.Y座標) = Y_add
            .Range(列名.グループ) = Distance(L_Nearest)
        End With
    
End Sub

それでは、1000点ほど追加してみよう。

Sub test()
    Dim i As Long
        For i = 1 To 1000
            AddPoint
            ActiveSheet.ListObjects(2).ListRows.Add
        Next
End Sub

↓ 実行前。

↓ 実行後。

これが何に役立つかと言われると、今回作成したものについては、多分何の役にも立たない。でもそれなりに面白かったので、良しとしよう。

参考まで。