[dr1nk]

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

[dr1nk]

Вот нашёл некий пример лабиринта в интернете:

Код:

program TestLab;

uses Windows, ShellAPI;

const LabWidth = 100;
      LabHeight = 100;

type TLabirint = array[1..LabHeight,1..LabWidth] of Integer;

var Lab: TLabirint;
    BI, BJ, EI, EJ: Integer;
    Path: string;

function IntToStr (A: Integer): string;
// Перевод из числа в строку:
begin
  Str (A, Result);
end; {function IntToStr}

function GetWay: string;
// Поиск пути в лабиринте:
const MinInit = -(LabWidth * LabHeight);
var I, J, N: Integer;
    Min: Integer;
    Res: string;

  procedure FindPath (I, J, Len: Integer);
  // Рекурсивный поиск пути:
  var DI, DJ: Integer;
  begin
    Dec (Len);
    if (Len - Abs (EI - I) - Abs (EJ - J) > Min) and (Lab[I,J] <> 1) and
       ((Lab[I,J] < Len) or (Lab[I,J] = 0)) then
    begin
      Lab[I,J] := Len;
      if (I <> EI) or (J <> EJ) then
      begin
        DI := -1;
        DJ := -1;
        if J < EJ then DJ := 1;
        if I < EI then DI := 1;
        if I = EI then
        begin
          FindPath (I, J + DJ, Len);
          FindPath (I + DI, J, Len);
          FindPath (I, J - DJ, Len);
          FindPath (I - DI, J, Len);
        end else
        begin
          FindPath (I + DI, J, Len);
          FindPath (I, J + DJ, Len);
          FindPath (I - DI, J, Len);
          FindPath (I, J - DJ, Len);
        end; {if}
      end else Min := Len;
    end; {if}
  end; {func FindPath}

begin
  Min := MinInit;
  FindPath (BI, BJ, 0);
  Res := '';
  I := EI;
  J := EJ;
  N := Lab[I,J];
  if N <> 0 then
  begin
    while (I <> BI) or (J <> BJ) do
    begin
      Inc (N);
      if Lab[I-1,J] = N then
      begin
        Res := Concat ('D', Res);
        Dec (I);
      end else
      if Lab[I+1,J] = N then
      begin
        Res := Concat ('U', Res);
        Inc (I);
      end else
      if Lab[I,J-1] = N then
      begin
        Res := Concat ('R', Res);
        Dec (J);
      end else
      if Lab[I,J+1] = N then
      begin
        Res := Concat ('L', Res);
        Inc (J);
      end; {if}
    end; {while}
  end; {if}
  Result := Res;
end; {func GetWay}

procedure PrintLab;
// Получение внешнего вида лабиринта:
var I, J, P: Integer;
    Steps: TLabirint;
    S, Row, WH, TDClass: string;
    F: Text;
begin
  for I := 1 to LabHeight do
    for J := 1 to LabWidth do
      Steps[I,J] := 0;
  I := BI;
  J := BJ;
  for P := 1 to Length (Path) do
  begin
    case Path[P] of
      'D': Inc (I);
      'U': Dec (I);
      'R': Inc (J);
      'L': Dec (J);
    end; {case}
    Steps[I,J] := 1;
  end; {for}
  Assign (F, 'output.html');
  Rewrite (F);
  WriteLn (F, '<style type="text/css"><!--');
  WriteLn (F, 'table.labirint');
  WriteLn (F, '{');
  WriteLn (F, '	border: 1px solid black;');
  WriteLn (F, '	background-color: white;');
  WriteLn (F, '	border-collapse: collapse;');
  WriteLn (F, '	padding: 0px;');
  WriteLn (F, '	font-size: 8pt;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint td');
  WriteLn (F, '{');
  WriteLn (F, '	border: 1px solid black;');
  WriteLn (F, '	background-color: white;');
  WriteLn (F, '	text-align: center;');
  WriteLn (F, '	text-decoration: none;');
  WriteLn (F, '	font-weight: normal;');
  WriteLn (F, '	padding: 0px;');
  WriteLn (F, '	width: 12px;');
  WriteLn (F, '	height: 12px;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint th');
  WriteLn (F, '{');
  WriteLn (F, '	border: 1px solid black;');
  WriteLn (F, '	background-color: #BF5000;');
  WriteLn (F, '	text-align: center;');
  WriteLn (F, '	text-decoration: none;');
  WriteLn (F, '	font-weight: normal;');
  WriteLn (F, '	padding: 0px;');
  WriteLn (F, '	width: 12px;');
  WriteLn (F, '	height: 12px;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint td.path');
  WriteLn (F, '{');
  WriteLn (F, '	background-color: red;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint td.step');
  WriteLn (F, '{');
  WriteLn (F, '	background-color: #EDFFEA;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint td.begin');
  WriteLn (F, '{');
  WriteLn (F, '	background-color: green;');
  WriteLn (F, '}');
  WriteLn (F, 'table.labirint td.end');
  WriteLn (F, '{');
  WriteLn (F, '	background-color: lightblue;');
  WriteLn (F, '}');
  WriteLn (F, '--></style>');
  WH := '';
  S := '';
  for I := 1 to LabHeight do
  begin
    Row := '';
    for J := 1 to LabWidth do
    begin
      TDClass := '';
      if Lab[I,J] < 0 then TDClass := ' class="step"';
      if Steps[I,J] = 1 then TDClass := ' class="path"';
      if (I = BI) and (J = BJ) then TDClass := ' class="begin"';
      if (I = EI) and (J = EJ) then TDClass := ' class="end"';
      if Lab[I,J] < 0 then Row := Concat (Row, '<td', WH, TDClass, '>', IntToStr (-Lab[I,J] - 1), '</td>');
      if Lab[I,J] = 0 then Row := Concat (Row, '<td', WH, TDClass, '></td>');
      if Lab[I,J] = 1 then Row := Concat (Row, '<th', WH, '></th>');
    end; {for}
    S := Concat (S, '<tr>', Row, '</tr>'#10);
    WH := '';
  end; {for}
  S := Concat ('<table class="labirint">'#10, S, '</table>'#10);
  WriteLn (F, S);
  Close (F);
  ShellExecute (0, 'open', 'output.html', nil, nil, SW_SHOW);
end; {proc PrintLab}

procedure RandomLab;
// Формирование случайного лабиринта:
var I, J, N, D: Integer;
begin
  for I := 1 to LabHeight do
  begin
    Lab[I,1] := 1;
    Lab[I,LabWidth] := 1;
  end; {for}
  for J := 1 to LabWidth do
  begin
    Lab[1,J] := 1;
    Lab[LabHeight,J] := 1;
  end; {for}
  D := Random (3) + 2;
  for N := 1 to LabWidth * LabHeight div D do
    Lab[Random(LabHeight)+1,Random(LabWidth)+1] := 1; 
  repeat
    BI := Random (LabHeight) + 1;
    BJ := Random (LabWidth) + 1;
  until Lab[BI,BJ] = 0;
  repeat
    EI := Random (LabHeight) + 1;
    EJ := Random (LabWidth) + 1;
  until Lab[EI,EJ] = 0;
end; {proc RandomLab}

begin
  Randomize;
  RandomLab;
  Path := GetWay;
  PrintLab;
end.

ТОлько в данном случае передвигается только по вертикали или горизонтали. Мне необходимо чтобы можно было двигаться и по диагонали. Подскажите что можно ли где то подправить данный код? Заранее спасибо