| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Lines
Grell © (2005-05-06 17:27:00)Как в играх типа Lines реализован поиск пути?
Kerk (2005-05-14 18:40:00) [21]А мог бы просто ссылку кинуть.... :)
Zer0 (2005-05-14 13:11:00) [22]const direction_cost:array[0..7] of integer=(4,6,4,6,4,6,4,6);
direction_delta:array[0..7] of array[0..1] of integer=((0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1),(1,0),(1,-1));
{const direction_cost:array[0..7] of integer=(4,4,4,4,6,6,6,6);
direction_delta:array[0..7] of array[0..1] of integer=((0,-1),(-1,0),(0,1),(1,0),(-1,-1),(-1,1),(1,1),(1,-1));}
ON_OPEN=1;
ON_CLOSED=2;
AVOID_UNITS=1;
AVOID_OBSTACLES=2;
Zer0 (2005-05-14 13:08:00) [23]
function tgamelevel.findpath(sx,sy,xd,yd : integer; search_mask:word):tcarray;
//This is a version of A* which uses the searchspace for storing its
//nodes. The big advantage is that one iteration takes O(1) instead of
//O(n). For n iterations this then comes to O(n) instead of O(n^2) which
//is decidedly faster.
//xd and yd are tile coordinates
function HEURISTIC(const x1,y1,x2,y2 : integer) : integer;
begin
result:=round(sqrt(sqr(x1-x2)+sqr(y1-y2))*6);
end;
function is_tile_busy(const x,y : integer) : boolean;
begin
result := false;
end;
function is_tile_blocked(const x,y : integer) : boolean;
begin
result := (grid[x+y*w].kind in ['b','f']);
end;
var i : integer;
open,closed,current,previous,best_node,succ : pelement;
path : tcarray;
goal_index,cx,cy,xx,yy,index,g,_h,{iterations,sorts,}position : integer;
begin
setlength(result,0);
if (sx<0) or (sx>=w) or (sy<0) or (sy>=h) or
(xd<0) or (xd>=w) or (yd<0) or (yd>=h) then
exit;
for i:=0 to w*h-1 do
begin
grid[i].id := 0;
end;
{iterations:=0; sorts :=0;} position:=sx+sy*w;
//This is a new search
goal_index:=xd+yd*w;
//Create root node
open:=@grid[position];
open^.parent:=nil; open^.right:=nil; open^.left:=nil;
open^.g:=0; open^.h:=HEURISTIC(sx,sy,xd,yd);
open^.depth:=0;
open^.id:=1;
open^.ai_parameters:=ON_OPEN;
//Start the search.
while (true) do
if open = nil then
//No solution
exit
else
begin
//Take best node from open and place it on closed
best_node:=open;
open:=open^.right;
if (open<>nil) then
open^.left:=nil;
best_node^.ai_parameters:=ON_CLOSED;
//Check if bestnode is the goal
if (best_node^.position=goal_index) then
begin
//FOUND GOAL
current:=best_node;
setlength(path,best_node^.depth+1);
i:=best_node^.depth;
while(current<>nil) do
begin
//Opposite since A* caused a reversed path
path[i].x:=current^.position mod w;
path[i].y:=current^.position div w;
dec(i);
current:=current^.parent;
end;
result := path;
exit;
end;
//Generate successors
cx:=best_node^.position mod w;
cy:=best_node^.position div w;
for i:=0 to 7 do
begin
//Do not exceed maximum allowed iterations
{inc(iterations);}
//Check if succesor is valid
xx:=cx+direction_delta[i][0];
yy:=cy+direction_delta[i][1];
if (xx<0) or (xx>=w) or (yy<0) or (yy>=h) then
continue;
index:=xx+yy*w;
if (search_mask and AVOID_OBSTACLES)>0 then
if (is_tile_blocked(xx,yy)) then
continue;//Skip
if (search_mask and AVOID_UNITS)>0 then
if (is_tile_busy(xx,yy)) then
continue;//Skip
//Create succesor
succ:=@grid[index];
//Calculate path value
//(тут вычисляется проходимость блока в зависимости от его типа)
case succ^.kind of
'0' : g:=2;
'1' : g:=9;
'2' : g:=13;
'3' : g:=17;
else
// крайне труднопроходимый блок блок
g:=100000;
end;
g:=g+best_node^.g+direction_cost[i];
_h:=HEURISTIC(xx,yy,xd,yd);
//Has this node been generated during this search
//Due to the way we store these things these are all
//O(1) operations rather than O(n) operations so that
//overall time complexity is O(n) instead of O(n^2)
//(Actually it used to be 2*(n(n+1)/2):=n(n+1):=n^2+n:=O(n^2))
if (succ^.id=1) then
begin
//Yes, it has been generated already
//Check if already on open
if (succ^.ai_parameters and ON_OPEN)>0 then
begin
//It is on open
if (g<succ^.g) then
begin
//Better path found to open
succ^.parent:=best_node;
succ^.g:=g;
succ^.depth:=best_node^.depth+1;
//Remove it from queue
if (succ^.left<>nil) then
succ^.left^.right:=succ^.right
else
open:=nil;//It was the first node
if (succ^.right<>nil) then
succ^.right^.left:=succ^.left;
end
else
//If it is on open but is g value is better
//than the current g value we do not
//generate the succesor
continue
end
else
if (succ^.ai_parameters and ON_CLOSED)>0 then
//It is on closed. Let's throw it away since
//we don't want to propagate
continue;
end
else
begin
//Succesor wasn't generated yet during this search
succ^.id:=1;
succ^.g:=g;
succ^.parent:=best_node;
succ^.depth:=best_node^.depth+1;
succ^.h:=_h;
succ^.ai_parameters:=ON_OPEN;
end;
//Insert succesor in open
if (open=nil) then
begin
open:=succ; open^.right:=nil; open^.left:=nil;
end
else
begin
current:=open; previous:=nil;
while(current<>nil) do
begin
{inc(sorts);}
if (current^.g+current^.h<succ^.g+succ^.h) then
begin
previous:=current; current:=current^.right;
end
else
break;
end;
if (previous<>nil) then
begin
succ^.right:=previous^.right;
if (succ^.right<>nil) then
succ^.right^.left:=succ;
previous^.right:=succ;
succ^.left:=previous;
end
else
begin
succ^.right:=open;
succ^.left:=nil;
open^.left:=succ;
open:=succ;
end;
end;
end;
end;
Zer0 (2005-05-14 13:03:00) [24]
constructor tgamelevel.create;
begin
imagename := ''; name := ''; fname := ''; changed := false;
h:=0; w:=0;
end;
procedure tgamelevel.cleargrid;
begin
h:=0; w:=0; setlength(grid,0);
end;
procedure tgamelevel.clear;
begin
cleargrid; imagename := ''; name := ''; fname := '';
end;
procedure tgamelevel.setsize( _w,_h : integer );
var i:integer;
begin
if h<>0 then cleargrid;
h:=_h; w:=_w;
setlength(grid,w*h);
for i:=0 to w*h-1 do
begin
grid[i].kind:='0';
grid[i].position := i;
end;
changed := true;
end;
function tgamelevel.getcell(x,y:integer):char;
begin
result:=#0;
if (x>=0) and (x<w) then
if (y>=0) and (y<h) then
result:=grid[x+y*w].kind
end;
procedure tgamelevel.setcell(x,y:integer; value : char);
begin
if (x>=0) and (x<w) then
if (y>=0) and (y<h) then
grid[x+y*w].kind:=value;
end;
Zer0 (2005-05-14 13:02:00) [25]Есть у меня быстрый астар++ со скоростью близкой к O(n):
type
pelement = ^telement;
telement = record
kind : char;
parameters : word;
g,depth,
h,position,
ai_parameters : integer;
blocked : word;
parent,left,right : pelement;
id : byte;
end;
tcoord = record
x,y : integer
end;
tcarray = array of tcoord;
tgrid = array of telement;
tgamelevel = class
imagename : string;
name : string;
fname : string;
grid : tgrid;
h,w : integer;
changed : boolean;
constructor create;
destructor destroy; override;
procedure cleargrid;
procedure clear;
procedure setsize( _w,_h : integer );
procedure load( str : tstream );
procedure save( str : tstream );
function getcell(x,y:integer):char;
procedure setcell(x,y:integer; value : char);
function findpath(sx,sy,xd,yd : integer; search_mask:word):tcarray;
public
property cell[x,y:integer] : char read getcell write setcell;
end;
Kerk (2005-05-12 10:55:00) [26]
mason1.zip
Вывод формулы Мэйсона. Данные - матрица смежности или граф (редактор графов прилагается). Программа анализирует граф, в том числе, ищет все пути из одной вершины в другую. Есть описание в .doc, немного урезанное. Писал давно, ногами не бейте %-)
http://kladovka.net.ru/index.php?action=downloadfile&filename=mason1.zip&directory=Students
П7 (2005-05-11 23:27:00) [27]Очень актуальная тема (:
Kerk (2005-05-11 22:14:00) [28]Zer0 © (11.05.05 21:56) [5]
можно извратиться и написать поиск наидлиннейшего непересекающегося пути =)
Диаметр графа?
Zer0 (2005-05-11 21:56:00) [29]можно извратиться и написать поиск наидлиннейшего непересекающегося пути =)
самый простой без извратов - рекурсия с отметками на карте "был, дошел за N шагов","не был".
Kerk (2005-05-11 21:24:00) [30]Алгоритм Дейкстры тоже пока никто не отменял.. экономичнее волнового по памяти.
Darth (2005-05-09 23:31:00) [31]ИМХО нечего мудрить с астаром. Волновой и все дела. Волна небольшая, так что считай хоть по 100 раз в секунду. Скорости это сильно не сбавит.
Sphinx (2005-05-07 12:13:00) [32]Волновой :)
XProger (2005-05-06 17:30:00) [33]Астар (A*)
| |
Страницы: 