Recent

Author Topic: Breadth first search not working consistently  (Read 420 times)

CyberFilth

  • Jr. Member
  • **
  • Posts: 63
    • CyberFilth.co.uk
Breadth first search not working consistently
« on: February 21, 2021, 12:17:20 pm »
I'm trying to create a breadth first search procedure for a game that I'm working on.
I have a game map filled with . for walkable floor tiles and # for blocking walls. I want to create a distance map, basically flood filling the map, starting from a target square, with a series of numbers that increment the further away from the starting square.
This article on red blob games describes it better, https://www.redblobgames.com/pathfinding/a-star/introduction.html

I've tried to implement this using a queue but it only seems to work around 70% of the time, the rest of the time it either doesn't search at all or only searches a couple of tiles deep.
I've attached screenshots of a working test and a failed test.

A simplified example of the code is below (the distance map is referred to as a smell map)
Code: Pascal  [Select][+][-]
  1. program floodFill;
  2.  
  3. uses
  4.   crt,
  5.   Contnrs,
  6.   SysUtils;
  7.  
  8. const
  9.   MAXROWS = 19;
  10.   MAXCOLUMNS = 19;
  11.   BLOCKVALUE = 500;
  12.  
  13. type
  14.   PtrProg = ^smellCoordinates;
  15.  
  16.   smellCoordinates = record
  17.     tileX, tileY: smallint;
  18.     distance: byte;
  19.   end;
  20.  
  21. var
  22.   r, c, counter: byte;
  23.   Queue: TQueue;
  24.   PtrShow: PtrProg;
  25.   myArray: array[1..MAXROWS, 1..MAXCOLUMNS] of string;  // the map that is used as input
  26.   smellMap: array [1..MAXROWS, 1..MAXCOLUMNS] of smallint; // map that is output
  27.  
  28.  
  29.   (* Add a tile to the queue *)
  30.   procedure addTile(y, x, dist: byte);
  31.   var
  32.     PtrNew: PtrProg;
  33.   begin
  34.     new(PtrNew);
  35.     PtrNew^.tileX := x;
  36.     PtrNew^.tileY := y;
  37.     PtrNew^.distance := dist;
  38.     Queue.Push(PtrNew);
  39.   end;
  40.  
  41.  
  42.   procedure floodFillGrid(currentTile: PtrProg);
  43.   begin
  44.     while Queue.Count > 0 do
  45.     begin
  46.       // Increment distance counter
  47.       Inc(counter);
  48.  
  49.       // check within bounds of grid
  50.       if (currentTile^.tileY >= 1) and (currentTile^.tileY <= MAXROWS) and
  51.         (currentTile^.tileX >= 1) and (currentTile^.tileX <= MAXCOLUMNS) then
  52.  
  53.       begin
  54.         if (myArray[currentTile^.tileY][currentTile^.tileX] = '.') then
  55.         begin  //select adjacent squares that aren't blocking walls
  56.           // give the selected square a distance value of the counter
  57.           if (myArray[currentTile^.tileY + 1][currentTile^.tileX] = '.') then
  58.             addTile(currentTile^.tileY + 1, currentTile^.tileX, counter);
  59.  
  60.           if (myArray[currentTile^.tileY - 1][currentTile^.tileX] = '.') then
  61.             addTile(currentTile^.tileY - 1, currentTile^.tileX, counter);
  62.  
  63.           if (myArray[currentTile^.tileY][currentTile^.tileX + 1] = '.') then
  64.             addTile(currentTile^.tileY, currentTile^.tileX + 1, counter);
  65.  
  66.           if (myArray[currentTile^.tileY][currentTile^.tileX - 1] = '.') then
  67.             addTile(currentTile^.tileY, currentTile^.tileX - 1, counter);
  68.  
  69.           // draw distance on the map
  70.           if (myArray[currentTile^.tileY][currentTile^.tileX] = '.') then
  71.           begin
  72.             (* drawn on the original map, just to make it easier to visualise while testing *)
  73.             myArray[currentTile^.tileY][currentTile^.tileX] :=
  74.               IntToStr(currentTile^.distance);
  75.             (* Draw the distance from the target onto the smell map *)
  76.             smellMap[currentTile^.tileY][currentTile^.tileX] := currentTile^.distance;
  77.           end;
  78.  
  79.         end
  80.         else;
  81.         (* send the next tile to the floodfill procedure *)
  82.         PtrShow := Queue.Pop;
  83.         floodFillGrid(PtrShow);
  84.       end;
  85.     end;
  86.   end;
  87.  
  88.  
  89. begin
  90.   // create queue
  91.   Queue := TQueue.Create;
  92.  
  93.   Randomize;
  94.  
  95.   // quick and dirty map
  96.   for r := 1 to MAXROWS do
  97.   begin
  98.     for c := 1 to MAXCOLUMNS do
  99.     begin
  100.       myArray[r][c] := '#';
  101.     end;
  102.   end;
  103.   for r := 2 to (MAXROWS - 1) do
  104.   begin
  105.     for c := 2 to (MAXCOLUMNS - 1) do
  106.     begin
  107.       if (random(3) <> 1) then
  108.         myArray[r][c] := '.';
  109.     end;
  110.   end;
  111.   myArray[2][2] := '.'; // starting tile is not a wall
  112.  
  113.  
  114.   // initialise smell map
  115.   for r := 1 to MAXROWS do
  116.   begin
  117.     for c := 1 to MAXCOLUMNS do
  118.     begin
  119.       if (myArray[r][c] = '#') then
  120.         smellMap[r][c] := BLOCKVALUE
  121.       else
  122.         smellMap[r][c] := 0;
  123.     end;
  124.   end;
  125.  
  126.   // set distance counter to 1
  127.   counter := 1;
  128.  
  129.   // add first tile to Queue twice (bit of a hack) so queue length is non-zero at start
  130.   addTile(2, 2, counter);
  131.   addTile(2, 2, counter);
  132.  
  133.   // Send first tile to flood fill procedure
  134.   PtrShow := Queue.Pop;
  135.   floodFillGrid(PtrShow);
  136.  
  137.  
  138.   (* Draw the map *)
  139.   ClrScr;
  140.   for r := 1 to MAXROWS do
  141.   begin
  142.     for c := 1 to MAXCOLUMNS do
  143.     begin
  144.       // GotoXY(c, r);
  145.       Write(myArray[r][c], '  ');
  146.     end;
  147.     writeln;
  148.   end;
  149.  
  150.   writeln;
  151.   readkey;
  152.  
  153.   (* Draw the smell map *)
  154.   ClrScr;
  155.   for r := 1 to MAXROWS do
  156.   begin
  157.     for c := 1 to MAXCOLUMNS do
  158.     begin
  159.       // GotoXY(c, r);
  160.       Write(smellMap[r][c], ' ');
  161.     end;
  162.     writeln;
  163.   end;
  164.  
  165.   writeln;
  166.   readkey;
  167. end.
  168.  

