Шустрый
Профиль
Группа: Участник
Сообщений: 52
Регистрация: 11.10.2011
Репутация: нет
Всего: нет
|
Пытался реализовать алгоритм A* (точнее пока алгоритм Дейкстры т.е. без эвристики) по этой статье: http://www.policyalmanac.org/games/aStarTutorial_rus.htmПолучился вот такой код, но работает неверно (находит неправильный путь). Что не так? Там, где пустой begin end; по идее должен был быть пункт | Цитата |
Если клетка уже в открытом списке, то проверяем, не дешевле ли будет путь через эту клетку. Для сравнения используем стоимость G. Более низкая стоимость G указывает на то, что путь будет дешевле. Если это так, то меняем родителя клетки на текущую клетку и пересчитываем для нее стоимости
|
но вроде бы он никак не должен влиять т.к. двигаться можно только в 4 стороны? | Код |
uses
crt;
type
TArr = array [0..11, 0..11] of integer;
TCell = record
x: integer;
y: integer;
end;
TListCell = record
x: integer;
y: integer;
G: integer;
parent: TCell;
end;
TListArr = array [1..100] of TListCell;
TList = record
arr: TListArr;
len: integer;
end;
var
i, j, minind, ind, c: integer;
start, finish: TCell;
current: TListCell;
field: TArr;
opened, closed: TList;
procedure ShowField;
var
i, j: integer;
begin
textcolor(15);
for i := 0 to 11 do
begin
for j := 0 to 11 do
begin
case field[j, i] of
99: textcolor(8); // непроходимая
71: textcolor(14); // проходимая
11: textcolor(10); // старт
21: textcolor(12); // финиш
15: textcolor(2); // путь
14: textcolor(5);
16: textcolor(6);
end;
write(field[j, i], ' ');
end;
writeln;
end;
textcolor(15);
end;
procedure AddClosed(a: TListCell);
begin
closed.arr[closed.len + 1] := a;
inc(closed.len);
end;
procedure AddOpened(x, y, G: integer);
begin
opened.arr[opened.len + 1].x := x;
opened.arr[opened.len + 1].y := y;
opened.arr[opened.len + 1].G := G;
inc(opened.len);
end;
procedure DelOpened(n: integer);
var
i: integer;
begin
AddClosed(opened.arr[n]);
for i := n to opened.len - 1 do
opened.arr[i] := opened.arr[i + 1];
dec(opened.len);
end;
procedure SetParent(var a: TListCell; parx, pary: integer);
begin
a.parent.x := parx;
a.parent.y := pary;
end;
function GetMin(var a: TList): integer;
var
i, min, mini: integer;
begin
min := MaxInt;
mini := 0;
for i := 1 to a.len do
if a.arr[i].G < min then
begin
min := a.arr[i].G;
mini := i;
end;
GetMin := mini;
end;
function FindCell(a: TList; x, y: integer): integer;
var
i: integer;
begin
FindCell := 0;
for i := 1 to a.len do
if (a.arr[i].x = x) and (a.arr[i].y = y) then
begin
FindCell := i;
break;
end;
end;
begin
randomize;
for i := 0 to 11 do
for j := 0 to 11 do
field[i, j] := 99;
for i := 1 to 10 do
for j := 1 to 10 do
if random(5) mod 5 = 0 then
field[i, j] := 99
else field[i, j] := 71;
// координаты начальной и конечной позиций
start.x := 5;
start.y := 3;
finish.x := 9;
finish.y := 8;
field[start.x, start.y] := 11;
field[finish.x, finish.y] := 21;
ShowField;
writeln;
opened.len := 0;
closed.len := 0;
AddOpened(start.x, start.y, 0);
SetParent(opened.arr[opened.len], -1, -1);
current.x := start.x;
current.y := start.y;
repeat
minind := GetMin(opened);
current.x := opened.arr[minind].x;
current.y := opened.arr[minind].y;
current.G := opened.arr[minind].G;
// field[opened.arr[minind].x, opened.arr[minind].y]:=14;
DelOpened(minind);
if (field[current.x + 1, current.y] <> 99) then
if (FindCell(closed, current.x + 1, current.y) <= 0) then
if (FindCell(opened, current.x + 1, current.y) <= 0) then
begin
AddOpened(current.x + 1, current.y, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
if (field[current.x - 1, current.y] <> 99) then
if (FindCell(closed, current.x - 1, current.y) <= 0) then
if (FindCell(opened, current.x - 1, current.y) <= 0) then
begin
AddOpened(current.x - 1, current.y, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
if (field[current.x, current.y + 1] <> 99) then
if (FindCell(closed, current.x, current.y + 1) <= 0) then
if (FindCell(opened, current.x + 1, current.y) <= 0) then
begin
AddOpened(current.x, current.y + 1, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
if (field[current.x, current.y - 1] <> 99) then
if (FindCell(closed, current.x, current.y - 1) <= 0) then
if (FindCell(opened, current.x, current.y - 1) <= 0) then
begin
AddOpened(current.x, current.y - 1, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
if (FindCell(opened, finish.x, finish.y) > 0) then
break;
until opened.len = 0;
// считаем и отмечаем обратный путь
c:=0;
while (current.x <> start.x) and (current.y <> start.y) do
begin
field[current.x, current.y] := 15;
ind := FindCell(closed, current.x, current.y);
current.x := closed.arr[ind].parent.x;
current.y := closed.arr[ind].parent.y;
inc(c);
end;
ShowField;
writeln(c);
readln;
end.
|
|
Поиск пути (A*/Дейкстра) 
Загрузка ...
