?? rand_2.pas
字號:
unit rand_2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm2 = class(TForm)
GroupBox1: TGroupBox;
cp: TButton;
qx: TButton;
sd: TSaveDialog;
Memo1: TMemo;
GroupBox2: TGroupBox;
jgxs: TMemo;
procedure FormCreate(Sender: TObject);
procedure cpClick(Sender: TObject);
procedure qxClick(Sender: TObject);
procedure sb1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
procedure sjxs_1;
procedure sjxs_2;
Procedure RANDIR;
procedure xran;
procedure sran;
procedure sfeas;
function rmd() : real;
implementation
uses rand_0, rand_1, rand_fgh ;
//var sss:string;
{$R *.DFM}
procedure TForm2.FormCreate(Sender: TObject);
begin
Form2.Left :=50;
Form2.Top :=50;
end;
procedure TForm2.cpClick(Sender: TObject);
begin
if sd.Execute then
begin
if fileexists(sd.filename) then
begin
if application.MessageBox('您確認要覆蓋此文件嗎？','警告',MB_YESNO)=idyes then
form1.WriteDataToFile(sd.filename);
end
else
begin
form1.WriteDataToFile(sd.filename);
end;
if application.MessageBox('要返回嗎？','提示',MB_YESNO)=idyes then
Form2.Close;
end;
end;
procedure TForm2.qxClick(Sender: TObject);
begin
Form2.Close;
end;
procedure TForm2.sb1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
var
j,k : integer;
begin
k := 0;
jgxs.SetFocus;
if scrollpos > 1 then
for j := 1 to scrollpos do
k := k+length(jgxs.Lines.Strings[j-1])+2
else k := 0;
jgxs.SelStart := k;
end;
//=================優化算法程序=============================
Procedure RANDIR; //開始計算
var ii,kk :integer;
tmp107,tmp113,tmp116 : integer;
begin
with form2.jgxs.lines do
begin
with form1.hfgd do
begin
rm := 2657863.0;
xran;
ffx;
f0 := fx;
tmp107:=107;
repeat
th:=t0;
sfeas;
ffx;
fl:=fx;
tmp113:=113;
repeat
th:=1.3*th;
for ii:=1 to n do x[ii]:=x[ii]+th*sf[ii];
ggx;
for kk:=1 to kg do if (gx[kk]>=1e-15) then begin tmp113:=999; break; end;
if tmp113=113 then
begin
FFX;
if (fx > fl) then
tmp113:=999
else
fl:=fx;
end;
if (th>1e15) then tmp113:=999;
//Add('113 目標函數值 F(X)= '+floattostr(FL)+' 步長 TH = '+floattostr(th));
until tmp113=999;
tmp116:=116;
repeat
for ii:=1 to n do x[ii]:=x[ii]-th*sf[ii];
th:=0.7*th;
for ii:=1 to n do x[ii]:=x[ii]+th*sf[ii];
ggx;
for kk:=1 to kg do
if(gx[kk]>=1e-15) then begin tmp116:=116; break; end
else tmp116:=777;
if tmp116=777 then
begin
FFX;
if (fx > fl) then
tmp116:=116
else
tmp116:=999;
end;
if (th<1e-15) then tmp116:=999;
//Add('116 目標函數值 F(X)= '+floattostr(FL)+' 步長 TH = '+floattostr(th));
until (tmp116=999);
if (abs(f0-fx)<(abs(f0)*eps+eps)) then tmp107:=999
else begin
ITE := ITE+1;
f0:=fx;
end;
IF (ITE=1) or (ITE = ((ITE div 10)*10)) THEN
BEGIN
Add(' 設計變量迭代點 X:'+' 迭代次數 ITE = '+inttostr(ITE));
for ii := 1 to n do Add(#9+#9+#9+'X['+inttostr(ii)+']= '+formatfloat('0.000000E+00',XL[ii]));
Add(' -----------------------------------------------------------------------------');
Add(' 目標函數值 F(X)= '+floattostr(FL));
Add(' -----------------------------------------------------------------------------');
END;
until (tmp107=999);
end;
end;
end;
function rmd() : real; //計算隨機數
var
rm35,rm36,rm37 : real;
begin
with form1.hfgd do
begin
rm35:= exp(35.0*ln(2.0));
rm36:=2.0*rm35;
rm37:=2.0*rm36;
rm:=5.0*rm;
if rm>=rm37 then rm:=rm-rm37;
if rm>=rm36 then rm:=rm-rm36;
if rm>=rm35 then rm:=rm-rm35;
rmd:=rm/rm35;
end;
end;
procedure xran; //產生可行的初始點
var
ii,temp,kk:integer;qq:real;
begin
with form1.hfgd do
begin
temp:=0;
repeat
ggx;
for ii:=1 to kg do
begin
if (gx[ii]>=0) then
begin
for kk:=1 to n do
begin qq:=random; x[kk]:=bl[kk]+qq*(bu[kk]-bl[kk]); end;
temp:=1;
break;
end
else
temp:=0;
if(temp=1) then break;
end;
until temp=0;
end;
end;
procedure sran; //產生隨機方向
var
ii,kk:integer;qq,rqu:real;
begin
with form1.hfgd do
begin
rqu:=0;
for ii:=1 to n do begin qq:=rmd(); sr[ii]:=2.0*qq-1.0; rqu:=rqu+sr[ii]*sr[ii]; end;
for kk:=1 to n do sr[kk]:=sr[kk]/sqrt(rqu);
end;
end;
procedure sfeas; //由初始點按最優方向迭代一輪
var ii,kk,jj,temp,temp1:integer;x0:arr1;
begin
with form1.hfgd do
begin
for ii:=1 to n do begin x0[ii]:=x[ii];xl[ii]:=x[ii];end;
fl:=f0;
temp:=1;temp1:=1;
repeat
for kk:=1 to nsr do
begin
sran;
for ii:=1 to n do x[ii]:=x0[ii]+th*sr[ii];
ggx;
for jj:=1 to kg do
begin
if (gx[jj]>=1e-15)then begin temp:=1; break; end
else temp:=0;
end;
ffx;
if(fx<fl)and(temp=0) then
begin
fl:=fx;
temp1:=0;
for ii:=1 to n do begin sf[ii]:=sr[ii]; xl[ii]:=x[ii]; end;
end;
end;
for ii:=1 to n do x[ii]:=xl[ii];
th:=0.9*th;
until (temp1=0)and(temp=0); //((th<1e-7)or((fl-f0)>=1e-15));
end;
end;
//===========================================================================
procedure sjxs_1;
var
ii : integer;
jg:array[1..400] of string;
begin
with form1.hfgd do
begin
jg[1]:=floattostr(n);
jg[2]:=floattostr(kg);
jg[3]:=floattostr(NSR);
jg[4]:=floattostr(T0);
jg[5]:=floattostr(EPS);
with form2.jgxs.lines do
begin
clear;
add(' 常用優化方法 ——約束隨機法');
add(' ^^^^^^^^^^^^^^^^^^^^^^^^^^^');
add(' ');
add('一、初始數據');
add('===============================================================================');
Add(' 設計變量個數 N = '+jg[1]+' 不等式約束個數 KG = '+jg[2]);
Add(' -----------------------------------------------------------------------------');
Add(' 隨機方向個數 NSR = '+jg[3]);
Add(' -----------------------------------------------------------------------------');
Add(' 初始步長 T0 = '+jg[4]+' 收斂精度 EPS = '+jg[5]);
Add(' -----------------------------------------------------------------------------');
Add(' 設計變量初始點 X0:');
for ii := 1 to n do Add(#9+#9+#9+'X['+inttostr(ii)+']='+floattostr(x[ii]));
Add(' -----------------------------------------------------------------------------');
Add(' 設計變量下界 BL:');
for ii := 1 to n do Add(#9+#9+#9+'BL['+inttostr(ii)+']='+floattostr(BL[ii]));
Add(' -----------------------------------------------------------------------------');
Add(' 設計變量上界 BU:');
for ii := 1 to n do Add(#9+#9+#9+'BU['+inttostr(ii)+']='+floattostr(BU[ii]));
Add(' -----------------------------------------------------------------------------');
Add(' 初始點目標函數值 F(X0)= '+floattostr(FX));
if kg>0 then
begin
Add(' -----------------------------------------------------------------------------');
Add(' 初始點處的不等約束函數值 G(X0):');
for ii := 1 to kg do Add(#9+#9+#9+#9+'GX['+inttostr(ii)+']= '+formatfloat('0.000000E+00',GX[ii]));
end;
add('-------------------------------------------------------------------------------');
add(' ');
add('二、計算過程__數據');
add('===============================================================================');
end;
end;
end;
//99999999999999999999999999999999999999999999999999999999999999999
procedure sjxs_2;
var
ii : integer;
jg:array[1..400] of string;
begin
with form1.hfgd do
begin
jg[1]:=inttostr(ITE);
jg[2]:=inttostr(NFX);
with form2.jgxs.lines do
begin
add(' ');
add('三、優化結果__數據');
add('===============================================================================');
Add(' 迭代次數 ITE = '+jg[1]+' 目標函數計算次數 IFX = '+jg[2]);
Add(' -----------------------------------------------------------------------------');
Add(' 設計變量最優點 X*:');
for ii := 1 to n do Add(#9+#9+#9+'X['+inttostr(ii)+']= '+formatfloat('0.000000E+00',XL[ii]));
Add(' -----------------------------------------------------------------------------');
Add(' 最優值 F(X*)= '+floattostr(FX));
if kg>0 then
begin
Add(' -----------------------------------------------------------------------------');
Add(' 最優點處的不等約束函數值 G(X*):');
for ii := 1 to kg do Add(#9+#9+#9+#9+'GX['+inttostr(ii)+']= '+formatfloat('0.000000E+00',GX[ii]));
end;
Add('-------------------------------------------------------------------------------');
Add('--- STOP --- ');
end;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -