New in Wolfram
Mathematica
8: Graph & Network Analysis
◄
previous
|
next
►
Application Areas
Shortest Paths
Finding your way through countries.
In[1]:=
X
weightedRelationalGraph[vertices_, adjacentQ_, weightFun_, opts : OptionsPattern[WeightedAdjacencyGraph]] := WeightedAdjacencyGraph[vertices, Table[If[adjacentQ[u, v] || adjacentQ[v, u], weightFun[u, v], \[Infinity]], {u, vertices}, {v, vertices}], DirectedEdges -> False, opts];
In[2]:=
X
countrySet = CountryData["Africa"];
In[3]:=
X
borderQ[cont1_, cont2_] := MemberQ[CountryData[cont1, "BorderingCountries"], cont2];
In[4]:=
X
dist[u_, v_] := GeoDistance[CountryData[u, "CenterCoordinates"], CountryData[v, "CenterCoordinates"]];
In[5]:=
X
coord = (# -> Reverse@CountryData[#, "CenterCoordinates"]) & /@ countrySet;
In[6]:=
X
g = weightedRelationalGraph[countrySet, borderQ, dist, VertexCoordinates -> coord, GraphHighlightStyle -> "Thick"];
In[7]:=
X
highlightPath[path_] := Show[{Graphics[{Hue[.15, .5, .9], CountryData[#, "Polygon"] & /@ CountryData["Africa"]}], HighlightGraph[g, PathGraph[path], VertexSize -> {0.2, path[[1]] -> 0.7, path[[-1]] -> 0.7}, EdgeStyle -> White]}, ImageSize -> 500];
In[8]:=
X
highlightPath[FindShortestPath[g, "Swaziland", "WesternSahara"]]
Out[8]=