I'm not sure what's going wrong here.
Running Windows 10 & Antix Linux | Lazarus 2.0.6 | FPC 3.0.4

avk

  • Sr. Member
  • ****
  • Posts: 360
    • my self-education project
Re: Breadth first search not working consistently
« Reply #1 on: February 21, 2021, 03:30:37 pm »
I have not really delved into your code, while there is no time for this.
In short, usually BFS doesn't have to be recursive, most often it is just a loop.
Also correct traversal usually requires some way to mark the already visited elements.
Pseudocode:
Code: Pascal  [Select][+][-]
  1.   Queue.Push(Root, 1); //1 is counter
  2.   while Queue.Count > 0 do
  3.     begin
  4.       Elem := Queue.Pop;
  5.       mark Elem as visited;
  6.       Counter := Elem.Counter;
  7.       do something with Elem;
  8.       for Every in Elem.Children do
  9.         if not visited Every then
  10.           Queue.Push(Every, Counter + 1);
  11.     end;
  12.  
And secondly, if there may be more than, say, 50 elements in the queue, never use the queue from Contnrs.
Better use the queue from GQueue unit.

speter

  • Full Member
  • ***
  • Posts: 162
Re: Breadth first search not working consistently
« Reply #2 on: February 22, 2021, 01:28:03 am »
I think you'd be better off using a 'standard' recursive pathing algorithm!?

If you are interested, look at the attached project (and screenshot). :)

cheers
S.
PS My code uses your board; and assumes diagonal movement is not allowed.  :D
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

Laz 2.0.10 / FPC 3.2.0 / Windows 10 (64bit)

