largeu.pas

运筹学演示程序之运输问题

unit LargeU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, Spin, ExtCtrls, ComCtrls, BasicU, LstepU;

type
  rclarge=record
    data_type:byte;
      // data_type : 1 -> 演示数据   2 -> 小规模问题   3 -> 大规模问题
      //             4 -> 迭代中数据  5 -> 最终结果(小)  6 -> 最终结果(大)
    pc,sc:integer;
    produce,sale:array [0..99] of real;
    c,ma1:array [0..99,0..99] of real;
  end;
  TLargeForm = class(TForm)
    Panel1: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Grid: TStringGrid;
    Button1: TButton;
    Panel2: TPanel;
    Label18: TLabel;
    Button8: TButton;
    Button10: TButton;
    Panel6: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button12: TButton;
    Button13: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    biaozhi: TLabel;
    Button14: TButton;
    SaveStep: TSaveDialog;
    Label4: TLabel;
    gridstep: TStringGrid;
    Panel3: TPanel;
    Label7: TLabel;
    Image1: TImage;
    Image2: TImage;
    Label8: TLabel;
    Edit1: TEdit;
    Button2: TButton;
    Button16: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Panel1DblClick(Sender: TObject);
    procedure Button16Click(Sender: TObject);
  private
    { Private declarations }
    c,ma1:matrix;
    pc,sc:byte;
    produce,sale:array of real;
    procedure do_balance;
    procedure do_cal;
    procedure stepdraw;
    function getfilename:string;
  public
    { Public declarations }
    filename:string;
  end;

var
  LargeForm: TLargeForm;

implementation

uses Main;

{$R *.DFM}
const
  max=100;      // 产、销地最多数目
var
  f:file of rclarge;
  rec:rclarge;

procedure TLargeForm.FormCreate(Sender: TObject);
var i:byte;
begin
  with grid do
  begin
    cells[0,0]:='产＼销';
    for i:=1 to 8 do
    begin
      cells[i,0]:=inttostr(i);
      cells[0,i]:=inttostr(i);
    end;
    cells[0,9]:='销量Bi';
    cells[9,0]:='产量Ai';
  end;
end;

function get_input:boolean;
var x,y:byte;
    i,j:byte;
    have_error:boolean;
begin
  with largeform do
  begin
    x:=spinedit2.Value;
    y:=spinedit1.value;
    have_error:=false;
    try
      for i:=1 to x do for j:=1 to y do
       begin
         if (grid.cells[i,j]='') then
         begin
           grid.cells[i,j]:='0';
           c[j-1,i-1]:=0;
         end
         else
           c[j-1,i-1]:=strtofloat(grid.cells[i,j]);
       end;
      for i:=1 to x do
      begin
         if (grid.cells[i,y+1]='') then
         begin
           grid.cells[i,y+1]:='0';
           sale[i-1]:=0;
         end
         else
           sale[i-1]:=strtofloat(grid.cells[i,y+1]);
      end;
      for j:=1 to y do
      begin
         if (grid.cells[x+1,j]='') then
         begin
           grid.cells[x+1,j]:='0';
           produce[j-1]:=0;
         end
         else
           produce[j-1]:=strtofloat(grid.cells[x+1,j]);
      end;
    except
      messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
      have_error:=true;
    end;
    result:=have_error;
  end;
end;

procedure TLargeForm.stepdraw;
var i,j:byte;
begin
    gridstep.colcount:=sc+1;
    gridstep.rowcount:=pc+1;
    gridstep.cells[0,0]:='产＼销';
{
    for i:=1 to sc do
      gridstep.cells[i,0]:=floattostr(sale[i-1]);
    for j:=1 to pc do
      gridstep.cells[0,j]:=floattostr(produce[j-1]);
}
    for i:=1 to sc do
      gridstep.cells[i,0]:='销地'+floattostr(i);
    for j:=1 to pc do
      gridstep.cells[0,j]:='产地'+floattostr(j);
