Путь в двумерном лабиринте - волновой алгоритм
Falk0ner, вс, 06/07/2008 - 15:35.
Путь в двумерном лабиринте - волновой алгоритм Идея этого метода весьма проста: в стороны от исходной точки распростроняется волна. Начальное значение волны - ноль. То есть ближайшие точки, в которые можно пойти, например, верх, низ, левая и правая, и которые еще не затронуты волной, получают значение волны+некоторый модификатор проходимости этой точки. Чем он больше - тем медленнее преодоление данного участка. Значение волны увеличивается на 1. Обрабатываем аналогично клетки, отходя от тех, на которой значение волны - 2. При этом на клетках с худшей проходимостью волна задержится. И так дальше все обрабатывается, пока не достигнута конечная точка маршрута. Сам путь в получившемся массиве значений волны вычисляется по наименьшим клеткам. В примере на Си все очень хорошо продемонстрировано.
Program Voln;
Uses Crt;
Const
Map : array [1..10, 1..10] of Byte =
(
(0, 0, 1, 0, 0, 0, 0, 0, 0, 0),
(1, 0, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 1, 1, 1, 0, 0, 1, 1),
(0, 1, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 0, 1, 1, 1, 0, 1, 0),
(0, 0, 1, 1, 1, 0, 1, 0, 0, 0),
(0, 0, 0, 1, 0, 0, 1, 0, 0, 0),
(1, 1, 0, 1, 0, 0, 1, 1, 1, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0)
);
var
XS, YS, XE, YE : Byte;
X, Y, I : Byte;
MapM : array [1..10, 1..10] of Byte;
Moves : Byte;
MovesX : array [1..100] of Byte;
MovesY : array [1..100] of Byte;
Procedure (Var X, Y : Byte);
Begin
If (X <10) and (MapM[X, Y] - MapM[X + 1, Y] = 1) then
Begin
X := X + 1;
Exit;
End;
If (X >1) and (MapM[X, Y] - MapM[X - 1, Y] = 1) then
Begin
X := X - 1;
Exit;
End;
If (Y <10) and (MapM[X, Y] - MapM[X, Y + 1] = 1) then
Begin
Y := Y + 1;
Exit;
End;
If (Y >1) and (MapM[X, Y] - MapM[X, Y - 1] = 1) then
Begin
Y := Y - 1;
Exit;
End;
End;
Begin
ClrScr;
For Y := 1 to 10 do
Begin
For X := 1 to 10 do Write(Map[X, Y], ' ');
WriteLn;
End;
WriteLn('Please enter X and Y of the start: ');
ReadLn(XS, YS);
WriteLn('Please enter X and Y of the end: ');
ReadLn(XE, YE);
If (Map[XS, YS] = 1) or (Map[XE, YE] = 1) then
Begin
WriteLn('Error!!!');
ReadLn;
Halt;
End;
MapM[XS, YS] := 1;
I := 1;
Repeat
I := I + 1;
For Y := 1 to 10 do
For X := 1 to 10 do
If MapM[X, Y] = I - 1 then
Begin
If (Y <10) and (MapM[X, Y + 1] = 0)
and (Map[X, Y+1] = 0) Then MapM[X, Y+1] := I;
If (Y >1)
and (MapM[X, Y-1] = 0) and (Map[X, Y-1] = 0) Then MapM[X, Y-1] := I;
If (X <10)
and (MapM[X+1, Y] = 0) and (Map[X+1, Y] = 0) Then MapM[X+1, Y] := I;
If (X >1)
and (MapM[X-1, Y] = 0) and (Map[X-1, Y] = 0) Then MapM[X-1, Y] := I;
End;
If I = 100 then
Begin
WriteLn('You cant go there!!!');
ReadLn;
Halt;
End;
Until MapM[XE, YE] >0;
Moves := I - 1;
X := XE;
Y := YE;
I := Moves;
Map[XE, YE] := 4;
Repeat
MovesX[I] := X;
MovesY[I] := Y;
(X, Y);
Map[X, Y] := 3;
I := I - 1;
Until (X = XS) and (Y = YS);
Map[XS, YS] := 2;
For I := 1 to Moves do WriteLn('X = ', MovesX[I],', Y = ', MovesY[I]);
WriteLn('Total: ', Moves, ' moves');
ReadLn;
For Y := 1 to 10 do
Begin
For X := 1 to 10 do Write(Map[X, Y], ' ');
WriteLn;
End;
ReadLn;
End.
Uses Crt;
Const
Map : array [1..10, 1..10] of Byte =
(
(0, 0, 1, 0, 0, 0, 0, 0, 0, 0),
(1, 0, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 1, 1, 1, 0, 0, 1, 1),
(0, 1, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 0, 1, 1, 1, 0, 1, 0),
(0, 0, 1, 1, 1, 0, 1, 0, 0, 0),
(0, 0, 0, 1, 0, 0, 1, 0, 0, 0),
(1, 1, 0, 1, 0, 0, 1, 1, 1, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0)
);
var
XS, YS, XE, YE : Byte;
X, Y, I : Byte;
MapM : array [1..10, 1..10] of Byte;
Moves : Byte;
MovesX : array [1..100] of Byte;
MovesY : array [1..100] of Byte;
Procedure (Var X, Y : Byte);
Begin
If (X <10) and (MapM[X, Y] - MapM[X + 1, Y] = 1) then
Begin
X := X + 1;
Exit;
End;
If (X >1) and (MapM[X, Y] - MapM[X - 1, Y] = 1) then
Begin
X := X - 1;
Exit;
End;
If (Y <10) and (MapM[X, Y] - MapM[X, Y + 1] = 1) then
Begin
Y := Y + 1;
Exit;
End;
If (Y >1) and (MapM[X, Y] - MapM[X, Y - 1] = 1) then
Begin
Y := Y - 1;
Exit;
End;
End;
Begin
ClrScr;
For Y := 1 to 10 do
Begin
For X := 1 to 10 do Write(Map[X, Y], ' ');
WriteLn;
End;
WriteLn('Please enter X and Y of the start: ');
ReadLn(XS, YS);
WriteLn('Please enter X and Y of the end: ');
ReadLn(XE, YE);
If (Map[XS, YS] = 1) or (Map[XE, YE] = 1) then
Begin
WriteLn('Error!!!');
ReadLn;
Halt;
End;
MapM[XS, YS] := 1;
I := 1;
Repeat
I := I + 1;
For Y := 1 to 10 do
For X := 1 to 10 do
If MapM[X, Y] = I - 1 then
Begin
If (Y <10) and (MapM[X, Y + 1] = 0)
and (Map[X, Y+1] = 0) Then MapM[X, Y+1] := I;
If (Y >1)
and (MapM[X, Y-1] = 0) and (Map[X, Y-1] = 0) Then MapM[X, Y-1] := I;
If (X <10)
and (MapM[X+1, Y] = 0) and (Map[X+1, Y] = 0) Then MapM[X+1, Y] := I;
If (X >1)
and (MapM[X-1, Y] = 0) and (Map[X-1, Y] = 0) Then MapM[X-1, Y] := I;
End;
If I = 100 then
Begin
WriteLn('You cant go there!!!');
ReadLn;
Halt;
End;
Until MapM[XE, YE] >0;
Moves := I - 1;
X := XE;
Y := YE;
I := Moves;
Map[XE, YE] := 4;
Repeat
MovesX[I] := X;
MovesY[I] := Y;
(X, Y);
Map[X, Y] := 3;
I := I - 1;
Until (X = XS) and (Y = YS);
Map[XS, YS] := 2;
For I := 1 to Moves do WriteLn('X = ', MovesX[I],', Y = ', MovesY[I]);
WriteLn('Total: ', Moves, ' moves');
ReadLn;
For Y := 1 to 10 do
Begin
For X := 1 to 10 do Write(Map[X, Y], ' ');
WriteLn;
End;
ReadLn;
End.
Отправить комментарий