CyberFilth

  • Jr. Member
  • **
  • Posts: 63
    • CyberFilth.co.uk
Re: Breadth first search not working consistently
« Reply #3 on: February 22, 2021, 11:25:04 am »
Quote
I think you'd be better off using a 'standard' recursive pathing algorithm!?

If you are interested, look at the attached project (and screenshot).
That's a fantastic solution and so much simpler than the one I was trying, thanks for sharing that.

 I'm tinkering with a roguelike game here https://github.com/cyberfilth/Axes-Armour-Ale and wanted something a little easier than A* pathfinding or Dijkstra maps for my first attempt.
Your solution has really helped so, thanks again.
Running Windows 10 & Antix Linux | Lazarus 2.0.6 | FPC 3.0.4

speter

  • Full Member
  • ***
  • Posts: 162
Re: Breadth first search not working consistently
« Reply #4 on: February 22, 2021, 11:35:28 am »
That's a fantastic solution and so much simpler than the one I was trying, thanks for sharing that.

No worries :)

Over the past few days I found some pathing issues in a game I'm working on. When I dug into the (quite old) code I found that I had 2 pathing functions - one a linked list approach and the other a recursive approach - and so it was fresh in my mind, when I read you post.

cheers
S.
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

Laz 2.0.10 / FPC 3.2.0 / Windows 10 (64bit)

CyberFilth

  • Jr. Member
  • **
  • Posts: 63
    • CyberFilth.co.uk
Re: Breadth first search not working consistently
« Reply #5 on: February 24, 2021, 12:26:29 am »
speter, I'm having an issue when trying to implement your code into my own.
Your example works great for a smaller sized map, but when I try and scale it up to 67 columns and 19 rows (the size of my game map) I run into an error.

Below is the code that I've adapted slightly to fit my game map, I initially thought the error might be due to using bytes on a larger map so replaced them with smallint but no joy.

At 19 x 19 the code runs just fine, but at larger sizes I get a range checking error at line 94
distances[c,r] := BLOCKVALUE

I understand that I've butchered your code a little but do you have any insights into what's going wrong?

Code: Pascal  [Select][+][-]
  1. program floodFill;
  2.  
  3. uses
  4.   crt,
  5.   Classes,
  6.   SysUtils;
  7.  
  8. const
  9.   MAXROWS = 19;
  10.   MAXCOLUMNS = 67;
  11.   BLOCKVALUE = 99;
  12.  
  13. type
  14.   TDist = array [1..MAXROWS, 1..MAXCOLUMNS] of smallint;
  15.   Tbkinds = (bNone, bWall, bClear);
  16.  
  17. var
  18.   r, c: smallint;
  19.   myArray: array[1..MAXROWS, 1..MAXCOLUMNS] of string;  // the map that is used as input
  20.   smellMap: array [1..MAXROWS, 1..MAXCOLUMNS] of smallint; // map that is output
  21.   distances: TDist;
  22.  
  23.  
  24.   function blockORnot(x, y: smallint): Tbkinds;
  25.   begin
  26.     if (myArray[y][x] = '#') then
  27.       Result := bWall
  28.     else if (myArray[y][x] = '.') then
  29.       Result := bClear
  30.     else
  31.       Result := bNone;
  32.   end;
  33.  
  34.   procedure calcDistances(x, y: smallint);
  35.  
  36.     function rangeok(x, y: smallint): boolean;
  37.     begin
  38.       Result := (x in [2..MAXCOLUMNS - 1]) and (y in [2..MAXROWS - 1]);
  39.     end;
  40.  
  41.     procedure setaround(x, y: smallint; d: smallint);
  42.     const
  43.       r: array[1..4] of tpoint =              // the four directions of movement
  44.         ((x: 0; y: -1), (x: 1; y: 0), (x: 0; y: 1), (x: -1; y: 0));
  45.     var
  46.       a: smallint;
  47.       dx, dy: smallint;
  48.     begin
  49.       for a := 1 to 4 do
  50.       begin
  51.         dx := x + r[a].x;
  52.         dy := y + r[a].y;
  53.         if rangeok(dx, dy) and (blockORnot(dx, dy) = bClear) and
  54.           (d < distances[dx, dy]) then
  55.         begin
  56.           distances[dx, dy] := d;
  57.           setaround(dx, dy, d + 1);
  58.         end;
  59.       end;
  60.     end;
  61.  
  62.   begin
  63.     distances[x, y] := 0;
  64.     setaround(x, y, 1);
  65.   end;
  66.  
  67.  
  68.  
  69. begin
  70.   Randomize;
  71.  
  72.   // quick and dirty map
  73.   for r := 1 to MAXROWS do
  74.   begin
  75.     for c := 1 to MAXCOLUMNS do
  76.     begin
  77.       myArray[r][c] := '#';
  78.     end;
  79.   end;
  80.   for r := 2 to (MAXROWS - 1) do
  81.   begin
  82.     for c := 2 to (MAXCOLUMNS - 1) do
  83.     begin
  84.       if (random(3) <> 1) then
  85.         myArray[r][c] := '.';
  86.     end;
  87.   end;
  88.   myArray[2][2] := '.'; // starting tile is not a wall
  89.  
  90.  
  91.   (* Initialise distance map *)
  92.   for r := 1 to MAXROWS do
  93.     for c := 1 to MAXCOLUMNS do
  94.       distances[c, r] := BLOCKVALUE;
  95.  
  96.  
  97.   (* Draw the map *)
  98.   ClrScr;
  99.   for r := 1 to MAXROWS do
  100.   begin
  101.     for c := 1 to MAXCOLUMNS do
  102.     begin
  103.       Write(myArray[r][c], '  ');
  104.     end;
  105.     writeln;
  106.   end;
  107.  
  108.  
  109.   calcDistances(2, 2);
  110.  
  111.   writeln;
  112.   readkey;
  113.  
  114.   (* create smell map *)
  115.   for r := 1 to MAXROWS do
  116.   begin
  117.     for c := 1 to MAXCOLUMNS do
  118.     begin
  119.       smellmap[r][c] := distances[c, r];
  120.     end;
  121.   end;
  122.  
  123.   (* Draw smell map *)
  124.   ClrScr;
  125.   for r := 1 to MAXROWS do
  126.   begin
  127.     for c := 1 to MAXCOLUMNS do
  128.     begin
  129.       Write(smellmap[r][c], '  ');
  130.     end;
  131.     WriteLn;
  132.   end;
  133.  
  134.   writeln;
  135.   readkey;
  136.  
  137. end.
  138.  