end;

function check_input:byte;
                        //1->  无问题
                        //2->  产销不平衡
                        //3->  输入有误
var i,j:byte;
    x,y:byte;
    pcount,scount:real;
    have_error:byte;
begin
  with largeform do
  begin
    x:=spinedit2.Value;
    y:=spinedit1.value;
  end;
  have_error:=1;
  pcount:=0;
  scount:=0;
  try
    for i:=1 to x do
    begin
       if (largeform.grid.cells[i,y+1]<>'') then
         scount:=scount+strtofloat(largeform.grid.cells[i,y+1]);
    end;
    for j:=1 to y do
    begin
       if (largeform.grid.cells[x+1,j]<>'') then
         pcount:=pcount+strtofloat(largeform.grid.cells[x+1,j]);
    end;
    if (scount<>pcount) then have_error:=2;
  except
    have_error:=3;
  end;
  result:=have_error;
end;

procedure TLargeForm.do_balance;
var i,j,k:byte;
    x,y:byte;
    pcount,scount:real;
begin
  messagedlg('产销不平衡，先增加虚拟点。',mtinformation,[mbok],0);
  x:=spinedit2.Value;  //  sc
  y:=spinedit1.value;  //  pc
  pcount:=0;
  scount:=0;
  try
    for i:=1 to x do
      begin
       if (grid.cells[i,y+1]<>'') then
         scount:=scount+strtofloat(largeform.grid.cells[i,y+1]);
      end;
    for j:=1 to y do
      begin
       if (grid.cells[x+1,j]<>'') then
         pcount:=pcount+strtofloat(largeform.grid.cells[x+1,j]);
      end;
    if (scount>pcount) then
    begin
      if (y>=max) then
         messagedlg('由于产地数已达到了'+inttostr(max)+'个，无法再增加虚发点。',
                              mterror,[mbok],0)
      else
      begin
        y:=y+1;  spinedit1.value:=y;
        with grid do
        begin
          rowcount:=y+2;
          cells[0,y]:=inttostr(y);
          cells[0,y+1]:='销量Bi';
          for k:=1 to x do
          begin
            cells[k,y+1]:=cells[k,y];
            cells[k,y]:='0';
          end;
          cells[x+1,y]:=floattostr(scount-pcount);
        end;
      end;
    end
    else if (scount<pcount) then
    begin
       if (x>=max) then
         messagedlg('由于销地数已达到了'+inttostr(max)+'个，无法再增加虚收点。',
                      mterror,[mbok],0)
       else
       begin
        x:=x+1;  spinedit2.value:=x;
        with grid do
        begin
          colcount:=x+2;
          cells[x,0]:=inttostr(x);
          cells[x+1,0]:='产量Ai';
          for k:=1 to y do
          begin
            cells[x+1,k]:=cells[x,k];
            cells[x,k]:='0';
          end;
          cells[x,y+1]:=floattostr(pcount-scount);
        end;
       end;
    end;
  except
    messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
  end;
end;

procedure TLargeForm.do_cal;
var i,j:integer;
  rc:real;
begin
   panel3.visible:=true;
   panel3.Refresh;
   label7.caption:='正在寻找初始可行解 . . .';
   label7.refresh;
   xbj_init(pc,sc,produce,sale,ma1);
   label7.caption:='迭代初始化 . . .';
   label7.refresh;
   large_init(pc,sc,ma1);
   rc:=large_step(pc,sc,produce,sale,c,ma1,image1,image2,label7);
   edit1.text:=floattostr(rc);
   for i:=1 to pc do for j:=1 to sc do
    if (ma1[i-1,j-1]>0) then
      gridstep.cells[j,i]:=floattostr(ma1[i-1,j-1])
    else
      gridstep.cells[j,i]:='0';
   gridstep.refresh;
end;

procedure TLargeForm.Button1Click(Sender: TObject);