Wolfram Archive
Wolfram Programming Lab is a legacy product.
All the same functionality and features, including access to Programming Lab Explorations, are available with Wolfram|One.
Start programming now. »

Shortest City Tours

In which order should you visit cities so as to travel the shortest distance?

Run the code to get a list of the capitals of Africa. Try other regions, like northern europe or the caribbean:

SHOW/HIDE DETAILS

Get a list of capitals of countries in Africa. Type += to get a natural language input box, and type capitals of africa into it. Run the code with +:

\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{107., {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]\)

HIDE DETAILS
\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{116., {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]\)

Get the geographic positions of the capitals. Try getting other properties, like "Population" or "Elevation":

SHOW/HIDE DETAILS

Get the geographic position of Paris. The result contains {latitude,longitude} coordinates:

EntityValue[\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "Paris", Typeset`boxes$$ = TemplateBox[{"\"Paris\"", RowBox[{"Entity", "[", RowBox[{"\"City\"", ",", RowBox[{"{", RowBox[{"\"Paris\"", ",", "\"IleDeFrance\"", ",", "\"France\""}], "}"}]}], "]"}], "\"Entity[\\\"City\\\", {\\\"Paris\\\", \\\"IleDeFrance\\\", \ \\\"France\\\"}]\"", "\"city\""}, "Entity"], Typeset`allassumptions$$ = {{ "type" -> "Clash", "word" -> "Paris", "template" -> "Assuming \"${word}\" is ${desc1}. Use as \ ${desc2} instead", "count" -> "5", "Values" -> {{ "name" -> "City", "desc" -> "a city", "input" -> "*C.Paris-_*City-"}, { "name" -> "AdministrativeDivision", "desc" -> "an administrative division", "input" -> "*C.Paris-_*AdministrativeDivision-"}, { "name" -> "Surname", "desc" -> "a surname", "input" -> "*C.Paris-_*Surname-"}, { "name" -> "GivenName", "desc" -> "a given name", "input" -> "*C.Paris-_*GivenName-"}, { "name" -> "Person", "desc" -> "a person", "input" -> "*C.Paris-_*Person-"}}}, { "type" -> "SubCategory", "word" -> "Paris", "template" -> "Assuming ${desc1}. Use ${desc2} instead", "count" -> "14", "Values" -> {{ "name" -> "{Paris, IleDeFrance, France}", "desc" -> "Paris (France)", "input" -> "*DPClash.CityE.Paris-_**Paris.IleDeFrance.\ France--"}, { "name" -> "{Paris, Illinois, UnitedStates}", "desc" -> "Paris (Illinois, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Illinois.\ UnitedStates--"}, { "name" -> "{Paris, Texas, UnitedStates}", "desc" -> "Paris (Texas, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Texas.\ UnitedStates--"}, { "name" -> "{Paris, Kentucky, UnitedStates}", "desc" -> "Paris (Kentucky, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Kentucky.\ UnitedStates--"}, { "name" -> "{Paris, Tennessee, UnitedStates}", "desc" -> "Paris (Tennessee, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Tennessee.\ UnitedStates--"}, { "name" -> "{Paris, Ontario, Canada}", "desc" -> "Paris (Canada)", "input" -> "*DPClash.CityE.Paris-_**Paris.Ontario.Canada--"}\ , {"name" -> "{Paris, Wisconsin, UnitedStates}", "desc" -> "Paris (Wisconsin, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Wisconsin.\ UnitedStates--"}, { "name" -> "{Paris, Arkansas, UnitedStates}", "desc" -> "Paris (Arkansas, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Arkansas.\ UnitedStates--"}, { "name" -> "{Paris, NewYork, UnitedStates}", "desc" -> "Paris (New York, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.NewYork.\ UnitedStates--"}, { "name" -> "{Paris, Missouri, UnitedStates}", "desc" -> "Paris (Missouri, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Missouri.\ UnitedStates--"}, { "name" -> "{Paris, Maine, UnitedStates}", "desc" -> "Paris (Maine, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Maine.\ UnitedStates--"}, { "name" -> "{ParisGrant, Wisconsin, UnitedStates}", "desc" -> "Paris (Wisconsin, USA)", "input" -> "*DPClash.CityE.Paris-_**ParisGrant.Wisconsin.\ UnitedStates--"}, { "name" -> "{ParisTownship, Michigan, UnitedStates}", "desc" -> "Paris Township (Michigan, USA)", "input" -> "*DPClash.CityE.Paris-_**ParisTownship.Michigan.\ UnitedStates--"}, { "name" -> "{Paris, Idaho, UnitedStates}", "desc" -> "Paris (Idaho, USA)", "input" -> "*DPClash.CityE.Paris-_**Paris.Idaho.\ UnitedStates--"}}}}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.717032`6.307083531469639, "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->{83., {7., 15.}}, 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]\), "Position"]

Get the geographic positions of the capitals of Africa, and give the result the name positions:

positions = EntityValue[\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \ \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{107., {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]\), "Position"]

HIDE DETAILS
positions = EntityValue[\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \ \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{116., {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]\), "Position"]

Find the order of capitals that gives the shortest route:

Note: run the code in the previous step first.

SHOW/HIDE DETAILS

Find the length of the shortest tour through all the capitals, and the order of the capitals along the route:

FindShortestTour[positions]

Extract just the order of the capitals on the shortest tour:

Last[FindShortestTour[positions]]

HIDE DETAILS
tour = Last[FindShortestTour[positions]]

Show the order of the capitals along the shortest route:

Note: run the code in the previous step first.

SHOW/HIDE DETAILS

Reorder the elements of a list. Put the second element first, then the fourth and so on:

{"one", "two", "three", "four", "five"}[[{2, 4, 1, 3, 5}]]

Order the capitals of Africa along the shortest tour route:

\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \ \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{107., {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]\)[[tour]]

HIDE DETAILS
\!\(\* NamespaceBox["LinguisticAssistant", DynamicModuleBox[{Typeset`query$$ = "capitals of africa", Typeset`boxes$$ = RowBox[{"EntityValue", "[", RowBox[{ TemplateBox[{"\"Africa\"", RowBox[{"EntityClass", "[", RowBox[{"\"Country\"", ",", "\"Africa\""}], "]"}], "\"EntityClass[\\\"Country\\\", \\\"Africa\\\"]\"", "\"countries\""}, "EntityClass"], ",", TemplateBox[{"\"capital city\"", RowBox[{"EntityProperty", "[", RowBox[{"\"Country\"", ",", "\"CapitalCity\""}], "]"}], "\"EntityProperty[\\\"Country\\\", \ \\\"CapitalCity\\\"]\""}, "EntityProperty"]}], "]"}], Typeset`allassumptions$$ = {}, Typeset`assumptions$$ = {}, Typeset`open$$ = {1}, Typeset`querystate$$ = { "Online" -> True, "Allowed" -> True, "mparse.jsp" -> 0.287733`5.910534667329372, "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->{116., {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]\)[[tour]]

Make a map of the shortest tour:

SHOW/HIDE DETAILS

Get the positions of the capitals in their order along the shortest tour route:

positions[[tour]]

Make a map with a thick red line showing the shortest capital tour:

GeoGraphics[{Thick, Red, Line[positions[[tour]]]}]

HIDE DETAILS
GeoGraphics[{Thick, Red, Line[positions[[tour]]]}]

Share ItMake a website that shows the shortest route through cities that you specify:

SHOW/HIDE DETAILS

Deploy a form that asks for a list of cities and makes a map showing the shortest route through them. GeoRangePadding is used to add a margin around the route:

CloudDeploy[ FormFunction[{{"cities", "cities (city1; city2; ...)"} -> DelimitedSequence["City"]}, Block[{positions, tour}, positions = EntityValue[#cities, "Position"]; tour = Last[FindShortestTour[positions]]; GeoGraphics[{Thick, Red, Line[positions[[tour]]]}, GeoRangePadding -> Scaled[.5]] ] &, "PNG" ], Permissions -> "Public" ]

Click the link in the output to visit the site. Separate the cities you enter with semicolons (;) rather than spaces or commas, since both of those can occur in city names.

Tell the world about your creation by sharing the link via email, tweet or other message.

HIDE DETAILS
CloudDeploy[ FormFunction[{{"cities", "cities (city1; city2; ...)"} -> DelimitedSequence["City"]}, Block[{positions, tour}, positions = EntityValue[#cities, "Position"]; tour = Last[FindShortestTour[positions]]; GeoGraphics[{Thick, Red, Line[positions[[tour]]]}, GeoRangePadding -> Scaled[.5]] ] &, "PNG" ], Permissions -> "Public" ]