visual basic||нахождение минимума функции методом покоординатного градиентного спуска

[bezumes]

Здравствуйте. Посмотрите пожалуйста правильно ли я решил задачу нахождения минимума функции методом покоординатного (градиентного спуска).
Почему-то у меня при градиентном спуске при любых значениях одна итерация итерируется.
Количество итераций при покоординатном спуске то же подозрительно мало.


Исходные данные:
Функция- a*x*x+b*y*y-c*x*y-d*y
где a,b,c,d коофициенты х,у координаты начальной точки (все вводятся с клавиатуры)также есть е(погрешность>=10^-5

Rem покоординатный спуск
Private Sub Command1_Click()
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim x As Double
Dim y As Double
Dim e As Double

a = Text1.Text
b = Text2.Text
c = Text3.Text
d = Text4.Text
x = Text5.Text
y = Text6.Text
e = 0.000001
Dim f(2) As Double
Dim schet As Integer
schet = 0
f(0) = 1
f(1) = 0
Dim x1 As Double
Dim x2 As Double
x1 = 1
x2 = 0
While x1 - x2 > e
Rem Получаю значение функции начальное
Call fun(a, b, c, d, x, y, f(0))
x1 = x
schet = schet + 1
Rem нахожу новую точку минимума по х и по у
Call funx(a, b, c, d, x, y)
Call funy(a, b, c, d, x, y)
x2 = x
Rem значение функции с новой точкой
Call fun(a, b, c, d, x, y, f(1))
Wend
Text7.Text = f(1)
Text8.Text = schet
End Sub

Private Sub fun(a, b, c, d, x, y, f)
f = a * x * x + b * y * y - c * x * y - d * y
End Sub

Private Sub funx(a, b, c, d, x, y)
Rem y=const
Rem производная f = 2 * a * x - cy
Rem f''=2a
Dim extremum As Double
Dim toch_min As Double
extremum = (c * y) / (2 * a)
If (2 * a > 0) Then
toch_min = extremum
Rem Call fun(a, b, c, d, toch_min, y, f)
x = toch_min
End If
End Sub

Private Sub funy(a, b, c, d, x, y)
Rem x=const
Rem производная f = 1 + 2 * b * y - c * x - d
Rem f''=2*b
Dim extremum As Double
Dim toch_min As Double
extremum = (d + c * x - 1) / (2 * b)
Rem Call fun(a, b, c, d, x, toch_min, f)
If (2 * b > 0) Then
toch_min = extremum
y = toch_min
End If
End Sub


Rem градиентный спуск
Private Sub Command2_Click()
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim x As Double
Dim y As Double
Dim e As Double

a = Text1.Text
b = Text2.Text
c = Text3.Text
d = Text4.Text
x = Text5.Text
y = Text6.Text
e = 0.000001
Dim f(3) As Double
Dim schet As Integer
f(0) = 1
f(1) = 0
f(2) = 0
f(3) = 0
Rem уменьшение функции >погрешности
While f(0) - f(1) > e
schet = schet + 1
Rem x1 = x
Rem y1 = y
Rem Получаю значение функции начальное
Call fun(a, b, c, d, x, y, f(0))
Rem нахожу новую точку минимума по х и по у
Call prox(a, b, c, d, x, y, f(2))
Call proy(a, b, c, d, x, y, f(3))
Rem значение функции с новой точкой
x = x - f(2)
y = y - f(3)
Call fun(a, b, c, d, x, y, f(1))
Wend
Text7.Text = f(1)
Text8.Text = schet
End Sub

Private Sub prox(a, b, c, d, x, y, f)
f = 2 * a * x - cy
End Sub

Private Sub proy(a, b, c, d, x, y, f)
f = 1 + 2 * b * y - c * x - d
End Sub



З.Ы. Еще надобно нарисовать график это функции, но как я рисуется такой график я не понимаю.

[ivank]

bezumes
З.Ы. Еще надобно нарисовать график это функции, но как я рисуется такой график я не понимаю.Линиями уровня. Карты когда-нибудь видел? x-y - координаты точки, z=f(x,y) - высота. Выбираешь себе какой-нибудь базовый уровень и рисуешь на экране все точки, где f(x,y) = A +- k*B, где A - безовый уровень, B-шаг, k - от 0 до бесконечности.

Как это делать правильно я не помню. Но помню как это делал я.
0. очищаем экран
1. Цикл по всем y от 0 до Ymax
2. Цикл по всем x от 0 до Xmax
3. Если floor((f(x,y)-A)/B) <> floor((f(x+1,y)-A)/B) значит через (x, y) проходит линия уровня. рисуем точку
4. Аналогично 3, но для (x, y) и (x, y+1)

Здесь floor - окгругление вниз

Ещё можно линии раскрасить разными цветами. Или вообще применить цветовое кодирование (как на картах морей) - выбрать градиент какого-нибудь цвета. Тогда минимому функции будет соответствовать самый тёмный цвет, максимому - самый светлый.

P.S. программу не читал. Но может посмотрю потом.

[bezumes]

А что делать если у меня при нахождении минимума покоординатным спуском при некоторых значениях прога в бесконечный цикл вываливается. В частности при значениях a=1;b=2;c=3;d=4;x=5;y=6;
я обошел эту проблему проверкой количества итераций. Причем вычисления первых итераций производится довольно шустро, а потом
при кол итераций>50 Происходит резкое замедления вычисления.
вот этим я пользовался при написании данного кода (http://school-sector.relarn.ru/dckt/projects/optim/pocspusc.htm)

Private Sub Command1_Click()
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim x As Double
Dim y As Double
Dim e As Double

a = Text1.Text
b = Text2.Text
c = Text3.Text
d = Text4.Text
x = Text5.Text
y = Text6.Text
e = 0.000001
Dim f(2) As Double
Dim schet As Integer
schet = 0
f(0) = 1
f(1) = 0
Dim ex As Boolean
ex = False

While f(0) - f(1) > e And ex = False
Rem Получаю значение функции начальное
Call fun(a, b, c, d, x, y, f(0))
schet = schet + 1
Rem нахожу новую точку минимума по х и по у
Call pokminx(a, b, c, d, x, y)
Call pokminy(a, b, c, d, x, y)
Rem значение функции с новой точкой
Call fun(a, b, c, d, x, y, f(1))
If (schet >= 70) Then
ex = True
End If
Wend
Text7.Text = f(1)
Text8.Text = schet + 1
End Sub



Private Sub fun(a, b, c, d, x, y, f)
f = a * x * x + b * y * y - c * x * y - d * y
End Sub


Private Sub pokminx(a, b, c, d, x, y)
Dim f As Double
Dim f1 As Double
Rem нахожу начальное значение ф-и
Call fun(a, b, c, d, x, y, f)
x = x + 0.1
Rem увеличиваем х и снова нахожу ф-ю
Call fun(a, b, c, d, x, y, f1)
Rem Если При увеличении х ф-я уменьшаемся увеличиваем далее
If (f - f1 > 0) Then
While (f - f1 > 0)
Call fun(a, b, c, d, x, y, f)
x = x + 0.1
Call fun(a, b, c, d, x, y, f1)
Wend
Else
Rem иначе уменьшаем до того зчто передалось и находим значение начальное
x = x - 0.1
Call fun(a, b, c, d, x, y, f)
x = x - 0.1
Call fun(a, b, c, d, x, y, f1)
While (f - f1 > 0)
Call fun(a, b, c, d, x, y, f)
x = x - 0.1
Call fun(a, b, c, d, x, y, f1)
Wend
End If
End Sub


Private Sub pokminy(a, b, c, d, x, y)
Rem аналогично предыдущей функции только вместо изменения х меняем у
Dim f As Double
Dim f1 As Double
Call fun(a, b, c, d, x, y, f)
y = y + 0.1
Call fun(a, b, c, d, x, y, f1)
If (f - f1 > 0) Then
While (f - f1 > 0)
Call fun(a, b, c, d, x, y, f)
y = y + 0.1
Call fun(a, b, c, d, x, y, f1)
Wend
Else
y = y - 0.1
Call fun(a, b, c, d, x, y, f)
y = y - 0.1
Call fun(a, b, c, d, x, y, f1)
While (f - f1 > 0)
Call fun(a, b, c, d, x, y, f)
y = y - 0.1
Call fun(a, b, c, d, x, y, f1)
Wend
End If
End Sub

[bezumes]

покоординатный спуск:
При фиксакции константой х, получаю уравнение линии.Как у линии может быть минимум.Получается что,при f(y)->min
y->+бесконечности или - бесконечности.И что теперь, придется расматривать её на каком-то отрезке(его че, с головы брать).Есле на отрезке, то что придется искать методами дихотомии или золотого сечения(через производные то не получится, вторая производная всегда будет равна нулю а первая всегда одного знака)