Mathematica 教學 求解迷宮最短路徑

(*輸入迷宮資料*)
maze={{1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,1,1,1},{0,0,1,1,1,0,1,0,0,0,0,0,0,1,0,1,0,1},{1,0,1,0,1,
0,1,1,1,1,1,1,1,1,0,1,0,1},{1,0,1,0,1,0,0,0,0,0,1,0,0,0,0,1,0,1},{1,1,1,0,1,0,1,0,1,1,1,1,
1,1,1,1,0,1},{0,0,0,0,1,1,1,0,0,0,1,0,0,1,0,1,0,1},{1,0,1,1,1,0,0,0,1,1,1,1,0,1,0,1,0,1},{1,
1,1,0,1,1,0,1,1,0,1,0,0,1,0,1,0,1},{0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,0,1},{1,0,1,0,1,1,1,1,
0,0,0,0,0,1,0,1,0,1},{1,0,1,0,0,1,0,1,0,1,0,1,0,1,0,0,0,1},{1,1,1,1,1,1,0,1,1,1,1,1,0,1,1,
1,0,1},{0,0,0,0,1,0,0,0,0,1,0,1,0,1,1,1,0,1},{1,1,1,1,1,1,0,1,1,1,1,0,0,0,0,0,0,1},{0,0,
0,1,0,1,1,1,0,0,1,1,1,1,1,1,0,1},{1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,1,0,1},{1,0,0,1,1,0,1,1,0,
0,1,0,0,0,0,1,0,1},{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1}};

(*以ArrayPlot產生迷宮*)
ArrayPlot@maze


(*建立迷宮通道資料*)
n1=Table[If[maze[[i,j]]*maze[[i,j+1]]==1,
UndirectedEdge[Length@maze*(i-1)+j, Length@maze*(i-1)+j+1]],
{i,1,Length@maze}, {j,1,Length@maze-1}];
n2=Table[If[maze[[i,j]]*maze[[i+1,j]]==1,
UndirectedEdge[Length@maze*(i-1)+j,Length@maze*i+j]],
{i,1,Length@maze-1},{j,1,Length@maze}];
medge=Select[Flatten[{n1,n2}],Length@#>=2&]

(*產生迷宮圖*)
mg=Graph[Range[Length@maze*Length@maze], medge,
{FrameTicks->None,
VertexCoordinates->Flatten[Table[{i,j},{i,0,Length@maze-1},{j,0,Length@maze-1}],1]}]
(*事實上也可產生Adjacency Matrix藉由SHortestPath函數求解*)

(*計算由起點走出迷宮的最短路徑*)
mpath = FindShortestPath[mg, First@VertexList[mg], Last@VertexList[mg]]

(*計算由起點走出迷宮的最短路徑，並將最短路徑以紅色顯示*)
HighlightGraph[mg, PathGraph@ FindShortestPath[mg, First@VertexList[mg], Last@VertexList[mg]]]

(*定義最短路徑*)
sp[k_]:=Flatten[{UndirectedEdge[#[[1]],#[[2]]]->{Thickness[0.01],
Red}}&/@Partition[FindShortestPath[mg,First@VertexList[mg],Last@VertexList[mg]],
2,1]][[1;;k]]

(*輸出最短路徑動畫*)
Animate[Graph[Range[Length@maze*Length@maze],
medge,{FrameTicks->None,VertexCoordinates->Flatten[
Table[{i,j},{i,0,Length@maze-1},{j,0,Length@maze-1}],
1]},GraphHighlightStyle->Thick[0.01],
EdgeStyle->sp[z]],{z,1,52,1}]

Export["test.gif",Graph[Range[Length@maze*Length@maze],
medge,{FrameTicks->None,VertexCoordinates->
Flatten[Table[{i,j},{i,0,Length@maze-1}, {j,0,Length@maze-1}],1]},
GraphHighlightStyle->Thick[0.01],EdgeStyle->sp[#]]&/@Range[Length@mpath-1]]


Tags: Mathematica 教學, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見