Running Windows 10 & Antix Linux | Lazarus 2.0.6 | FPC 3.0.4

speter

  • Full Member
  • ***
  • Posts: 162
Re: Breadth first search not working consistently
« Reply #6 on: February 24, 2021, 12:54:30 am »
speter, I'm having an issue when trying to implement your code into my own.
Your example works great for a smaller sized map, but when I try and scale it up to 67 columns and 19 rows (the size of my game map) I run into an error.
Try using integer instead of shortint / byte; with the 19x19 map you max out at 160 distance; but 67x19 gives a max possible distance of 592 (I think) so byte (and shortint) will not work.

cheers
S.
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

Laz 2.0.10 / FPC 3.2.0 / Windows 10 (64bit)

CyberFilth

  • Jr. Member
  • **
  • Posts: 63
    • CyberFilth.co.uk
Re: Breadth first search not working consistently
« Reply #7 on: February 24, 2021, 01:08:46 am »
I tried amending to integers and, when that still didn't work, I tried scaling up the map uniformly.
20x20, 30x30 etc, and that worked. Even as much as 67x67 so it looks like I've probably switched the x and y coordinates somewhere and that's why it's going out of bounds (trying to reach the 67th row instead of column, for instance.

I'll play around and see if I can see where I screwed up.
Running Windows 10 & Antix Linux | Lazarus 2.0.6 | FPC 3.0.4

CyberFilth

  • Jr. Member
  • **
  • Posts: 63
    • CyberFilth.co.uk
Re: Breadth first search not working consistently
« Reply #8 on: February 24, 2021, 01:21:56 am »
Yup, that was it.
I found the offending lines and the amended version is below just for the sake of completeness.

Again, the problem wasn't with the code that you kindly provided. Just in my hacky way of converting it to use a 2 dimensional array.

