Путь в двумерном лабиринте - волновой алгоритм

Материал из DRKB


Идея этого метода весьма проста: в стороны от исходной точки распространяется волна.

Начальное значение волны - ноль.

То есть ближайшие точки, в которые можно пойти, например, верх, низ, левая и правая, и которые еще не затронуты волной, получают значение волны + некоторый модификатор проходимости этой точки. Чем он больше - тем медленнее преодоление данного участка. Значение волны увеличивается на 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 Next(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
    begin
      for X := 1 to 10 do
      begin
        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;
      end;
    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;
    Next(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.


Source: http://algolist.manual.ru
ID: 04245