implement Prim's algorithm?  

Autor: mohammad fami  

Homepage: http://www.irdrugstore.org

http://www.swissdelphicenter.ch/en/showcode.php?id=2396

图论中的最小生成树算法，不过有BUG，没有修正

// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

// Algorithmus von Prim - Spannbaum - Graphentheorie

// Prim's algorithm - Minimum spanning tree - Graph Theory

// http://en.wikipedia.org/wiki/Prim's_algorithm

// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

unit prim;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls, Grids, ExtCtrls;

type

 TForm1 = class(TForm)

   sg1: TStringGrid;

   Edit1: TEdit;

   Button1: TButton;

   Button2: TButton;

   i1: TImage;

   Button4: TButton;

   i2: TImage;

   Label1: TLabel;

   Label2: TLabel;

   Label3: TLabel;

   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);

   procedure Button3Click(Sender: TObject);

   procedure Button4Click(Sender: TObject);

 private

   { Private declarations }

 public

   procedure prim(n: Integer);

   procedure showgraph(i1: TImage);

 end;

var

 Form1: TForm1;

 w: array [1..5,1..5] of Integer;

 f, nearest, distance, t: array [2..5] of Integer;

 n: Integer;

 x, y: array of Integer;

implementation

procedure tform1.prim(n: Integer);

var

 ss, l, i, vnear, min, e, k, c, j: Integer;

begin

 // for i:=0 to 100 do f[i]:=0;//f=null

 for i := 2 to n do

 begin

   nearest[i]  := 1;

   distance[i] := w[1,i];

 end;

 i1.Canvas.MoveTo(x[1], y[1]);

 k := 0;

 c := 2;

 j := 1;

 for k := 1 to n - 1 do

 begin

   min := 1000;

   for i := 2 to n do

     if (distance[i] >= 0) and (min > distance[i]) then

     begin

       min   := distance[i];

       vnear := i;

     end;

   e := w[vnear, nearest[vnear]];

   i1.Canvas.Pen.Color := clred;

   i1.Canvas.LineTo(x[vnear], y[vnear]);

   ss := 0;

   for i := 1 to n do if (w[i, vnear] = e) then

     begin

       j  := i;

       ss := ss + 1;

     end;

   if Ss > 1 then j := vnear;

   i1.Canvas.MoveTo(x[j], y[j]);

   //move to vnear

   //search nearet junction

   //move to last

   f[c] := e;

   c    := c + 1;

   distance[vnear] := -1;

 {

 t[2*j]:=vnear;

 t[(2*j)+1]:=nearest[vnear];}

   //  j:=j+1;

   for i := 2 to n do if w[i, vnear] < distance[i] then

     begin

       distance[i] := w[i, vnear];

       nearest[i]  := vnear;

     end;

 end;//k

end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

 i, j: Integer;

begin

 n := StrToInt(edit1.Text);

 sg1.RowCount := n + 1;

 sg1.ColCount := n + 1;

 for i := 1 to StrToInt(edit1.Text) + 1 do

 begin

   sg1.Cells[0,i]  := IntToStr(i);

   sg1.Cells[i, 0] := IntToStr(i);

 end;

 for i := 1 to n do

 begin

   for j := 1 to n do

   begin

     sg1.Cells[i, j]  := IntToStr(Random(19) + 1);

     sg1.ColWidths[i] := 50;

     if i = j then sg1.Cells[i, j] := '0';

   end;

 end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

 i, j: Integer;

begin

{w[1,2]:=1;

w[1,3]:=3;

w[1,4]:=1000;

w[1,5]:=1000;

w[2,1]:=1;

w[2,3]:=3;

w[2,4]:=6;

w[2,5]:=1000;

w[3,1]:=3;

w[3,2]:=3;

w[3,4]:=4;

w[3,5]:=2;

w[4,1]:=1000;

w[4,2]:=6;

w[4,3]:=4;

w[4,5]:=5;

w[5,1]:=1000;

w[5,2]:=1000;

w[5,3]:=2;

w[5,4]:=5;

}

 for i := 1 to n do

   for j := 1 to n do

     w[i, j] := StrToInt(sg1.Cells[j, i]);

end;

procedure tform1.showgraph(i1: TImage);

var

 l, j, k, r, i, centerx, teta, rad, centery: Integer;

begin

 i1.Canvas.Brush.Style := bsSolid;

 //n:=strtoint(edit1.Text);

 setlength(x, n + 1);

 setlength(y, n + 1);

 centery := i1.Width div 2;

 centerx := i1.Height div 2;

 rad     := centerx - 20;

 teta    := 360 div n;

 i1.Canvas.Rectangle(0,0,i1.Width, i1.Height);

 i1.Canvas.Pen.Color := clgreen;

 i1.Canvas.Pen.Width := 3;

 for i := 1 to n do

 begin

   Y[i] := centerx + trunc(rad * sin(teta * i * ((2 * 3.14) / 360)));

   X[i] := centery + trunc(rad * cos(teta * i * ((2 * 3.14) / 360)));

   l    := y[i];

   k    := x[i];

   r    := 3;

   i1.Canvas.Pie(k - r, l - r, k + r, l + r, 1,1,1,1);

 end;

 i1.Canvas.Pen.Width := 1;

 for i := 1 to n do

   for j := 1 to n do

   begin

     if (w[i, j] >= 0) and (w[i, j] <> 1000) then

     begin

       i1.Canvas.MoveTo(x[i], y[i]);

       i1.Canvas.LineTo(x[j], y[j]);

     end;

   end;

 i1.Canvas.Pen.Width := 3;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

 showgraph(i1);

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

 Button2Click(Sender);

 showgraph(i1);

 showgraph(i2);

 prim(n);

end;

end.