Теперь можно потрогать вариант метода для непрерывной ф-ции. Сама ф-ция та же самая. Изменения в порге минимальные.
Зато изменения в параметрах весьма значительны:
52*80прогонов по 10^3 итераций M=40 точек на [1; 15]
MO= 0,6089 mediana= 0,6016 СКО= 0,6087
- Начальная скорость= 1+Rnd (на первой итерации метода).
- Кол-во точек M= 40 (вмесо 10). Даже этого недостаточно, из-за вида непрерывной ф-ции. Шаг=+1.0 теряет слишком много подробностей. Уменьшил область определения ф-ции до отрезка [1; 15] (вмесо 1-150).
- Кол-во итераций одного прогона NN = 10^3 (и скажу, даже этого недостаточно, но может сгодиться для разведочного анализа).
- Чтобы не терять время коло-во прогонов для усреднения tn= 80 (вместо 800).
- Учитывая, что аргументы ф-ции теперь непрерывные и double, округление их до целого не выполнять.
И всё равно судя по тестовым прогонам оценка глобального минимума на [1; 15] очень неточна. При шаге дискретизации =+0.1 глобальный мин на отрезке = 0,043.
Ещё кучка локальных минимумов на уровнях 0,5 1,0 1,5 2,0.
Однако судя по СКО==МО, на 80 прогонах оценка гуляла по всем перечисленным уровням. Причём похоже, что именно уровень глобального мин. достигался реже всего. Неудивительно, поскольку впадин уровня ~ 0.000 меньше,чем на других уровнях.
Как может помочь гибрид Ньютона и градиента, не представляю.
А значит проще всего в такой ситуации (если ф-ция вычисляется достаточно быстро) полный перебор с достаточно мелким шагом. Но надо ещё выбрать этот шаг.
ИМХО, без разведочного анализа не обойтись.
Теперь вариант проги для непрерывного случая (точнее сказать ф-ция,опредедлена на отрезке):
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
'' Искать Min( f()) и точку Xmin, метод роения M вещественных точек
Option Explicit
Option Base 1
Private Type MyStat
fm As Single
ym As Single
End Type
'' M точек роения, NN итераций на непрерывном [1; k],
'' {alf, bet, gam} параметры для расчёта след точки
'' Ksi - независимые случ.вел. (но здесь они НЕ независ.)
'' FF(x) - аргумент x и значения ф-ции double
'' Xm(M), Xm2(M) - M эволюционирующих точек: x(i) и x(i+1), где i - итерации.
'' Xm0(M) - начальный значени точек (чтобы потом сравнить с окончанием)
'' V(M) - вектор скорости эволюционирования к следующей итерации x(i)= x(i+1) + V(i+1)
'' eps - не исп.
Const dd = 0, NN = 10 ^ 3, M = 40, k = 15, alf = 0.95, bet = 0.2, gam = 0.2, eps = 0.000001
''''''Const dd = 0, NN = 10 ^ 2, M = 40, k = 15, alf = 0.85, bet = 0.3, gam = 0.3, eps = 0.000001
'' ******************************************************
'' Тест для статистики
Sub test()
On Error GoTo myerr
Dim tn As Integer, t As Integer '', ind As Integer
tn = 80 '' : ind = 1 ''2
Dim tt As Integer, pp As Integer, x As Single
For tt = 1 To 52
x = Timer: For pp = 1 To 1023 * (x - Int(x)): DoEvents: Next pp
ReDim f0(tn) As MyStat
Dim m0 As Double, d0 As Double, tmp As Single
m0 = 0: d0 = 0
For t = 1 To tn
tmp = roen(f0(t))
m0 = m0 + f0(t).fm: d0 = d0 + f0(t).fm ^ 2
Next t
m0 = m0 / tn: d0 = d0 / (tn - 1) - m0 ^ 2
Debug.Print "m="; m0; " sqr(d)="; Sqr(d0); " m-s="; _
m0 - Sqr(d0); " m+s="; m0 + Sqr(d0)
Next tt
Exit Sub
myerr:
Debug.Print Err.Number; " "; Error
Resume Next
End Sub
'' ******************************************************
Private Function roen(ByRef f0 As MyStat) As Double
On Error GoTo myerr
ReDim Xm(M) As Double, Xm2(M) As Double, V(M) As Double, Xm0(M) As Double
Dim minf as Double, Xmm as Double, Ksi1 as Double, Ksi2 as Double, _
tmp as Double, t As Integer, kmin As Integer, fXmm As Double
Dim i As Integer, j As Integer, kdim As Integer, FF1 as Double, FF2 as Double
Randomize
tmp= Rnd ''(Time): tmp= Rnd ''(Time) на [0; 1]
For i=1 to M: V(i)= 1 + Rnd : Next i '' начальные скорости
'' FF() - оптимизируемая непрерывная ф-ция
'' FF() = 2 + (1 + Sin(x)) * Sin(7 * x + 3.14159265358979 / 1023)
''' FF= x^2*(2+abs(sin(8*x))) на [-2.0; +2.0]
'' ******************************************************
'' Случайные точки начальных min значений
For i=1 to M: Xm(i)= 1+ Rnd *(k-1): Xm2(i)= Xm(i): Xm0(i)= Xm(i) :Next i '' нормировать случ.знач. на оси X
'' Основной цикл работы
For t=1 to NN
'' Xm() - точки предыдущей итерации, Xm2() - новые точки для текущей итерации
'' Xmm - их общий минимум
For i = 1 To M
tmp = Xm2(i): FF1= FF(Xm(i)): FF2= FF(Xm2(i))
If FF2 >= FF1 Then Xm2(i) = Xm(i)
Xm(i) = tmp
Next i
kmin= 1: minf= FF(Xm2(kmin))
For i = 1 + 1 To M
If FF2 < minf Then minf = FF2: kmin = i
Next i
Xmm = Xm2(kmin)
'''' новые скорости
For i=1 to M
tmp= Rnd: Ksi1 = Rnd: tmp= Rnd: Ksi2 = Rnd
V(i) = alf * V(i) + bet * Ksi1 * (Xm2(i) - Xm(i)) + gam * Ksi2 * (Xmm - Xm(i))
Next i
'' новые точки
For i = 1 To M
Xm2(i) = Xm(i) + V(i)
If Xm2(i) < 1 Then Xm2(i) = 1
If Xm2(i) > k Then Xm2(i) = k
Next i
Next t
'' Итоговый min и его координата
kmin = 1: minf = FF(Xm2(kmin))
For i = 1 + 1 To M
If FF(Xm2(i)) < minf Then minf = FF(Xm2(i)): kmin = i
Next i
fXmm = FF(Xm2(kmin))
''''''''''ret = MsgBox("min=" + Str(fXmm) + ", " + Str(Xm2(kmin)), vbOKOnly, "Закончили")
f0.fm = fXmm: f0.ym = Xm2(kmin)
roen = fXmm
Exit Function ''Sub
'' ******************************************************
myerr:
Debug.Print Err.Number; " "; Error
Resume Next
End Function
'' ******************************************************
Private Function FF( x as double) as double '' на [1: k]
FF = 2 + (1 + Sin(x)) * Sin(7 * x + 3.14159265358979 / 1023)
End Function
'' ******************************************************
Пример ф-ции, отрезок [1; 15], точки с шагом +0,1
