unit1.pas

最小生成树程序。使用克鲁斯卡尔(Kruskal)算法

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    procedure input;
    function find(v:integer):integer;
    procedure sort;
    procedure kruskal;
    procedure output;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  points=set of 0..9;
type
  road=Record
    v1,v2,len:integer;
    select:boolean;
  end;
var
  Form1: TForm1;
  vset:array of points;//连通向量集合
  e:array of road;//边
  enum:integer;//边个数
  n:integer;//顶点个数
  weight:array of array of integer;//权值矩阵
  tot:integer;//权值之和

implementation

{$R *.dfm}
uses math;

procedure TForm1.input;
var
str,substr:string;
i,j,sign:integer;
begin
n:=strtoint(edit1.Text);
setlength(weight,n,n);
setlength(vset,n);
for i:=0 to n-1 do
begin
str:=memo1.Lines[i];
for j:=0 to i do
begin
sign:=pos(',',str);
if (sign=0) then sign:=length(str)+1;
substr:=copy(str,1,sign-1);
weight[i,j]:=strtoint(substr);
substr:='';
delete(str,1,sign);
end;
end;
enum:=0;
for i:=0 to n-1 do
for j:=0 to i do
begin
if (weight[i,j]<>0) then
enum:=enum+1;
end;
setlength(e,enum);
enum:=0;
for i:=0 to n-1 do
for j:=0 to i do
begin
if (weight[i,j]<>0) then
begin
//
//memo2.Lines.Add(' '+inttostr(i)+' '+inttostr(j)+' '+inttostr(weight[i,j]));
e[enum].len:=weight[i,j];
e[enum].v1:=i;
e[enum].v2:=j;
//
//memo2.Lines.Add(' '+inttostr(e[enum].v1)+' '+inttostr(e[enum].v2)+' '+inttostr(weight[i,j]));
e[enum].select:=false;
enum:=enum+1;
end;
end;
end;

//按权值递增顺序删去图中的边，若不形成回路则将此边加入最小生成树。
function TForm1.find(v:integer):integer; {返回顶点v所在的集合}
  var
  i:integer;
  begin
    for i:=1 to n do
    if (v in vset[i-1])
    then find:=i;
  end;

procedure TForm1.sort;//按边的权值从小到大排序
var
  temp:road;
  i,j:integer;
  flag:boolean;
begin
  i:=1;
  repeat
    flag:=true;
    for j:=0 to enum-1-i do
      if e[j].len>e[j+1].len
      then begin
             temp:=e[j];
             e[j]:=e[j+1];
             e[j+1]:=temp;
             flag:=false;
           end;
      i:=i+1;
    until flag;
end;

procedure TForm1.kruskal;
  var
    i,j:integer;
    p,q:integer;
  begin
    for i:=0 to n-1 do vset[i]:=[i];
    {初始化定义n个集合，第I个集合包含一个元素I}
     p:=enum; q:=0;tot:=0;
    {p为尚待加入的边数，q为边集指针}
     sort;
    {对所有边按权值递增排序，存于e[I]中，
    e[I].v1与e[I].v2为边I所连接的两个顶点的序号，e[I].len为第I条边的长度}
    while p>0 do begin
      i:=find(e[q].v1)-1;
      j:=find(e[q].v2)-1;
      if i<>j then begin
        inc(tot,e[q].len);
        e[q].select:=true;
        vset[i]:=vset[i]+vset[j];
        vset[j]:=[];
      end;
        dec(p);
      inc(q);
    end;
  end;

procedure TForm1.output;
var
i:integer;
begin
memo2.Clear;
memo2.Lines.Add('最小生成树由以下顶点间的边组成：');
for i:=0 to enum-1 do
if (e[i].select)
then
     begin
     memo2.Lines.Add('('+inttostr(e[i].v1)+','+inttostr(e[i].v2)+')'+' '+' '+'  权值:'+inttostr(e[i].len));
     end;
     memo2.Lines.Add('最小生成树权值之和为：'+inttostr(tot));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
input;
kruskal;
output;
end;

end.