Breadth first search not working consistently

[CyberFilth]

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.

[avk]

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]

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. 

[CyberFilth]

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.

[speter]

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.

[CyberFilth]

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.  

[speter]

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.

[CyberFilth]

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.

[CyberFilth]

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.