📜 ⬆️ ⬇️

Algorithm for finding paths in the maze

Good day, dear community.

Prehistory



One day, walking around the internet, a maze was found. It was interesting to find out its passage and having walked on the network, I still did not find a working software implementation, a solution to the maze.
')
Here it is:




The working day was boring, the mood was great. Purpose, means and desire are available. The conclusion is obvious, we will pass.



Story



For a convenient solution, it is necessary to have a maze image available, lead to the type of two-dimensional array. Each element of which can take one of 3 values:

const WALL=-1; BLANK=-2; DEADBLOCK=-3; 


In advance, I want to show the functions for scanning an image of a maze and then writing data to an array, and a function to generate a new image, based on the data from the array:
Image scan:

 ... var N:integer=600; LABIRINT:array[0..600,0..600] of integer; ... var bit:TBitmap; i,j:integer; begin bit:=TBitmap.Create; If OpenDialog1.Execute then begin bit.LoadFromFile(OpenDialog1.FileName); for i:=0 to N do for j:=0 to N do if bit.Canvas.Pixels[j,i]=clWhite then LABIRINT[j,i]:=BLANK else LABIRINT[j,i]:=WALL; bit.Free; ... end; end; ... 


Image generation:

 ... var N:integer=600; LABIRINT:array[0..600,0..600] of integer; ... procedure genBitmap; var bit:TBitmap; i,j:Integer; begin bit:=TBitmap.Create; bit.Width:=N+1; bit.Height:=N+1; for i:=0 to N do for j:=0 to N do begin if LABIRINT[i,j]=BLANK then bit.Canvas.Pixels[i,j]:=clWhite // else if LABIRINT[i,j]=WALL then bit.Canvas.Pixels[i,j]:=clBlack else bit.Canvas.Pixels[i,j]:=clRed; end; bit.SaveToFile('tmp.bmp'); bit.Free; end; ... 




To begin with, it is necessary to resave the image as monochrome bmp, in order to have 2 colors white or black. If you look at the labyrinth, then it has a wall with a thickness of 2 pixels and a road with a thickness of 4 pixels. It would be ideal to make the wall and the thickness of the road 1 pixel. To do this, you need to rebuild the image, divide the image into 3, that is, remove each 2nd and 3rd, row and a column of pixels from the picture (this will not affect the correctness and patency of the maze).

Prepared drawing:


Image width and height: 1802 pixels.



1. Use the image scanning function.
2. Rebuild the image:

 ... var N:integer=1801; LABIRINT:array[0..1801,0..1801] of integer; ... procedure rebuildArr2; var i,j:integer; begin for i:=0 to ((N div 3) ) do for j:=0 to ((N div 3) ) do LABIRINT[i,j]:=LABIRINT[i*3,j*3]; N:=N div 3; end; ... 


3. Generate the rebuilt image.

The result of the procedure:


Image width and height: 601 pixels.



And so, we have the image of the maze of the desired type, now the most interesting, the search for all options for the passage of the maze. What do we have? Array with recorded values ​​WALL - wall and BLANK - road.

There was one unsuccessful attempt to find the passage of the maze using a wave algorithm. Why unsuccessful, in all attempts, this algorithm resulted in a “Stack Overflow” error. I am 100% sure that using it, you can find a passage, but a fuse appeared to come up with something more interesting.

The idea did not come immediately, there were several implementations of the passage, which by time worked for about 3 minutes, after which came the insight: “what if you’re not looking for the paths but the paths that do not lead to the labyrinth and mark them as dead ends”.

The algorithm is as follows:
Perform recursive function on all points of the maze roads:
1. If we stand on the road and there are 3 walls around us, mark the place where we stand as a dead end, otherwise we exit the function;
2. Go to a place that is not a wall from point number 1, and repeat point number 1;

