Shortest path for king on chessboard

Question

I have a 8x8 chessboard. This is info I get:

• coordinates of the king
• coordinates of the goal
• number of blocked squares
• coordinates of blocked squares

I cannot step on blocked squares. I want to find shortest path to goal, if no path is available (the goal is unreachable), I want to return -1.

I tried my hand at it, but I am not sure if the code makes any sense and I am kinda lost, any help is greatly appreciated.

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

The task in the current case (small board with only 64 cells) can be solved without recursion in the following way.

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.

The ideea is the following. We use an array representing the board. Each cell can be set either to 0 - starting point, either to -1 - unknown/unreachable cell, either to -2 - blocked cell. All positive numbers represent the minimum turns to reach the current cell form the starting point.

Later on we check if the goal cell contains a number greater then 0. This means that the king can move to the destination cell. If so we find the cells with ordinal numbers following each other from goal to starting point and represent them in the decision array.

The two additional procedures: BoardOutput and OutputTurns print the Board structure and the decision to the console.

Answer 2

You can transform this a graph theory problem and then apply one of the standard algorithms.

You consider all fields of the chess board nodes in a graph. All fields y that the king can move to from a given field x are connected to x. So c4 is connected to b3, b4, b5, c3, c5, d3, d4, d5. Remove all the nodes, and their connections that are blocked.

Now finding your shortest path can be solved using the Dijkstras Algorithm

This is essentially what @asd-tm implements in his/her solution, but I think implementing the Dijkstra Algorithm for the general case and using it for the special case might lead to cleaner, easier to understand code. Hence the separate answer.

Answer 3

Because the dimensions of your problem is so small you are not bound to use the most efficient method. So you can use BFS to find the shortest path because first the cost of moving is consistent second you won't face memory limit due to small size of the problem.

 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

But when the problem gets larger you are bound to use more efficient methods. The ultimate solution is using IDA*. Because IDA* space complexity is linear and it will always return the optimal solution if you use consistent heurisitc.

Answer 4

A* Search is a good path-finding algorithm for graphs like your chess board, a bit of googling located an implementation in C that you can adapt to Pascal.

A* works by exploring the most promising paths first using an 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 aka the chessboard distance.