Find Shortest Paths in String Space

Find a "shortest path" with respect to edit distance in the space of country names.

Text[#[[Last[

     FindShortestTour[#, DistanceFunction -> EditDistance]]]] &[

  CountryData[]]]

Out[1]=