SRL Archive - Delphi/FPC Help and Tutorials

Graph maker.


mastaraymond

2008-10-11 11:10:26

Kinda was bored yesterday day so I decided to make this little program. With this program you can make some basic graphs and execute the "Shortest pad algorithm" by Dijkstra. Kinda made my OOP lay-out.

Left click on the white image to make a new "node".
Right click on the white image to delete a node.
Hold ctrl + left click will allow you to draw a connection between two nodes. (First ctrl + left click one node then the other).

Generate random graph should generate a nice graph, which you can use to execute the Dijkstra algorithm on :).

I've attached the program in this post,

~Raym0nd.


Explain algorithm:
http://en.wikipedia.org/wiki/Dijkstra's_algorithm

EDIT: Be sure to take a look at the script I posted few posts below, might be useful.

nielsie95

2008-10-11 12:38:22

Nice :)

mastaraymond

2008-10-11 17:42:52

Alright, ported the code to scar. Attached it.

Bobarkinator

2008-10-13 23:38:57

From: mastaraymond
Alright, ported the code to scar. Attached it.


After reading the Wikipedia page, you're right, this is exactly what we need.

n3ss3s

2008-10-21 11:29:28

Bob, don't work on any walker stuff pls, I'm almost finished with mine :p

mastaraymond

2008-10-21 16:35:57

From: n3ss3s
Bob, don't work on any walker stuff pls, I'm almost finished with mine :p

Finished your idea..
It was a PAIN in the ass to make, so you better make a awesome walker from it.


program Hoi;


type
TTpaNode = record
x,y : integer;
Last : integer;
HasBeenChecked : Boolean;
Distance : LongWord;
Roads : Array[0..7] of integer;
RoadExists : Array[0..7] of Boolean;
end;
{Tiles next to eachother x-x dist is 169
Tiles cross to eacother x dist is 239
\
x
}
{const
NW = 0;
W = 1;
SW = 2;
S = 3;
SE = 4;
E = 5;
NE = 6;
N = 7; }

Function PointToStr(PT : TPoint) : String;
begin;
Result := '(' + inttostr(PT.x) + ', ' + inttostr(pt.y) + ')';
end;

function ReverseArr(Arr : TPointArray) : TPointArray;
var
i,l : integer;
begin;
l := high(arr);
Setlength(result,l+1);
for i := 0 to l do
Result[i] := Arr[l-i];
end;
procedure AddToTPA(var TPA : TPointArray; PT : TPoint);
var
x : integer;
begin;
x := Length(TPA);
SetLengtH(TPA,x + 1);
TPA[x] := pt;
end;
Function FilterRandomTPA( TPA : TPointArray) : TPointArray;
var
I : integer;
begin;
AddToTPA(Result,Point(0,0));
for i := 1 to High(TPA) - 1 do
if random(2) <> 0 then
AddToTPA(Result,Point(TPA[i].x,TPA[i].y));
AddToTPA(Result,TPA[High(TPA)]);

end;
Function ShortestRoute(Point1,Point2 : integer; TPA : TPointArray) : TPointArray;
var
I,L,W,H,x,y: integer;
Grid : Array of Array of Integer;
Nodes : Array of TTpaNode;
TempDist : LongWord;
StartNode, EndNode : integer;
Pt1,Pt2 : TPoint;
uNode : Integer;
TempNodeCount,NodeCount : integer;
Box : TBox;
Str : String;
begin;
Box := GetTPABounds(TPA);
SetLength(Grid, box.x2 - Box.x1 + 1);
w := Box.x2 - Box.x1;
h := Box.y2 - Box.y1 + 1;
for i := 0 to w do
SetLength(Grid[i], h);
h := Box.y2 - Box.y1;
l := High(TPA);
NodeCount := (w + 1) * (H + 1);
SetLength(Nodes,l + 1);
for i := 0 to l do
Grid[TPA[i].x - Box.x1][TPA[i].y - Box.y1] := i + 1;
pt1 := Point( TPA[Point1].x - Box.x1, TPA[Point1].y - Box.y1);
pt2 := Point( TPA[Point2].x - Box.x1, TPA[Point2].y - Box.y1);
i := -1;
for y := 0 to h do
begin;
str := '';
for x := 0 to w do
if Grid[x][y] < 1 then
Str := Str + '-'
else
Str := Str + 'x';
Writeln(str);

