Antipodal Land Area Calculation

Mathematica 12 does antipodal graphics! See here for my treatment of antipodal New Zealand. Most of the Earth's above-sea-level land will have ocean at its antipode. Is there a way to calculate what percentage of above-sea-level land will also have above-sea-level land at its antipode?

Yes, this is possible with a little faff.

What we want to do is get the RegionUnion of all the countries the antipode intersects with, and then intersect the antipode with that region, and get the remaining area.

Let's use New Zealand as an example.

ant = GeoAntipode[Polygon@Entity["Country", "NewZealand"]]


Now, we can get the countries that this antipode intersects using GeoEntities:

GeoEntities[ant, "Country"]


{Entity["Country", "Portugal"], Entity["Country", "Spain"], Entity["Country", "Gibraltar"], Entity["Country", "Morocco"]}

Now, it seems like there's a bit of a bug with Gibraltar in my solution, so I've removed it. I'm not sure what causes it, but including Gibraltar deletes Morocco from the Region (don't tell the British).

countries =
RegionUnion @@ (EntityValue[{Entity["Country", "Portugal"],
Entity["Country", "Spain"], Entity["Country", "Morocco"]},
"Polygon"] /. GeoPosition[x_] -> x)


(We need to do GeoPosition[x_]->x to convert the GeoPositions into regular points, for Region calculations)

Now we intersect our antipode with this region:

int = RegionIntersection[ant /. GeoPosition[x_] -> x, countries]


(This can take a little time depending on the complexity of your polygons)

We can now convert back to GeoPositions:

geoint = MeshPrimitives[int, 2] /. Polygon[x_] -> Polygon[GeoPosition[x]]


and check the graphics to make sure we got it right:

GeoGraphics[geoint]


Finally, to get the actual area of intersections:

GeoArea[geoint] // Total


Quantity[1.58773*10^11, ("Meters")^2]

We can see that we are in the right ballpark:

UnitConvert[GeoArea[Entity["Country", "NewZealand"]]]


Quantity[2.64511*10^11, ("Meters")^2]