Wolfram Computation Meets Knowledge

Creating an Animated Historical Map Function for the Wolfram Function Repository

Mapping an Ancient Empire

Geocomputation is an indispensable modern tool for analyzing and viewing large-scale data such as population demographics, natural features and political borders. And if you’ve read some of my other posts, you can probably tell that I like working with maps. Recently, a Wolfram Community member asked:

“How do I make an interactive map of the
Byzantine Empire through the years?”

To figure out a solution, we’ll tap into the Wolfram Knowledgebase for some historical entities, as well as some of the high-level geocomputation and visualizations of the Wolfram Language. Once we’ve created our brand-new function, we’ll submit it to the Wolfram Function Repository for anyone to use.

Byzantine Empire

Working with Geographic Entities

First, let’s see what knowledge is available on the Byzantine Empire. We can grab the appropriate Entity using natural language input ( + =):

Byzantine Empire
&#10005

\!\(\*NamespaceBox["LinguisticAssistant", 
	    DynamicModuleBox[{Typeset`query$$ = "byzantine empire", 
	      Typeset`boxes$$ = 
	       TemplateBox[{"\"Byzantine Empire\"", 
	         RowBox[{"Entity", "[", 
	           RowBox[{"\"HistoricalCountry\"", ",", 
	             "\"ByzantineEmpire\""}], "]"}], 
	         "\"Entity[\\\"HistoricalCountry\\\", \
	\\\"ByzantineEmpire\\\"]\"", "\"historical country\""}, "Entity"], 
	      Typeset`allassumptions$$ = {{"type" -> "Clash", 
	         "word" -> "byzantine empire", 
	         "template" -> 
	          "Assuming \"${word}\" is ${desc1}. Use as ${desc2} instead",
	          "count" -> "3", 
	         "Values" -> {{"name" -> "HistoricalCountry", 
	            "desc" -> "a historical country", 
	            "input" -> 
	             "*C.byzantine+empire-_*HistoricalCountry-"}, {"name" -> 
	             "HistoricalPeriod", "desc" -> "a historical period", 
	            "input" -> 
	             "*C.byzantine+empire-_*HistoricalPeriod-"}, {"name" -> 
	             "Word", "desc" -> "a word", 
	            "input" -> "*C.byzantine+empire-_*Word-"}}}}, 
	      Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, 
	      Typeset`querystate$$ = {"Online" -> True, "Allowed" -> True, 
	        "mparse.jsp" -> 0.401559`6.055294357536461, 
	        "Messages" -> {}}}, 
	     DynamicBox[
	      ToBoxes[AlphaIntegration`LinguisticAssistantBoxes["", 4, 
	        Automatic, Dynamic[Typeset`query$$], Dynamic[Typeset`boxes$$],
	         Dynamic[Typeset`allassumptions$$], 
	        Dynamic[Typeset`assumptions$$], Dynamic[Typeset`open$$], 
	        Dynamic[Typeset`querystate$$]], StandardForm], 
	      ImageSizeCache -> {128., {7., 16.}}, 
	      TrackedSymbols :> {Typeset`query$$, Typeset`boxes$$, 
	        Typeset`allassumptions$$, Typeset`assumptions$$, 
	        Typeset`open$$, Typeset`querystate$$}], 
	     DynamicModuleValues :> {}, 
	     UndoTrackedVariables :> {Typeset`open$$}], 
	    BaseStyle -> {"Deploy"}, DeleteWithContents -> True, 
	    Editable -> False, SelectWithContents -> True]\)

empire = Entity
&#10005

empire = Entity["HistoricalCountry", "ByzantineEmpire"];

As with most entities, we can use the "Properties" element here for a convenient list of built-in information:

empire["Properties"]
&#10005

empire["Properties"]

In this case, we’re mainly looking for the political borders; for geographic entities, this is normally stored as the "Polygon" property. We can use GeoGraphics for a quick preview:

GeoGraphics[empire["Polygon"]]
&#10005

GeoGraphics[empire["Polygon"]]

The Byzantine Empire (a “historical country”) no longer exists, but this is a snapshot of the empire at its largest state. Dated provides access to historical properties by year. Using All as the second argument, we can get a list of all polygons over the lifetime of the empire, indexed by year (with DeleteMissing removing empty entries):

polygonList = DeleteMissing
&#10005

polygonList = DeleteMissing[Dated[empire, All]["Polygon"], 1, 2];v

This list contains both dates and polygons, so splitting it into two separate lists will help simplify our code later:

dateList = DateObject /@ polygonList
&#10005

dateList = DateObject /@ polygonList[[All, 1]];
polygonList = polygonList[[All, 2]];

To add an additional layer of info to our map, let’s also get a list of the modern countries that overlap with the empire’s former territory:

countryList = empire["CurrentCountries"]
&#10005

countryList = empire["CurrentCountries"]

Creating and Styling Geovisualizations

Now we have all the data we need to start creating our interactive maps; let’s see how we can tweak styles for a well-polished final result.

All of our maps should have a consistent plot range that covers the empire at its peak. We can compute the bounds for our plot using GeoBounds and to add a five-degree buffer space around the edges:

bounds = GeoBounds
&#10005

bounds = GeoBounds[polygonList, Quantity[5, "AngularDegrees"]]

To visualize the countries, we’ll use GeoListPlot with the appropriate GeoRange, applying the "Satellite" setting for GeoBackground and adding interactive Tooltip labels with GeoLabels:

countryMap = GeoListPlot
&#10005

countryMap = 
 GeoListPlot[countryList, GeoBackground -> "Satellite", 
  GeoLabels -> (Tooltip[#1, #2["Name"]] &), PlotStyle -> Gray, 
  GeoRange -> bounds]

As shown in the previous section, we can use GeoGraphics to show the empire’s polygon. Using GeoStyling directives, we give the polygon a look to distinguish it from the background. The Wolfram Language provides a number of ways to represent colors; for simplicity, we’ll use the built‐in Orange. Since this is going to display in front of the other graphic, we’ll set GeoBackground to None:

empireOverlay = GeoGraphics
&#10005

empireOverlay = GeoGraphics[{GeoStyling[{
	     FaceForm[{Opacity[0.7], Orange}],
	     EdgeForm[{Dashed, Darker@Orange}]}],
	   empire["Polygon"]}, GeoBackground -> None, GeoRange -> bounds]

To make a label for the graphic, we can generate a Grid with the name of the empire, the year (standardized using DateString), and the total GeoArea of the polygon:

date = Extract
&#10005

date = Extract[dateList, 
	  FirstPosition[polygonList, empire["Polygon"]]]

Grid
&#10005

Grid[{
	  {empire["Name"], SpanFromLeft},
	  {"Year: ", DateString[date, {"Year", " ", "CEBCE"}]},
	  {"Area: ", GeoArea@empire["Polygon"]}
	  }]

Then we add a frame and wrap the result in Inset to define its position; the second argument {Left, Bottom} refers to the bottom-left corner of the graphic, and the third argument {-1.1, -1.2} gives some extra space around the label:

Inset
&#10005

Inset[
	 Framed[%],
	 {Left, Bottom}, {-1.1, -1.2}]

Adding a few more styling options, we can create a function to generate the appropriate labels:

makeLabel
&#10005

makeLabel[name_, date_, area_] := Inset[
	  Framed[Grid[{
	     {Style[name, 14], SpanFromLeft},
	     {Style["Year: ", Gray], DateString[date, {"Year", " ", "CEBCE"}]},
	     {Style["Area: ", Gray], 
	      QuantityForm[area // Round, "Abbreviation"]}
	     }, Alignment -> Left, BaseStyle -> {"Text", Orange, 10}], 
	   FrameStyle -> GrayLevel[0.9], Background -> White, 
	   RoundingRadius -> 5],
	  {Left, Bottom}, {-1.1, -1.2}]

label = makeLabel
&#10005

label = makeLabel[empire["Name"], date, GeoArea[empire["Polygon"]]]

Finally, we combine all the graphics with Overlay, setting the third argument to 1 to keep the tooltips active in the first layer. Our inline label can be added to the polygon using Show and Epilog for a fully styled and labeled interactive map:

Overlay
&#10005

Overlay[{countryMap, 
  Show[empireOverlay, Epilog -> {label}, GeoRange -> bounds]}, All, 1]

Creating and Tweaking Animations

Adapting this code slightly, we can make an animation of the empire’s territory over time. First we’ll use Table to make lists of empire overlays and labels for each year:

empireOverlays = Table
&#10005

empireOverlays = Table[GeoGraphics[{GeoStyling[{
	       FaceForm[{Opacity[0.7], Orange}],
	       EdgeForm[{Dashed, Darker@Orange}]}],
	     p}, GeoBackground -> None], {p, polygonList}];

labels = Table
&#10005

labels = Table[
	   makeLabel[empire["Name"], dateList[[d]], 
	    GeoArea[polygonList[[d]]]], {d, Length@dateList}];

Then we use Animate to display the combined graphics in sequence:

Animate
&#10005

Animate[
	 Overlay[{countryMap, 
	   Show[empireOverlays[[i]], Epilog -> {labels[[i]]}, 
	    GeoRange -> bounds]}, All, 1],
	 {{i, 1, "Year"}, 1, Length[labels], 1}]

On some systems (and for some empires), this animation may not perform very well. That’s because these raw GeoGraphics objects are computationally complex, and the animation is trying to overlay two of them in every frame. One easy trick for improving the performance of a heavy-duty animation is to apply Rasterize to all the frames and use ListAnimate to assemble them:

frames = Table

&#10005

frames = Table[Rasterize[
    Overlay[{countryMap, 
      Show[empireOverlays[[i]], Epilog -> {labels[[i]]}, 
       GeoRange -> bounds]}, All, 1]],
   {i, 1, Length[labels]}];
ListAnimate[frames]

This smooths out the final animation, but it also takes substantially longer to evaluate and removes our interactive tooltips. Deciding between more features, faster loading or better performance can be tricky, but fortunately we don’t need to choose—yet. For now, it’s sufficient to note that the interactive version works better in a desktop session, whereas the rasterized version is more appropriate for cloud/web deployment.

Generating a ResourceFunction

Although we started with the Byzantine Empire in mind, this entire workflow can actually work for many of the historical country entities in the language. Others might find this useful—so we’ll publish it through the Wolfram Function Repository for quick access from any Wolfram Language interface.

We can launch the ResourceFunction template notebook by selecting File > New > Repository Item > Function Repository Item. First we’ll give the function a name—let’s go with HistoricalCountryAnimate—and describe what it does:

Definition notebook

Our code goes in the Definition section as a SetDelayed (:=) expression, structured like so:

HistoricalCountryAnimate
&#10005

HistoricalCountryAnimate[arg_, opts___] := Module[{vars}, expr]

For this function our argument (arg) should be the Entity for the desired empire:

HistoricalCountryAnimate
&#10005

HistoricalCountryAnimate[empire_Entity, opts___] := 
 Module[{vars}, expr]

Using OptionsPattern, we can provide a few options (opts) for our different output types. We’ll add "Tooltips" as a Boolean (True/False) option, as well as including the standard GeoBackground, with default settings given for both:

HistoricalCountryAnimate
&#10005

HistoricalCountryAnimate[
  empire_Entity,
  OptionsPattern[{
    "Tooltips" -> True,
    GeoBackground -> "Satellite"}]
  ] := Module[{vars}, expr]

Most of the code within the Module follows what we’ve done in this post so far—defining all local variables (vars) and entering the rest of the code to be evaluated (expr)—but with some additions for dealing with options. For instance, to determine whether to add tooltips, we can use an If statement within the function that depends on OptionValue["Tooltips"]:

GeoListPlot
&#10005

GeoListPlot[countryList,
 GeoLabels -> 
  If[OptionValue["Tooltips"], Tooltip[#1, #2["Name"]] &, None],
 ... ]

GeoBackground can be passed to the graphics using the appropriate OptionValue expression:

countryMap = GeoListPlot
&#10005

countryMap = GeoListPlot[countryList,
  GeoBackground -> OptionValue[GeoBackground],
  ... ]

Using similar strategies, we can add any number of options to our function. Check out the published function in the Wolfram Function Repository to see some additional ideas, including a “Rasterize” option for producing a non-interactive version.

In the Documentation section, we add our single usage case, along with details about the function’s behavior (e.g., as in this case, a long evaluation time) and possible options:

Function documentation

The submission notebook also provides space for usage examples, keywords, related symbols and additional information. Once everything is filled out, clicking the Submit to Repository button converts the notebook and sends it for review. This particular function has already been accepted for publication—you can now access it directly from Wolfram Language 12:

ResourceFunction["HistoricalCountryAnimate"]
&#10005

ResourceFunction["HistoricalCountryAnimate"]

With that, we have a fully implemented and published function for displaying an interactive map of the Byzantine Empire or any other historical country. Using the Wolfram Language’s range of geographic entities, visualizations and styles, we can create any number of similar functions. And with the unified structure of the language, it’s easy to apply strategies for a single entity to an entire class. So take a few minutes to explore the Maps & Cartography reference guide and some of the latest geovisualization features. If you make something useful, don’t forget to share it in the Wolfram Function Repository!

Have questions on a project using the Wolfram Language? Share them here and browse other questions from Wolfram Community!

Comments

Join the discussion

!Please enter your comment (at least 5 characters).

!Please enter your name.

!Please enter a valid email address.

2 comments

  1. This is very cool! I’m curious as to why you chose an Overlay approach, instead of putting everything in one GeoGraphics – was it a performance-related decision?

    Reply
  2. Thanks Brian

    This was a very interesting blog on how to animate historical data from our data resources. It provides a good template for undertaking other time based resources.

    Regards
    Michael

    Reply