sumt_1.pas

机械优化设计中的惩罚函数法

unit sumt_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;

   dcd = record

   n : integer;            //设计变量的个数（维数）
   kg : integer;           //不等式约束函数个数
   kh : integer;           //等式约束函数个数
   Kcheck : integer;       //选择系数：0--powell法,1--dfp法,2--bfgs法
   Kcheck_Z : string[8];   //选择系数：0--powell法,1--dfp法,2--bfgs法

   R00  : real;    //初始惩罚因子
   R    : real;    //惩罚因子
   Cr   : real;    //惩罚因子降低系数

   T0  : real;     //一维搜索步长
   eps : real;     //收敛精度

   x   : arr1;     //设计变量初始值数组
   s   : arr1;     //搜索方向数组
   direct: arr2;   //搜索方向矩阵
   H  : arr2;      //变尺度矩阵
   dpdx: arr1;     //惩罚函数微分
   dfdx: arr1;     //目标函数微分
   dgdx: arr2;     //微分
   dhdx: arr2;     //等式约束函数微分
   dx  : arr1;     //设计变量差值
   dg  : arr1;     //不等式约束函数差值
   Hdg : arr1;     //H.DG
   xcs: arr1;
   pen: real;     //惩罚函数值
   fx : real;     //目标函数值
   gx : arr1;     //不等式约束函数值数组
   hx : arr1;     //等式约束函数值数组
   phi: real;     //反射系数
   bl : arr1;     //设计变量下界值数组
   bu : arr1;     //设计变量上界值数组
   f0 : real;     //目标函数值的初始值
   dxtdg   : real;    //DXT.DG
   dgthdg  : real;
   ffxx0   : real;
   x00  :  arr1;
   rm   :  real;        //产生随机数的常数
   IRC,ITE,KTE,ILI,NPE,NFX : integer;  //各程序段调用次数计数器
end;

type
  TForm1 = class(TForm)
    ksjs: TButton;
    tc: TButton;         //退出
    od: TOpenDialog;
    sd: TSaveDialog;
    GroupBox3: TGroupBox;
    xx0: TStringGrid;
    GroupBox4: TGroupBox;
    xbl: TStringGrid;
    Label6: TLabel;
    Label7: TLabel;
    xbu: TStringGrid;
    Label1: TLabel;
    dsj: TButton;
    GroupBox2: TGroupBox;
    Label17: TLabel;
    Label18: TLabel;
    fyz: TEdit;
    ccc: TEdit;
    Label11: TLabel;
    csbc: TEdit;
    Label10: TLabel;
    sljd: TEdit;
    kpd: TRadioGroup;
    GroupBox5: TGroupBox;
    Label2: TLabel;
    sjbl: TEdit;
    GroupBox6: TGroupBox;
    Label3: TLabel;
    bdys: TEdit;
    dsys: TEdit;
    GroupBox7: TGroupBox;
    Label4: TLabel;
    bz: TButton;
    bzxsb: TPanel;
    ListBox1: TListBox;
    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 dsysChange(Sender: TObject);
    procedure dsysKeyPress(Sender: TObject; var Key: Char);
    procedure csbcChange(Sender: TObject);
    procedure csbcKeyPress(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 fyzChange(Sender: TObject);
    procedure fyzKeyPress(Sender: TObject; var Key: Char);
    procedure cccChange(Sender: TObject);
    procedure cccKeyPress(Sender: TObject; var Key: Char);
    procedure kpdClick(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 }
    sumt : dcd;
    procedure ReadDataFromFile(filename : string);
    procedure WriteDataToFile(filename : string);
  end;

var
  Form1: TForm1;
  Function testvalue(s : string) : real;


implementation

uses sumt_0, sumt_2,sumt_fgh;


{$R *.DFM}


//=========================================================

procedure TForm1.FormCreate(Sender: TObject);   //第一幅画面创建
var i : integer;
begin
  form1.Left := 50;
  form1.top  := 50;
  form1.bzxsb.Visible := false;

   with form1.sumt do begin
   n  :=-1;
   kg :=-1;
   kh :=-1;
   Kcheck := 0 ;
   R00:=-1.0;
   Cr:=0.0;
   T0:=0.0;
   for i:=1 to n do
   begin
     x[i]:=0.0;
     bl[i]:=0.0;
     bu[i]:=0.0;
   end;
end;
end;

procedure TForm1.ksjsClick(Sender: TObject);  //开始计算
var i,j,jj : integer;
begin
    with form1.sumt  do
    begin
      for jj:= 1 to n do  x[jj]:=x00[jj];
      r := r00;
      IRC:=0; ITE:=0; KTE :=0; ILI:=0; NPE:=0; NFX:=0;  //各程序段调用次数计数器
      pen:=0.0;
      fx:=0.0;
      for i:=1 to kg do gx[i]:=0.0;
      for i:=1 to kh do hx[i]:=0.0;
      ffxx0:=0.0;
      rm:=2657863.0;
      dxtdg:=0.0;
      for i:=1 to n do
      begin
        s[i]:=0.0;
        dpdx[i]:=0.0;
        dfdx[i]:=0.0;
        dx[i]:=0.0;
        dg[i]:=0.0;
        Hdg[i]:=0.0;
        xcs[i]:=0.0;
//        x00[i]:=0.0;
      end;
      for i:=1 to 25 do
        for j:=1 to 25 do
        begin
          H[i,j]:=0.0;  direct[i,j]:=0.0;  dgdx[i,j]:=0.0;  dhdx[i,j]:=0.0;
        end;
    end;

    form2.Show;
    form2.jgxs.lines.Clear;
    ffx;  ggx;  hhx;
    sjxs_1;                   //初始数据显示;
    sump;                     //优化算法过程
    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;
end;

procedure TForm1.ReadDataFromFile(filename : string);  //读数据文件
var
  infile : file of dcd;
begin
  assignfile(infile,filename);
  reset(infile);
  read(infile,sumt);
  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,sumt);
  closefile(outfile);
  j := length(filename);
  filename[j-2] :='r';   filename[j-1] := 't'; filename[j] := 'f';
  form2.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.sumt  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.sumt  do
    begin
     if (eps<=0) then sljd.SetFocus;
     if (t0 <=0) then csbc.SetFocus;
     if (Cr <=0) then  ccc.SetFocus;
     if (R00< 0) then  fyz.SetFocus;
     if (kh <0)  then dsys.SetFocus;
     if (kg <0)  then bdys.SetFocus;
     if (n  <0)  then sjbl.SetFocus;

     if (n>0)and(kg>=0)and(KH>=0)and(R00>=0)and(Cr>0)and(t0>0)and(eps>0) then xx0.SetFocus;
    end;
  end;
