Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2003.12.09;
Скачать: [xml.tar.bz2];

Вниз

Алгоритм поиска пути   Найти похожие ветки 

← →
pavel_k   (2003-05-20 21:19) [0]

Прочитав пару статей, я сварганил процедурку поиска пути, вот только работает она медленно. Посоветуйте, как ее ускорить. Сразу извиняюсь, что вынужден грузить большим куском кода. И просьба сильно не материть, это первая хоть и медленно, но работающая версия.


type
PUsel=^TUsel;

TUsel=record узел (клетка для поиска пути)
Parent:PUsel;//узел с которого пришли
Cost:integer;//стоимость пути до данной клетки
cor:TPoint;// координаты
end;

TFinder=class
public
Open:TList;//список открытых узлов
Path:array of TPoint; //путь сохраняется сюда
function FindPath(Src:TPoint; Dest:TPoint):boolean;
// процедура поиска

constructor Create;
destructor Destroy; override;
end;

function TFinder.FindPath(Src, Dest: TPoint): boolean;
var s, n1, n2:PUsel;
Freer:TList;
i:integer;
//Freer - доп. список, куда добавляются все динамические переменные, чтобы их потом наверняка освободить


procedure SortList;
//лок. процедура, сортирует список Open по значению cost указателей)
Var i,j:integer;
q,q2:PUsel;
begin
for j:=0 to Open.Count-1 do
for i:=0 to Open.Count-2 do
begin
q:=Open.Items[i];
q2:=Open.Items[i+1];
if q^.Cost>q2^.Cost then
begin
Open.Exchange(i,i+1);
end;
end;
end;

procedure MakePath(k:PUsel);//создает путь
Var z:PUsel; i:integer;
begin
SetLength(Path,0);
z:=k;
while not ((z^.cor.X =src.X) and (z^.cor.Y=src.Y)) do
begin
SetLength(Path,Length(Path)+1);
Path[Length(Path)-1].X:=z^.cor.X;
Path[Length(Path)-1].Y:=z^.cor.Y;
z:=z^.Parent;
end;
SetLength(Path,Length(Path)+1);
Path[Length(Path)-1].X:=z^.cor.X;
Path[Length(Path)-1].Y:=z^.cor.Y;
end;

procedure AddUsel(g:PUsel);
//добавление узла, проверка на существование, проходимость
var newcost,i:integer;
f:PUsel;
begin
if (not ( ( (g^.cor.X >= 0 ) and (g^.cor.X<map.MapW)) and ((g^.cor.Y >= 0 )
and (g^.cor.Y<map.MapW)))) or (not CanPass(map.Flur[g^.cor.X][g^.cor.Y].landtype)) then
begin
Dispose(g);
exit;
end;
NewCost:=n1.Cost+1;
for i:=0 to Open.Count-1 do
begin
f:=Open.Items[i];
if (f^.cor.X=g^.cor.X) and (f^.cor.Y=g^.cor.Y) then
if f^.Cost<=newcost then
begin
Dispose(g);
exit;
end else
Open.Delete(i);
end;
g^.Parent:=n1;
g^.Cost:=newcost;
Open.Add(g);
Freer.Add(g);
end;

begin //FindPath

//*****
Freer:=TList.Create;


Open.Clear;
new(s);
s^.cor.X:=Src.X;
s^.cor.Y:=SRC.Y;
s.Cost:=0;//s-точка старта
s.Parent:=nil;
Open.Add(s);
Freer.Add(s);
while Open.Count>0 do
begin
SortList;//сортируем список
n1:=Open.Items[0];//достаем элемент с наименьшим cost (после сортировки он-первый)
if (n1^.cor.x=dest.x) and (n1^.cor.y=dest.y) then
begin
//если это точка финиша, создаем путь и выходим
MakePath(n1);
Result:=True;
//Убиваем все переменные
for i:=0 to Freer.Count-1 do
Dispose(Freer.Items[i]);
Freer.Free;
exit;
( n2) Прочитав пару статей, я сварганил процедурку поиска пути, вот только работает она медленно. Посоветуйте, как ее ускорить. Сразу извиняюсь, что вынужден грузить большим куском кода. И просьба сильно не материть, это первая хоть и медленно, но работающая версия.


