6
$\begingroup$

Say I have a list of cities

cities = {"Istanbul", "Moscow", "London", "Saint Petersburg", 
   "Berlin", "Madrid", "Kyiv", "Rome", "Bucharest", "Paris", "Minsk", 
   "Vienna", "Warsaw", "Hamburg", "Budapest", "Belgrade", "Barcelona",
    "Munich", "Kharkiv", "Milan", "Kazan", "Sofia", "Prague", 
   "Tbilisi", "Samara", "Ufa", "Birmingham", "Cologne", "Voronezh", 
   "Perm", "Volgograd"};

coordinates = GeoPosition[ CityData[#, "Coordinates"]] & /@ cities;
country = CityData[#, "Country"] & /@ cities;

GeoListPlot[coordinates]

enter image description here

I want to travel to every country. I don't need to travel to every city but I'm happy travelling to multiple cities in a country.

I don't see an obvious way to write this condition using FindShortestTour[]

For example,

tour = FindShortestTour[coordinates];
GeoGraphics[{Thick, Red, GeoPath[coordinates[[tour[[2]]]]]}]

I can run all the permutations - but this seems silly. Is there a way to tell FindShortestTour[] to optimise something else?

enter image description here

$\endgroup$
2
  • $\begingroup$ I'm pretty confident that if you want a shortest tour with at least one city per country, that in practice means exactly one city per country. I guess this would be a binary-valued linear programming problem with constraints in practice? $\endgroup$
    – kirma
    Apr 22, 2023 at 16:45
  • $\begingroup$ The original task was to incorporate vertices of different length linking the cities - but I simplified it for this case. I agree - no need to go to different cities. $\endgroup$
    – Tomi
    Apr 22, 2023 at 16:49

2 Answers 2

7
$\begingroup$
tuples = Tuples @ Values @
  GroupBy[cities, CityData[#, "Country"] &, Map[CityData[#, "Coordinates"] &]];

{length, tour} = First @ MinimalBy[First] @
  Map[With[{fst = FindShortestTour @ #}, {First @ fst, #[[Last @ fst]]}] &] @  
  tuples;

coordsToCity = AssociationThread[CityData[#, "Coordinates"] & /@ cities, cities];

{length, coordsToCity /@ tour}
{112.502,
 {"Istanbul", "Bucharest", "Sofia", "Belgrade", "Budapest", "Vienna",  
 "Milan", "Barcelona", "Paris", "London", "Cologne", "Prague", "Warsaw",  
 "Minsk", "Kharkiv", "Voronezh", "Tbilisi", "Istanbul"}}
countrypolygons = DeleteDuplicates[Polygon[CityData[#, "Country"]] & /@ cities];

GeoGraphics[{{RandomColor[], #} & /@ countrypolygons, Black, 
  Point[Reverse@CityData[#, "Coordinates"] & /@ cities], 
  Text[#, Reverse@CityData[#, "Coordinates"], {0, -1}] & /@ cities, 
  Thick, PointSize[Large], Red, Point@Map[Reverse]@tour, 
  GeoPath[tour]}, 
 GeoBackground -> None, GeoRange -> {{30, 70}, {-10, 60}}]

enter image description here

$\endgroup$
6
$\begingroup$
Clear["Global`*"]

cities = {"Istanbul", "Moscow", "London", "Saint Petersburg", "Berlin", 
   "Madrid", "Kyiv", "Rome", "Bucharest", "Paris", "Minsk", "Vienna", 
   "Warsaw", "Hamburg", "Budapest", "Belgrade", "Barcelona", "Munich", 
   "Kharkiv", "Milan", "Kazan", "Sofia", "Prague", "Tbilisi", "Samara", "Ufa",
    "Birmingham", "Cologne", "Voronezh", "Perm", "Volgograd"};

The center of all the cities is

geoCenter = Mean[CityData[#, "Coordinates"] & /@ cities]

(* {49.4251, 23.6938} *)

Group cities by their country

cities2 = GatherBy[cities, CityData[#, "Country"] &];

Select city from each country closest to geoCenter

nearestCenter[cities_List] :=
 SortBy[cities, GeoDistance[CityData[#, "Coordinates"], geoCenter] &][[1]]

cities3 = nearestCenter /@ cities2

(* {"Istanbul", "Voronezh", "London", "Berlin", "Barcelona", "Kyiv", "Milan", \
"Bucharest", "Paris", "Minsk", "Vienna", "Warsaw", "Budapest", "Belgrade", \
"Sofia", "Prague", "Tbilisi"} *)

tour = FindShortestTour[CityData[#, "Coordinates"] & /@ cities3]

(* {114.463, {1, 8, 15, 14, 13, 11, 7, 5, 9, 3, 4, 16, 12, 10, 6, 2, 17, 1}} *)

coordinates = GeoPosition[CityData[#, "Coordinates"]] & /@ cities3;

GeoGraphics[{Thick, Red, GeoPath[coordinates[[tour[[2]]]]]}]

enter image description here

$\endgroup$

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.