unit1.pas

用delphi语言实现运筹学最速下降法程序

unit Unit1;

interface

uses
  Windows,math, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
const length=10;tol=0.000001;ex=0.001;b=100;
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type  array1=array[1..length] of array[1..length] of Tedit;
type  array2=array[1..length] of Tedit;
type  array3=array[1..length] of real;
type  array4=array[1..length] of Tlabel;
var
  Form1: TForm1;

implementation
{$R *.dfm}
var m,n:integer;      
    xishu:array[1..length,1..length]  of real;
    shuru1:array1;              
    STpoint:array2;            
    xx:array3;
function zzD(xxx:array3):array3;
var s:array3;
    i,j:integer;
begin
  for i:=1 to m  do
    begin
      s[i]:=0;
      for j:=1 to n  do
        s[i]:=s[i]+xishu[i,j]*(n+1-j)*power(xxx[i],n-j); 
      zzD[i]:=-s[i];
    end;                 
end;
{---------------计算函数在某点的负梯度方向----------}
function ABSzz(a:integer;xxx:array3):real ;     
var i:integer;
    s:real;
begin
  s:=0;
  for i:=1 to a do
    s:= s+ power(zzD(xxx)[i],2);
  result:=sqrt(s);
end;
{------------------------计算向量的模---------------------}
function Func(temp:array3):real;
var i,j:integer;
   s:real;
begin
   s:=0;
   for i:=1  to  m  do
     for j:=1  to n+1  do
       s:=s+xishu[i,j]*power(temp[i],n+1-j);
   result:=s;
end;
{-------------------求初始的函数值----------------------}
function GolFunc(u:real):real ;
var i:integer;
   temp,t1:array3;
begin
  t1:=zzD(xx);
  for i:=1  to  m  do
    temp[i]:=xx[i]+t1[i]*u;
  result:=Func(temp);
end;
{------------------对此函数做黄金分割搜索-----------}
function xGolden(ax,bx,ex:real):real ;
var a,b,t1,t2,f1,f2:real;
    k:integer;
begin
  k:=1;
  a:=ax;b:=bx;
  t1:=0.382*a+0.618*b;;
  t2:=0.618*a+0.382*b;
  f1:=GolFunc(t1);
  f2:=GolFunc(t2);
  while (abs(f2-f1)>ex) do
    begin
       if  f1<f2 then
         begin
           a:=t2;
           t2:=t1;
           t1:=0.382*a+0.618*b;
           f2:=f1;
           f1:=GolFunc(t1);
         end
       else
         begin
           b:=t1;
           t1:=t2;
           t2:=0.618*a+0.382*b;
           f1:=f2;
           f2:=GolFunc(t2);
         end;
      k:=k+1;
    end;
    result:=(t1+t2)/2;
end;   
{----------------黄金分割法做一维搜索-----------------}
procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
    lab:array4;
begin
if (edit1.Text<>'') and  (edit2.Text<>'') then
  begin
    m:=strtoint(edit1.text);
    n:=strtoint(edit2.text);
    for i:=1  to  m  do
      begin
        STpoint[i]:=Tedit.Create(self);    
        STpoint[i].parent:=tabsheet2;
        STpoint[i].Width:=40;
        STpoint[i].Height:=24;
        STpoint[i].left:=40+(i-1)*(STpoint[i].Width+15);
        STpoint[i].top:=25;
        lab[i]:=Tlabel.Create(self);
        lab[i].parent:=tabsheet2;
        lab[i].Width:=30;
        lab[i].Height:=24;
        lab[i].left:=20;
        lab[i].top:=76+(i-1)*(lab[i].Height+2);;
        lab[i].caption:='X'+inttostr(i);
        for j:=1  to n+1  do
          begin
            shuru1[i,j]:=Tedit.Create(self);
            shuru1[i,j].parent:=tabsheet2;
            shuru1[i,j].Width:=60;
            shuru1[i,j].Height:=24;
            shuru1[i,j].left:=40+(j-1)*(shuru1[i,j].Width+20);
            shuru1[i,j].top:=70+(i-1)*(shuru1[i,j].Height+2);
          end;
        PageControl1.ActivePageIndex:=1;
      end;
  end;
end;
{------------------------------生成控件--------------------------}
procedure TForm1.Button3Click(Sender: TObject);
var i,j:integer;
    u:real;
    Str:string;
begin
  for i:=1 to m do
    xx[i]:=strtofloat(STpoint[i].text);
  for i:=1 to m  do
    for j:=1 to n+1  do
      xishu[i,j]:=strtofloat(shuru1[i,j].text);
  while (ABSzz(m,xx)>ex) do
    begin
      u:=xGolden(0,b,tol) ;
      for i:=1 to m do
        xx[i]:=xx[i]+u*zzD(xx)[i];
    end;
  Str:='';
  for i:=1 to m do
  Str:=Str+'x'+inttostr(i)+'='+floattostr(xx[i])+#13;
  showmessage(Str+'f='+formatfloat('0.###',Func(xx)));
end;
{---------------------输出显示最优解与最优值------------------}
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  for i:= 0 to PageControl1.PageCount-1 do
    PageControl1.Pages[I].TabVisible := False;
  PageControl1.ActivePageIndex:=0 ;
end;
{-----------------------控制控件的可视性----------------------}
procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['1'..'9']) then
    key:=chr(0);
end;

end.