棋盘上国王的最短路径

Question

我有一个 8x8 的棋盘。这是我得到的信息：

王座坐标
目标坐标
方块数
方块坐标

我不能踩到被挡住的方块。我想找到到达目标的最短路径，如果没有路径可用（目标无法到达），我想 return -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

A* Search is a good path-finding algorithm for graphs like your chess board, a bit of googling located an implementation in C 你可以适应 Pascal。

A* 的工作原理是首先使用 admissible heuristic to determine which paths are (probably) the best, i.e. the search first explores the most direct path to the goal and only explores more circuitous paths if the direct paths are blocked. In your case you can either use the cartesian distance as your heuristic, or else you can use the Chebyshev distance 又名棋盘距离探索最有希望的路径。

Answer 2

当前案例（只有64个cell的小板）的任务可以通过以下方式不递归解决。

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 - unknown/unreachable 单元格，或者设置为 -2 - 阻塞单元格。所有正数表示从起点到达当前单元格的最小圈数。

稍后我们检查目标方格是否包含大于 0 的数字。这意味着国王可以移动到目标方格。如果是这样，我们会找到从目标到起点依次排列序号的单元格，并将它们表示在决策数组中。

另外两个程序：BoardOutput 和 OutputTurns 将董事会结构和决定打印到控制台。

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* space 复杂度是线性的，如果您使用一致的启发式算法，它总是 return 最佳解决方案。

Answer 4

您可以将其转化为图论问题，然后应用其中一种标准算法。

您考虑图中棋盘节点的所有字段。国王可以从给定区域 x 移动到的所有区域 y 都连接到 x。所以 c4 连接到 b3、b4、b5、c3、c5、d3、d4、d5。删除所有节点及其被阻止的连接。

现在可以使用 Dijkstras Algorithm

来解决寻找最短路径的问题

这基本上是 @asd-tm 在 his/her 解决方案中实现的，但我认为对一般情况实施 Dijkstra 算法并将其用于特殊情况可能会导致更清晰、更易于理解的代码。因此单独的答案。

棋盘上国王的最短路径

Shortest path for king on chessboard

algorithm

pascal

shortest-path

directed-acyclic-graphs