type
PUsel=^TUsel;

TUsel=record узел (клетка для поиска пути)
Parent:PUsel;//узел с которого пришли
Cost:integer;//стоимость пути до данной клетки
cor:TPoint;// координаты
end;

TFinder=class
public
Open:TList;//список открытых узлов
Path:array of TPoint; //путь сохраняется сюда
function FindPath(Src:TPoint; Dest:TPoint):boolean;
// процедура поиска

constructor Create;
destructor Destroy; override;
end;

function TFinder.FindPath(Src, Dest: TPoint): boolean;
var s, n1, n2:PUsel;
Freer:TList;
i:integer;
//Freer - доп. список, куда добавляются все динамические переменные, чтобы их потом наверняка освободить


procedure SortList;
//лок. процедура, сортирует список Open по значению cost указателей)
Var i,j:integer;
q,q2:PUsel;
begin
for j:=0 to Open.Count-1 do
for i:=0 to Open.Count-2 do
begin
q:=Open.Items[i];
q2:=Open.Items[i+1];
if q^.Cost>q2^.Cost then
begin
Open.Exchange(i,i+1);
end;
end;
end;

procedure MakePath(k:PUsel);//создает путь
Var z:PUsel; i:integer;
begin
SetLength(Path,0);
z:=k;
while not ((z^.cor.X =src.X) and (z^.cor.Y=src.Y)) do
begin
SetLength(Path,Length(Path)+1);
Path[Length(Path)-1].X:=z^.cor.X;
Path[Length(Path)-1].Y:=z^.cor.Y;
z:=z^.Parent;
end;
SetLength(Path,Length(Path)+1);
Path[Length(Path)-1].X:=z^.cor.X;
Path[Length(Path)-1].Y:=z^.cor.Y;
end;

procedure AddUsel(g:PUsel);
//добавление узла, проверка на существование, проходимость
var newcost,i:integer;
f:PUsel;
begin
if (not ( ( (g^.cor.X >= 0 ) and (g^.cor.X<map.MapW)) and ((g^.cor.Y >= 0 )
and (g^.cor.Y<map.MapW)))) or (not CanPass(map.Flur[g^.cor.X][g^.cor.Y].landtype)) then
begin
Dispose(g);
exit;
end;
NewCost:=n1.Cost+1;
for i:=0 to Open.Count-1 do
begin
f:=Open.Items[i];
if (f^.cor.X=g^.cor.X) and (f^.cor.Y=g^.cor.Y) then
if f^.Cost<=newcost then
begin
Dispose(g);
exit;
end else
Open.Delete(i);
end;
g^.Parent:=n1;
g^.Cost:=newcost;
Open.Add(g);
Freer.Add(g);
end;

begin //FindPath

//*****
Freer:=TList.Create;


Open.Clear;
new(s);
s^.cor.X:=Src.X;
s^.cor.Y:=SRC.Y;
s.Cost:=0;//s-точка старта
s.Parent:=nil;
Open.Add(s);
Freer.Add(s);
while Open.Count>0 do
begin
SortList;//сортируем список
n1:=Open.Items[0];//достаем элемент с наименьшим cost (после сортировки он-первый)
if (n1^.cor.x=dest.x) and (n1^.cor.y=dest.y) then
begin
//если это точка финиша, создаем путь и выходим
MakePath(n1);
Result:=True;
//Убиваем все переменные
for i:=0 to Freer.Count-1 do
Dispose(Freer.Items[i]);
Freer.Free;
exit;
end;
//добавляем все соседние точки
new(n2);
n2^.cor.X:=n1^.cor.X+1;
n2^.cor.Y:=n1^.cor.Y;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X;
n2^.cor.Y:=n1^.cor.Y+1;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X;
n2^.cor.Y:=n1^.cor.Y-1;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X-1;
n2^.cor.Y:=n1^.cor.Y;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X+1;
n2^.cor.Y:=n1^.cor.Y+1;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X+1;
n2^.cor.Y:=n1^.cor.Y-1;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X-1;
n2^.cor.Y:=n1^.cor.Y+1;
AddUsel(n2);

