Message Boards Message Boards

[GiF] Computational history: countries that are gone

GROUPS:

X - country birth | Y - country death | RADIUS - lifetime

enter image description here

Mongol Empire

enter image description here

The Mongol Empire existed during the 13th and 14th centuries and was the largest contiguous land empire in history. Originating in the steppes of Central Asia, the Mongol Empire eventually stretched from Eastern Europe to the Sea of Japan, extending northwards into Siberia, eastwards and southwards into the Indian subcontinent, Indochina, and the Iranian plateau, and westwards as far as the Levant and Arabia. As you probably guessed the information is from here:

WikipediaData["Mongol Empire"]

And the image you see above is built with information stored in

EntityProperties["HistoricalCountry"]

enter image description here

Let's see what we can do with these data. First of I will get the data, - and you can see we have 1990 countries listed:

hc = EntityList["HistoricalCountry"];
hc // Length
(*1990*)

First of all I am curious about chronology of these social structures. The data go back in time so far that sometimes we simply do not have some information. Hence I will apply some filters to drop the missing information:

startend = DeleteMissing[EntityValue[hc, {"Entity", 
    EntityProperty["HistoricalCountry", "StartDate"], 
    EntityProperty["HistoricalCountry", "EndDate"]}], 1, 2];
startend = DeleteCases[startend, {_, _, _Alternatives}];

Now I sort by duration of country existence and look at a few countries with longest-existence:

