我有一个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.
答案 0 :(得分：3)
当前案例中的任务（只有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.
ideea如下。我们使用代表董事会的数组。每个单元格可以设置为0 - 起始点，或者设置为-1 - 未知/不可达的单元格，或者设置为-2 - 阻塞的单元格。所有正数表示从起始点到达当前单元格的最小转弯。
稍后我们检查目标单元格是否包含大于0的数字。这意味着国王可以移动到目标单元格。如果是这样的话，我们会发现从目标到起点的序数跟随的序列号，并在决策数组中表示它们。
另外两个程序：BoardOutput和OutputTurns将Board结构和决定打印到控制台。
答案 1 :(得分：1)
由于问题的维度很小，因此您无需使用最有效的方法。所以你可以使用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，它将始终返回最优解。
答案 2 :(得分：0)
A* Search是一个很好的路径搜索算法，适用于像棋盘这样的图形，一些谷歌搜索位于implementation in C，你可以适应Pascal。
A *通过首先使用admissible heuristic探索最有希望的路径来确定哪些路径（可能）是最好的，即搜索首先探索到目标的最直接路径，并且仅探索更多迂回路径直接路径被阻止。在您的情况下，您可以使用笛卡尔距离作为启发式，或者您可以使用Chebyshev distance即棋盘距离。
答案 3 :(得分：0)
您可以将此转换为图论问题，然后应用其中一种标准算法。
您可以在图表中考虑国际象棋棋盘节点的所有字段。国王可以从给定的字段x移动到的所有字段y都连接到x。因此c4连接到b3，b4，b5，c3，c5，d3，d4，d5。删除所有节点及其被阻止的连接。
现在可以使用Dijkstras Algorithm
解决找到最短路径的问题这实际上是@ asd-tm在他/她的解决方案中实现的，但我认为针对一般情况实现Dijkstra算法并将其用于特殊情况可能会导致更清晰，更易于理解的代码。因此，单独的答案。