10
$\begingroup$

A recent question in chat about "When you are in Aachen, Germany, five other countries capitals are closer than Berlin." triggered me to try to write something to find the cities automatically for whatever city I like.

At first, I get all UN countries and their respective capitals.

countries = CountryData["UN"];
capitals = Map[CountryData[#, "CapitalCity"] &, countries];
capitalCoord = 
  Select[Map[{#, CityData[#, "Coordinates"]} &, capitals], 
   NumericQ[#[[2, 1]]] &];

The "Select..."-part in capitalCoord is due to the fact, that some countries (before I only selected UN countries) did not have a listed capital. I just left it in, because this is only executed once.

Second is to define a reference city (here Aachen) and based on the found capitals above to get all distances to all capitals, sorting them, and show all closer and the own capital.

refCity = CityData[{"Aachen", "NorthRhineWestphalia", "Germany"}];
ref = GeoPosition[refCity];
erg = Map[{#[[1]], GeoDistance[ref, #[[2]]]} &, capitalCoord];
With[{l = Sort[erg, #1[[2]] < #2[[2]] &], 
   city = CountryData[CityData[refCity, "Country"], "CapitalCity"]}, 
  For[i = 1, i <= Length[countries], i++, 
   If[l[[i, 1]] == city, Break[]]]];
GeoGraphics[Insert[With[{l = Sort[erg, #1[[2]] < #2[[2]] &][[;; i]]},
   Table[GeoPath[{l[[j, 1]], refCity}], {j, i}]], Red, i], 
 GeoProjection -> "Robinson", 
 PlotLabel -> ToString[i - 1] <> " UN nation capitals are closer"]

Some examples (Red is always the own capital):

Aachen, Germany
Aachen
There are actually seven capitals closer than Berlin. Then we were trying more fancy cities …

Vladivostok, Russia
Vladivostok

Kashi, China
Kaxgar

Unalaska, USA
Unalaska

Honolulu, USA
Honolulu

My question is now … again … what would be a more elegant way to do it?

If you can do it more fancy, please do. :)

$\endgroup$
5
$\begingroup$

Using GeoNearest:

capitals = Map[CountryData[#, "CapitalCity"] &, CountryData["UN"]];
nearest = GeoNearest[capitals, Here, 10]

Mathematica graphics

And then use LengthWhile like this to answer the question in the title (the capital in my country is Stockholm):

Mathematica graphics

I only printed the ten closest capitals for display purposes, you can use this:

nearest = GeoNearest[capitals, Here, All]

You can also use free-form input in place of CountryData:

Mathematica graphics

There is also TakeWhile if you want to make a visualization. Here is a suggestion. I apologize for using images for code, but I like how entities look in notebooks:

Mathematica graphics

Mathematica graphics

Note that my answer to the question "how many capitals are closer to me than my own?" is short enough to be a one-liner, if using free-form input:

Mathematica graphics

$\endgroup$
  • 2
    $\begingroup$ To generalize the last line: With[{city = Entity["City", {"Aachen", "NorthRhineWestphalia", "Germany"}]}, LengthWhile[GeoNearest[CountryData[#, "CapitalCity"] & /@ CountryData["UN"], city, All], CityData[city, "Country"] =!= CityData[#, "Country"] &]] $\endgroup$ – J. M. is in limbo Nov 3 '17 at 3:00
4
$\begingroup$

For efficiently retrieving nearby cities, use Nearest[] with a custom DistanceFunction:

capitals = Map[CountryData[#, "CapitalCity"] &, CountryData["UN"]];
locs = CityData[#, "Coordinates"] & /@ capitals;

nf = Nearest[locs -> capitals, DistanceFunction -> (QuantityMagnitude @* GeoDistance)];

Then:

CommonName /@ nf[CityData[{"Aachen", "NorthRhineWestphalia", "Germany"}, "Coordinates"], 7]
   {"Brussels", "Luxemburg", "Amsterdam", "Paris", "Bern", "London", "Vaduz"}

From that, just increase the value of the second argument until the last city returned is in the same country as the original city:

nearestCapitals[city_, opts___] := Module[{k = 0, res},
       While[res = nf[CityData[city, "Coordinates"], ++k]; 
             CityData[Last[res], "Country"] =!= CityData[city, "Country"]];
       GeoGraphics[{Tooltip[GeoMarker[city, "Color" -> Blue], CommonName[city]], 
                    MapAt[{Directive[Red, Thick], #} &, 
                          GeoPath[{city, #}, "Geodesic"] & /@ res, {-1}], 
                    Tooltip[GeoMarker[#], CommonName[#]] & /@ res}, opts, 
                   PlotLabel -> StringForm["`` UN capital cities are closer",
                                           Length[res] - 1]]]

nearestCapitals[Entity["City", {"Unalaska", "Alaska", "UnitedStates"}], 
                GeoBackground -> GeoStyling["CountryBorders"]]

nearest capitals to Unalaska

$\endgroup$
  • $\begingroup$ What does QuantityMagnitude@*GeoDistance, esp. the @* do? $\endgroup$ – pH13 - Yet another Philipp Nov 1 '17 at 14:06
  • 1
    $\begingroup$ That's the short form for Composition[]. If you're in a version that does not yet support this, use DistanceFunction -> Composition[QuantityMagnitude, GeoDistance] instead. $\endgroup$ – J. M. is in limbo Nov 1 '17 at 14:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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