局所的な最大最小値の取得
１．はじめに
何らかの波形のようなデータでは、局所的に最大値、最小値（特定の範囲での極大値や極小値）を取ることがあります。データからその位置を探索するために、端から順に調べればよいのですが、どの範囲での極大値なのかなど、判定が複雑なように思います。そこで、範囲と最大最小値を一括して取得する方法を考えたので、以下に示します。
２．手順
例を用いて、手順を説明します。連番と値の組
（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)と範囲を広げて記録します。
こうやって、並べ替えたデータを先頭から順に見て
記録済みの最小値グループの隣のデータが出てくれば最小値グループの範囲を広げる、
記録済みの最小値グループの隣のデータではない時は、最小値グループを新たに作る、
を繰り返し、すべてのデータを処理すると、最小値の位置と範囲が記録されます。
最大値については、データの終端（値の大きい方）から先頭に向かって同様のやり方で最大値を記録します。
３．例題
図１のようなデータがあった時、上述の方法で探索した結果を表１に示します。
１から62の範囲での最小位置が1、72から98の範囲での最小位置が83であることなどがわかります。最小値そのものはその位置のデータを参照すればわかります。
４．ソースコード
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
以上
いいなと思ったら応援しよう！
