乞う! Mathematicaの文法色づけ!

話がそれますが、Mathematica Advent Calendar 2016 - Qiita の、

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

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

コード

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

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)], "%)"]

今回のアルゴリズム

分割アルゴリズム

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

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

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}]