end;

procedure TForm1.bdysChange(Sender: TObject);  //不等式约束函数个数
begin
  form1.sumt.kg := round(testvalue(bdys.text));
end;

procedure TForm1.bdysKeyPress(Sender: TObject; var Key: Char);
begin
  sjblKeyPress(Sender,Key);
end;

procedure TForm1.dsysChange(Sender: TObject);  //等式约束函数个数
begin
  form1.sumt.kh := round(testvalue(dsys.text));
end;

procedure TForm1.dsysKeyPress(Sender: TObject; var Key: Char);
begin
  sjblKeyPress(Sender,Key);
end;

procedure TForm1.fyzChange(Sender: TObject);  //惩罚因子
begin
   form1.sumt.R00 := testvalue(fyz.text);
end;

procedure TForm1.fyzKeyPress(Sender: TObject; var Key: Char);
begin
   sjblKeyPress(Sender,Key);
end;

procedure TForm1.cccChange(Sender: TObject);  //惩罚因子降低系数
begin
    form1.sumt.Cr := testvalue(ccc.text);
end;

procedure TForm1.cccKeyPress(Sender: TObject; var Key: Char);
begin
    sjblKeyPress(Sender,Key);
end;

procedure TForm1.csbcChange(Sender: TObject);  //初始步长
begin
  form1.sumt.t0 := testvalue(csbc.text);
end;

procedure TForm1.csbcKeyPress(Sender: TObject; var Key: Char);
begin
  sjblKeyPress(Sender,Key);
end;

procedure TForm1.sljdChange(Sender: TObject);  //收敛精度
begin
  form1.sumt.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.sumt.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.sumt.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.sumt.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.sumt.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.sumt.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.sumt.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.sumt do
    begin
      R := R00;
      if n   >0 then   sjbl.Text := floattostrf(n,fffixed,7,0);
      if kg >=0 then   bdys.Text := floattostrf(kg,fffixed,7,0);
      if kh >=0 then   dsys.Text := floattostrf(kh,fffixed,7,0);
      if R  >=0 then    fyz.Text := floattostrf(R,fffixed,7,2);
      if Cr  >0 then    ccc.Text := floattostrf(Cr,fffixed,7,2);
      if t0  >0 then   csbc.Text := floattostrf(t0,fffixed,7,3);
      if eps >0 then   sljd.Text := floattostrf(eps,fffixed,12,10);
      kpd.ItemIndex := kcheck;
      case kpd.ItemIndex of
        0 : Kcheck_Z := 'POWELL法';
        1 : Kcheck_Z := 'DFP法';
        2 : Kcheck_Z := 'BFGS法';
      end;
      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.kpdClick(Sender: TObject);  //无约束优化方法选择
begin
  with form1.sumt do
    case kpd.ItemIndex of
      0 : begin  Kcheck := 0; Kcheck_Z := 'POWELL法' end  ;
      1 : begin  Kcheck := 1; Kcheck_Z := 'DFP法'    end  ;
      2 : begin  Kcheck := 2; Kcheck_Z := 'BFGS法'   end  ;
    end;
    xx0.SetFocus
  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.