// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// 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.
|