Code: Pascal  [Select][+][-]
  1. program floodFill;
  2.  
  3. uses
  4.   crt,
  5.   Classes,
  6.   SysUtils;
  7.  
  8. const
  9.   MAXROWS = 19;
  10.   MAXCOLUMNS = 40;
  11.   BLOCKVALUE = 99;
  12.  
  13. type
  14.   TDist = array [1..MAXROWS, 1..MAXCOLUMNS] of integer;
  15.   Tbkinds = (bNone, bWall, bClear);
  16.  
  17. var
  18.   r, c: integer;
  19.   myArray: array[1..MAXROWS, 1..MAXCOLUMNS] of string;  // the map that is used as input
  20.   smellMap: array [1..MAXROWS, 1..MAXCOLUMNS] of integer; // map that is output
  21.   distances: TDist;
  22.  
  23.  
  24.   function blockORnot(x, y: integer): Tbkinds;
  25.   begin
  26.     if (myArray[y][x] = '#') then
  27.       Result := bWall
  28.     else if (myArray[y][x] = '.') then
  29.       Result := bClear
  30.     else
  31.       Result := bNone;
  32.   end;
  33.  
  34.   procedure calcDistances(x, y: integer);
  35.  
  36.     function rangeok(x, y: integer): boolean;
  37.     begin
  38.       Result := (x in [2..MAXCOLUMNS - 1]) and (y in [2..MAXROWS - 1]);
  39.     end;
  40.  
  41.     procedure setaround(x, y: integer; d: integer);
  42.     const
  43.       r: array[1..4] of tpoint =              // the four directions of movement
  44.         ((x: 0; y: -1), (x: 1; y: 0), (x: 0; y: 1), (x: -1; y: 0));
  45.     var
  46.       a: integer;
  47.       dx, dy: integer;
  48.     begin
  49.       for a := 1 to 4 do
  50.       begin
  51.         dx := x + r[a].x;
  52.         dy := y + r[a].y;
  53.         if rangeok(dx, dy) and (blockORnot(dx, dy) = bClear) and
  54.           (d < distances[dy, dx]) then
  55.         begin
  56.           distances[dy, dx] := d;
  57.           setaround(dx, dy, d + 1);
  58.         end;
  59.       end;
  60.     end;
  61.  
  62.   begin
  63.     distances[x, y] := 0;
  64.     setaround(x, y, 1);
  65.   end;
  66.  
  67.  
  68.  
  69. begin
  70.   Randomize;
  71.  
  72.   // quick and dirty map
  73.   for r := 1 to MAXROWS do
  74.   begin
  75.     for c := 1 to MAXCOLUMNS do
  76.     begin
  77.       myArray[r][c] := '#';
  78.     end;
  79.   end;
  80.   for r := 2 to (MAXROWS - 1) do
  81.   begin
  82.     for c := 2 to (MAXCOLUMNS - 1) do
  83.     begin
  84.       if (random(4) <> 1) then
  85.         myArray[r][c] := '.';
  86.     end;
  87.   end;
  88.   myArray[2][2] := '.'; // starting tile is not a wall
  89.  
  90.  
  91.   (* Initialise distance map *)
  92.   for r := 1 to MAXROWS do
  93.   begin
  94.     for c := 1 to MAXCOLUMNS do
  95.     begin
  96.       distances[r, c] := BLOCKVALUE;
  97.     end;
  98.   end;
  99.  
  100.  
  101.   (* Draw the map *)
  102.   for r := 1 to MAXROWS do
  103.   begin
  104.     for c := 1 to MAXCOLUMNS do
  105.     begin
  106.       Write(myArray[r][c], '  ');
  107.     end;
  108.     writeln;
  109.   end;
  110.  
  111.  
  112.   calcDistances(2, 2);
  113.  
  114.   writeln;
  115.   readkey;
  116.  
  117.   (* create smell map *)
  118.   for r := 1 to MAXROWS do
  119.   begin
  120.     for c := 1 to MAXCOLUMNS do
  121.     begin
  122.       smellmap[r][c] := distances[r, c];
  123.     end;
  124.   end;
  125.  
  126.   (* Draw smell map *)
  127.   for r := 1 to MAXROWS do
  128.   begin
  129.     for c := 1 to MAXCOLUMNS do
  130.     begin
  131.       Write(smellmap[r][c], '  ');
  132.     end;
  133.     WriteLn;
  134.   end;
  135.  
  136.   writeln;
  137.   readkey;
  138.  
  139. end.
  140.  
  141.  
Running Windows 10 & Antix Linux | Lazarus 2.0.6 | FPC 3.0.4

 

TinyPortal © 2005-2018