Software implementation:

 ... var N:integer=600; LABIRINT:array[0..600,0..600] of integer; ... procedure setBlankAsDeadblockRec(x,y:integer); var k:integer; begin k:=0; if LABIRINT[x,y]=blank then begin if LABIRINT[x-1,y]<>BLANK then k:=k+1; if LABIRINT[x,y-1]<>BLANK then k:=k+1; if LABIRINT[x+1,y]<>BLANK then k:=k+1; if LABIRINT[x,y+1]<>BLANK then k:=k+1; if k=4 then LABIRINT[x,y]:=DEADBLOCK; if k=3 then begin LABIRINT[x,y]:=DEADBLOCK; if LABIRINT[x-1,y]=BLANK then setBlankAsDeadblockRec(x-1,y); if LABIRINT[x,y-1]=BLANK then setBlankAsDeadblockRec(x,y-1); if LABIRINT[x+1,y]=BLANK then setBlankAsDeadblockRec(x+1,y); if LABIRINT[x,y+1]=BLANK then setBlankAsDeadblockRec(x,y+1); end; end; end; procedure setDeadblock; var i,j:integer; begin for i:=1 to N-1 do for j:=1 to N-1 do setBlankAsDeadblockRec(i,j); end; ... 


Conclusion



I got a “full” working algorithm that can be used to search for all the maze passes. Last in speed of work exceeded all expectations. I hope my little work will benefit someone or push you to new thoughts.

The program code and the maze passed:
 //       . unit Unit1; interface uses Windows, Graphics, Forms, Dialogs, ExtCtrls, StdCtrls, Controls, Classes; const WALL=-1; BLANK=-2; DEADBLOCK=-3; type TForm1 = class(TForm) Button1: TButton; OpenDialog1: TOpenDialog; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; N:integer=600; LABIRINT:array[0..600,0..600] of integer; implementation {$R *.dfm} procedure genBitmap; var bit:TBitmap; i,j:Integer; begin bit:=TBitmap.Create; bit.Width:=N+1; bit.Height:=N+1; for i:=0 to N do for j:=0 to N do begin if LABIRINT[i,j]=BLANK then bit.Canvas.Pixels[i,j]:=clWhite // else if LABIRINT[i,j]=WALL then bit.Canvas.Pixels[i,j]:=clBlack else bit.Canvas.Pixels[i,j]:=clRed; end; bit.SaveToFile('tmp.bmp'); bit.Free; end; procedure rebuildArr2; var i,j:integer; begin for i:=0 to ((N div 3) ) do for j:=0 to ((N div 3) ) do LABIRINT[i,j]:=LABIRINT[i*3,j*3]; N:=N div 3; end; procedure setBlankAsDeadblockRec(x,y:integer); var k:integer; begin k:=0; if LABIRINT[x,y]=blank then begin if LABIRINT[x-1,y]<>BLANK then k:=k+1; if LABIRINT[x,y-1]<>BLANK then k:=k+1; if LABIRINT[x+1,y]<>BLANK then k:=k+1; if LABIRINT[x,y+1]<>BLANK then k:=k+1; if k=4 then LABIRINT[x,y]:=DEADBLOCK; if k=3 then begin LABIRINT[x,y]:=DEADBLOCK; if LABIRINT[x-1,y]=BLANK then setBlankAsDeadblockRec(x-1,y); if LABIRINT[x,y-1]=BLANK then setBlankAsDeadblockRec(x,y-1); if LABIRINT[x+1,y]=BLANK then setBlankAsDeadblockRec(x+1,y); if LABIRINT[x,y+1]=BLANK then setBlankAsDeadblockRec(x,y+1); end; end; end; procedure setDeadblock; var i,j:integer; begin for i:=1 to N-1 do for j:=1 to N-1 do setBlankAsDeadblockRec(i,j); end; procedure TForm1.Button1Click(Sender: TObject); var bit:TBitmap; i,j:integer; begin bit:=TBitmap.Create; If OpenDialog1.Execute then begin bit.LoadFromFile(OpenDialog1.FileName); for i:=0 to N do for j:=0 to N do if bit.Canvas.Pixels[j,i]=clWhite then LABIRINT[j,i]:=BLANK else LABIRINT[j,i]:=WALL; bit.Free; setDeadblock; genBitmap; end; end; end. 






To search for the shortest path, it is planned to apply the wave algorithm to the found maze passes. It would be interesting to hear what other algorithms can be used to quickly find the way in a large maze?

Source: https://habr.com/ru/post/198266/


All Articles