Wolfram言語™

歴史上の国々の盛衰をアニメーションにする

バージョン11では，歴史上の国の境界を示す多角形が数多く含まれるようになったため，さまざまな国や帝国の隆盛と衰退を可視化できるようになった．

In[1]:=

historicalCountryAnimate[entity_, nframes_: 100, opts : OptionsPattern[]] := Module[ {ini, end, step, polygon, times, reducedPolygon, countries, len, frames}, {ini, end} = First[DateList[#]] & /@ Entity["HistoricalCountry", entity][{EntityProperty["HistoricalCountry", "StartDate"], EntityProperty["HistoricalCountry", "EndDate"]}]; step = Ceiling[(end - ini) / nframes]; polygon = ParallelTable[EntityValue[Entity["HistoricalCountry", entity], EntityProperty["HistoricalCountry", "Polygon", {"Date" -> DateObject[{t}]}]], {t, ini, end, step}]; times = Table[t, {t, ini, end, step}]; reducedPolygon = DeleteMissing[ DeleteDuplicates[Transpose[{times, polygon}], Last[#1] == Last[#2] &], 1, 2]; countries = EntityValue[Entity["HistoricalCountry", entity], EntityProperty["HistoricalCountry", "CurrentCountries"]]; len = Length[reducedPolygon]; frames = ParallelTable[ GeoGraphics[{EdgeForm[Red], Blue, GeoStyling[Opacity[.07]], reducedPolygon[[t, 2]]}, opts, GeoProjection -> "Mercator", ImageSize -> 500, GeoRange -> "World", GeoBackground -> GeoStyling["StreetMap"], Epilog -> Text[Framed[Style[reducedPolygon[[t, 1]], 20, Red, Bold], Background -> White], Scaled[{.06, .955}]] ], {t, 1, len} ]; ListAnimate[frames, AnimationRunning -> False, AnimationRepetitions -> 1] ]

In[2]:=

historicalCountryAnimate["RomanRepublic", 100, GeoRange -> {{30, 50}, {-15, 40}}]

動画を開始

動画を中止

In[3]:=

historicalCountryAnimate["MongolEmpire", 100, GeoRange -> {{20, 70}, {20, 140}}]

動画を開始

動画を中止