Самый короткий путь для короля на шахматной доске

Question

У меня есть шахматная доска 8x8. Это информация я получаю:

• координаты короля
• координаты цели
• количество заблокированных квадратов
• координаты блокированных квадратов

Я не могу наступить на заблокированных квадратов. Я хочу найти кратчайший путь к цели, если нет пути (цель недостижима), я хочу вернуть -1.

Я попробовал свою руку, но я не уверен, имеет ли смысл какой-либо смысл, и я потерян, любая помощь очень ценится.

Program ShortestPath; 

TYPE 
    coords = array [0..1] of integer; 

var goal,shortest : coords; 
    currentX, currentY,i : integer; 
    arrBlocked,result : array [0..64] of coords; 

function findShortestPath (currentX, currentY, goal, arrBlocked,path,i) : array [0..64] of coords; 
begin 
    {check if we are still on board} 
    if (currentX < 1 OR currentX > 8 OR currentY < 1 OR currentY > 8) then begin 
     exit; 
    end; 
    if (currentX = arrBlocked[currentX] AND currentY = arrBlocked[currentY]) then begin 
     exit; 
    end; 
    {save the new square into path} 
    path[i] = currentX; 
    path[i+1] = currentY; 
    {check if we reached the goal} 
    if (currentX = goal[0]) and (currentY = goal[1]) then begin 
     {check if the path was the shortest so far} 
     if (shortest > Length(path)) then begin 
      shortest := Length(path); 
      findShortestPath := path; 
     end else begin 
      exit; 
     end; 
    end else begin 
     {move on the board} 
     findShortestPath(currentX+1, currentY, goal, arrBlocked,path,i+2); 
     findShortestPath(currentX, currentY+1, goal, arrBlocked,path,i+2); 
     findShortestPath(currentX-1, currentY, goal, arrBlocked,path,i+2); 
     findShortestPath(currentX, currentY-1, goal, arrBlocked,path,i+2); 
    end; 
end; 

begin 
    {test values} 
    currentX = 2; 
    currentY = 5; 
    goal[0] = 8; 
    goal[1] = 7; 
    arrBlocked[0] = [4,3]; 
    arrBlocked[1] = [2,2]; 
    arrBlocked[2] = [8,5]; 
    arrBlocked[3] = [7,6]; 
    i := 0; 
    shortest := 9999; 
    path[i] = currentX; 
    path[i+1] = currentY; 
    i := i + 2; 
    result := findShortestPath(currentX,currentY,goal,arrBlocked,path,i); 
end. 

Answer 1

Задача в текущем случае (небольшая плата с 64 ячейками) может быть решена без рекурсии следующим образом.

Program ShortestPath; 
type 
    TCoords = record 
    X, Y: byte; 
    end; 

    TBoardArray = array [0 .. 63] of TCoords; 

var 
    Goal: TCoords; 
    Current: TCoords; 
    i, j: integer; 
    ArrBlocked, PathResult: TBoardArray; 
    BlockedCount: byte; 
    Board: array [1 .. 8, 1 .. 8] of integer; 

procedure CountTurnsToCells; 
var 
    Repetitions: byte; 
    BestPossible: byte; 
begin 
    for Repetitions := 1 to 63 do 
    for j := 1 to 8 do 
     for i := 1 to 8 do 
     if Board[i, j] <> -2 then 
     begin 
      BestPossible := 255; 
      if (i < 8) and (Board[i + 1, j] >= 0) then 
      BestPossible := Board[i + 1, j] + 1; 
      if (j < 8) and (Board[i, j + 1] >= 0) and 
      (BestPossible > Board[i, j + 1] + 1) then 
      BestPossible := Board[i, j + 1] + 1; 
      if (i > 1) and (Board[i - 1, j] >= 0) and 
      (BestPossible > Board[i - 1, j] + 1) then 
      BestPossible := Board[i - 1, j] + 1; 
      if (j > 1) and (Board[i, j - 1] >= 0) and 
      (BestPossible > Board[i, j - 1] + 1) then 
      BestPossible := Board[i, j - 1] + 1; 
      { diagonal } 
      if (j > 1) and (i > 1) and (Board[i - 1, j - 1] >= 0) and 
      (BestPossible > Board[i - 1, j - 1] + 1) then 
      BestPossible := Board[i - 1, j - 1] + 1; 
      if (j > 1) and (i < 8) and (Board[i + 1, j - 1] >= 0) and 
      (BestPossible > Board[i + 1, j - 1] + 1) then 
      BestPossible := Board[i + 1, j - 1] + 1; 
      if (j < 8) and (i < 8) and (Board[i + 1, j + 1] >= 0) and 
      (BestPossible > Board[i + 1, j + 1] + 1) then 
      BestPossible := Board[i + 1, j + 1] + 1; 
      if (j < 8) and (i > 1) and (Board[i - 1, j + 1] >= 0) and 
      (BestPossible > Board[i - 1, j + 1] + 1) then 
      BestPossible := Board[i - 1, j + 1] + 1; 

      if (BestPossible < 255) and 
      ((Board[i, j] = -1) or (Board[i, j] > BestPossible)) then 
      Board[i, j] := BestPossible; 
     end; 