end;
for i := 0 to l do
begin;
Nodes[i].x := TPA[i].x;
Nodes[i].y := TPA[i].y;
Nodes[i].Last := -1;
Nodes[i].Distance :=2147483647;
if (TPA[i].x = Pt1.x) and (TPA[i].y = pt1.y) then
StartNode := i
else if (TPA[i].x = pt2.x) and (TPA[i].y = pt2.y) then
EndNode := i;
if (TPA[i].x > 0) and (TPA[i].y > 0) then
begin;
Nodes[i].Roads[0] := Grid[TPA[i].x-1][TPA[i].y-1] - 1;//(x-1) + (y-1) *WPlus;
Nodes[i].RoadExists[0] := Grid[TPA[i].x-1][TPA[i].y-1] >= 1;
end;
if (TPA[i].x > 0) then
begin;
Nodes[i].Roads[1] := Grid[TPA[i].x-1][TPA[i].y] - 1; //Nodes[i].Roads[1] := Grid[x-1][y];
Nodes[i].RoadExists[1] := Grid[TPA[i].x-1][TPA[i].y]>= 1;;
end;
if (TPA[i].x > 0) and (TPA[i].y < h) then
begin;
Nodes[i].Roads[2] := Grid[TPA[i].x-1][TPA[i].y+1]- 1; //Nodes[i].Roads[2] := Grid[x-1][y+1];
Nodes[i].RoadExists[2] := Grid[TPA[i].x-1][TPA[i].y+1]>= 1;;
end;
if (TPA[i].y < h) then
begin;
Nodes[i].Roads[3] := Grid[TPA[i].x][TPA[i].y+1]- 1; //Nodes[i].Roads[3] := Grid[x][y+1];
Nodes[i].RoadExists[3] := Grid[TPA[i].x][TPA[i].y+1]>= 1;;
end;
if (TPA[i].x < w) and (TPA[i].y < h) then
begin;
Nodes[i].Roads[4] :=Grid[TPA[i].x + 1][TPA[i].y + 1]- 1; //Nodes[i].Roads[4] := Grid[x + 1][y + 1];
Nodes[i].RoadExists[4] := Grid[TPA[i].x + 1][TPA[i].y + 1]>= 1;;
end;
if (TPA[i].x < w) then
begin;
Nodes[i].Roads[5] := Grid[TPA[i].x + 1][TPA[i].y]- 1; //Nodes[i].Roads[5] := Grid[x + 1][y];
Nodes[i].RoadExists[5] := Grid[TPA[i].x + 1][TPA[i].y]>= 1;;
end;
if (TPA[i].x < w) and (TPA[i].y > 0) then
begin;
Nodes[i].Roads[6] := Grid[TPA[i].x + 1][TPA[i].y - 1]- 1; // Nodes[i].Roads[6] := Grid[x + 1][y - 1];
Nodes[i].RoadExists[6] := Grid[TPA[i].x + 1][TPA[i].y - 1]>= 1;;
end;
if (TPA[i].y > 0) then
begin;
Nodes[i].Roads[7] :=Grid[TPA[i].x][TPA[i].y-1]- 1; //Nodes[i].Roads[7] := Grid[x][y-1];
Nodes[i].RoadExists[7] := Grid[TPA[i].x][TPA[i].y-1]>= 1;;
end;
end;
Nodes[StartNode].Distance := 0;
TempNodeCount :=l;
While TempNodeCount > 0 do
begin;
TempDist := 2147483647;
for i := 0 to l do
if (Nodes[i].HasBeenChecked = false) then
begin;
if NOdes[i].Distance < TempDist then
begin;
TempDist := Nodes[i].Distance;
uNode := i;
end;
end;
if TempDist = 2147483647 then
Break;
// Writeln(PointToStr(Point(Nodes[uNode].x,Nodes[uNode].y)));
Nodes[uNode].HasBeenChecked := True;
for i := 0 to 7 do
if Nodes[uNode].RoadExists[i] then
if (Nodes[Nodes[uNode].Roads[i]].HasBeenChecked = false) then
begin;
{Tiles next to eachother x-x dist is 169
Tiles cross to eacother x dist is 239
\
x
}
case i of
0,2,4,6 : TempDist := Nodes[uNode].Distance + 239;
1,3,5,7 : TempDist := Nodes[uNode].Distance + 169;
end;
if TempDist < Nodes[Nodes[uNode].Roads[i]].Distance then
begin;
Nodes[Nodes[uNode].Roads[i]].Distance := TempDist;
Nodes[Nodes[uNode].Roads[i]].Last := uNode;
// Writeln(inttostr(Nodes[Nodes[uNode].Roads[i]].Distance) +'-'+ inttostr(Nodes[Nodes[uNode].Roads[i]].x) + '-' + inttostr(Nodes[Nodes[uNode].Roads[i]].y));
end;
end;
Dec(TempNodeCount);
end;
uNode := EndNode;
if Nodes[uNode].Last > -1 then
begin;
SetLength(Result, NodeCount);
Result[0] := Point(Nodes[EndNode].x,Nodes[EndNode].y);
i := 1;
while Nodes[uNode].Last > -1 do
begin;
Result[i] := Point(Nodes[Nodes[uNode].Last].x,Nodes[Nodes[uNode].Last].y);// Nodes[uNode].Last;
uNode := Nodes[uNode].Last;
inc(i);
end;
Setlength(result,i);
Result := ReverseArr(Result);
Exit;
end;
SetLength(result,0);
end;



