4
$\begingroup$

I would like to draw a map of the German states ("Bundesländer") with Mathematica 12.

I found examples how to outline countries. But I need the next smaller levels.

I have not found anything how to highlight the administrative divisions of a country of the first level (in DE: Länder, in France Region), of the second level (in DE: Regierungspräsidium, in FR: Département) etc. at all on a map.

How do you find out for which keywords there are geographical data in the Wolfram database?

How do you get a map with these entities outlined and how do you assign colors to them?

$\endgroup$
4
  • 2
    $\begingroup$ This should get you started: GeoGraphics[Flatten[{RandomColor[], Polygon@#} & /@ Entity["Country", "Germany"][EntityProperty["Country", "AdministrativeDivisions"]]]] $\endgroup$
    – Carl Lange
    Commented Aug 30, 2021 at 11:07
  • $\begingroup$ @CarlLange Do you know if there's built-in information about which states are adjacent? I would have expected Entity["AdministrativeDivision", {"Thuringia", "Germany"}][ EntityProperty["AdministrativeDivision", "BorderingStates"]] to work, but it does not. If it did, this could be directly generalized: mathematica.stackexchange.com/a/161343/12 $\endgroup$
    – Szabolcs
    Commented Aug 30, 2021 at 11:17
  • $\begingroup$ @Szabolcs Apparently not, neither BorderingStates nor BorderingCounties contain any data. It's odd because I would have thought they'd be (fairly) easily computed. $\endgroup$
    – Carl Lange
    Commented Aug 30, 2021 at 11:21
  • 3
    $\begingroup$ @Szabolcs It looks like you could create your own AdministrativeDivisionAdjacentQ easily using GeoDistance[{a, b}, DistanceFunction -> "Boundary"] and use that to fill the blanks... $\endgroup$
    – Carl Lange
    Commented Aug 30, 2021 at 11:25

1 Answer 1

6
$\begingroup$

Randomly-colored map

Let's start with a colored map of the first level of administrative divisions for a country. We'll use Germany, but any country that has curated data for administrative divisions and their polygons will work. For Germany, these divisions are the Bundesländer.

country = Entity["Country", "Germany"];
regions = 
  EntityList[
    country[EntityProperty["Country", "AdministrativeDivisions"]]];

For the regions that don't have polygons, the map will display dots at the center of each region. Here's a map with a random color for each region. Tooltip allows you to move the cursor over the map to see the names of the regions.

SeedRandom[1234];
randomColors = 
  Normal@AssociationThread[regions, RandomColor[Length[regions]]];
GeoGraphics[{EdgeForm[
   Directive[Thin, 
    Black]], {GeoStyling[#2], 
     Tooltip[Polygon[#1], 
      StringReplace[#1["Name"], "," ~~ __ -> ""]]} & @@@ 
   randomColors}]

region map with random colors

Four-color theorem map and border entity list

Another way to color the regions is to assign colors by solving the four-color theorem. We need to know the regions that have common borders. Unfortunately, except for the United States, the curated data doesn't list the bordering regions for country administrative divisions. However, we can make a list from the regions' polygons. This method will work for any country if the regions have polygons.

Build a list of regions and match the other regions that have a common border.

Again, we start with the list of administrative division regions.

  1. Make a matrix of the distance between borders for the regions using GeoDistance.
  2. Use the matrix to create an adjacency list with self-to-self references removed, e.g. {1, 1} is deleted. For any region with no bordering regions (i.e., islands), insert a place-holder with Null as the adjacent region.
  3. Cross reference the positions in adjacencyList to region entities, and apply the entities to the list.
  4. Use GroupBy to collect each region with a list of the regions with common borders to create borderEntityList.
country = Entity["Country", "Germany"];
regions = 
  EntityList[
   country[EntityProperty["Country", "AdministrativeDivisions"]]];
boundaryDistanceMatrix = GeoDistance[regions, regions];
adjacencyList = 
  Cases[Position[QuantityMagnitude[boundaryDistanceMatrix], 0.], 
   Except[{n_, n_}]];
If[Length@regions != 
   Length@DeleteDuplicates[adjacencyList[[All, 1]]],
  adjacencyList = Sort@Join[adjacencyList,
     Partition[
      Rest@Riffle[
        Complement[Range[Length@regions], 
          DeleteDuplicates[adjacencyList[[All, 1]]]], {Null},
        {1, -1, 2}], 2]]];
entityMap = AssociationThread[Range[Length[regions]], regions];
borderEntityList = 
  Normal@GroupBy[adjacencyList /. entityMap, 
     First -> Last] /. {Null} -> {};

We can use the border entity list to assign colors. I modified a method from Wolfram Community to find color assignments that are a solution to the four-color theorem.

(*choose four contrasting colors*)
fourColors = {RGBColor[.2, .67, .7], RGBColor[.21, .42, .65],
  RGBColor[1.0, .8, 0.0], RGBColor[.11, .49, .12]};
borderingregions = Values@borderEntityList;
neighbors = 
  Transpose[{regions, 
    Intersection[#, regions] & /@ borderingregions}];
toColor[tf_] := fourColors[[
   Switch[tf,
    {False, False}, 1, {False, True}, 2,
    {True, False}, 3, {True, True}, 4,
    _, Null
    ]]]
eqs = And @@ (Flatten[
     Function[{c, n}, 
       BooleanConvert[Xor[x[c], x[#]] || Xor[y[c], y[#]], "CNF"] & /@ 
        n] @@@ neighbors]);
solution = 
  Join[First[
    FindInstance[eqs, Union[Cases[eqs, _x | _y, \[Infinity]]], 
     Booleans]],
   Flatten[{x[#] -> True, y[#] -> True} & /@ 
     Flatten[Cases[neighbors, {_, {}}]]]];
colorAssignments = (#[[1, 1, 1]] -> toColor[Last /@ #]) & /@ 
   Partition[SortBy[solution , #[[1, 1]] &], 2];

Draw a four-color map

GeoGraphics[{EdgeForm[
   Directive[Thin, 
    Black]], {GeoStyling[#2], 
     Tooltip[Polygon[#1], 
      StringReplace[#1["Name"], "," ~~ __ -> ""]]} & @@@ 
   colorAssignments}]

four-color map

Border entity list demonstrations

Table of regions and number of bordering regions

TableForm[{StringReplace["," ~~ __ -> ""]@CommonName@First@#, 
    Length[Last@#]} & /@ borderEntityList, 
 TableHeadings -> {None, {"Region", "Bordering"}}]

Graph of adjacent regions

borderingQ[r1_, r2_] := MemberQ[r1 /. borderEntityList, r2]
RelationGraph[borderingQ, regions]

region adjacency graph

Notes

  • The first level of administrative-division regions for most countries have subdivisions. We can get a list of subdivisions, but the curated data doesn't have polygons, so they can't be mapped as outlines. If you have a set of latitude and longitude coordinates for the regions' outlines, you can convert them to polygons for Mathematica.
subdivisions = 
  EntityValue[regions, "Subdivisions", "EntityAssociation"];
EntityValue[Flatten@Values@subdivisions, "HasPolygon"]~AnyTrue~TrueQ
(* False *)

How do you find out for which keywords there are geographical data in the Wolfram database?

  • The "keywords" are properties of entity types. Here's a list of the properties for the "Country" entity type.
EntityProperties["Country"] // CanonicalName
  • The subdivisions belong to entity type "AdministrativeDivision". Here's a list of the properties.
EntityProperties["AdministrativeDivision"] // CanonicalName
$\endgroup$
2
  • $\begingroup$ Really nice answer! $\endgroup$
    – Carl Lange
    Commented Aug 31, 2021 at 13:57
  • $\begingroup$ Thank you for your comprehensive and detailed explanation. I could learn a lot from it. $\endgroup$ Commented Sep 3, 2021 at 9:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.