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.

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 ( + =):

Engage with the code in this post by downloading the Wolfram Notebook

&#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]\)

&#10005 empire = Entity["HistoricalCountry", "ByzantineEmpire"];

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

&#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:

&#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):

&#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:

&#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:

&#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:

&#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:

&#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:

&#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:

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

&#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:

&#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:

&#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}]

&#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:

&#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:

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

&#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:

&#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:

&#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:

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

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

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

&#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:

&#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"]:

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

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

&#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:

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:

&#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!