‹›Élargissement de la base de connaissancesAnimez l'ascension et la chute des pays historiques
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.
Afficher l'entrée complète de Wolfram Language
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}}]