Программа на основе метода наискорейшего спуска и метода Фибоначчи

Дата публикации PostDateIcon 15.06.2014 |

1. Разработать программу для решения задачи оптимизации для функции:

F(x1,x2) = 10000/(x12 + 4x22 — 50x1 — 140x2 + 2x1x2 + 1100) — 10000/(x12 + 4x22 + 130x1 + 140x2 + 2x1x2 + 2200)

Для нахождения оптимального решения данной функции использовать сочетание методов одномерной и многомерной оптимизации:
— метод наискорейшего спуска;
— метод Фибоначчи.
2. В разработанной программе при демонстрации ее работы на ПЭВМ необходимо иметь возможность изменять следующие параметры:
— начальная точка;
— шаг движения в направлении антиградиента;
— количество шагов в направлении антиградиента;
— максимальное количество итераций;
— приращение аргумента при вычислении производной;
— точность поиска оптимальной точки;
— выбор поиска минимума или максимума.

Сочетание методов
Общая блок схема


1. Модуль MOACDC:
unit MOACDC;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Spin, Mask, Menus, Math, ExtCtrls;

type
TForm1 = class(TForm)
GB_MGrad: TGroupBox;
GB_MFib: TGroupBox;
L_Em: TLabel;
L_Nm: TLabel;
L_L: TLabel;
ME_Em: TMaskEdit;
SE_Nm: TSpinEdit;
ME_L: TMaskEdit;
ME_dx: TMaskEdit;
L_dx: TLabel;
L_Nf: TLabel;
SE_Nf: TSpinEdit;
GB_Points: TGroupBox;
L_X01: TLabel;
L_X02: TLabel;
ME_X01: TMaskEdit;
ME_X02: TMaskEdit;
B_Graph: TButton;
B_Min: TButton;
GB_Rez: TGroupBox;
M_Rez: TMemo;
L_Ni: TLabel;
SE_Ni: TSpinEdit;
B_Max: TButton;
MainMenu: TMainMenu;
N_File: TMenuItem;
N1: TMenuItem;
N_Exit: TMenuItem;
N_Znak: TMenuItem;
N5: TMenuItem;
N_About: TMenuItem;
N_Graph: TMenuItem;
N_Image: TMenuItem;
N_Clear: TMenuItem;
N3: TMenuItem;
procedure B_ExitClick(Sender: TObject);
procedure B_MinClick(Sender: TObject);
procedure B_GraphClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure B_MaxClick(Sender: TObject);
procedure N_ExitClick(Sender: TObject);
procedure N_ImageClick(Sender: TObject);
procedure N_AboutClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure N_ClearClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
BigX: array[0..50,1..2] of real48;
CloseCount:Word;
k: byte;

implementation

uses Graph;

{$R *.DFM}

