?? comp_1.pas
字號:
unit comp_1;
//單元1
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls, ExtCtrls;
type
arr1=array[1..25]of real;
arr2=array[1..25,1..25]of real;
type
dcd = record
step:integer;
n : integer; //設計變量的個數(維數)
kg : integer; //不等式約束函數個數
Kfh: integer; //復合形頂點的個數
LL : integer; //復合形最優點號
Lh : integer; //復合形最壞點號
eps: real; //收斂精度
fx0: real; //中心點函數值
fxh: real; //最壞點函數值
fxl: real; //最優點函數值
fxr: real; //反射點函數值
th : real; //步長
x00 : arr1; //設計變量初始點值數組
x : arr1; //設計變量數組
Xl : arr1; //設計變量最優點值數組
xh : arr1; //設計變量最壞點值數組
gx : arr1; //約束函數值數組
x0 : arr1; //中心點值數組
xr : arr1; //反射點值數組
bl : arr1; //設計變量下界值數組
bu : arr1; //設計變量上界值數組
fx : real; //目標函數值
fx00 : real; //目標函數值的初始值
fl : real; //目標函數值的最小值
rm : real; //產生隨機數的常數
sf : arr1; //可行的隨機方向數組
sr : arr1; //隨機方向數組值數組
fxk: arr1; //復合形各頂點函數值數組
xcom: arr2; //復合形各頂點值數組
ITE,NFX : integer; //各程序段調用次數計數器
// row : integer; //行數
// xsxs : integer; //顯示項數
end;
type
TForm1 = class(TForm)
ksjs: TButton;
tc: TButton; //退出
od: TOpenDialog;
sd: TSaveDialog;
GroupBox2: TGroupBox;
Label4: TLabel;
Label8: TLabel;
sjfx: TEdit;
sljd: TEdit;
GroupBox3: TGroupBox;
xx0: TStringGrid;
GroupBox4: TGroupBox;
xbl: TStringGrid;
Label6: TLabel;
Label7: TLabel;
xbu: TStringGrid;
Label1: TLabel;
dsj: TButton;
GroupBox1: TGroupBox;
Label5: TLabel;
sjbl: TEdit;
GroupBox5: TGroupBox;
Label3: TLabel;
bdys: TEdit;
bzxsb: TPanel;
ListBox1: TListBox;
bz: TButton; //設計要點說明框
procedure ksjsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure tcClick(Sender: TObject);
procedure sjblChange(Sender: TObject);
procedure sjblKeyPress(Sender: TObject; var Key: Char);
procedure bdysChange(Sender: TObject);
procedure bdysKeyPress(Sender: TObject; var Key: Char);
procedure sjfxChange(Sender: TObject);
procedure sjfxKeyPress(Sender: TObject; var Key: Char);
procedure sljdChange(Sender: TObject);
procedure sljdKeyPress(Sender: TObject; var Key: Char);
procedure xx0KeyPress(Sender: TObject; var Key: Char);
procedure xx0SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure xblKeyPress(Sender: TObject; var Key: Char);
procedure xblSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure xbuSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure xbuKeyPress(Sender: TObject; var Key: Char);
procedure dsjClick(Sender: TObject);
procedure bzMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure bzMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
comple : dcd;
procedure ReadDataFromFile(filename : string);
procedure WriteDataToFile(filename : string);
end;
var
Form1: TForm1;
Function testvalue(s : string) : real;
implementation
uses comp_0, comp_2,comp_fgh;
{$R *.DFM}
//=========================================================
procedure TForm1.FormCreate(Sender: TObject); //第一幅畫面創建
var i,j : integer;
begin
form1.Left := 40;
form1.top := 40;
form1.bzxsb.Visible:=false;
with form1.comple do
begin
n :=0;
kg :=-1;
Kfh :=0;
eps :=0.0;
rm:=2657863.0;
fx00:=0.0;
for i :=1 to n do
begin
x00[i] :=0.0; x[i] :=0.0; xl[i]:=0.0; xh[i]:=0.0; x0[i]:=0.0;
bl[i] :=0.0; bu[i] :=0.0; fxk[i]:=0.0;
end;
for i:=1 to n do
for j:=1 to kfh do xcom[i,j]:=0.0;
end;
end;
procedure TForm1.ksjsClick(Sender: TObject); //開始計算
var jj : integer;
begin
with form1.comple do
begin
for jj:= 1 to n do x[jj]:=x00[jj];
ITE:=0;
NFX:=0; //各程序段調用次數計數器
end;
form2.Show;
form2.jgxs.lines.Clear;
ffx; ggx;
sjxs_1; //初始數據顯示;
comp; //優化算法過程
sjxs_2; //優化結果數據顯示;
end;
procedure TForm1.tcClick(Sender: TObject); //退出
//var j : integer;
//begin
// j := application.messagebox('您確認要取消這次設計計算嗎?','警告',MB_YESNO);
// if j=IDYES then
begin
form1.Close;
formfm.Close;
end;
procedure TForm1.ReadDataFromFile(filename : string); //讀數據文件
var
infile : file of dcd;
begin
assignfile(infile,filename);
reset(infile);
read(infile,comple);
closefile(infile);
end;
procedure TForm1.WriteDataToFile(filename : string);
//寫數據進磁盤文件
// *.hgd--臨時文件;*.rtf--word格式;*.txt--文本格式
var
outfile : file of dcd;
j : integer;
// ff : Textfile;
begin
assignfile(outfile,filename);
rewrite(outfile);
write(outfile,comple);
closefile(outfile);
j := length(filename);
filename[j-2] :='r'; filename[j-1] := 't'; filename[j] := 'f';
// form1.jgxs.Lines.SaveToFile(filename);
end;
function testvalue(s : string) : real; //測試S是否為數字
var
j : real;
begin
j := 0;
if (length(s)=1)and((s[1]='-')or(s[1]='+')) then
begin
testvalue := 0;
exit;
end;
if length(s)>0 then
try
j := strtofloat(s);
except
application.messagebox('請輸入數字!','提示',MB_OK);
end
else
j :=0;
testvalue := j;
end;
procedure TForm1.sjblChange(Sender: TObject); //設計變量個數
begin
with form1.comple do
begin
n := round(testvalue(sjbl.text));
xx0.rowcount:=1;
xbl.rowcount:=1;
xbu.rowcount:=1;
if sjbl.text='' then
begin xx0.ColCount:=1;
xbl.ColCount:=1;
xbu.ColCount:=1;
end
else
begin xx0.colcount:=n;
xbl.colcount:=n;
xbu.colcount:=n;
if (n>7) then
begin xx0.width:=64*7+20;
xbl.width:=64*7+20;
xbu.width:=64*7+20;
end
else
begin xx0.width:=64*n+20;
xbl.width:=64*n+20;
xbu.width:=64*n+20;
end;
end;
end;
end;
procedure TForm1.sjblKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
with form1.comple do
begin
if (eps<=0) then sljd.SetFocus;
if (Kfh<=0) then sjfx.SetFocus;
if (kg <0) then bdys.SetFocus;
if (n<=0) then sjbl.SetFocus;
if (n>0)and(kg>=0)and(Kfh>0)and(eps>0) then xx0.SetFocus;
end;
end;
end;
procedure TForm1.bdysChange(Sender: TObject); //不等約束函數個數
begin
form1.comple.kg := round(testvalue(bdys.text));
end;
procedure TForm1.bdysKeyPress(Sender: TObject; var Key: Char);
begin
sjblKeyPress(Sender,Key);
end;
procedure TForm1.sjfxChange(Sender: TObject); //復合形頂點個數
begin
form1.comple.Kfh := round(testvalue(sjfx.text));
end;
procedure TForm1.sjfxKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
with form1.comple do
begin
if (Kfh>=n+1) and (Kfh<=2*n) then sjblKeyPress(Sender,Key)
else
begin
application.messagebox('一般應有:N+1 ≤ K ≥ 2×N !','注意',MB_OK+MB_ICONWARNING);
sjfx.SetFocus;
end;
end;
end;
end;
procedure TForm1.sljdChange(Sender: TObject); //收斂精度
begin
form1.comple.eps := testvalue(sljd.text);
end;
procedure TForm1.sljdKeyPress(Sender: TObject; var Key: Char);
begin
sjblKeyPress(Sender,Key);
end;
procedure TForm1.xx0KeyPress(Sender: TObject; var Key: Char); //初始點
var j:integer;
begin
if key = #13 then
begin
j:=xx0.Col;
inc(j);
if j=form1.comple.n then xbl.SetFocus
else begin xx0.Col:=j; xx0.Row:=0; end;
end;
end;
procedure TForm1.xx0SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
var j : integer;
begin
for j:=0 to acol do
begin
if xx0.Cells[j,0]='' then xx0.setfocus
else form1.comple.x00[j+1]:=testvalue(xx0.cells[j,0]);
application.ProcessMessages;
end;
end;
procedure TForm1.xblKeyPress(Sender: TObject; var Key: Char); //X的下界
var j:integer;
begin
if key = #13 then
begin
j:=xbl.Col;
inc(j);
if j=form1.comple.n then xbu.SetFocus
else begin xbl.Col:=j; xbl.Row:=0; end;
end;
end;
procedure TForm1.xblSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
var j:integer;
begin
for j:=0 to acol do
begin
if xbl.Cells[j,0]='' then xbl.setfocus
else form1.comple.bl[j+1]:=testvalue(xbl.cells[j,0]);
application.ProcessMessages;
end;
end;
procedure TForm1.xbuKeyPress(Sender: TObject; var Key: Char); //X的上界
var j:integer;
begin
if key = #13 then
begin
j:=xbu.Col;
inc(j);
if j=form1.comple.n then ksjs.SetFocus
else begin xbu.Col:=j; xbu.Row:=0; end;
end;
end;
procedure TForm1.xbuSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
var j:integer;
begin
for j:=0 to acol do
begin
if xbu.Cells[j,0]='' then xbu.setfocus
else form1.comple.bu[j+1]:=testvalue(xbu.cells[j,0]);
application.ProcessMessages;
end;
end;
procedure TForm1.dsjClick(Sender: TObject); //讀數據文件
var j : integer;
begin
if od.Execute then
begin
readdatafromfile(od.filename);
with form1.comple do
begin
if n >0 then sjbl.Text := floattostrf(n,fffixed,7,0);
if kg >=0 then bdys.Text := floattostrf(kg,fffixed,7,0);
if Kfh >0 then sjfx.Text := floattostrf(Kfh,fffixed,7,0);
if eps >0 then sljd.Text := floattostrf(eps,fffixed,12,10);
for j:= 1 to n do xx0.Cells[j-1,0]:=floattostrf(x00[j],fffixed,7,2);
for j:= 1 to n do xbl.Cells[j-1,0]:=floattostrf(bl[j],fffixed,7,2);
for j:= 1 to n do xbu.Cells[j-1,0]:=floattostrf(bu[j],fffixed,7,2);
for j:= 1 to n do x[j]:=x00[j];
end;
form1.Show;
end;
end;
procedure TForm1.bzMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.bzxsb.Visible:=true;
end;
procedure TForm1.bzMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.bzxsb.Visible:=false;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -