kruskal.~pas

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

unit Kruskal;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    CheckBox2: TCheckBox;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Panel2: TPanel;
    BitBtn2: TBitBtn;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
var lieshu,lieshu2,M,N:integer;
var matrix,edit:array of array of TEdit;
var XX:array[1..999]of real;
var C,B,A:array[1..999,1..999]of real;
implementation

{$R *.dfm}



procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 CheckBox2.Checked:=CheckBox1.Checked=False;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
 CheckBox1.Checked:=CheckBox2.Checked=False;
 showmessage('不能选有向图');
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var i,j:integer;
begin
  Label3.Caption:='输　　　入　　　矩　　　阵';
  Label4.Caption:='最　小　支　撑　树';
  Label5.Caption:='边的长度：';
  Label6.Caption:='边顶点号1：';
  Label7.Caption:='边顶点号2：';
  Label8.Caption:='边的长度：';
  Label9.Caption:='边顶点号1：';
  Label10.Caption:='边顶点号2：';
  N:=StrToInt(Edit2.Text);
  M:=StrToInt(Edit1.Text)-1;
//创建边的长度、节点名称输入编辑框
  if m<1 then  showmessage('节点的数目不能小于2');
  if N<1 then showmessage('边的数目不能为零');
  if edit<>nil then
    for i:=0 to 2 do
      for j:=0 to lieshu-1 do
        edit[i,j].Free;
  lieshu:=N;
  SETLength(edit,3);
  for i:=low(edit) to high(edit) do
    SETLength(edit[i],lieshu);
  for i:=low(edit) to high(edit) do
     for j:=0 to lieshu-1 do
       begin
         edit[i,j]:=TEdit.CreaTE(SElf);
         with edit[i,j] do
           begin
              Parent:=Panel2;
              Width:=48;
              Height:=35;
              left:=110+j*50;
              top:=70+i*40;
           end;
       end;
//创建最小支撑树边的长度、节点名称输出编辑框
  if matrix<>nil then
    for i:=0 to 2 do
      for j:=0 to lieshu2-1 do
        matrix[i,j].Free;
  lieshu2:=M;
  SETLength(matrix,3);
  for i:=low(matrix) to high(matrix) do
    SETLength(matrix[i],lieshu2);
  for i:=low(matrix) to high(matrix) do
     for j:=0 to lieshu2-1 do
       begin
         matrix[i,j]:=TEdit.CreaTE(SElf);
         with matrix[i,j] do
           begin
              Parent:=Panel2;
              Width:=48;
              Height:=35;
              left:=110+j*50;
              top:=250+i*40;
           end;
       end;

end;

procedure TForm1.Edit1Change(Sender: TObject);

begin
  M:=StrToInt(Edit1.Text)-1;
  if m<1 then  showmessage('节点的数目不能小于2');
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  N:=StrToInt(Edit2.Text);
  if N<1 then showmessage('边的数目不能为零');
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var h,p,flag1,flag2,M2,nn,KP,JS,L,j1,i,ii,kk,KI,j,k:integer;
var  X,C2,C3,Y:real;

label 1;
label 2;
label 3;

label 4;
begin
  for i:=0 to 2 do
    for j:=0 to n-1 do
      A[i+1,j+1]:=StrToFloat(edit[i,j].Text );

  L:=1;
  M2:=3;
  for i:=1 to m2 do
  xx[i]:=0;
  NN:=N-1;
  for J1:=1 to NN do
    begin
      y:=A[L,j1];
      JS:=J1+1;
      k:=j1;

      for j:=JS to N do
        begin
          if A[L,j]-Y<0 then
            begin
              Y:=A[L,j];
              K:=j;
            end;
        end;
        if K<>j1 then
           begin
             for i:=1 to m2 do
               XX[i]:=A[i,k];
             for i:=1 to m2 do
               A[i,k]:=A[i,j1];
             for i:=1 to m2 do
               A[i,j1]:=XX[i];
           end;
    end;
  for k:=1 to n do
    begin
      C[1,k]:=A[2,K];
      C[2,K]:=A[3,k];
    end;
  KP:=3;
  for i:=1 to m2 do
    for j:=1 to m do
      B[i,j]:=A[i,j];
  for i:=3 to n do
    begin
      flag1:=0;
      flag2:=0;
      for j:=1 to i do
        if A[2,i]=A[2,j] then flag1:=flag1+1;
      for k:=1 to i do
        if A[2,i]=A[3,k] then flag2:=flag2+1;
      for h:=1 to i do
        if A[3,i]=A[2,h] then flag1:=flag1+1;
      for P:=1 to i do
        if A[3,i]=A[3,P] then flag2:=flag2+1;
      if (flag1<=3) and (flag2<=3) then
        begin
          B[i,1]:=A[i,1];
          B[i,2]:=A[i,2];
          B[i,3]:=A[i,3];
          if kp=m then goto 4;
          KP:=KP+1;
      end;
    end;
4: for i:=0 to 2 do
    for j:=0 to  m-1 do
      matrix[i,j].Text:=FloatToStr(B[I+1,j+1]); 
end;

end.