unit1.pas

很好运筹学的DEOPHI原代码.包括动态规划,原始单纯形法,对策论,决策论等

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, Buttons, Grids;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    StringGrid2: TStringGrid;
    StringGrid3: TStringGrid;
    Label2: TLabel;
    Label3: TLabel;
    TabSheet4: TTabSheet;
    Memo1: TMemo;
    Label4: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    Button5: TButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type array1r=array[1..99] of real;
type array1i=array[1..99] of integer;
//自定义的一维实型和一维整型的数组类型
var
  Form1: TForm1;
  n:integer;
  pb,vl,re,sm:array1r;
  nr,no,yr:array1i;
//定义的全局变量。其中n是分枝总数，nr是始点编号，no是终点编号，pb是发生概率，
//vl是每年收益值，yr是具有相同支付值的年数，re是贴现率，sm是最终求得的收益期望值。

implementation
uses math;  //因程序中用到power和abs函数，所以要先引用math单元。
{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin
  n:=strtoint(edit1.text);
  stringgrid1.RowCount:=n+1;
  stringgrid2.RowCount:=n+1;
  stringgrid3.RowCount:=n+1;
  //根据实际的分枝总数，动态调整stringgrid的行数。
  for i:=1 to 100 do
    sm[i]:=0;
  //期望值初始化。
  for i:=1 to n do
  begin
    stringgrid1.Cells[0,i]:='分枝'+inttostr(i);
    stringgrid2.Cells[0,i]:='分枝'+inttostr(i);
    stringgrid3.Cells[0,i]:='分枝'+inttostr(i);
  end;
  stringgrid1.Cells[1,0]:='始点编号';
  stringgrid1.Cells[2,0]:='终点编号';
  stringgrid1.Cells[3,0]:='发生概率';
  stringgrid1.Cells[4,0]:='每年收入';
  stringgrid1.Cells[5,0]:='相同年数';
  stringgrid1.Cells[6,0]:='贴现率';

  stringgrid2.Cells[1,0]:='始点编号';
  stringgrid2.Cells[2,0]:='终点编号';
  stringgrid2.Cells[3,0]:='发生概率';
  stringgrid2.Cells[4,0]:='每年收入';
  stringgrid2.Cells[5,0]:='相同年数';
  stringgrid2.Cells[6,0]:='贴现率';

  stringgrid3.Cells[1,0]:='始点编号';
  stringgrid3.Cells[2,0]:='终点编号';
  stringgrid3.Cells[3,0]:='发生概率';
  stringgrid3.Cells[4,0]:='每年收入';
  stringgrid3.Cells[5,0]:='相同年数';
  stringgrid3.Cells[6,0]:='贴现率';
  //在stringgrid的边框上添加标题。
end;

procedure TForm1.Button1Click(Sender: TObject);   //排序操作
var
  i,j,nn,nx,ny,ty:integer;
  tp,tv,tr:real;
begin
  for i:=1 to n do
  begin
    nr[i]:=strtoint(stringgrid1.cells[1,i]);
    no[i]:=strtoint(stringgrid1.cells[2,i]);
    pb[i]:=strtofloat(stringgrid1.cells[3,i]);
    vl[i]:=strtofloat(stringgrid1.cells[4,i]);
    yr[i]:=strtoint(stringgrid1.cells[5,i]);
    re[i]:=strtofloat(stringgrid1.cells[6,i]);
    //根据输入的内容，对各数组变量赋值。
  end;
  for i:=1 to n do
  begin
    nn:=n-i;
    for j:=1 to nn do
    begin
      if (nr[j]>nr[j+1]) or ((nr[j]=nr[j+1]) and (no[j]>no[j+1])) then
      begin
        nx:=nr[j];
        ny:=no[j];
        tp:=pb[j];
        tv:=vl[j];
        ty:=yr[j];
        tr:=re[j];

        nr[j]:=nr[j+1];
        no[j]:=no[j+1];
        pb[j]:=pb[j+1];
        vl[j]:=vl[j+1];
        yr[j]:=yr[j+1];
        re[j]:=re[j+1];

        nr[j+1]:=nx;
        no[j+1]:=ny;
        pb[j+1]:=tp;
        vl[j+1]:=tv;
        yr[j+1]:=ty;
        re[j+1]:=tr;
      //按照始点编号从小到大的顺序（始点编号相同时，终点编号亦按照从小到大顺序）进行排序，
      //如有颠倒，进行两行之间的换行操作。nx,ny,tp,tv,ty,ty是中间变量。
      end;
      if (nr[j]=nr[j+1]) and (no[j]=no[j+1]) then
        showmessage('编号出错！请检查从始点'+inttostr(nr[j])+'到终点'+inttostr(no[j])+'的分枝！');
        //若出现两个分枝的始终点号都相同，则提示出错，要求检查，重新输入。
    end;
  end;
  for i:=1 to n do
  begin
    stringgrid2.cells[1,i]:=inttostr(nr[i]);
    stringgrid2.cells[2,i]:=inttostr(no[i]);
    stringgrid2.cells[3,i]:=floattostr(pb[i]);
    stringgrid2.cells[4,i]:=floattostr(vl[i]);
    stringgrid2.cells[5,i]:=inttostr(yr[i]);
    stringgrid2.cells[6,i]:=floattostr(re[i]);
    //排序后的数据显示在stringgrid2中。
  end;
  pagecontrol1.ActivePageIndex:=1;
  //将页面切换到stringgrid2所在的第二页上。
end;

procedure TForm1.Button2Click(Sender: TObject);    //校验操作，校验输入的始点终点编号和发生概率是否正确
var
  j,nt:integer;
  pp:real;
begin
  pp:=0;
  nt:=nr[1];
  for j:=1 to n do
  begin
    if nr[j]-nt>0 then
    begin
      if (abs(pp)<=0.00001) or (abs(pp-1)<=0.00001) then
      begin
        pp:=pb[j];
        nt:=nr[j];
        //当始点编号变大而pp=0或pp=1时认为该行校验正确。即同一始点的概率和为0或1。
      end
      else
      begin
        showmessage('发生概率出错，请检查从始点'+inttostr(nr[j-1])+'到终点'+inttostr(no[j-1])+'的分枝！');
        break;
        //当始点编号变大而pp!=0且pp!=1时认为该行发生概率校验出错。即同一始点的概率和不为0和1。
      end;
    end

    else if nr[j]-nt<0 then
    begin
      showmessage('始终点编号出错，请检查从始点'+inttostr(nr[j])+'到终点'+inttostr(no[j])+'的分枝！');
      break;
      //如果始点编号反而变小，说明出错。
    end

    else pp:=pp+pb[j];
    //如果仍是同一始点而且没有出错，那么概率继续迭加，直到同一始点的概率和为0或1。

    if (j=n) and (pp<>1) then  showmessage('发生概率出错，请检查从始点'+inttostr(nr[n])+'到终点'+inttostr(no[n])+'的分枝！');
    //判断终止条件。
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  pagecontrol1.ActivePageIndex:=0;
  //程序运行时，默认启动页面是页面一。
end;

procedure TForm1.Button6Click(Sender: TObject);     //处理求解。
var
  i,j,k,nt,jp:integer;
  pa,pv,sp:real;
label 1,2,3,4,5,6,7,8,9,10;
begin
  pa:=1;
  for i:=1 to n do
    if yr[i]>=1 then
    begin
      pv:=power(1+re[i],yr[i]);
      pa:=(pv-1)/(re[i]*pv);
      vl[i]:=vl[i]*pa*pv;
      //对非决策点，求出其新的vl值(即re[i]年的总回收现值)(公式e)。
    end;

  k:=1;
1:i:=n+1-k;
  if pb[i]<=0 then goto 4;  //对决策点，转向4。
  pv:=power(re[i]+1,yr[i]);
  sm[i]:=(sm[i]+vl[i])/pv;    //公式b
  sm[i]:=sm[i]*pb[i];      //期望值乘以概率
  j:=i;
2:j:=j-1;
  if j<=0 then goto 3;  //当循环终止时转向3
  if (nr[i]-no[j]<0) or (nr[i]-no[j]>0) then goto 2; //当i的始点号不等于j的终点号时，转向2。
3:sm[j]:=sm[j]+sm[i];  //期望效益值叠加。
  goto 9;
4:pv:=power(re[i]+1,yr[i]);
  sm[i]:=(sm[i]+vl[i])/pv;      //公式b
  sp:=sm[i];
  nt:=nr[i];
  jp:=i;
  //用sp,nt,jp记录决策点的临时最大值。
  j:=i;
5:j:=j-1;
  if j<=0 then goto 6;
  if nr[i]-nr[j]>0 then goto 6;
  if nr[i]-nr[j]<0 then
  begin
    showmessage('始终点编号出错，请检查从始点'+inttostr(nr[j])+'到终点'+inttostr(no[j])+'的分枝！');
 
  end;
  //求出该决策点其他的分支期望值。
  pv:=power(re[j]+1,yr[j]);
  sm[j]:=(sm[j]+vl[j])/pv;
  if sm[j]-sp<=0 then goto 5;
  sp:=sm[j];
  jp:=j;
  //如果该分枝期望值比记录的临时期望值更大，则将其作为新的临时期望值。
  goto 5;
6:pb[jp]:=-99;  //将确定的决策分支的概率定为－99。
  k:=n-j;
  if n-k<=0 then goto 10;
  j:=n+1-k;
7:j:=j-1;
  if j<=0 then goto 8;
  if (nt-no[j]<0) or (nt-no[j]>0) then goto 7;
8:sm[j]:=sm[j]+sp;  //决策点的期望值求法。
9:k:=k+1;
  if k<=n then goto 1;
10:for i:=1 to n do    //将最终决策表显示在stringgrid3中。
   begin
     if pb[i]>0 then
     begin
       stringgrid3.cells[1,i]:=inttostr(nr[i]);
       stringgrid3.cells[2,i]:=inttostr(no[i]);
       stringgrid3.cells[3,i]:=floattostr(pb[i]);
       stringgrid3.cells[4,i]:=inttostr(round(int(sm[i])));
       stringgrid3.cells[5,i]:=inttostr(yr[i]);
       stringgrid3.cells[6,i]:=floattostr(re[i]);
       //非决策点赋值。
     end
     else
     begin
       stringgrid3.cells[1,i]:=inttostr(nr[i]);
       stringgrid3.cells[2,i]:=inttostr(no[i]);
       stringgrid3.cells[3,i]:='决策';
       stringgrid3.cells[4,i]:=inttostr(round(int(sm[i])));
       stringgrid3.cells[5,i]:=inttostr(yr[i]);
       stringgrid3.cells[6,i]:=floattostr(re[i]);
       //决策点赋值。
     end;
   end;
   pagecontrol1.ActivePageIndex:=2;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  pagecontrol1.ActivePageIndex:=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i,j:integer;
begin
  memo1.Text:='';
  i:=0;
  for j:=1 to n do
    if pb[j]=-99 then
    begin
      i:=i+1;
      memo1.Text:=memo1.Text+'决策点'+inttostr(i)+'选择从'+inttostr(nr[j])+'到'+inttostr(no[j])+'的分枝,其费用期望值是'+inttostr(round(int(sm[j])))+'             ';
      //在memo1上用文字表达最优方案。
    end;
  pagecontrol1.ActivePageIndex:=3;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  pagecontrol1.ActivePageIndex:=0;
end;

end.