Como ya sabéis, me encantan los retos y ejercicios de geometría computacional. Pues bien, aquí os traigo una implementación en Delphi de A* pathfinding, que consiste en encontrar y dibujar la ruta más corta entre 2 puntos saltando obstáculos. Para la resolución del pathfinding utilizaremos un algoritmo A* (A star) que es un algoritmo de búsqueda sobre grafos, intentando ir de un nodo principal a uno final con el coste mínimo. Para mi aplicación utilizaré un algoritmo creado por William Cairns donde he hecho pequeñas modificaciones y mejoras para adaptarlo a mis necesidades. Éste algoritmo se utiliza mucho en los videojuegos. Si alguna vez habéis podido leer algún libro sobre videojuegos (os lo recomiendo sobre todo por las estructuras de datos, OpenGL, etc.) nos muestran la manera que tienen para resolver que un jugador del tipo Starcraft 
, se mueva de un sitio a otro indicado salvando todos los obstáculos.En la siguiente imagen, sacada de "Programación de videojuegos con SDL", podemos ver un arbol con posibles caminos dentro del mapa del juego:
En la web de policyAlmanac de U.S podemos encontrar un tutorial -> A* pathfinding para principiantes. El cuál nos muestra unas imágenes muy interesantes que me sirven para mi explicación:Si nos fijamos en la imagen inicial:
Tenemos que ir del punto verde al punto rojo con el mínimo camino posible. Pero si nos fijamos en la imagen podemos ver que tenemos 2 caminos principales posibles, para éso hay que tener en cuenta la distancia Manhattan de manera que calculamos el número total de cuadros movidos horizontalmente y verticalmente para alcanzar el cuadrado destino desde el cuadro actual, sin hacer uso de movimientos diagonales. Al aplicar los diferentes algoritmos, obtenemos el diagrama siguiente con el cálculo realizado y el camino más corto:
Aplicación Thundax A Star PathFinding:
Aquí os dejo mi aplicación, la podéis descargar desde aquí. Por ejemplo, si creamos el ejemplo anterior, obtenemos algo parecido a:
Ahora, podemos poner los puntos donde queramos y los obstáculos que queramos y buscar el camino:
El código fuente de la unidad Astar.pas lo podéis encontrar aquí:
// originally written by William Cairns - http://www.cairnsgames.co.za
// http://www.pascalgamedevelopment.com/forums/profile.php?mode=viewprofile&u=65
// Enchanchements, additional code by Jernej L.
// http://www.gtatools.com
// please note that the path returned is REVERSED.
// Modified by Jordi Coll
unit Astar;
interface
uses windows, dialogs, sysutils;
type
AstarRec = packed record
point: Tpoint;
weight: integer;
end;
PInspectBlock = function(X, Y, Fx, Fy: integer): integer;
var
Searching, Found: Boolean;
Astack: array of AstarRec;
Source, Goal: Tpoint;
freedom: integer;
CanGo: PInspectBlock;
GRID: array of array of integer;
GridDimensions: Tpoint;
maxval: integer;
patherror: boolean;
Path: array of Tpoint;
closestpoint: AstarRec;
IsClosest: boolean;
Offsets: array[0..7] of
record
DX, DY: Integer;
Cost: Integer;
end =
((DX: 0; DY: - 1; Cost: 10), //90° neighbour cubes
(DX: - 1; DY: 0; Cost: 10),
(DX: + 1; DY: 0; Cost: 10),
(DX: 0; DY: + 1; Cost: 10),
(DX: - 1; DY: - 1; Cost: 14), //45° diagonals
(DX: + 1; DY: - 1; Cost: 14),
(DX: - 1; DY: + 1; Cost: 14),
(DX: + 1; DY: + 1; Cost: 14));
procedure FindPath(const src, dest, Gridsize: Tpoint; const diagonals, pleasefallback: boolean; const grabcallback: PInspectBlock);
implementation
procedure InspectBlock(X, Y: Integer);
var
I: Integer;
W: Integer;
AX, AY, AW, ABV: Integer;
begin
if (x = Source.x) and (y = Source.y) then
W := 0
else
W := GRID[x, y];
for I := 0 to freedom do
begin
AX := X + Offsets[I].DX;
AY := Y + Offsets[I].DY;
if (AX = Goal.X) and (AY = Goal.Y) then
begin
Found := True;
Exit;
end;
if (AX >= 0) and
(AY >= 0) and
(AX <= GridDimensions.x - 1) and
(AY <= GridDimensions.y - 1) = false then
continue;
if (ax = Source.x) and (ay = Source.y) then
continue;
if GRID[AX, AY] <> 0 then
continue;
ABV := CanGo(AX, AY, X, Y);
AW := W + Offsets[I].Cost + ABV;
if (ABV <> -1) then
begin
if ABV = 0 then
begin
Found := false;
Searching := false;
Exit;
end;
GRID[AX, AY] := AW;
if aw > maxval then
maxval := aw;
if (ABS(Goal.X - AX) + ABS(Goal.Y - AY)) < closestpoint.weight then
begin
closestpoint.point.x := ax;
closestpoint.point.y := ay;
closestpoint.weight := (ABS(Goal.X - AX) + ABS(Goal.Y - AY));
end;
setlength(Astack, length(Astack) + 1);
with Astack[length(Astack) - 1] do
begin
point.x := ax;
point.y := ay;
weight := aw;
end;
end;
end;
end;
procedure Step;
var
I, LC, X, Y: Integer;
begin
if Found then
Exit;
if not Searching then
begin
InspectBlock(Source.X, Source.Y);
Searching := True;
end
else
begin
if high(astack) = -1 then
begin patherror := true;
exit;
end;
LC := 0;
for i := 0 to length(Astack) - 1 do
begin
if astack[i].weight < astack[LC].weight then
LC := i;
end;
X := Astack[LC].point.x;
Y := Astack[LC].point.y;
move(astack[LC + 1], astack[LC], (length(Astack) - 1 - LC) * sizeof(AstarRec));
setlength(Astack, length(Astack) - 1);
InspectBlock(X, Y);
end;
end;
procedure CalcBestPath;
var
lowest: Tpoint;
lowvalue: integer;
finished: boolean;
function findbestprev(pt: Tpoint): Tpoint;
var
i, ax, ay: integer;
begin
for I := 0 to freedom do
begin
AX := pt.X + Offsets[I].DX;
AY := pt.Y + Offsets[I].DY;
if (AX < 0) or
(AY < 0) or
(AX > GridDimensions.x - 1) or
(AY > GridDimensions.y - 1) then
continue;
if (AX = source.X) and (AY = source.Y) then
begin
finished := True;
Exit;
end;
if GRID[AX, AY] > 0 then
begin
if GRID[AX, AY] < lowvalue then
begin
lowvalue := GRID[AX, AY];
lowest.x := ax;
lowest.y := ay;
end;
end;
end;
end;
begin
if Found = false then
exit;
finished := false;
lowvalue := maxint;
lowest := Goal;
repeat
findbestprev(lowest);
if not finished then
begin
setlength(Path, length(path) + 1);
Path[length(path) - 1] := lowest;
end;
until (finished);
end;
procedure LookForPath;
begin
repeat step;
until (found = true) or (patherror = true);
end;
procedure FindPath(const src, dest, Gridsize: Tpoint; const diagonals, pleasefallback: boolean; const grabcallback: PInspectBlock);
begin
Source := src;
Goal := dest;
freedom := 3;
if diagonals then
freedom := 7;
CanGo := grabcallback;
GridDimensions := Gridsize;
Searching := false;
Found := false;
patherror := false;
closestpoint.weight := maxint;
IsClosest := false;
setlength(Astack, 0);
setlength(Path, 0);
setlength(GRID, 0, 0);
setlength(GRID, gridsize.x, gridsize.y);
LookForPath;
if (patherror = true) and (pleasefallback = true) then
begin
Goal := closestpoint.point;
Searching := false;
Found := false;
patherror := false;
closestpoint.weight := maxint;
setlength(GRID, 0, 0);
setlength(GRID, gridsize.x, gridsize.y);
setlength(Path, length(path) + 1);
Path[length(path) - 1] := closestpoint.point;
LookForPath;
CalcBestPath;
IsClosest := true;
end
else if patherror = false then
CalcBestPath;
end;
end.
Una parte de la implementación del funcionamiento y la generación del dibujo con una TStringGrid lo podéis encontrar aquí:
function blocktester(X, Y, Fx, Fy: integer): integer;
begin
result := -1;
with Form1 do
begin
if (board.Cells[X, Y] = '') or (board.Cells[X, Y] = 'A') then
result := ((ABS(finalPos.x - X) + ABS(finalPos.y - Y)) * 3);
end;
end;
procedure TForm1.SearchClick(Sender: TObject);
var
i: integer;
begin
Astar.findpath(cellPos, finalPos, point(board.colcount, board.rowcount), true, true, @blocktester);
for i := 0 to high(astar.path) do
board.Cells[astar.path[i].x, astar.path[i].y] := '·';
if astar.IsClosest then
Statusbar1.Panels[1].text := 'Close path.';
if ((high(astar.path) = -1) and (astar.Found)) then
caption := 'immediatelly path.'
else
Statusbar1.Panels[1].text := 'Direct Path';
if not astar.Found then
Statusbar1.Panels[1].text := 'There is no path !';
end;
procedure TForm1.boardDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
with Sender as TDrawGrid do
begin
if board.cells[acol, arow] = '1' then
Canvas.Brush.Color := shape1.Brush.color
else if board.cells[acol, arow] = '2' then
Canvas.Brush.Color := shape2.Brush.color
else if board.cells[acol, arow] = '-' then
Canvas.Brush.Color := shape3.Brush.color
else if board.cells[acol, arow] = '·' then
Canvas.Brush.Color := clyellow
else if (acol = mousePos.x) and (arow = mousePos.y) then
Canvas.Brush.Color := clwhite;
Canvas.FillRect(Rect);
Canvas.TextOut(rect.left + 12, rect.top + 8, board.cells[acol, arow]);
end;
if (state = [gdSelected]) then
with TStringGrid(Sender), Canvas do
begin
Brush.Color := clwhite;
FillRect(Rect);
TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]);
end;
end;
- Enlaces de interés:
PathFinding Applet 2.
