見出し画像

局所的な最大最小値の取得

1.はじめに
 何らかの波形のようなデータでは、局所的に最大値、最小値(特定の範囲での極大値や極小値)を取ることがあります。データからその位置を探索するために、端から順に調べればよいのですが、どの範囲での極大値なのかなど、判定が複雑なように思います。そこで、範囲と最大最小値を一括して取得する方法を考えたので、以下に示します。

2.手順
 例を用いて、手順を説明します。連番と値の組
(No, Data)=(1, 1.5), (2, 2.8),(3, 5.4),….(100, -3.7)
のようなデータがあるとします。
これを値の昇順(降順でも良い)で並べ替えます。
(No, Data)=(7, -9.5), (15, -8.7),(16, -7.6),….(35, 12.7)

並べ替えたデータを先頭(値の小さい方)から順に見ていきます。

 最初は(7, -9.5)で、No=7の位置がこの付近No=7~7での最小値(7, -9.5)です。最小値グループ1(最小位置, 下限範囲, 上限範囲)=(7, 7, 7)と記録します。

 次は(15, -8.7)で、No=15の位置がこの付近No=15~15での最小値(15, -8.7)です。最小値グループ2(15, 15, 15)と記録します。

その次の(16, -7.6)は、No=15の隣ですから、最小値(15, -8.7)はNo=15~16の範囲での最小値であることがわかります。最小値グループ2(15, 15, 16)と範囲を広げて記録します。

こうやって、並べ替えたデータを先頭から順に見て
記録済みの最小値グループの隣のデータが出てくれば最小値グループの範囲を広げる、
記録済みの最小値グループの隣のデータではない時は、最小値グループを新たに作る、
を繰り返し、すべてのデータを処理すると、最小値の位置と範囲が記録されます。
最大値については、データの終端(値の大きい方)から先頭に向かって同様のやり方で最大値を記録します。

3.例題
 図1のようなデータがあった時、上述の方法で探索した結果を表1に示します。
 1から62の範囲での最小位置が1、72から98の範囲での最小位置が83であることなどがわかります。最小値そのものはその位置のデータを参照すればわかります。

表1.最大・最小探索結果
図1.データ

4.ソースコード
 Excel VBAのソースコードを以下にしまします。データはアクティブなシートから取得します。結果はイミディエイトウィンドウに表示します。ソートは「選択ソート」を使っています。データと連番を組みでソートできればどんなソートでも構いません。
  一番下にExcelのファイルを添付します。

Option Explicit

'メイン
Public Sub SearchMinMax()
    'データの用意
    Dim dt As Variant
    Dim numbr As Variant
    makedata dt, numbr
    
    'データで昇順に並べ替え
    MinSortWith dt, numbr
    
    '戻り値の辞書の宣言
    '辞書の書式 dic(GroupNo)=array(numbr,minnumbr,maxnumbr)
    Dim dicMin As New Dictionary
    Dim dicMax As New Dictionary
    
    'データのの分析
    Srch numbr, dicMin, dicMax

    '結果の表示。イミディエイトウィンドウに出力
    Dim keywd As Variant
    Dim itmdt As Variant
    Debug.Print "min"
    For Each keywd In dicMin.Keys
        itmdt = dicMin(keywd)
        Debug.Print itmdt(0) & "," & itmdt(1) & "," & itmdt(2)
    Next
    
    Debug.Print "max"
    For Each keywd In dicMax.Keys
        itmdt = dicMax(keywd)
        Debug.Print itmdt(0) & "," & itmdt(1) & "," & itmdt(2)
    Next
    
End Sub

'アクティブシートのデータを配列に取り込む
Private Sub makedata(A As Variant, B As Variant)
    '取り込むデータの位置
    Const col1 = 2 '連番の列
    Const col2 = 7 'データの列
    Const srow = 6 'データの開始行
    
    '開始行から最下行まで取得
    B = Range(Cells(srow, col1), Cells(rows.Count, col1).End(xlUp))
    A = Range(Cells(srow, col2), Cells(rows.Count, col2).End(xlUp))
    B = WorksheetFunction.Transpose(B) '1次元配列に変換
    A = WorksheetFunction.Transpose(A) '1次元配列に変換
End Sub

'データの分析。最小値最大値の探索
Private Sub Srch(numbr As Variant, dicMin As Dictionary, dicMax As Dictionary)
    Dim keywd As Variant '辞書のキー
    Dim itmdt As Variant '辞書のアイテム
    Dim i As Long
    Dim num As Variant
    Dim dnum As Variant '連番の差分(通常は1)
    Dim flg As Boolean '新しくグループを追加するフラグ
    
    dnum = 1 '連番の差分(通常は1)
    
    '極小値の探索
    '初期値として1番目を登録
    i = 1
    dicMin(dicMin.Count) = Array(numbr(i), numbr(i), numbr(i))
    '2番目以降
    For i = 2 To UBound(numbr) '極小の処理は小さい順
        num = numbr(i)
        '局所最小値に属する範囲を広げていく
        flg = True
        For Each keywd In dicMin.Keys
            itmdt = dicMin(keywd)
            If itmdt(2) + dnum = num Then
                itmdt(2) = itmdt(2) + dnum
                flg = False
            ElseIf num = itmdt(1) - dnum Then
                itmdt(1) = itmdt(1) - dnum
                flg = False
            End If
            dicMin(keywd) = itmdt
        Next
        If flg Then
            dicMin(dicMin.Count) = Array(numbr(i), numbr(i), numbr(i))
        End If
    Next
    
    '極大値
    '初期値として1番目を登録
    i = UBound(numbr)
    dicMax(dicMax.Count) = Array(numbr(i), numbr(i), numbr(i))
    For i = UBound(numbr) - 1 To 1 Step -1 '極大の処理は大きい順
        num = numbr(i)
        '局所最大値に属する範囲を広げていく
        flg = True
        For Each keywd In dicMax.Keys
            itmdt = dicMax(keywd)
            If itmdt(2) + dnum = num Then
                itmdt(2) = itmdt(2) + dnum
                flg = False
            ElseIf num = itmdt(1) - dnum Then
                itmdt(1) = itmdt(1) - dnum
                flg = False
            End If
            dicMax(keywd) = itmdt
        Next
        If flg Then
            dicMax(dicMax.Count) = Array(numbr(i), numbr(i), numbr(i))
        End If
    Next
    
End Sub


'選択ソート。a()b()をa()で昇順に並べ替え。
Private Function MinSortWith(SortA As Variant, withB As Variant)
    Dim imax As Long, imin As Long, i1 As Long, i2 As Long
    Dim Amin As Double, minNum As Long, Bmin As Variant

    imax = UBound(SortA)
    imin = LBound(SortA)

    For i1 = imin To imax - 1
        Amin = SortA(i1)
        Bmin = withB(i1)
        minNum = i1
        For i2 = i1 + 1 To imax
            If Amin > SortA(i2) Then
                Amin = SortA(i2)
                Bmin = withB(i2)
                minNum = i2
            End If
        Next i2
        SortA(minNum) = SortA(i1)
        SortA(i1) = Amin
        withB(minNum) = withB(i1)
        withB(i1) = Bmin
    Next i1
End Function

以上

#Excel , #VBA , #最大最小 , #極大極小

応援してやろうということで、お気持ちをいただければ嬉しいです。もっと勉強したり、調べたりする糧にしたいと思います。