rand_1.pas

机械优化设计中的约束随机法

unit rand_1;
//单元1
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Grids, StdCtrls, ExtCtrls;
type
   arr1=array[1..25]of real;
   arr3=array[1..25]of real;
type
   dcd = record
   step:integer;
   n : integer;   //设计变量的个数（维数）
   kg : integer;  //不等式约束函数个数
   nsr: integer;  //产生随机方向的个数
   eps:  real;    //收敛精度
   t0 : real;     //初始步长
   th : real;     //步长

   x00 : arr1;    //设计变量初始点值数组
   x  : arr1;     //设计变量数组
   Xl:  arr1;     //设计变量最优点值数组
   gx : arr1;     // 约束函数值数组
   bl : arr1;     //设计变量下界值数组
   bu : arr1;     //设计变量上界值数组

   fx : real;     //目标函数值
   f0 : real;     // 目标函数值的初始值
   fl : real;     // 目标函数值的最小值
   rm : real;     //产生随机数的常数
   sf : arr1;     // 可行的随机方向数组
   sr : arr1;     // 随机方向数组
   ITE,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;
    GroupBox1: TGroupBox;
    Label5: TLabel;
    sjbl: TEdit;
    GroupBox5: TGroupBox;
    Label10: TLabel;
    bdys: TEdit;
    GroupBox6: TGroupBox;
    Label11: TLabel;
    Label12: TLabel;
    sjfx: TEdit;
    Label9: TLabel;
    csbc: TEdit;
    sljd: TEdit;   //设计要点说明框

    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 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);
  private
    { Private declarations }
  public
    { Public declarations }
    hfgd : dcd;
    procedure ReadDataFromFile(filename : string);
    procedure WriteDataToFile(filename : string);
  end;

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


implementation

uses rand_0, rand_2, rand_fgh;

{$R *.DFM}


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

procedure TForm1.FormCreate(Sender: TObject);   //第一幅画面创建
var i : integer;
begin
  form1.Left := 50;
  form1.top  := 50;
  with form1.hfgd do
  begin
    n  :=0;
    kg :=-1;
    nsr:=0;
    eps:=0.0;
    t0 :=0.0;
    rm :=2657863.0;
    for i :=1 to n do
    begin
      x00[i] :=0.0;  x[i] :=0.0;  xl[i]:=0;
      bl[i] :=0.0;   bu[i] :=0.0;
    end;
  end;
end;

procedure TForm1.ksjsClick(Sender: TObject);  //开始计算
var jj : integer;
begin
    with form1.hfgd  do
    begin
      for jj:= 1 to n do  x[jj]:=x00[jj];
      ITE :=0;  NFX :=0;
    end;
  form2.Destroy;
  Application.CreateForm(TForm2, Form2);
    form2.Show;
    form2.jgxs.lines.Clear;
    FFX; GGX;
    sjxs_1;    //初始数据显示;
    RANDIR;
    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,hfgd);
  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,hfgd);
  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
  form1.hfgd.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:=form1.hfgd.n;
    xbl.colcount:=form1.hfgd.n;
    xbu.colcount:=form1.hfgd.n;
  with form1.hfgd  do
  begin
  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.hfgd  do
    begin
      if (eps <=0) then sljd.SetFocus;
      if (t0  <=0) then csbc.SetFocus;
      if (nsr <=0) then sjfx.SetFocus;
      if (kg   <0) then bdys.SetFocus;
      if (n   <=0) then sjbl.SetFocus;

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

procedure TForm1.bdysChange(Sender: TObject);  //约束函数个数
begin
  form1.hfgd.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.hfgd.nsr := round(testvalue(sjfx.text));
end;

procedure TForm1.sjfxKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
  begin
    with form1.hfgd  do
    begin
      if (nsr>=n+1) and (nsr<=2*n) then  sjblKeyPress(Sender,Key)
      else
      begin
         application.messagebox('一般应有：N+1 ≤NSR ≥2*N ！','注意',MB_OK+MB_ICONWARNING);
         sjfx.SetFocus;
      end;
    end;
  end;
end;

procedure TForm1.csbcChange(Sender: TObject);  //初始步长
begin
  form1.hfgd.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.hfgd.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.hfgd.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.hfgd.x00[j+1]:=testvalue(xx0.cells[j,0]);

  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.hfgd.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.hfgd.bl[j+1]:=testvalue(xbl.cells[j,0]);
  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.hfgd.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.hfgd.bu[j+1]:=testvalue(xbu.cells[j,0]);
  end;
end;

procedure TForm1.dsjClick(Sender: TObject);  //修改设计
var j : integer;
begin
  if od.Execute then
  begin
    readdatafromfile(od.filename);
    with form1.hfgd 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 nsr >0 then   sjfx.Text := floattostrf(nsr,fffixed,7,0);
      if t0  >0 then   csbc.Text := floattostrf(t0,fffixed,7,3);
      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;

end.