アメリカの郡（カウンティ）の接続性
アメリカの隣接する郡の間の接続グラフを構築する．
アメリカ本土の隣接する州のすべての郡のリストを得る．
In[1]:=
Length[counties =
Flatten[EntityClass["AdministrativeDivision",
"ContinentalUSStates"]["Subdivisions"]]]Out[1]=
本土の48州のどれにも属さないコロンビア特別区を加える．
In[2]:=
AppendTo[counties,
Entity["AdministrativeDivision", {"DistrictOfColumbia",
"DistrictOfColumbia", "UnitedStates"}]];それぞれの郡と境界をなす郡のリストを計算する．
In[3]:=
bordering = EntityValue[counties, "BorderingCounties"];境界情報が得られないものは削除する．
In[4]:=
Length[missingpos = Position[bordering, _Missing]]Out[4]=
In[5]:=
counties = Delete[counties, missingpos];
bordering = Delete[bordering, missingpos];アメリカの郡の接続グラフの辺を構築する．
In[6]:=
Length[edges =
DeleteDuplicates[
Sort /@ Flatten[
MapThread[Thread[UndirectedEdge[##]] &, {counties, bordering}]]]]Out[6]=
In[7]:=
Graph[counties, edges]Out[7]=
より見慣れた埋込みを構築するために，すべての郡の中心位置をダウンロードする．
In[8]:=
pos = GeoPosition[EntityValue[counties, "Position"]]Out[8]=
次の地図投影法を使う．
In[9]:=
proj = {"LambertAzimuthal",
"Centering" ->
Entity["City", {"Topeka", "Kansas", "UnitedStates"}]};In[10]:=
projpos = First@GeoGridPosition[pos, proj];以下のグラフ埋込みが得られる．
In[11]:=
graph = Graph[counties, edges, VertexCoordinates -> projpos]Out[11]=
サンフランシスコ郡からマンハッタンに行くためには，始点と終点の郡も含めて少なくとも67郡を訪れる必要がある．
In[12]:=
Length[path = FindShortestPath[graph,
Entity[
"AdministrativeDivision", {"SanFranciscoCounty", "California",
"UnitedStates"}],
Entity[
"AdministrativeDivision", {"NewYorkCounty", "NewYork",
"UnitedStates"}]]]Out[12]=
In[13]:=
HighlightGraph[graph, PathGraph[path]]Out[13]=
