unit1.~pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ComCtrls;
const long=10;//定义常量控制数组长度
type
  TForm1 = class(TForm)
    Pgmain: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    GroupBox1: TGroupBox;
    Edit3: TEdit;
    Button2: TButton;
    BitBtn2: TBitBtn;
    GroupBox2: TGroupBox;
    TabSheet2: TTabSheet;
    Label9: TLabel;
    GroupBox3: TGroupBox;
    GroupBox5: TGroupBox;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    TabSheet3: TTabSheet;
    GroupBox4: TGroupBox;
    Label10: TLabel;
    Label11: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    GroupBox6: TGroupBox;
    BitBtn4: TBitBtn;
    Edit4: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Edit7: TEdit;
    Label8: TLabel;
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type  array1=array[1..long]  of  array[1..long] of tedit;
type  array2=array[1..long]  of  Tlabel;              //自定义两种类型，分别供输入数据和显示信息使用
var
  Form1: TForm1;

implementation
{$R *.dfm}
var n,m:integer;
    Cd,Cp,Cs,C,S,f3,f4:real;
    P,D:array[1..long] of real;
    shuru1:array1;   //edit
    shuru2:array2; //label
function  budengshi(k:integer):integer;         //判断是否满足求s的不等式 ,k为数组标号
var i:integer;
    f1,f2:real;
begin
  f1:=0; f2:=0;
  for i:=1 to k do
    f1:=f1+Cp*(D[k]-D[i])*P[i];
  for i:=k+1 to n do
    f2:=f2+Cs*(D[i]-D[k])*P[i];

  if C*D[k]+f1+f2<=Cd+C*S+f3+f4 then
    result:=1
  else
    result:=0;
end;


procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['1'..'9']) then          //拒绝非整数输入
    key:=chr(0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
for i:= 0 to pgMain.PageCount - 1 do
    pgMain.Pages[I].TabVisible := False;
  pgmain.ActivePageIndex:=0 ;
end;

procedure TForm1.Button2Click(Sender: TObject);   //生成n个Tedit输入框
var i,j:integer;

begin
  n:=0;
  if edit3.text<>'' then
            begin
               try
                 for i:=1 to n do
                   begin
                     shuru2[i].free;
                     for j:=1 to 2  do
                       shuru1[i,j].free;
                   end;
               finally
                 n:=0;
                 n:=strtoint(edit3.text);
                 if n>9 then
                   begin
                     showmessage('分布个数不能大于9！');
                     pgmain.ActivePageIndex:=0;
                   end
                 else
                   begin
                     for i:=1  to  n  do
                        for j:=1  to 2  do
                           begin
                              shuru1[i,j]:=tedit.Create(self);
                              shuru1[i,j].parent:=tabsheet2;
                              shuru1[i,j].Width:=62;
                              shuru1[i,j].Height:=24;
                              shuru1[i,j].left:=80+(j-1)*(shuru1[i,j].Width+80);  //90代表[1，1]离左边框的距离宽度，+80表示各edit框之间的左右距离
                              shuru1[i,j].top:=50+(i-1)*(shuru1[i,j].Height+2);

                              shuru2[i]:=Tlabel.Create(self);
                              shuru2[i].parent:=tabsheet2;
                              shuru2[i].Width:=40;
                              shuru2[i].Height:=24;
                              shuru2[i].left:=50;
                              shuru2[i].top:=54+(i-1)*(shuru2[i].Height+2);
                              shuru2[i].Caption:='D'+inttostr(i)+'='+'                                          P'+inttostr(i)+'=';
                            end;
                     pgmain.ActivePageIndex:=1;
                   end;
                 end;
            end;

end;

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

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

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

procedure TForm1.BitBtn1Click(Sender: TObject); //计算单元
var IH,P0,x,x1,x2,temp1,temp2,Q,ss,f:real;
    i,j,min:integer;

begin
  Cd:=StrTofloat(Edit1.Text);                //订货费
  Cp:=StrTofloat(Edit2.Text);                //存储费
  Cs:=StrTofloat(Edit4.Text);                //缺货费
  C:=StrTofloat(Edit5.Text);                 //单位货物的价格
  IH:=StrTofloat(Edit6.Text);                //初始库存量
  P0:=0;
  for i:=1  to  n  do
   begin
     D[i]:=strtofloat(shuru1[i,1].text);    //将需求量读入数组中
     P[i]:=strtofloat(shuru1[i,2].text);    //将各需求量所对应的概率读入到数组
     P0:=P0+P[i]; // P0=1?
   end;
  if abs(P0-1)>0.000001 then
    begin
      showmessage('输入的概率数据不合法！');
      exit;
    end
  else
     begin
       x:=(Cs-C)/(Cp+Cs);
       x1:=0;x2:=0;
      for i:=1 to n do
        begin
          min:=i;
          for j:=i+1 to n do
            if D[min]>D[j] then min:=j;
          temp1:=D[i];D[i]:=D[min];D[min]:=temp1;
          temp2:=P[i];P[i]:=P[min];P[min]:=temp2;      //保证P内的数据和D内的数据同步排序
        end;
      //此时的数组P和D已经是由小到大排序后的数组了
      for j:=1 to n-1 do           //注意这里计算的算法！有时候脑子不能太死
        begin
          x1:=x1+p[j];
          x2:=x1+p[j+1];
          if (x>x1) and (x<=x2) then
            begin
              S:=D[j+1];              //最优数量订货后达到的存储水平
              m:=j+1;    //记录S对应的数组标号，是下面比较的最大值
              break;
            end;
        end;
        Q:=S-IH;               //最佳订货量
        f3:=0; f4:=0;
        for i:=1 to m do
          f3:=f3+Cp*(S-D[i])*P[i];   //存储费用
        for i:=m+1 to n do
          f4:=f4+Cs*(D[i]-S)*P[i];   //缺货费用
        f:=Cd+C*Q+f3+f4;      //最小总费用
        edit8.Text:=formatfloat('0.###',Q);     //格式化输出结果
        edit9.Text:=formatfloat('0.###',f);
       //开始计算临界值
       for i:=1 to m do
         if budengshi(i)=1 then  ss:=D[i];  //赋初值
       for i:=1 to m do
         if budengshi(i)=1 then
           if D[i]<ss then  ss:=D[i];    //肯定有更好的算法!!    2004.3.31：那为什么当时不把更好的算法找出来呢？
     end;
       edit7.Text:=formatfloat('0.###',ss);
       label8.Caption:='存储策略为当存储I≤'+floattostr(ss)+'时补充存储使存储量达到'+floattostr(S)+'，'+#13+'当存储I>'+floattostr(ss)+'时不补充.';
       pgmain.ActivePageIndex:=2;
end;

end.