sorthc = SortBy[{#1, #3 - #2} & @@@ startend, Last];

Row[TableForm[{#1, #2, N[UnitConvert[#2, "Year"]]} & @@@ 
Reverse[#]] & /@{sorthc[[-10 ;;]], sorthc[[-20 ;; -11]]}, Spacer[50]]

enter image description here

So the longest existing historical country according to our data is Ordos Culture counting about 28,000 years.

StringTake[WikipediaData["Ordos culture"], 505]

The Ordos culture was a culture occupying a region centered on the Ordos Loop (modern Inner Mongolia, China) during the Bronze and early Iron Age from the 6th to 2nd centuries BCE. The Ordos culture is known for significant finds of Scythian art and is thought to represent the easternmost extension of Indo-European Eurasian nomads, such as the Scythians. Under the Qin and Han dynasties, from the 6th to 2nd centuries BCE, the area came under at least nominal control of contemporaneous Chinese states.

Now I am curios of how the countries' lifetime was distributed throughout the whole history. Wolfram Language has a neat visualization tool - TimelinePlot - for that. We have so many countries that I will take a random sample of them to not overload the visual.

SeedRandom[3];
tmp=RandomSample[startend,20];
TimelinePlot[Association@@Thread[EntityValue[tmp[[All,1]],"Name"]->
(Interval/@tmp[[All,2;;3]])],Filling->Below,
FillingStyle->Directive[Opacity[.2],Orange],PerformanceGoal->"Speed"]

enter image description here

And now with a larger sample of 1000 countries but without labels:

SeedRandom[5];
tmp=RandomSample[startend[[All,2;;3]],1000];
TimelinePlot[Interval/@tmp,Filling->Below,
PerformanceGoal->"Speed",AspectRatio->1,PlotTheme->"Marketing"]

enter image description here

We see that the deeper in the past, the longer is lifetime and the fewer countries we have. This tendency can be easily visualized by plotting:

BubbleChart[{#1,#2,#2-#1}&@@@Map[AbsoluteTime,startend[[;;500,2;;3]],{2}],
ChartStyle->EdgeForm[Opacity[.05]],FrameTicks->None,ColorFunction->Function[{x,y,r},
RGBColor[r,1-r,1-r,r]],PerformanceGoal->"Speed",ImageSize->1000]

X - country birth | Y - country death | RADIUS - lifetime

enter image description here

Obviously above-diagonal nature is due to the fact that enddate is always later than the start date. Amazingly there are many countries that exist just a few days. Let's see the shortest living countries:

fewDAYs = Cases[sorthc[[All, 2]], x_ /; x > Quantity[0, "Days"]][[;; 10]]

enter image description here

TableForm@Flatten[Cases[sorthc, {_, #}] & /@ fewDAYs, 1]

enter image description here

I sort countries by their lifetime in years and plot RANK vs LIFETIME in a log-log plot:

yearLIFETIME=QuantityMagnitude@N[UnitConvert[Cases[sorthc[[All,2]],x_/;x>Quantity[0, "Days"]],"Year"]];
ListLogLogPlot[yearLIFETIME,PlotRange->All,PlotTheme->"Business",Filling->Bottom,
FrameLabel->{"RANK","LIFETIME"},PlotLabel->"Log-Log plot in YEARs",BaseStyle->15,ImageSize->1000]

enter image description here

For small-lifetime countries we see almost a straight line - the sign of a power law. Now I would like to take a look at some specific counties. Especially those who grew spatially very fast, - of course, due to their military conquest.

Mongol Empire

enter image description here

Let's get all polygons related to historical borders of Mongol Empire for every year between its existence 1206 -1368:

mongPOLY=ParallelTable[EntityValue[Entity["HistoricalCountry","MongolEmpire"],
EntityProperty["HistoricalCountry","Polygon",{"Date"->DateObject[{t}]}]],{t,1206,1368}];

For many years we have many identical borders - let's compress - find only unique borders:

mongPOLY//Length
mongPOLYcomp=DeleteMissing[DeleteDuplicates[
    Transpose[{Range[1206,1368],mongPOLY}],Last[#1]==Last[#2]&],1,2];
mongPOLYcomp//Length

13 compressed out of total 163 total borders! I plot them all:

GeoGraphics[{EdgeForm[Red], GeoStyling[Opacity[.07]], #} & /@ 
  mongPOLYcomp[[All, 2]], GeoProjection -> "Mercator", 
 ImageSize -> 800, GeoBackground -> GeoStyling["StreetMap"], 
 GeoRange -> {{20, 70}, {17, 133}}, GeoZoomLevel -> 4]

enter image description here

And for animation show at the top of the post:

frames=ParallelTable[
GeoGraphics[{EdgeForm[Red],GeoStyling[Opacity[.07]],mongPOLYcomp[[;;t,2]]},
GeoProjection->"Mercator",ImageSize->800,GeoRange->{{20,70},{17,133}},
GeoBackground->GeoStyling["StreetMap"],
Epilog->Text[Framed[Style[mongPOLYcomp[[t,1]],20,Red,Bold],Background->White],
Scaled[{.06,.955}]]],{t,1,13}];

Export["MongolEmpire.gif", frames, "DisplayDurations" -> {.5}]

Nazi Germany

enter image description here

We need finer dates for Nazi Germany because it existed just a few years, let's choose month:

enter image description here

Get all borders:

gerPOLY=ParallelTable[EntityValue[Entity["HistoricalCountry","NaziGermany"],
EntityProperty["HistoricalCountry","Polygon",{"Date"->DateObject[t]}]],{t,gerdates}];

gerPOLY//Length
gerPOLYcomp=DeleteMissing[DeleteDuplicates[Transpose[{gerdates,gerPOLY}],Last[#1]==Last[#2]&],1,2];
gerPOLYcomp//Length

9 unique borders out 148 total! Lets plot them all:

GeoGraphics[{EdgeForm[Red], GeoStyling[Opacity[.07]], 
  gerPOLYcomp[[All, 2]]}, GeoProjection -> "Equirectangular", 
 ImageSize -> 800, GeoBackground -> GeoStyling["StreetMap"], 
 GeoZoomLevel -> 5]

enter image description here

Now, for the history buffs of WWII, I am curious what these borders exactly correspond to in this labeled map from Wikipedia, which differentiates between occupied and allied counties.

enter image description here

Kingdom of France

Using the same technique we can get the evolution of borders for the Kingdom of France (without remote colonies):

enter image description here

enter image description here

You could probably even 3D print this evolution, a start is here (see attached notebook for code):

enter image description here

Attachments:
POSTED BY: Vitaliy Kaurov
Answer
1 year ago

Dear Vitaliy,

this is an absolutely amazing post!!! It would have been nice to have these graphics in my history classes back at school.

As you say RANK vs LIFETIME in a log-log for a large range there is a power-law like behaviour. It is actually interesting to look at the countries that did better than that. What did they do differently? It also appears that the half life time of countries/empires becomes shorter over time; there might be a strong selection bias though.

This is a really beautiful piece of work. Thanks for posting.

Marco

POSTED BY: Marco Thiel
Answer
1 year ago

Dear Marco, thank you! Yes I think selection bias is quite strong. History is tough to quantify. The deeper in past the harder it is to detect fabrication and access cultural background, so the perception is distorted. On the other hand, perception of modern history is strongly distorted by politics and mass media. My old highschool history teacher was suggesting that history is akin quantum mechanics: one can make only probable descriptions and one's "measurements" (journalism) might affect the outcome and you always part of the process. This challenges make it even more interesting though.

POSTED BY: Vitaliy Kaurov
Answer
1 year ago

Group Abstract Group Abstract