La version 11 inclut une vaste collection de polygones pour les frontières des pays historiques. Vous pouvez l'utiliser pour visualiser la croissance (et le déclin) de nombreuses nations et de nombreux empires.
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]
]
historicalCountryAnimate["RomanRepublic", 100,
GeoRange -> {{30, 50}, {-15, 40}}]
historicalCountryAnimate["MongolEmpire", 100,
GeoRange -> {{20, 70}, {20, 140}}]