end; 

function GetPath: TBoardArray; 
var 
    n, TurnsNeeded: byte; 
    NextCoord: TCoords; 

    function FindNext(CurrentCoord: TCoords): TCoords; 
    begin 
    result.X := 0; 
    result.Y := 0; 

    if (CurrentCoord.X > 1) and (Board[CurrentCoord.X - 1, CurrentCoord.Y] >= 0) 
     and (Board[CurrentCoord.X - 1, CurrentCoord.Y] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X - 1; 
     result.Y := CurrentCoord.Y; 
     exit; 
    end; 

    if (CurrentCoord.Y > 1) and (Board[CurrentCoord.X, CurrentCoord.Y - 1] >= 0) 
     and (Board[CurrentCoord.X, CurrentCoord.Y - 1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X; 
     result.Y := CurrentCoord.Y - 1; 
     exit; 
    end; 

    if (CurrentCoord.X < 8) and (Board[CurrentCoord.X + 1, CurrentCoord.Y] >= 0) 
     and (Board[CurrentCoord.X + 1, CurrentCoord.Y] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X + 1; 
     result.Y := CurrentCoord.Y; 
     exit; 
    end; 

    if (CurrentCoord.Y < 8) and (Board[CurrentCoord.X, CurrentCoord.Y + 1] >= 0) 
     and (Board[CurrentCoord.X, CurrentCoord.Y + 1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X; 
     result.Y := CurrentCoord.Y + 1; 
     exit; 
    end; 
    { diagonal } 
    if (CurrentCoord.X > 1) and (CurrentCoord.Y > 1) and 
     (Board[CurrentCoord.X - 1, CurrentCoord.Y-1] >= 0) and 
     (Board[CurrentCoord.X - 1, CurrentCoord.Y-1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X - 1; 
     result.Y := CurrentCoord.Y - 1; 
     exit; 
    end; 

    if (CurrentCoord.X < 8) and (CurrentCoord.Y > 1) and 
     (Board[CurrentCoord.X + 1, CurrentCoord.Y-1] >= 0) and 
     (Board[CurrentCoord.X + 1, CurrentCoord.Y-1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X + 1; 
     result.Y := CurrentCoord.Y - 1; 
     exit; 
    end; 

    if (CurrentCoord.X < 8) and (CurrentCoord.Y < 8) and 
     (Board[CurrentCoord.X + 1, CurrentCoord.Y+1] >= 0) and 
     (Board[CurrentCoord.X + 1, CurrentCoord.Y+1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X + 1; 
     result.Y := CurrentCoord.Y + 1; 
     exit; 
    end; 

    if (CurrentCoord.X > 1) and (CurrentCoord.Y < 8) and 
     (Board[CurrentCoord.X - 1, CurrentCoord.Y+1] >= 0) and 
     (Board[CurrentCoord.X - 1, CurrentCoord.Y+1] < Board[CurrentCoord.X, 
     CurrentCoord.Y]) then 
    begin 
     result.X := CurrentCoord.X - 1; 
     result.Y := CurrentCoord.Y + 1; 
     exit; 
    end; 

    end; 

begin 
    TurnsNeeded := Board[Goal.X, Goal.Y]; 
    NextCoord := Goal; 
    for n := TurnsNeeded downto 1 do 
    begin 
    result[n] := NextCoord; 
    NextCoord := FindNext(NextCoord); 
    end; 
    result[0] := NextCoord; // starting position 
end; 

procedure BoardOutput; 
begin 
    for j := 1 to 8 do 
    for i := 1 to 8 do 
     if i = 8 then 
     writeln(Board[i, j]:2) 
     else 
     write(Board[i, j]:2); 
end; 

procedure OutputTurns; 
begin 
    writeln(' X Y'); 
    for i := 0 to Board[Goal.X, Goal.Y] do 
    writeln(PathResult[i].X:2, PathResult[i].Y:2) 
end; 

begin 
    { test values } 
    Current.X := 2; 
    Current.Y := 5; 
    Goal.X := 8; 
    Goal.Y := 7; 
    ArrBlocked[0].X := 4; 
    ArrBlocked[0].Y := 3; 
    ArrBlocked[1].X := 2; 
    ArrBlocked[1].Y := 2; 
    ArrBlocked[2].X := 8; 
    ArrBlocked[2].Y := 5; 
    ArrBlocked[3].X := 7; 
    ArrBlocked[3].Y := 6; 
    BlockedCount := 4; 

    { preparing the board } 
    for j := 1 to 8 do 
    for i := 1 to 8 do 
     Board[i, j] := -1; 

    for i := 0 to BlockedCount - 1 do 
    Board[ArrBlocked[i].X, ArrBlocked[i].Y] := -2; // the blocked cells 

    Board[Current.X, Current.Y] := 0; // set the starting position 

    CountTurnsToCells; 
    BoardOutput; 

    if Board[Goal.X, Goal.Y] < 0 then 
    writeln('no path') { there is no path } 

    else 
    begin 
    PathResult := GetPath; 
    writeln; 
    OutputTurns 
    end; 

    readln; 

end. 

Идея заключается в следующем. Мы используем массив, представляющий плату. Каждая ячейка может быть установлена ​​либо в 0 - начальную точку, либо на -1 - неизвестную/недоступную ячейку, либо на -2 - заблокированную ячейку. Все положительные числа представляют собой минимальные обороты, чтобы достичь текущей ячейки в начальной точке.

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

Две дополнительные процедуры: BoardOutput и OutputTurns распечатать структуру Совета и принять решение на консоль.

Answer 2

A* Search хороший путь, найти алгоритм для графов, как ваш шахматной доске, немного погуглить расположен в implementation in C, что вы можете адаптироваться к Pascal.

A * работает, исследуя наиболее перспективные пути сначала, используя admissible heuristic, чтобы определить, какие пути являются (возможно) лучшими, то есть поиск сначала исследует самый прямой путь к цели и только исследует более обходные пути, если прямые пути блокируются. В вашем случае вы можете использовать декартовую дистанцию ​​в качестве эвристики, иначе вы можете использовать Chebyshev distance, а также расстояние до шахмат.

Answer 3

Поскольку размеры вашей проблемы настолько малы, вы не обязаны использовать наиболее эффективный метод. Таким образом, вы можете использовать BFS для поиска кратчайшего пути, потому что сначала затраты на перемещение согласованы во втором, вы не будете сталкиваться с ограничением памяти из-за небольшого размера проблемы.

1 Breadth-First-Search(Graph, root): 
2 
3  for each node n in Graph:    
4   n.distance = INFINITY   
5   n.parent = NIL 
6 
7  create empty queue Q  
8 
9  root.distance = 0 
10  Q.enqueue(root)      
11 
12  while Q is not empty:   
13  
14   current = Q.dequeue() 
15  
16   for each node n that is adjacent to current: 
17    if n.distance == INFINITY: 
18     n.distance = current.distance + 1 
19     n.parent = current 
20     Q.enqueue(n) 

https://en.wikipedia.org/wiki/Breadth-first_search

Но когда проблема становится все больше вы обязаны использовать более эффективные методы. Конечным решением является IDA*. Поскольку сложность пространства IDA * является линейной, и она всегда будет возвращать оптимальное решение, если вы используете последовательный метод heurisitc.

Answer 4

Вы можете преобразовать эту проблему теории графов, а затем применить один из стандартных алгоритмов.

Вы рассматриваете все поля узлов шахматной доски на графике. Все поля y, к которым король может перейти из заданного поля x, связаны с x. Таким образом, c4 подключается к b3, b4, b5, c3, c5, d3, d4, d5. Удалите все узлы и заблокированные их соединения.

Теперь найти свой кратчайший путь может быть решена с помощью Dijkstras Algorithm

Это, по существу, что @ ASD-тм реализует в его/ее решение, но я думаю, что реализации Дейкстры алгоритм для общего случая и использовать его для специальный случай может привести к более чистым, понятным кодам. Отсюда отдельный ответ.