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.