‹›Expansion de la base de connaissanceAnimez l'ascension et la chute des pays historiques
La version 11 inclut une vaste collection de polygones pour les frontières des pays historiques, qui peuvent être utilisés pour visualiser la croissance (et le déclin) de nombreuses nations et empires.
Montrer 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}}]