var
TPA,TPA2 : TPointArray;
Canvas : TCanvas;
i : integer;
TStringArray : string;
begin
DisplayDebugImgWindow(500,500);
Canvas := GetDebugCanvas;
Canvas.Brush.Color := clBlack
Canvas.Rectangle(0,0,501,501);

{ TPA := [Point(0,0), Point(1,0), Point(2,0),Point(3,0),Point(4,0),
Point(0,1), Point(1,1),
Point(0,2), Point(2,2), Point(3,2),
Point(0,3), Point(4,3),
Point(0,4),Point(1,4),Point(2,4),Point(3,4),Point(4,4)];}
TPA := TPAFromBox(inttobox(0,0,10,10));
TPA2 := FilterRandomTPA(TPA);
TPA := TPA2;
Canvas.Brush.Color := clYellow;
for i := 0 to High(TPA) do
begin;
Canvas.Rectangle(TPA[i].x*5,TPA[i].y*5,TPA[i].x*5 + 5,TPA[i].y*5 + 5);
end;
Writeln(PointToStr(TPA[0]) + '-' + PointTOStr(TPA[High(TPA)]));
TPA := ShortestRoute(0,High(TPA),TPA);
Wait(10);
While Length(TPA) > 0 do
begin;

Canvas.Brush.Color := clRed;
for i := 0 to High(TPA) do
begin;
Writeln('WIN WIN WIN: ' + inttostr(TPA[i].x) + '-' + inttostr(TPA[i].y));
Wait(50);
Canvas.Rectangle(TPA[i].x*5,TPA[i].y*5,TPA[i].x*5 + 5,TPA[i].y*5 + 5);
end;
Wait(200);
Canvas.Brush.Color := clYellow;
for i := high(TPA) downto 0 do
begin;
Canvas.Rectangle(TPA[i].x*5,TPA[i].y*5,TPA[i].x*5 + 5,TPA[i].y*5 + 5);
Wait(50);
end;
end;
end.

n3ss3s

2008-10-22 14:12:21

All hail to raymond!

mastaraymond

2008-10-22 17:17:37

From: n3ss3s
All hail to raymond!

*Looks around*

HyperSecret

2008-10-24 15:43:45


Harry

2008-10-24 19:30:00

Raym0nd` should spend more time making these types of awesome/phunny programs, and less on CSS :D

Naice work. Keep it up :)