人口を約半分にする都道府県二分割をMathematicaでやってみた

ちょっと前に流行った、人口が約半分になるように都道府県を二分割する問題を Mathematica で書いてみました。

バージョンは Mathematica 11.0.1.0 を使いました。

参考: [人口が半分になるように都道府県を二分割してみたまとめ - Togetterまとめ](http://togetter.com/li/1053132)

# 乞う! Mathematicaの文法色づけ!

話がそれますが、[Mathematica Advent Calendar 2016 - Qiita](http://qiita.com/advent-calendar/2016/mathematica) の、

> "ぜひこのカレンダーを盛り上げて今度こそQiitaにMathematicaのシンタックスハイライトを対応してもらいましょう！"

この1文に「乗った!」と思いました。

# コード

Mathematica のプログラムはこれです。``prefectureName`` のところをお好きな都道府県に書き換えて遊んでみてください。広島大学の学生など、Mathematica をキャンパスライセンスで好き放題で遊べる人は学生のうちにこのとっても高価なソフトウェアで遊んでみるのもいいかもしれませんね。:-P

```mathematica
prefectureName = "Hiroshima";
a = CityData[{All, prefectureName, "Japan"}]
allPopulation = 
 Total[QuantityMagnitude[CityData[#, "Population"]] & /@ 
   a]; diff = 1;
Do[
 rs = RandomSample[Range[Length[a]], RandomInteger[Length[a]]];
 t = Total[
   QuantityMagnitude[CityData[#, "Population"]] & /@ a[[rs]]];
 d = Abs[1/2 - t/allPopulation];
 If[d < diff, diff = d; goodPartition = rs;];
 , {300}]
part = ImportString[URLFetch[#], 
     "JSON"] & /@ \
("http://nominatim.openstreetmap.org/search/?country=Japan&state=" <> 
        prefectureName <> "&city=" <> # <> 
        "&format=json&polygon_geojson=1" //. 
       x : {__Rule} :> Association[x] & /@ 
     Table[CityData[c, "Name"], {c, a[[goodPartition]]}]);
wholeArea = 
  "coordinates" /. ("geojson" /. 
     Import["http://nominatim.openstreetmap.org/search/?country=Japan&\
state=" <> prefectureName <> "&format=json&polygon_geojson=1", 
       "JSON"][[1]]);
Lookup[#, "display_name", {}] & /@ part
Lookup[#, "coordinates", {}] & /@ (Lookup[#, "geojson", {}] & /@ part);
GeoGraphics[{{EdgeForm[Red], FaceForm[Red], 
   Polygon /@ Flatten[%, 2]}, {EdgeForm[{Thick, Black}], 
   FaceForm[White], Polygon /@ wholeArea}}]

t = Total[
   QuantityMagnitude[CityData[#, "Population"]] & /@ 
    a[[goodPartition]]];

Print["Partition A: ", a[[goodPartition]], " ", t, " people (", 
 N[100 t/allPopulation], "%)"]

Print["Partition B: ", 
 a[[Complement[Range[Length[a]], goodPartition]]], " ", 
 allPopulation - t, " people (", N[100 (1 - t/allPopulation)], "%)"]
```

# 今回のアルゴリズム

## 分割アルゴリズム

今回はこの二分割アルゴリズムには、 ~~思考停止アルゴリズム~~ 乱択アルゴリズムにしました。(時間があったらもっとかっこいい構築的なアルゴリズムにも挑戦したいデス!)

分割アルゴリズム自体はここだけです。(残りのコードは結果の描画のためです。)

```mathematica
Do[
 rs = RandomSample[Range[Length[a]], RandomInteger[Length[a]]];
 t = Total[
   QuantityMagnitude[CityData[#, "Population"]] & /@ a[[rs]]];
 d = Abs[1/2 - t/allPopulation];
 If[d < diff, diff = d; goodPartition = rs;];
 , {300}]
```

ここを通過した後は ``a[[goodPartition]]`` が「ほぼ2分割した片側の市町村オブジェクトのリスト」になっています。

Mathematicaはこのような地理的な情報もネットワーク経由でダウンロードして来てくれるようになって、純粋数学以外にも結構使えます。人口は ``CityData[, "Population"]`` で取れます。

実験した感じによると、**200回から300回ぐらい回せばほとんど 1% も違わないような選択が得られる** ようです。

## 結果を地図で出すところは OpenStreetMap

結果を地図で出すところまで Mathematica でやりたかったのですが、Mathematicaの `CityData[]` が日本の市町村の境界を出してくれてないみたいなので、仕方なく OpenStreetMap を利用しました。

> http://nominatim.openstreetmap.org/search/?country=Japan&state=Hiroshima&city=Higashihiroshima&format=json&polygon_geojson=1

にアクセスすると広島県東広島市の情報を GEO JSON 形式でくださるので、それをそのまま ``Polygon[]`` に突っ込んでいるだけです。

OpenStreetMap Nominantim の API について詳しくは [OpenStreetMap Nominatim: Search](https://nominatim.openstreetmap.org/) をご覧ください。

# 種々の結果

いくつか画像により結果を載せておきます。変数 ``prefectureName`` をお好きな都道府県に変更して遊んでみてください。

## 広島県

![hiroshima-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/eee16dc9-95e9-9863-30fb-e94c2090ef3e.png)

## 岡山県

![okayama-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/32fbb8d9-018b-d92f-c17a-6c366df7314d.png)

## 山口県

![yamaguchi-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/6587c8d0-f18d-d55a-024f-da0506af0bdd.png)

## 大阪府

![osaka-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/71308128-8b45-62c4-6000-e89da528abd6.png)

## 長野県

<img width="619" alt="nagano-map.png" src="https://qiita-image-store.s3.amazonaws.com/0/3190/dd1003bb-80bf-fe8a-7f49-b50e9ab4d12b.png">

## 秋田県

<img width="508" alt="akita-map.png" src="https://qiita-image-store.s3.amazonaws.com/0/3190/ab3b3d5a-ca1a-1d67-bbdc-521285e676df.png">

## 神奈川県

![kanagawa-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/786dc60b-58ab-a163-0e81-9960ca608220.png)

## 東京都

wwwwwwwwwwww だめだこりゃwwww

![tokyo-map.png](https://qiita-image-store.s3.amazonaws.com/0/3190/8730e900-fa4f-80a8-9dec-9ced71404642.png)


# まとめ

そういうわけで Qiita の皆様、QiitaにMathematicaのシンタックスハイライト対応してください!🙇🏽