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