//******************************************************************************
procedure TForm1.B_ExitClick(Sender: TObject);
begin
close();
end;
//******************************************************************************
function FibNum(N:byte):integer;
var
i:byte;
FibNumID:array[0..45] of integer;
begin
for i:=0 to 45 do FibNumID[i]:=0;
FibNumID[0]:=1;
FibNumID[1]:=1;
case N of
0:FibNumID[0]:=1;
1:FibNumID[1]:=1;
else
begin
for i:=2 to N do
FibNumID[i]:=FibNumID[i-2]+FibNumID[i-1];
end;
end;
FibNum:=FibNumID[N];
end;
//******************************************************************************
function Fall(x1:real48;x2:real48):real48;
begin
Fall:=10000/(x1*x1+ 4*x2*x2- 50*x1- 140*x2+ 2*x1*x2+ 1100)
-10000/(x1*x1+ 4*x2*x2+ 130*x1+ 140*x2+ 2*x1*x2+ 2200);
end;
//******************************************************************************
function FallMax(x1:real48;x2:real48):real48;
begin
FallMax:=-10000/(x1*x1+ 4*x2*x2- 50*x1- 140*x2+ 2*x1*x2+ 1100)
+10000/(x1*x1+ 4*x2*x2+ 130*x1+ 140*x2+ 2*x1*x2+ 2200);
end;
//******************************************************************************
function F1(x1:real48;x2:real48):real48;
begin F1:=x1*x1+4*x2*x2-50*x1-140*x2+2*x1*x2+1100; end;
//******************************************************************************
function F2(x1:real48;x2:real48):real48;
begin F2:=x1*x1+4*x2*x2+130*x1+140*x2+2*x1*x2+2200; end;
//******************************************************************************
function MFibonachi_VarX1(A:real48; B:real48; Nf:byte; cnst:real48):real48;
var//эта функция должна вернуть оптимальное значение для первой координаты
E,x1,x2,Fx1,Fx2:real48;
L:array[1..2] of real48;
k:byte;
begin
E:=(B-A)/FibNum(Nf+1);//точность поиска точки
L[1]:=B-A;
L[2]:=FibNum(Nf-1)*L[1]/FibNum(Nf)+power(-1,Nf)*E/FibNum(Nf);
x2:=A+L[2]; Fx2:=Fall(x2,cnst);{10000/F1(x2,cnst)-10000/F2(x2,cnst);}
k:=1;
while (k<=Nf) do begin x1:=A+B-x2; Fx1:=Fall(x1,cnst);{10000/F1(x1,cnst)-10000/F2(x1,cnst);} if (x1x2) and ( Fx1 < Fx2 ) then begin A:=x2; x2:=x1; Fx2:=Fx1; end; if (x1= Fx2 ) then begin A:=x1; end;
if (x1>x2) and ( Fx1 >= Fx2 ) then begin B:=x1; end;
k:=k+1;
end;
MFibonachi_VarX1:=(A+B)/2;
end;
//******************************************************************************
function MFibonachi_VarX2(A:real48; B:real48; Nf:byte; cnst:real48):real48;
var//эта функция должна вернуть оптимальное значение для первой координаты
E,x1,x2,Fx1,Fx2:real48;
L:array[1..2] of real48;
k:byte;
begin
E:=(B-A)/FibNum(Nf+1);//точность поиска точки
L[1]:=B-A;
L[2]:=FibNum(Nf-1)*L[1]/FibNum(Nf)+power(-1,Nf)*E/FibNum(Nf);
x2:=A+L[2]; Fx2:=Fall(cnst,x2);{10000/F1(cnst,x2)-10000/F2(cnst,x2);}
k:=1;
while (k<=Nf) do begin x1:=A+B-x2; Fx1:=Fall(cnst,x1);{10000/F1(cnst,x1)-10000/F2(cnst,x1);} if (x1x2) and ( Fx1 < Fx2 ) then begin A:=x2; x2:=x1; Fx2:=Fx1; end; if (x1= Fx2 ) then begin A:=x1; end;
if (x1>x2) and ( Fx1 >= Fx2 ) then begin B:=x1; end;
k:=k+1;
end;
MFibonachi_VarX2:=(A+B)/2;
end;
//******************************************************************************
procedure TForm1.B_MinClick(Sender: TObject);
var
Em,L,dx: real48;
Nm,Nf,Ni: byte;
ent:string;
i,j: byte;
X: array[0..50,1..2] of real48;
A,B: array[1..2] of real48;
dFdx1,dFdx2,dFMod:real48;
deltaXk:boolean;//=true пока разность |X[k+1,]-X[k,]|>=Em;
label gothere;
begin
ent:=#13+#10;//перевод каретки
M_Rez.Text:=’Результаты вычислений:’+ ent;
Em:=strtofloat(ME_Em.text);//ввод исходных данных
Nm:=SE_Nm.value;
L:=strtofloat(ME_L.text);
dx:=strtofloat(ME_dx.text);
Nf:=SE_Nf.value;
Ni:=SE_Ni.value;
BigX[0,1]:=strtofloat(ME_X01.text);
BigX[0,2]:=strtofloat(ME_X02.text);
//обнуление всех массивов:
A[1]:=0;B[1]:=0;A[2]:=0;B[2]:=0;
for j:=1 to Ni do
begin X[j,1]:=0;X[j,2]:=0;BigX[j,1]:=0;BigX[j,2]:=0;end;
//НУ-У-У-У, ВЗДРОГНУЛИ…
X[0,1]:=BigX[0,1];X[0,2]:=BigX[0,2];k:=0;deltaXk:=true;
while (k<=Nm) and (deltaXk) do begin i:=0; dFdx1:=( Fall(X[i,1]+dx,X[i,2])-Fall(X[i,1],X[i,2]) )/dx; {(10000/F1(X[i,1]+dx,X[i,2])-10000/F2(X[i,1]+dx,X[i,2])) -(10000/F1(X[i,1],X[i,2])-10000/F2(X[i,1],X[i,2]));} dFdx2:=( Fall(X[i,1],X[i,2]+dx)-Fall(X[i,1],X[i,2]) )/dx; {(10000/F1(X[i,1],X[i,2]+dx)-10000/F2(X[i,1],X[i,2]+dx)) -(10000/F1(X[i,1],X[i,2])-10000/F2(X[i,1],X[i,2]));} dFMod:=sqrt(dFdx1*dFdx1+dFdx2*dFdx2); if dFMod=0 then goto gothere; X[i+1,1]:=X[i,1]-L*dFdx1/dFMod;//перешли в точку i+1 координата 1 X[i+1,2]:=X[i,2]-L*dFdx2/dFMod;//перешли в точку i+1 координата 2 while (Fall(X[i,1],X[i,2])>Fall(X[i+1,1],X[i+1,2]))
{(10000/F1(X[i,1],X[i,2])-10000/F2(X[i,1],X[i,2])) >
(10000/F1(X[i+1,1],X[i,2])-10000/F2(X[i+1,1],X[i,2]))}
and (i0) and (F2(x,y)<>0) then
begin
f:=Fall(x,y);
if(f>-0.3) and (f<0.3) then Pixels[i+400,280-j]:=clOlive;//оливковый if(f<=0)and(f>=-100) then Pixels[i+400,280-j]:=clSilver;//светло-серый
if(f<-100) then Pixels[i+400,280-j]:=clBlue;//синий if(f<-300) then Pixels[i+400,280-j]:=clRed;//красный if(f>4.9)and(f<5.1) then Pixels[i+400,280-j]:=clFuchsia;//светло-фиолетовый if(f>100) then Pixels[i+400,280-j]:=clAqua;//голубой
if(f>300) then Pixels[i+400,280-j]:=clGreen;//темно-зеленый
if(f>0.9)and(f<1.1) then Pixels[i+400,280-j]:=clPurple;//темно-фиолетовый if(f>1.9)and(f<2.1) then Pixels[i+400,280-j]:=clBlack; if(f>14.6)and(f<15.4) then Pixels[i+400,280-j]:=clLime;//светло-зеленый if(f>19)and(f<21) then Pixels[i+400,280-j]:=clTeal;//темно-серый if(f>6)and(f<6.5) then Pixels[i+400,280-j]:=clMaroon;//коричневый end; end; if (i mod 35 = 0) then begin UpdateWindow(form2.Handle); InvalidateRect(form2.Handle,nil,false); end; end;//for i:=-400 to 400 do} Moveto(400,0);//координатные оси Lineto(400,560); Moveto(0,280); Lineto(800,280); TextOut(780,265,'X1'); TextOut(410,0,'X2'); for i:=-400 to 400 do//сетка вертикальная begin if (i mod 50 = 0) then begin moveto(i+400,0); Lineto(i+400,560); textOut(i+400,265,inttostr(round(i/ZoomX))); end; end; for i:=-280 to 280 do//сетка горизонтальная begin if (i mod 40 = 0) then begin moveto(0,280-i); Lineto(800,280-i); textOut(390,280-i,inttostr(round(i/ZoomY))); end; end; end;//if (CloseGraph=false)and(CloseCount=1)then begin case k of//трассировка 0:Ellipse(round(BigX[0,1])*ZoomX+400-5,280-round(BigX[0,2])*ZoomY-5, round(BigX[0,1])*ZoomX+400+5,280-round(BigX[0,2])*ZoomY+5); else begin for i:=0 to (k-1) do begin Ellipse(round(BigX[i,1])*ZoomX+400-5,280-round(BigX[i,2])*ZoomY-5, round(BigX[i,1])*ZoomX+400+5,280-round(BigX[i,2])*ZoomY+5); Ellipse(round(BigX[i+1,1])*ZoomX+400-5,280-round(BigX[i+1,2])*ZoomY-5, round(BigX[i+1,1])*ZoomX+400+5,280-round(BigX[i+1,2])*ZoomY+5); moveto( round(BigX[i,1])*ZoomX+400,280-round(BigX[i,2])*ZoomY ); Lineto( round(BigX[i+1,1])*ZoomX+400,280-round(BigX[i+1,2])*ZoomY ); end; end; end;//case k of end;//with form2.Image.Canvas do end; //****************************************************************************** procedure TForm1.FormCreate(Sender: TObject); begin CloseGraph:=false; end; //****************************************************************************** //****************************************************************************** //****************************************************************************** //****************************************************************************** //****************************************************************************** //****************************************************************************** //****************************************************************************** //****************************************************************************** function MFibonachi_VarX1Max(A:real48; B:real48; Nf:byte; cnst:real48):real48; var//эта функция должна вернуть оптимальное значение для первой координаты E,x1,x2,Fx1,Fx2:real48; L:array[1..2] of real48; k:byte; begin E:=(B-A)/FibNum(Nf+1);//точность поиска точки L[1]:=B-A; L[2]:=FibNum(Nf-1)*L[1]/FibNum(Nf)+power(-1,Nf)*E/FibNum(Nf); x2:=A+L[2]; Fx2:=FallMax(x2,cnst);{10000/F1(x2,cnst)-10000/F2(x2,cnst);} k:=1; while (k<=Nf) do begin x1:=A+B-x2; Fx1:=FallMax(x1,cnst);{10000/F1(x1,cnst)-10000/F2(x1,cnst);} if (x1x2) and ( Fx1 < Fx2 ) then begin A:=x2; x2:=x1; Fx2:=Fx1; end; if (x1= Fx2 ) then begin A:=x1; end;
if (x1>x2) and ( Fx1 >= Fx2 ) then begin B:=x1; end;
k:=k+1;
end;
MFibonachi_VarX1Max:=(A+B)/2;
end;
//******************************************************************************
function MFibonachi_VarX2Max(A:real48; B:real48; Nf:byte; cnst:real48):real48;
var//эта функция должна вернуть оптимальное значение для первой координаты
E,x1,x2,Fx1,Fx2:real48;
L:array[1..2] of real48;
k:byte;
begin
E:=(B-A)/FibNum(Nf+1);//точность поиска точки
L[1]:=B-A;
L[2]:=FibNum(Nf-1)*L[1]/FibNum(Nf)+power(-1,Nf)*E/FibNum(Nf);
x2:=A+L[2]; Fx2:=FallMax(cnst,x2);{10000/F1(cnst,x2)-10000/F2(cnst,x2);}
k:=1;
while (k<=Nf) do begin x1:=A+B-x2; Fx1:=FallMax(cnst,x1);{10000/F1(cnst,x1)-10000/F2(cnst,x1);} if (x1x2) and ( Fx1 < Fx2 ) then begin A:=x2; x2:=x1; Fx2:=Fx1; end; if (x1= Fx2 ) then begin A:=x1; end;
if (x1>x2) and ( Fx1 >= Fx2 ) then begin B:=x1; end;
k:=k+1;
end;
MFibonachi_VarX2Max:=(A+B)/2;
end;
//******************************************************************************
procedure TForm1.B_MaxClick(Sender: TObject);
var
Em,L,dx: real48;
Nm,Nf,Ni: byte;
ent:string;
i,j: byte;
X: array[0..50,1..2] of real48;
A,B: array[1..2] of real48;
dFdx1,dFdx2,dFMod:real48;
deltaXk:boolean;//=true пока разность |X[k+1,]-X[k,]|>=Em;
label gothere;
begin
ent:=#13+#10;//перевод каретки
M_Rez.Text:=’ПОКА НЕТУ НИЧЕГО!!!!!’;
M_Rez.Text:=’Результаты вычислений:’+’ Да ни хрена еще нет!’+ ent;
Em:=strtofloat(ME_Em.text);//ввод исходных данных
Nm:=SE_Nm.value;
L:=strtofloat(ME_L.text);
dx:=strtofloat(ME_dx.text);
Nf:=SE_Nf.value;
Ni:=SE_Ni.value;
BigX[0,1]:=strtofloat(ME_X01.text);
BigX[0,2]:=strtofloat(ME_X02.text);
//обнуление всех массивов:
A[1]:=0;B[1]:=0;A[2]:=0;B[2]:=0;
for j:=1 to Ni do
begin X[j,1]:=0;X[j,2]:=0;BigX[j,1]:=0;BigX[j,2]:=0;end;
//НУ-У-У-У, ВЗДРОГНУЛИ…
X[0,1]:=BigX[0,1];X[0,2]:=BigX[0,2];k:=0;deltaXk:=true;
while (k<=Nm) and (deltaXk) do begin i:=0; dFdx1:=( FallMax(X[i,1]+dx,X[i,2])-FallMax(X[i,1],X[i,2]) )/dx; {(-10000/F1(X[i,1]+dx,X[i,2])+10000/F2(X[i,1]+dx,X[i,2])) -(-10000/F1(X[i,1],X[i,2])+10000/F2(X[i,1],X[i,2]));} dFdx2:=( FallMax(X[i,1],X[i,2]+dx)-FallMax(X[i,1],X[i,2]) )/dx; {(-10000/F1(X[i,1],X[i,2]+dx)+10000/F2(X[i,1],X[i,2]+dx)) -(-10000/F1(X[i,1],X[i,2])+10000/F2(X[i,1],X[i,2]));} dFMod:=sqrt(dFdx1*dFdx1+dFdx2*dFdx2); if dFMod=0 then goto gothere; X[i+1,1]:=X[i,1]-L*dFdx1/dFMod;//перешли в точку i+1 координата 1 X[i+1,2]:=X[i,2]-L*dFdx2/dFMod;//перешли в точку i+1 координата 2 while (FallMax(X[i,1],X[i,2])>FallMax(X[i+1,1],X[i+1,2]))
{(-10000/F1(X[i,1],X[i,2])+10000/F2(X[i,1],X[i,2])) >
(-10000/F1(X[i+1,1],X[i,2])+10000/F2(X[i+1,1],X[i,2]))}
and (i0) and (F2(x,y)<>0) then
begin
f:=Fall(x,y);
if(f>-0.3) and (f<0.3) then Pixels[i+400,280-j]:=clOlive;//оливковый if(f<=0)and(f>=-100) then Pixels[i+400,280-j]:=clSilver;//светло-серый
if(f<-100) then Pixels[i+400,280-j]:=clBlue;//синий if(f<-300) then Pixels[i+400,280-j]:=clRed;//красный if(f>4.9)and(f<5.1) then Pixels[i+400,280-j]:=clFuchsia;//светло-фиолетовый if(f>100) then Pixels[i+400,280-j]:=clAqua;//голубой
if(f>300) then Pixels[i+400,280-j]:=clGreen;//темно-зеленый
if(f>0.9)and(f<1.1) then Pixels[i+400,280-j]:=clPurple;//темно-фиолетовый if(f>1.9)and(f<2.1) then Pixels[i+400,280-j]:=clBlack; if(f>14.6)and(f<15.4) then Pixels[i+400,280-j]:=clLime;//светло-зеленый if(f>19)and(f<21) then Pixels[i+400,280-j]:=clTeal;//темно-серый if(f>6)and(f<6.5) then Pixels[i+400,280-j]:=clMaroon;//коричневый end; end; if (i mod 35 = 0) then begin UpdateWindow(form2.Handle); InvalidateRect(form2.Handle,nil,false); end; end;//for i:=-400 to 400 do} Moveto(400,0);//координатные оси Lineto(400,560); Moveto(0,280); Lineto(800,280); TextOut(780,265,'X1'); TextOut(410,0,'X2'); for i:=-400 to 400 do//сетка вертикальная begin if (i mod 50 = 0) then begin moveto(i+400,0); Lineto(i+400,560); textOut(i+400,265,inttostr(round(i/ZoomX))); end; end; for i:=-280 to 280 do//сетка горизонтальная begin if (i mod 40 = 0) then begin moveto(0,280-i); Lineto(800,280-i); textOut(390,280-i,inttostr(round(i/ZoomY))); end; end; end;//with form2.Image.Canvas do end; //****************************************************************************** end.//А чо это вы здесь делаете? Кино-то давно кончилось... Respect! 2. Модуль Graph: unit Graph; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Menus; type TForm2 = class(TForm) Image: TImage; procedure OnClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormHide(Sender: TObject); procedure FormResize(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; CloseGraph: boolean; implementation uses MOACDC, Help; {$R *.DFM} //****************************************************************************** procedure TForm2.OnClose(Sender: TObject; var Action: TCloseAction); begin form1.visible:=true; CloseGraph:=true;//типа закрыто CloseCount:=0; FormHelp.Visible:=false; end; //****************************************************************************** procedure TForm2.FormCreate(Sender: TObject); begin ClientWidth := 800; with HorzScrollBar do begin Range := 800; Position := Range - ClientWidth; { start form out fully scrolled } Increment := 10; { clicking the scroll arrows moves the form 10 pixels } Visible := True; { Show the scrollbar } end; ClientHeight:= 550; with VertScrollBar do begin Range := 550; Position := Range - ClientHeight; { start form out fully scrolled } Increment := 10; { clicking the scroll arrows moves the form 10 pixels } Visible := True; { Show the scrollbar } end; end; //****************************************************************************** procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin case key of 112:FormHelp.visible:=true; 27: form2.visible:=false; end; end; //****************************************************************************** procedure TForm2.FormHide(Sender: TObject); begin FormHelp.Visible:=false; end; //****************************************************************************** procedure TForm2.FormResize(Sender: TObject); begin FormHelp.Visible:=false; end; //****************************************************************************** end.

Похожие записи
  1. Программа эмуляции работы КЭШ-памяти
  2. Задача минимизации методами наискорейшего спуска и поразрядного приближения
  3. Комбинация метода случайного поиска (спуска) и метода Фибонначи
  4. Ассоциативные запоминающие устройства, моделирование ассоциативной ячейки
  5. Создание модели накопителя АЗУ на языке C++
  6. Открытый В-сплайн 3-ей степени на Builder C++
  7. Составная кривая Безье 3-ей степени на Builder C++
  8. Код Фримэна на Builder C++
  9. Вычисление суммы ряда через Pascal
  10. Программа калькулятора, осуществляющего простейшие арифметические действия
  11. Метод Фибоначчи
  12. Математические основы анализа и синтеза дискретных систем
  13. Программа на Pascal: найти минимальное из трех чисел
  14. Событие OnMessage, перехватчики сообщений, перехваты Windows
  15. Механизм обработки сообщений в Delphi
  16. Программирование калькулятора на C++
  17. Тест IQ – сомнения и недостатки метода
PostCategoryIcon Рубрика: Программирование

Комментарии запрещены.


Поиск
Категории


Статистика

Образовательный блог разработан в 2009 году.