Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 18.08.2011, 14:51
BIG_BO BIG_BO вне форума
Прохожий
 
Регистрация: 09.10.2010
Сообщения: 29
Репутация: 10
По умолчанию Кратчайший путь до финиша

Помогите доделать программу. Я выложил прогу, хотелось бы сделать процедуру, которая по нажатии кнопки будет показывать кратчайший путь от старта до финиша в лабиринте
Ответить с цитированием
  #2  
Старый 18.08.2011, 14:54
BIG_BO BIG_BO вне форума
Прохожий
 
Регистрация: 09.10.2010
Сообщения: 29
Репутация: 10
По умолчанию

Вот ссылка проги
Ответить с цитированием
  #3  
Старый 18.08.2011, 21:28
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

У меня давно валяется чей-то пример. Посмотри, если нужно выкину весь проект:
Код:
unit PathFinder;

interface

type
 TPoint  = record
            X : longint;
            Y : longint;
           end;

 TTile    = record
             TerrType : byte;
             Status   : byte;
             value    : real;
             gval     : real;
             hval     : real;
             fval     : real;
             Prev     : TPoint;
            end;


const
  ttWall   = 0; // препятствие
  ttType1  = 1; // тип территории 1 - самый плохо проходимый тип территории
  ttType2  = 2; // тип территории 2
  ttType3  = 3; // тип территории 3
  ttType4  = 4; // тип территории 4
  ttType5  = 5; // тип территории 5
  ttClear  = 6; // проходимая клетка - самый хорошо проходимый тип территории

  tsPath       = 1; // путь
  tsUnvisited  = 2; // непосещенная точка
  tsBound      = 3; // граничная точка
  tsPassed     = 4; // проверенная точка
  tsStart      = 5; // точка старта
  tsFinish     = 6; // точка финиша


  MaxX   = 56;
  MaxY   = 56;

 Courses : array [1..8] of TPoint=((X:0;Y:-1),(X:1;Y:-1),(X:1;Y:0),(X:1;Y:1),
                                   (X:0;Y:1),(X:-1;Y:1),(X:-1;Y:0),(X:-1;Y:-1));
 Marks   : Set of byte = [tsPath, tsBound, tsPassed];

 MaxBoundSize = 500;

type
 TMap     = array[0..101,0..101] of TTile;
 TBound   = array[1..MaxBoundSize] of TPoint;

 function FindPath(Src,Dst: TPoint;var Map: TMap): boolean;
 function EqualPoints(a,b:TPoint):boolean ;

implementation

function EqualPoints(a,b:TPoint):boolean ;
begin
 Result:=(A.X=B.X) and (A.Y=B.Y);
end;
function Point(AX , AY : integer): TPoint;
begin
 Result.X:=AX;
 Result.Y:=AY;
end;

function Max(x,y: real):real;
begin
 if x>y then Result:=x else Result:=y;
end;

function Min(x,y: real):real;
begin
 if x>y then Result:=y else Result:=x;
end;

function HEst(A,B: TPoint; dx2,dy2:real): real;
var dx,dy,cross : real;
begin
 dx:= A.X - B.X;
 dy:= A.Y - B.Y;
// dx2:= Src.X - Dst.X;
// dy2:= Src.Y - Dst.Y;
 cross:= dx*dy2 - dx2*dy;
 if( cross<0 ) then cross:=-cross;
 Result:= max(abs(dx), abs(dy))+cross*0.001;

// Result:=sqrt(sqr(A.x-B.x)+sqr(A.y-B.y));
end;


function FindPath(Src,Dst: TPoint;var Map: TMap): boolean;
var
         A : TPoint;
     i,j,k : byte;
     dx,dy : real;
     Bound : TBound;
     BSize : integer;

const kk   : array[0..1] of real=(1.42,1);

function FindMin: integer;
var i,n: integer;
begin
  n:=1;
  for i:=1 to BSize do
    if Map[bound[n].X,bound[n].Y].fval>Map[bound[i].X,bound[i].Y].fval
      then n:=i;
  result:=n;
end;

procedure AddToBound(Point:TPoint);
begin
 if BSize>=MaxBoundSize then exit;
 BSize:=BSize+1;
 Bound[BSize]:=Point;
end;

begin // FindPath
 dx:=Src.X-Dst.X;
 dy:=Src.Y-Dst.Y;
 Map[Src.X,Src.Y].Status:=tsBound;
 Map[Dst.X,Dst.Y].Status:=tsFinish;
 BSize:=1;
 Map[Src.x,Src.y].gval:=0;
 Map[Src.x,Src.y].hval:=HEst(Src,Dst,dx,dy);
 Map[Src.x,Src.y].fval:=Map[Src.x,Src.y].gval+Map[Src.x,Src.y].hval;
 Bound[1]:=Src;
 Result:=False;
 while BSize>0 do
  begin
      k:=FindMin; //BSize;
      i:=Bound[k].x;
      j:=Bound[k].y;
      Map[bound[k].X,bound[k].Y].Status:=tsPassed;
      bound[k]:=bound[BSize];
      BSize:=BSize-1;
        for k:=1 to 8 do
         begin
          A.X:=i+Courses[k].X;
          A.Y:=j+Courses[k].Y;
          if Map[A.x,A.y].TerrType<>ttWall then
           case Map[A.x,A.y].Status of
            tsUnvisited:
                       begin
                        Map[A.X,A.Y].gval:=Map[i,j].gval+Map[A.X,A.Y].value*kk[k mod 2];
                        Map[A.X,A.Y].fval:=Map[A.X,A.Y].gval+HEst(A,Dst,dx,dy);
                        Map[A.X,A.Y].Prev:=Point(i,j);
                        Map[A.X,A.Y].Status:=tsBound;
                        AddToBound(A);
                       end;
            tsFinish :
                       begin
                        Map[A.X,A.Y].Prev:=Point(i,j);
                        Map[Src.X,Src.Y].Status:=tsStart;
                        Result:=True;
                        exit;
                       end;
 {           tsBound  :
                       begin
                        _gval:=Map[i,j].gval+Map[A.X,A.Y].value*kk[k mod 2];
                        if _gval<Map[A.X,A.Y].gval then
                         begin
                           Map[A.X,A.Y].gval:=_gval;
                           Map[A.X,A.Y].fval:=Map[A.X,A.Y].gval+HEst(A,Dst);
                           Map[A.X,A.Y].Prev:=Point(i,j);
                           AddToBound(A);
                         end;
                       end;}
           end;
         end;
  end;
 Map[Src.X,Src.Y].Status:=tSStart;
end;

end.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:30.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025