Новое в системе Wolfram Mathematica 9 › Расширенная поддержка графов и сетей

Расширенная функциональность нахождения цепей и туров

Планирование инспекционной поездки, посещающей пограничные посты между соседствующими странами как минимум один раз при минимальной длине путешествия.

In[1]:=

borderQ[cont1_, cont2_] := 
  MemberQ[CountryData[cont1, "BorderingCountries"], cont2];
countryGraph[country_] :=
  Block[{countries, coords, adjm},
   countries = CountryData[country];
   coords = 
    Reverse[CountryData[#, "CenterCoordinates"] & /@ countries, 2];
   adjm = 
    Table[If[borderQ[u, v] || borderQ[v, u], 1, 0], {u, 
      countries}, {v, countries}];
   AdjacencyGraph[countries, adjm, VertexCoordinates -> coords, 
    EdgeStyle -> Directive[Thickness[.003], White], 
    VertexStyle -> Directive[EdgeForm[GrayLevel[.8]], GrayLevel[.7]], 
    VertexSize -> .8]
   ];
showTour[graph_, tour_, country_] :=
 Block[{path, vrule, route},
  vrule = Thread[VertexList[graph] -> Range[VertexCount[graph]]];
  path = tour[[1, All, 1]];
  route = GraphEmbedding[graph][[Join[path, {path[[1]]}] /. vrule]];
  Show[{Graphics[{LightGray, 
      CountryData[#, "Polygon"] & /@ CountryData[country]}], 
    HighlightGraph[graph, path[[1]], VertexLabels -> "Name"], 
    Graphics[{Arrowheads[Join[{0}, ConstantArray[.018, 45]]], 
      GrayLevel[.3], Arrow[BSplineCurve[route, SplineDegree -> 2]]}]},
    ImageSize -> 500]
  ]

In[2]:=

In[3]:=

Out[3]//Short=

In[4]:=

Out[4]=