Задача минимизации методами наискорейшего спуска и поразрядного приближения
1. Техническое задание
1. Разработать программу для решения задачи оптимизации для функции:
f(x1,x2)= 100 (x2 — x12)2 + (1 — x1)2 + (√[x12+x22 — 1)2 + 100 (ϕ(x1, x2)) 2, где
ϕ(x1, x2) = 0.5*π arctg(x2/x1), x1 > 0
ϕ(x1, x2) = 0.25, x1 = 0
ϕ(x1, x2) = 0.5*π (π + arctg(x2/x1)), x1 > 0
Для нахождения оптимального решения данной функции использовать сочетание методов одномерной и многомерной оптимизации:
— метод наискорейшего спуска;
— метод поразрядного приближения.
2. В разработанной программе при демонстрации ее работы на ПЭВМ необходимо иметь возможность задать следующие параметры:
— начальная точка;
— шаг движения в направлении антиградиента;
— коэффициент деления отрезка для метода поразрядного приближения;
— точность, с которой следует искать точку экстремума.
2. Описание функции
Общий вид функции f(x1,x2)= 100 (x2 — x12)2 + (1 — x1)2 + (√[x12+x22 — 1)2 + 100 (ϕ(x1, x2)) 2 показан на рисунках:
Как видно из рисунка, функция не ограничена сверху (она представляет собой сумму многочленов и функций четных степеней), т.е. не существует абсолютного максимума, так как при бесконечно большом X1 или X2 значение функции будет также бесконечно большим. Однако функция может иметь несколько минимумов, лежащих, как следует из полученного рисунка, где-то около точки (0,0)T. Линии уровня функции имеют вид:
Как видно из этого графика, своих наименьших значений функция достигает приблизительно при –0.5
Функция имеет множество точек перегиба при x1=0, x2>0.
Седловых точек функция не имеет.
3. Описание используемых методов
3.1. Метод наискорейшего спуска
В вычислительном аспекте этот метод использует только первые производные целевой функции. Градиент целевой функции F(x1,x2) в любой точке F(x1,x2) есть вектор в направлении наибольшего локального увеличения F(x1,x2). Следовательно, нужно двигаться в направлении, противоположном градиенту F(x1,x2), т.е. в направлении наискорейшего спуска, поскольку отрицательный градиент F(x1,x2) в точке x(k) направлен в сторону наибольшего уменьшения по всем компонентам и ортогонален линии уровня F(x1,x2) в точке x(k). Введение направления, противоположного нормированному (единичному) градиенту F(x1,x2), т.е. направления наискорейшего спуска, определяемого в точке x(k) по формуле
S(k) = — (∇F(x(k))/ ||(∇F(x(k))||
Формула перехода из x(k) в x(k+1):
x(k+1) = x(k) — λ(k) * (∇F(x(k))/ ||(∇F(x(k))||
Алгоритм метода:
1. Задается:
— точность Em;
— максимальное количество итераций Nm;
— шаг градиента L;
— приращение аргумента производной dx;
— максимальное количество в сторону антиградиента Ni;
— начальная точка.
2. Положить k = 1, i = 0
3. Вычисляется градиент по формуле
dF/dxi = F(x1,..,xi + dx, …, xn) — F(x1,…,xn)/dx
||F(x1,…,xn)|| = √(∑(dF/dxi)2)
4. Если ||F(x1,…,xn)|| = 0, то идем 11.
5. Если k > Nm, то идем 11.
6. xi+1(k) = xi(k) — λ(k) * (∇F(x(k))/ ||(∇F(x(k))||.
Если F(xi+1(k)) < f(xi(k)), то i = i + 1, иначе идем 8.
7. Если i ≤ Ni , то идем в 6.
8. xi+1 = xi — λ* (∇F(x(k))/ ||(∇F(x(k))||
9. Если |x(k+1) — x(k)| < Em, то идем в 11. 10. Положить k = k + 1, идем в 3. 11. Вывод результата. 12. Конец. Схема алгоритма метода наискорейшего спуска:
3.2. Метод поразрядного приближения
Можно усовершенствовать метод равномерного поиска с целью уменьшения количества значений F(x), которые необходимо находить в процессе минимизации. Во-первых, если оказывается, что F(xi)<= F(x[i+1]), то отпадает необходимость вычислять F(x) в точках x[i+2], x[i+3] и т.д.. Во-вторых, разумно было бы сначала определить отрезок, содержащий оптимальную точку, грубо, т.е. найти точку xm с небольшой точностью, а затем искать ее на этом отрезке с меньшим шагом дискретизации, повышая точность. Эти возможности улучшения и реализованы в методе поразрядного приближения. В этом методе перебор точек отрезка происходит сначала с шагом sh=x[i+1]-xi > eps до тех пор, пока не выполнится условие F(xi) < F(x[i+1]) или пока очередная из точек не совпадет с концом отрезка. После этого шаг уменьшается, и перебор точек с новым шагом производится в противоположном направлении до тех пор, пока значения F(x) снова не перестанут уменьшаться или очередная точка не совпадет с другим концом отрезка и т.д. Описанный процесс завершается, когда перебор в данном направлении закончен, а использованный при этом шаг дискретизации не превосходит eps. [ads2] Алгоритм метода поразрядного поиска
1. Задать коэффициент деления K.
2. Выбрать начальный шаг sh=(b-a)/K. Положить x0=a. Вычислить F(x0).
3. Положить x1=x0+sh. Вычислить F(x1).
4. Сравнить F(x0) и F(x1). Если F(x0)>F(x1), то перейти к шагу 5, иначе к шагу 6.
5. Положить x0=x1 и F(x0)=F(x1). Проверить условие принадлежности x0 интервалу [a,b]. Если a < x0 < b, то перейти к шагу 3, иначе к шагу 6. 6. Проверка на окончание поиска: если |sh| <= eps, то вычисления завершить, полагая xm=x0, Fm=F(x0), иначе перейти к шагу 7. 7. Изменить направление поиска: положить x0=x1, F(x0)=F(x1), sh=-sh/K. Перейти к шагу 3.
3.3. Сочетание одномерного и многомерного методов.
Найденный методом наискорейшего спуска отрезок между точками Xi и Xi+1 можно считать одномерным пространством и применять на нем одномерный метод поразрядного приближения. Для перехода к функции одной переменной будем использовать следующую формулу:
F(k) = f(x1i — |grad(xi|λik,
x2i — |grad(xi|λik)
Алгоритм сочетания методов наискорейшего спуска и поразрядного приближения:
1. Задается:
точность Em;
максимальное количество итераций Nm;
шаг градиента L;
приращение аргумента производной dx;
максимальное количество в сторону антиградиента Ni;
начальная точка.
2. Положить k = 1, i = 0
3. Вычисляется градиент по формуле
dF/dxi = F(x1,..,xi + dx, …, xn) — F(x1,…,xn)/dx
||F(x1,…,xn)|| = √(∑(dF/dxi)2)
4. Если ||F(x1,…,xn)|| = 0, то идем 20.
5. Если k > Nm, то идем 20.
6. xi+1(k) = xi(k) — λ(k) * (∇F(x(k))/ ||(∇F(x(k))||.
Если F(xi+1(k)) < f(xi(k)), то i = i + 1, иначе идем 8.
7. Если i ≤ Ni, то идем в 6.
8. xi+1 = xi — λ* (∇F(x(k))/ ||(∇F(x(k))||
9. Присвоить a=0, b=1
10. Выбрать начальный шаг sh=(b-a)/K. Положить K0=a. Вычислить F(K0).
11. Положить K1=K0+sh. Вычислить F(K1).
12. Сравнить F(K0) и F(K1). Если F(K0)>F(K1), то перейти к шагу 13, иначе к шагу 14.
13. Положить K0=K1 и F(K0)=F(K1). Проверить условие принадлежности K0 интервалу [a,b]. Если a < K0 < b, то перейти к шагу 11, иначе к шагу 14. 14. Проверка на окончание поиска: если |sh| <= eps, то перейти к шагу 17, полагая Km=K0, Fm=F(K0), иначе—перейти к шагу 15. 15. Изменить направление поиска: положить K0=K1, F(K0)=F(K1), sh=-sh/K. 16. Перейти к шагу 11. 17. Переход от одномерных координат к многомерным: xi(k+1) = xi(k)-|grad(x(k))|*λ(k)*Km
18. Если |x(k+1) — x(k))| < Em, то идем в 20. 19. Положить k = k +1 , идем в 3. 20. Вывод результата. 21. Конец. [ads3] 4. Программа для поиска экстремума
4.1. Допущения, сделанные в программе
1. При поиске производной приращение аргумента dx берется равным E/100 (где E – точность многомерного поиска).
2. Для избежания ситуаций, когда программа зацикливается (это возможно в случае, если экстремума не существует, а также при некоторых сочетаниях параметров поиска) после определенного количества итераций (N1=10000) или числа измерений функции (N2=250000) поиск прекращается и выводится соответствующее сообщение. В этом случае в качестве результатов выводится точка, в которой была сделана последняя итерация, и не производится прорисовки линий уровня.
4.2. Описание интерфейса версии программы для Windows
После запуска программы на экране появляется основное окно, которое имеет вид:
В левой части окна расположены поля ввода параметров поиска:
— начальной точки (X1 и X2)
— точности многомерного поиска (E1)
— точности одномерного поиска (E2)
— коэффициенте деления отрезка для метода поразрядного приближения (K)
— шаге градиента (L).
После того, как все требуемые параметры введены, для начала поиска экстремума следует нажать кнопку «Начать поиск» или выбрать соответствующий пункт в меню «Оптимизация». Во время поиска экстремума в строке состояния внизу экрана будет отражаться ход поиска (вывод номера шага многомерного метода, который программа делает в данный момент).
После того, как экстремум найден, программа выведет на экран результаты и нарисует линии уровня для тех значений, через которые проходил поиск экстремума. Окно в этом случае приобретает вид:
В левой части окна выводится найденная точка экстремума (ее координаты X1*, X2*, значение функции в этой точке), а также число шагов многомерного поиска (N1) и количество измерений функции, которое было сделано при поиске (N2).
В нижней части окна можно настроить параметры графика:
— значения по осям X и Y для которых следует рисовать график
— как рисовать линии уровня: по значениям, найденным при поиске или начиная с заданного пользователем с некоторым постоянным шагом, а также возможность задать это начальное значение и шаг.
— количество линий уровня, которые следует рисовать (если выбран пункт «Значения, полученные при поиске», то рисуются первые N значений, а также линия уровня, на которой найден экстремум)
После того, как введены все желаемые параметры, следует нажать кнопку «Обновить» для перерисовки графика.
В программе предусмотрена возможность посмотреть значение функции в любой точке, отображенной на графике. Для этого достаточно подвести к желаемой точке курсор мыши и в правой части строки состояния отобразятся координаты этой точки и значение функции в ней.
Также программа имеет главное меню, состоящее из двух разделов: «Файл» и «Оптимизация».
В меню «Файл» доступны следующие пункты:
«Сохранить точки многомерного поиска» — сохраняет все точки, через которые проходил поиск и значения функции в них в CSV-файл (текстовый файл с разделенными запятыми значениями).
«Сохранить линии уровня» — сохранить полученный график линий уровня как рисунок BMP.
«Сохранить отчет» — создает текстовый файл, в котором записываются параметры и направление поиска (минимум или максимум), найденный экстремум, а также количество шагов и измерений функции, которые были сделаны при поиске.
«Выход» — завершает работу с программой.
В разделе «Оптимизация» есть такие пункты:
«Начать поиск экстремума» — аналогично кнопке «Начать поиск» в основном окне.
«Перерисовать график» — аналогично кнопке «Обновить».
«Начать заново» — сбрасывает все результаты предыдущего поиска, после чего его можно начать заново.
5. Зависимость количества вычислений функции и времени поиска от параметров.
Количество измерений функции для различных сочетаний параметров поиска представлено в таблице:
Количество измерений функции, необходимое для поиска экстремума, возрастает с ростом точности поиска как многомерным методом (E1), так и одномерным методом (E2), однако с уменьшением E1 оно растет быстрее, чем при уменьшении E2. Кроме того, число вычислений значения функции также меняетя с ростом соотношения коэффициента деления (K) и шага градиента (L): при большом K для большего L требуется меньшее число вычислений, тогда как при малых K экстремум находится быстрее при малых L.
Также следует отметить, что при некоторых соотношениях E1>=E2 программа может зациклиться и экстремум найден не будет.
Зависимости времени поиска от различных параметров: коэффициента деления, точности и шага градиента представлены на графиках:
6. Результаты
Функция не имеет максимумов и имеет два минимума:
X*=(-0.968,0.967)T F(X*)=18.167 локальный минимум.
X*=(0.544,0.280)T F(X*)=0.956 абсолютный минимум.
Параметры, при которых можно найти эти экстремумы:
Контрольный пример расчетов:
Параметры поиска:
Начальная точка: X=(2,2)T
Коэффициент деления: K=10
Шаг вектора градиента: L=3
Точность многомерного поиска: E1=0.002
Точность одномерного поиска: E2=0.0001
Ход поиска:
grad(x)=(1603.631,-396.417)T
grad(x)=grad(x)/|grad(x)|=( 0.971,-0.240)T
Lambda=1
f(x+grad(x))=144.840
f(x+2*grad(x))=12572.867
unit mainform;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Menus, Spin, ExtDlgs;type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Label5: TLabel;
Label7: TLabel;
MainMenu1: TMainMenu;
NM1: TMenuItem;
NM2: TMenuItem;
NM4: TMenuItem;
NM5: TMenuItem;
NM6: TMenuItem;
NM7: TMenuItem;
NM8: TMenuItem;
NM9: TMenuItem;
Label8: TLabel;
Edit5: TEdit;
Edit6: TEdit;
Label9: TLabel;
Label10: TLabel;
Edit7: TEdit;
Label11: TLabel;
Button1: TButton;
Button2: TButton;
Edit8: TEdit;
Edit9: TEdit;
Label12: TLabel;
Label13: TLabel;
SaveDialog1: TSaveDialog;
Edit10: TEdit;
Label14: TLabel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Edit11: TEdit;
Label15: TLabel;
GroupBox2: TGroupBox;
Panel1: TPanel;
Image1: TImage;
SpinEdit1: TSpinEdit;
Label17: TLabel;
Label18: TLabel;
Edit13: TEdit;
Edit14: TEdit;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Edit15: TEdit;
Edit16: TEdit;
SavePictureDialog1: TSavePictureDialog;
NM10: TMenuItem;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
Edit12: TEdit;
Edit17: TEdit;
Label16: TLabel;
Label22: TLabel;
SaveDialog2: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure OnPaint(Sender: TObject);
procedure NM2Click(Sender: TObject);
procedure NM5Click(Sender: TObject);
procedure NM7Click(Sender: TObject);
procedure NM8Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure NM3Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure NM4Click(Sender: TObject);
procedure NM10Click(Sender: TObject);
procedure NM9Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation
type
FType=Function (x,y:extended):extended;
pointptr = ^point;
point = record
x1,x2 : extended;
CVal : extended;
Next : pointptr;
px,py : integer;
end;var
List : pointptr;
List2 : pointptr;
maxX,maxY : extended;
minX,minY : extended;
MinValue : extended;
MaxValue : extended;
Calculated : boolean;
N1,N2 : integer;
stX,stY : extended;
FindX,FindY : extended;
E1,E2,L : extended;
K : integer;
A : integer;Procedure DestroyList(var List:pointptr);
var
P : pointptr;
Begin
while (List<>nil) do begin
p:=List;
List:=List^.Next;
Dispose(p);
end;
End;Procedure AddPoint(var Lst:pointptr;x1,x2,CurVal:extended);
var
P : pointptr;
Begin
if (Lst=nil) then begin
New(Lst);
Lst^.x1:=x1;
Lst^.x2:=x2;
Lst^.CVal:=CurVal;
Lst^.Next:=nil;
Lst^.px:=-1;
Lst^.py:=-1;
end
else begin
P:=Lst;
while (P^.Next<>nil) do P:=P^.Next;
New(P^.Next);
P:=P^.Next;
P^.x1:=x1;
P^.x2:=x2;
P^.CVal:=CurVal;
P^.Next:=nil;
end;
End;Function Sign(x:extended):integer;
Begin
if (x>0) then
Sign:=1
else if (x=0) then
Sign:=0
else Sign:=-1;
End;Function Phi(x1,x2:extended):extended;
Begin
if (x1=0) then
Phi:=0.25
else if (x1>0) then
Phi:=arctan(x2/x1)/(2*Pi)
else
Phi:=(Pi+arctan(x2/x1))/(2*Pi);
End;Function MyFunc(x1,x2:extended):extended;
Begin
MyFunc:=100*sqr(x2-x1*x1)+sqr(1-x1)+sqr(sqrt(x1*x1+x2*x2)-1)+100*sqr(Phi(x1,x2));
End;Function GradX(Func:FType; x,y:extended; E:extended):extended;
var
dx : extended;
Value : extended;
Begin
dx:=E/100;
Value:=(Func(x+dx,y)-Func(x,y))/dx;
GradX:=Value;
End;Function GradY(Func:FType; x,y:extended; E:extended):extended;
var
dy : extended;
Begin
dy:=E/100;
GradY:=(Func(x,y+dy)-Func(x,y))/dy;
End;Procedure ExtrFind(Func:FType; StartX,StartY: extended; Dir:integer; k:integer;
E,E2,L:extended; var FindX,FindY:extended);
var
oldX,oldY : extended;
newX,newY : extended;
oldV,newV : extended;
gx,gy : extended;
CurV : extended;
K1,K2,b : extended;
Test : text;
L1 : extended;
Lambda : integer;
Begin
N1:=0;
N2:=0;
Calculated:=false;
AssignFile(Test,'report.txt');
Rewrite(Test);
minX:=StartX;
minY:=StartY;
maxX:=StartX;
maxY:=StartY;
newX:=StartX;
newY:=StartY;
NewV:=Func(StartX,StartY);
MinValue:=NewV;
MaxValue:=NewV;
AddPoint(List,newX,newY,Func(NewX,NewY));
repeat
Form1.StatusBar1.Panels[0].Text:='Идет поиск экстремума. '+IntToStr(N1)+' шагов сделано.';
oldX:=newX;
oldY:=newY;
oldV:=newV;
N2:=N2+1;
gx:=gradX(Func,newX,newY,E);
gy:=gradY(Func,newX,newY,E);
writeln(Test,'grad(x)=(',gx:6:3,',',gy:6:3,')T');
L1:=sqrt(sqr(gx)+sqr(gy));
if (L1>1) then begin
gx:=gx/L1;
gy:=gy/L1;
writeln(Test,'grad(x)=grad(x)/|grad(x)|=(',gx:6:3,',',gy:6:3,')T');
end;
NewV:=Func(NewX+gx*Dir,NewY+gy*Dir);
writeln(Test,'Lambda=1');
writeln(Test,'f(x+grad(x))=',NewV:6:3);
Lambda:=1;
while (NewV*Dir1)) then begin
b:=-b/k;
writeln(Test,'Sh=',b:8:6);
end;
K1:=K2;
writeln(Test,'K1=K2');
writeln(Test,'F(K1)=F(K2)');
NewV:=CurV;
N2:=N2+1;
until ((abs(b)250000));
writeln(Test,'Sh250000) then
MessageDlg('Неудачно выбраны параметры одномерного метода поиска или экстремума не существует',
mtError,[mbOk],0);
writeln(Test,'Km*=',K1);
NewX:=OldX+gx*L*K1*Dir;
NewY:=OldY+gy*L*K1*Dir;
writeln(Test,'x=x+grad(x)/|grad(x)|*Km=(',NewX:6:3,',',NewY:6:3,')T');
NewV:=Func(NewX,NewY);
if (NewX>maxX) then maxX:=NewX;
if (NewXmaxY) then maxY:=NewY;
if (NewYmaxValue) then maxValue:=NewV;
AddPoint(List,newX,newY,NewV);
N1:=N1+1;
if ((sqrt(sqr(OldX-NewX)+sqr(OldY-NewY))250000) or (N1>10000));
if (N1>10000) then
MessageDlg('Экстремума не существует или неудачно заданы параметры многомерного метода поиска',
mtError,[mbOk],0);
if ((N1>10000) or (N2>250000)) then Calculated:=false;
writeln(Test,'|x(i)-x(i+1)|N1 then Form1.SpinEdit1.Value:=N1;
Form1.SpinEdit1.MaxValue:=N1;
Form1.Label8.Visible:=true;
Form1.Label9.Visible:=true;
Form1.Label10.Visible:=true;
Form1.Label11.Visible:=true;
Form1.Label12.Visible:=true;
Form1.Label13.Visible:=true;
Form1.Edit5.Visible:=true;
Form1.Edit6.Visible:=true;
Form1.Edit7.Visible:=true;
Form1.Edit8.Visible:=true;
Form1.Edit9.Visible:=true;
Form1.GroupBox2.Visible:=true;
Form1.Button2.Visible:=true;
End;{ if (CurPoint^.px=-1) then begin
CurPoint^.px:=i;
CurPoint^.py:=Form1.Image1.Height-j;
end
else begin
Pen.Color:=RGB(128,0,255*K div Form1.SpinEdit1.Value);
MoveTo(CurPoint^.px,CurPoint^.py);
CurPoint^.px:=i;
CurPoint^.py:=Form1.Image1.Height-j;
LineTo(CurPoint^.px,CurPoint^.py);
end;}Procedure DrawLines(Func:FType);
var
DotsX,DotsY : extended;
CurValue : array[0..2] of extended;
CurPoint : pointptr;
LastPoint : pointptr;
StartValue : extended;
Step : extended;
i,j : integer;
K : integer;
Begin
{ maxX:=(trunc(maxX*10)+1)/10;
minX:=(trunc(minX*10)-1)/10;
maxY:=(trunc(maxY*10)+1)/10;
minY:=(trunc(minY*10)-1)/10;}
StartValue:=StrToFloat(Form1.Edit12.Text);
Step:=StrToFloat(Form1.Edit17.Text);
Form1.StatusBar1.Panels[0].Text:='Идет прорисовка линий уровня';
DotsX:=(maxX-minX)/(Form1.Image1.Width);
DotsY:=(maxY-minY)/(Form1.Image1.Height);
LastPoint:=List;
while (LastPoint^.Next<>nil) do LastPoint:=LastPoint^.Next;
with Form1.Image1.Canvas do begin
FillRect(Form1.Image1.ClientRect);
for i:=0 to Form1.Image1.Width do begin
CurValue[0]:=Func(i*DotsX+minX,minY);
for j:=0 to Form1.Image1.Height do begin
CurPoint:=List;
CurValue[2]:=Func(i*DotsX+minX,(j+1)*DotsY+minY);
for K:=0 to Form1.SpinEdit1.Value do begin
if (Form1.RadioButton3.Checked) then
CurValue[1]:=CurPoint^.CVal
else
CurValue[1]:=StartValue+K*Step;
if (((CurValue[0]>CurValue[1]) and (CurValue[2]CurValue[1]))) then
Pixels[i,Form1.Image1.Height-j]:=RGB(K,0,byte(abs(255-K)));
CurPoint:=CurPoint^.Next;
end;
CurValue[1]:=LastPoint^.CVal;
if (((CurValue[0]>CurValue[1]) and (CurValue[2]CurValue[1]))) then
Pixels[i,Form1.Image1.Height-j]:=RGB(0,255,0);
CurValue[0]:=CurValue[2];
end;
end;
CurPoint:=List;
MoveTo(trunc((CurPoint^.X1-minX)/DotsX),Form1.Image1.Height-trunc((CurPoint^.X2-minY)/DotsY));
CurPoint:=CurPoint^.Next;
Pen.Color:=clRed;
while (CurPoint<>nil) do begin
LineTo(trunc((CurPoint^.X1-minX)/DotsX),Form1.Image1.Height-trunc((CurPoint^.X2-minY)/DotsY));
CurPoint:=CurPoint^.Next;
end;
Pen.Color:=ClBlack;
if ((minX<0) and (maxX>0)) then begin
MoveTo(trunc((0-minX)/DotsX),0);
LineTo(trunc((0-minX)/DotsX),Form1.Image1.Height);
end;
if ((minY<0) and (maxY>0)) then begin
MoveTo(0,Form1.Image1.Height-trunc((0-minY)/DotsY));
LineTo(Form1.Image1.Width,Form1.Image1.Height-trunc((0-minY)/DotsY));
end;
end;
Form1.StatusBar1.Panels[0].Text:='Готово!';
End;Procedure TForm1.OnPaint(Sender: TObject);
Begin
if Calculated then begin
Image1.Invalidate;
Image1.SetBounds(Panel1.Left+1,Panel1.Top+1,Panel1.Width-1,Panel1.Height-1);
minX:=StrToFloat(Edit13.Text);
maxX:=StrToFloat(Edit15.Text);
minY:=StrToFloat(Edit14.Text);
maxY:=StrToFloat(Edit16.Text);
DrawLines(MyFunc);
end;
End;{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
try
if (RadioButton1.Checked) then
A:=-1
else
A:=1;
DestroyList(List);
DestroyList(List2);
StX:=StrToFloat(Edit1.Text);
StY:=StrToFloat(Edit2.Text);
E1:=StrToFloat(Edit3.Text);
E2:=StrToFloat(Edit10.Text);
L:=StrToFloat(Edit4.Text);
K:=StrToInt(Edit11.Text);
except
MessageDlg('Неправильно введены параметры поиска или начальная точка.',
mtError,[mbOk],0);
end;
ExtrFind(MyFunc,StX,StY,A,K,E1,E2,L,FindX,FindY);
Image1.Visible:=true;
Edit5.Text:=FloatToStrF(FindX,ffFixed,8,4);
Edit6.Text:=FloatToStrF(FindY,ffFixed,8,4);
Edit7.Text:=FloatToStrF(MyFunc(FindX,FindY),ffFixed,8,4);
Edit8.Text:=IntToStr(integer(N1));
Edit9.Text:=IntToStr(integer(N2));
NM2.Enabled:=true;
NM4.Enabled:=true;
NM9.Enabled:=true;
NM8.Enabled:=true;
Form1.OnPaint(Sender);
end;procedure TForm1.NM2Click(Sender: TObject);
var
p : pointptr;
F1 : TextFile;
Begin
p:=List;
if (SaveDialog1.Execute) then begin
AssignFile(F1,SaveDialog1.FileName);
Rewrite(F1);
while (p<>nil) do begin
writeln(F1,p^.x1:9:4,',',p^.x2:9:4,',',p^.CVal:9:4);
p:=p^.Next;
end;
closefile(F1);
end;
End;procedure TForm1.NM5Click(Sender: TObject);
begin
Halt;
end;procedure TForm1.NM7Click(Sender: TObject);
begin
Form1.Button1Click(Sender);
end;procedure TForm1.NM8Click(Sender: TObject);
begin
Form1.OnPaint(Sender);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.OnPaint(Sender);
end;procedure TForm1.NM3Click(Sender: TObject);
var
p : pointptr;
F1 : textfile;
begin
p:=List2;
if (SaveDialog1.Execute) then begin
AssignFile(F1,SaveDialog1.FileName);
Rewrite(F1);
while (p<>nil) do begin
writeln(F1,p^.x1:9:4,',',p^.x2:9:4,',',p^.CVal:9:4);
p:=p^.Next;
end;
closefile(F1);
end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
StatusBar1.Panels[0].Width:=Form1.Width-150;
end;procedure TForm1.NM4Click(Sender: TObject);
begin
if (SavePictureDialog1.Execute) then begin
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;
end;procedure TForm1.NM10Click(Sender: TObject);
begin
Form1.Label8.Visible:=false;
Form1.Label9.Visible:=false;
Form1.Label10.Visible:=false;
Form1.Label11.Visible:=false;
Form1.Label12.Visible:=false;
Form1.Label13.Visible:=false;
Form1.Edit5.Visible:=false;
Form1.Edit6.Visible:=false;
Form1.Edit7.Visible:=false;
Form1.Edit8.Visible:=false;
Form1.Edit9.Visible:=false;
Form1.GroupBox2.Visible:=false;
Form1.Button2.Visible:=false;
DestroyList(List);
DestroyList(List2);
Calculated:=false;
Image1.Visible:=false;
NM2.Enabled:=false;
NM4.Enabled:=false;
NM9.Enabled:=false;
NM8.Enabled:=false;
end;procedure TForm1.NM9Click(Sender: TObject);
var
F : textfile;
begin
if (SaveDialog2.Execute) then begin
AssignFile(F,SaveDialog2.FileName);
Rewrite(F);
writeln(F,'Результаты поиска экстремума:');
writeln(F);
writeln(F,'Функция, для которой велся поиск:');
writeln(F,'F(x)=100*(x2-x1^2)^2+(1-x1)^2+(sqrt(x1^2+x2^2)-1)^2+100*(Phi(x1,x2))^2');
writeln(F);
writeln(F,'Параметры поиска:');
writeln(F,'Начальная точка: X0=(',StX:5:3,',',StY:5:3,')T');
writeln(F,'Точность многомерного метода: E1=',E1:9:7);
writeln(F,'Точность одномерного метода: E2=',E2:9:7);
writeln(F,'Шаг градиента: L=',L:4:6);
writeln(F,'Коэффициент деления: K=',K);
if (A<0) then writeln(F,'Направление поиска - минимум.') else writeln(F,'Направление поиска - максимум.'); if Calculated then begin writeln(F); writeln(F,'Результаты поиска:'); writeln(F,'Экстремум найден в точке X*=(',FindX:5:3,',',FindY:5:3,')T'); writeln(F,'Значение функции в этой точке равно F(X*)=',MyFunc(FindX,FindY):5:3); writeln(F,'При поиске экстремума было сделано ',N1,' шагов многомерного метода.'); writeln(F,'Значение функции было измерено ',N2,' раз.'); end else begin writeln(F,'В процессе поиска экстремум не был найден.'); writeln(F,'Возможно, его не существует или неудачно заданы начальные параметры.'); writeln(F,'При поиске экстремума было сделано ',N1,' шагов многомерного метода.'); writeln(F,'Значение функции было измерено ',N2,' раз.'); end; CloseFile(F); end; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var DotsX,DotsY : extended; Cx,Cy : extended; begin if Calculated then begin DotsX:=(maxX-minX)/(Form1.Image1.Width); DotsY:=(maxY-minY)/(Form1.Image1.Height); Cx:=X*DotsX+minX; Cy:=(Form1.Image1.Height-Y)*DotsY+minY; StatusBar1.Panels[1].Text:='F('+FloatToStrF(Cx,ffFixed,5,3)+','+ FloatToStrF(Cy,ffFixed,5,3)+')='+FloatToStrF(MyFunc(Cx,Cy),ffFixed,5,3); end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin StatusBar1.Panels[1].Text:=''; end; end.