implement the Floyd-Warshall algorithm?
Autor: mohammad fami
Homepage: http://www.irdrugstore.org
// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// Floyd-Warshall algorithm - shortest path problem - Graph Theory
//
// Algorithmus von Floyd und Warshall - k ürzester Weg zwischen allen
// Paaren von Knoten eines gewichteten Graphen - Graphentheorie
//
// http://de.wikipedia.org/wiki/Algorithmus_von_Floyd_und_Warshall
// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, ExtCtrls;
type
typ = array [1..50,1..50] of Integer;
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
sg1: TStringGrid;
Button2: TButton;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button3: TButton;
i1: TImage;
sg2: TStringGrid;
Edit4: TEdit;
sg3: TStringGrid;
Label5: TLabel;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
public
procedure floyd2(n: Integer; w: typ; var d: typ; var p: typ);
procedure path(q: Integer; r: Integer);
procedure laa(teta: Integer; r: Integer; x: Integer; y: Integer; i1: TImage);
end;
var
Form1: TForm1;
w: typ;
d: typ;
p: typ;
n, cont: Integer;
v: array of Integer;
X, y: array of Integer;
implementation
procedure tform1.path(q: Integer; r: Integer);
begin
if not (p[q, r] = 0) then
begin
path(q, p[q, r]);
label4.Caption := label4.Caption + IntToStr(p[q, r]) + ',';
path(p[q, r], r);
end;
end;
procedure tform1.floyd2(n: Integer; w: typ; var d: typ; var p: typ);
var
i, j, k: Integer;
begin
for i := 1 to n do
for j := 1 to n do
p[i, j] := 0;
d := w;
for k := 1 to n do
for i := 1 to n do
for j := 1 to n do
begin
if (d[i, k] + d[k, j] < d[i, j]) then
begin
p[i, j] := k;
d[i, j] := d[i][k] + d[k][j];
end;
end;
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
s: string;
e: TEdit;
begin
Button3Click(Sender);
n := StrToInt(edit1.Text);
setlength(v, n);
for i := 1 to n do
for j := 1 to n do
w[i, j] := StrToInt(sg1.Cells[i, j]);
floyd2(n, w, d, p);
label4.Caption := edit2.Text + ',';
path(StrToInt(edit2.Text), StrToInt(edit3.Text));
Button3Click(Sender);
label4.Caption := label4.Caption + edit3.Text + '.';
s := label4.Caption;
i := 1;
label3.Caption := '';
cont := 0;
while not (s[i] = '.') do
begin
label3.Caption := s[i] + label3.Caption;
if s[i] = ',' then i := i + 1
else
begin
if cont <> 0 then
begin
i1.Canvas.MoveTo(x[cont], y[cont]);
i1.Canvas.LineTo(x[StrToInt(s[i])], y[StrToInt(s[i])]);
end;
cont := StrToInt(s[i]);
i := i + 1;
end;
end;
for i := 1 to n do
for j := 1 to n do
sg2.Cells[i, j] := IntToStr(p[i, j]);
for i := 1 to n do
for j := 1 to n do
sg3.Cells[i, j] := IntToStr(d[i, j]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, j: Integer;
begin
Button3Click(Sender);
sg1.Visible := True;
sg1.Cells[0,0] := 'W matris:';
sg1.RowCount := StrToInt(edit1.Text) + 1;
sg1.ColCount := StrToInt(edit1.Text) + 1;
sg2.Visible := True;
sg2.Cells[0,0] := 'Paths:';
sg2.RowCount := StrToInt(edit1.Text) + 1;
sg2.ColCount := StrToInt(edit1.Text) + 1;
sg3.Visible := True;
sg3.Cells[0,0] := 'D Matris:';
sg3.RowCount := StrToInt(edit1.Text) + 1;
sg3.ColCount := StrToInt(edit1.Text) + 1;
for i := 1 to StrToInt(edit1.Text) + 1 do
begin
sg1.Cells[0,i] := IntToStr(i);
sg1.Cells[i, 0] := IntToStr(i);
sg2.Cells[0,i] := IntToStr(i);
sg2.Cells[i, 0] := IntToStr(i);
sg3.Cells[0,i] := IntToStr(i);
sg3.Cells[i, 0] := IntToStr(i);
end;
for i := 1 to StrToInt(edit1.Text) + 1 do
begin
for j := 1 to StrToInt(edit1.Text) + 1 do
begin
sg1.Cells[i, j] := IntToStr(Random(19) + 1);
if i = j then sg1.Cells[i, j] := '0';
end;
end;
//sg1.Width:=(strtoint(edit1.Text)+3)*sg1.ColWidths[0];
//sg1.Height:=(strtoint(edit1.Text)+3)*sg1.RowHeights[0];
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i, j, k, l, r, rt: Integer;
centerx, centery: Integer;
rad, teta, alfax: Integer;
alfa: Extended;
a, b: TPoint;
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;
rt := 10;//pointer
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 not (w[i, j] = 0) then
begin
if i = j then
begin
i1.Canvas.Pen.Color := clred;
i1.Canvas.Brush.Style := bsClear;
l := y[i];
k := x[i];
i1.Canvas.Pie(k, l, k + 6 * r, l + 6 * r, 1,1,1,1);
//loop
end;
if (i <> j) and (w[i, j] <> StrToInt(edit4.Text)) then
begin
i1.Canvas.Pen.Color := clblue;
i1.Canvas.Pen.Width := 1;
i1.Canvas.MoveTo(x[i], y[i]);
i1.Canvas.LineTo(x[j], y[j]);
// i1.Canvas.Chord();
end;
i1.Canvas.Pen.Width := 2;
{ if i<j then begin
if (y[i]-y[j])<>0 then alfa:=ArcTan((X[i]-x[j])/(y[j]-y[i])) else alfa:=pi/2;
if x[i]>x[j] then alfax:=round((180/Pi)*alfa+90);
if (x[i]<x[j]) and (y[i]<y[j]) then alfax:=90-round((180/Pi)*alfa);
if (x[i]<x[j]) and (y[i]>y[j]) then alfax:=270+round((180/Pi)*alfa);
l:=x[j];k:=y[j];
laa(alfax,10,l,k,i1);
end;
if i>j then begin
if (y[i]-y[j])<>0 then alfa:=ArcTan((X[i]-x[j])/(y[j]-y[i])) else alfa:=pi/2;
if x[i]>x[j] then alfax:=round((180/Pi)*alfa+90);
if (x[i]<x[j]) and (y[i]<y[j]) then alfax:=90-round((180/Pi)*alfa);
if (x[i]<x[j]) and (y[i]>y[j]) then alfax:=270+round((180/Pi)*alfa);
l:=x[i];k:=y[i];
laa(alfax,10,l,k,i1);
end;}
end;
end;
end;
procedure tform1.laa(teta: Integer; r: Integer; x: Integer; y: Integer; i1: TImage);
var
tetap: Extended;
begin
teta := teta mod 360;
tetap := (pi / 180) * (teta);
tetap := (pi / 180) * (teta - 30);
i1.Canvas.MoveTo(x - round(r * sin(tetap)), y - round(r * cos(tetap)));
i1.Canvas.LineTo(x, y);
tetap := (pi / 180) * (teta + 30);
i1.Canvas.MoveTo(x - round(r * sin(tetap)), y - round(r * cos(tetap)));
i1.Canvas.LineTo(x, y);
{end;
if (teta<=180) and (teta>=90) then begin
tetap:=(pi/180)*(teta-30);
i1.Canvas.MoveTo(x-round(r*cos(tetap)),y-round(r*sin(tetap)));
i1.Canvas.LineTo(x,y);
tetap:=(pi/180)*(teta+30);
i1.Canvas.MoveTo(x-round(r*cos(tetap)),y-round(r*sin(tetap)));
i1.Canvas.LineTo(x,y);
end;
if (teta<=270) and (teta>=180) then begin
tetap:=(pi/180)*(teta-30);
i1.Canvas.MoveTo(x+round(r*sin(tetap)),y+round(r*cos(tetap)));
i1.Canvas.LineTo(x,y);
tetap:=(pi/180)*(teta+30);
i1.Canvas.MoveTo(x+round(r*sin(tetap)),y+round(r*cos(tetap)));
i1.Canvas.LineTo(x,y);
end;
if (teta<=360) and (teta>=270) then begin
tetap:=(pi/180)*(teta-30);
i1.Canvas.MoveTo(x+round(r*cos(tetap)),y+round(r*sin(tetap)));
i1.Canvas.LineTo(x,y);
tetap:=(pi/180)*(teta+30);
i1.Canvas.MoveTo(x+round(r*cos(tetap)),y+round(r*sin(tetap)));
i1.Canvas.LineTo(x,y);
end;
}
end;
procedure TForm1.Button4Click(Sender: TObject);
var
i: Integer;
begin
for i := 1 to 360 do
begin
laa(i, 10,100,100,i1);
ShowMessage(IntToStr(i));
end;
end;
end.