Clever Geek Handbook

迷路経路アルゴリズム

良い一日、親愛なるコミュニティ。



背景





ある晴れた日、インターネットの広がりを歩いて、迷路が見つかりました。 その通過を知り、ネットワークを散歩するのは興味深いものになりましたが、動作するソフトウェアの実装、迷路の解決策を見つけることができませんでした。



それは実際にはそれです：








仕事の日は退屈で、気分は最高でした。 目標、手段、希望があります。 結論は明らかで、合格します。







物語





便利な解決策として、迷路の既存の画像が必要であり、2次元配列のタイプになります。 各要素は、次の3つの値のいずれかを取ることができます。 



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




最初に、迷路の画像をスキャンするための関数を示し、続いて配列にデータを書き込み、配列のデータに基づいて新しい画像を生成する関数を示します。
画像スキャン： 



 ... 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; ...




画像生成： 



 ... 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; ...








手始めに、白または黒の2色にするために、画像をモノクロbmpとして再保存する必要があります。 迷路をよく見ると、壁の厚さは2ピクセル、道路の厚さは4ピクセルです。 壁と道路の厚さを1ピクセルにすることが理想的です。 これを行うには、画像を再構築し、画像を3つに分割する必要があります。つまり、画像から2番目と3番目のピクセルの行と列をすべて削除する必要があります（これは迷路の正確さと開通性に影響しません）。



準備図：




画像の幅と高さ：1802ピクセル。







1.画像スキャン機能を使用します。

2.イメージを再構築します。 



 ... 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.再構築されたイメージを生成します。



手順の結果：




画像の幅と高さ：601ピクセル。







したがって、目的のタイプのラビリンスのイメージがあります。今最も興味深いのは、ラビリンスを渡すためのすべてのオプションの検索です。 何がありますか？ 記録された値WALL-wallおよびBLANK-roadを持つ配列。



ウェーブアルゴリズムを使用して迷路の通過を見つける試みが1回失敗しました。 すべての試行で失敗した理由は、このアルゴリズムにより「スタックオーバーフロー」エラーが発生したためです。 私はそれを使用して、あなたが通路を見つけることができると100％確信していますが、より興味深い何かを思い付くヒューズがありました。



アイデアはすぐには出てきませんでしたが、通路のいくつかの実現があり、約3分間働きました。その後、インスピレーションが生まれました：「パスではなく、迷路に至らず、行き止まりとしてマークするパスを探すとどうなるでしょうか？」



アルゴリズムは次のとおりです。

迷路のすべてのポイントに沿って再帰関数を実行します。

1.道路上に立ち、周囲に3つの壁がある場合、立ち止まっている場所を行き止まりとしてマークし、そうでない場合は機能を終了します。

2.ポイント1から壁ではない場所に進み、ポイント1を繰り返します。



ソフトウェアの実装： 



 ... 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; ...




おわりに





すべての迷路を見つけるために使用できる「完全な」作業アルゴリズムを取得しました。 最新の速度はすべての期待を上回っていました。 私の小さな仕事が誰かの利益になるか、新しい考えを押し進めることを願っています。



プログラムコードと迷路を横断しました： 
 //       . 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.












最短経路を見つけるために、見つかった迷路歩行に波動アルゴリズムを適用することが計画されています。 大きな迷路の中でパスをすばやく見つけるために使用できる他のアルゴリズムを聞くのは興味深いでしょうか？


More articles:


All Articles