new(n2);
n2^.cor.X:=n1^.cor.X-1;
n2^.cor.Y:=n1^.cor.Y-1;
AddUsel(n2);

Open.Delete(0);//??????? ???? ???? ?? ??????
end;
Result:=False;
Open.Clear;

//Убиваем все переменные
for i:=0 to Freer.Count-1 do
Dispose(Freer.Items[i]);

Freer.Free;
end;

← →
default   (2003-05-20 21:24) [1]

это об чём хоть?

← →
pavel_k   (2003-05-20 21:31) [2]

>это об чём хоть?
Ну я не совсем понял, что непонятно:)
Если вы имели ввиду кусок чего это, то это кусок моей мини игры (будующей) на Делфи с использованием DelphiX.

← →
A_n_t   (2003-05-21 04:30) [3]

To pavel_k:

Лучше бы вместо кода сам алгоритм рассказал, а то что-то в лом разбираться, как и чего там работает.

И что значит "работает медленно", скажи сколько точно считает, например, на PII-300 - делает за 10 мин :)

← →
Думкин   (2003-05-21 05:52) [4]


> pavel_k (20.05.03 21:31)

Читать твой текст - в лом. Вначале расскажи что делаешь и что надо. Про поиск пути - не знаю - у меня в одном лабиринте героиха это делает 40 в секунду - и то потому что я ограничиваю, но она готова это делать 10000 раз в секунду. Поэтому поставь точно задачу, описание решения. А код - потом.

← →
Gandalf   (2003-05-21 09:44) [5]

Может я криво смотрел (всматриваться лень - громозко), но судя по всему ты из точки кидаешь 4 путь - потом делаешь из каждого путь 4 новых добавляю клетку, и т.д. и т.д. - жрет памяти видимо немеренно и тормозит дико (во всяком случаи я видел такую реализацию). Возьми алгоритм A* (А звездочка, он же "Волновой алгоритм") - он гарантирует, большое бытродействие, нахождение пути если он существует вообще, и гарантирует его кратчайшесть. Хорошо работает на дискетных и анизотропных картах, не очень на картах с дискретным временем (обычно кривые WarGame - может не найти путь или найти некротчайший). Есть алгоритмы которые схожы с "человечиским брожением" - дихотомия, лабирант и т.п. - но они обычно ничего не гарантируют. У меня где-то валяется мой "WarGame" (в кавычках) - "Атака" - тупая реализация (VCL StringGrid) и графика - рисовал "от ноги" - нет AI и т.п. но поиск пути есть - быстро. Могу дать.

← →
cyborg   (2003-05-21 12:49) [6]

Gandalf © (21.05.03 09:44)
Поделись со всеми :)

← →
Думкин   (2003-05-21 13:05) [7]


> cyborg © (21.05.03 12:49)

А что делиться то? На алголисте все есть и прописано - и в Си и Паскале.

← →
Holocaust   (2003-05-21 13:27) [8]

Gandalf © (21.05.03 09:44)
Выложи...

← →
pavel_k   (2003-05-21 20:47) [9]

> Gandalf
> Могу дать.
Буду благодарен...

← →
Gandalf   (2003-05-22 15:00) [10]

Я тут снова на сие посмотрел - полный косяк, написано непонятно зачем и с большого похмелья.
Сам поиск пути - "Wave".
kol.mastak.ru/temp/ataka.rar

Надеюсь поможет.

ЗЫ: Если кому интересно могу объяснить правила. Но думаю таких не найдется.


Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2003.12.09;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.093 c
11-28392
alfromorel
2003-03-28 14:55
2003.12.09
Как перейти на следующие поле по Enter

1-28396
Ничего не знающий
2003-11-30 01:14
2003.12.09
Frame

9-28387
asmai
2003-05-23 12:33
2003.12.09
простой пример openGL?

9-28388
Juster~
2003-05-08 18:02
2003.12.09
2NailMan

11-28395
Ice777
2003-03-24 15:58
2003.12.09
Использование VCL компонетов в KOL




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский