4
$\begingroup$

I am trying to make traveling salesman type graph using the locations of NFL stadiums as the vertices. I need to get the EdgeLabels to appear was the distance between the vertices. I was able to slightly modify some code from

Building graph based on the cities connection?

but I am still unsure about how to incorporate the distances.

stateConnections = {{"TEN", "CAR"}, {"NYGJ", "PIT", "DET"}, {"SEA", 
"MIN" }, {"SFO", "SEA", "SDO"}, {"ARZ", "HOU"}, {"DAL", 
"STL"}, {"PHI", "MIA", "KCY"}, {"OAK", "ARZ", "DEN"}, {"DEN", 
"DAL"}, {"GBY", "CIN", "CHI"}, {"MIN", "MIA"}, {"NOR", "TEN", 
"HOU"}, {"DET", "KCY"}, {"BUF", "CLE"}, {"CLE", "NWE"}, {"NWE", 
"TBY"}, {"TBY", "STL"}, {"PIT", "BAL"}, {"JAC", "ATL"}, {"IND", 
"BAL", "CHI"}, {"ATL", "CIN"},  {"JAC", "BUF"}, {"WAS", "CAR", 
"JAC"}, {"SDO", "ARZ"}};


stateData = {"TEN,36.1665,-86.7713", "NYGJ,40.8122,-74.077", "PIT,40.4468,-80.0158", "CAR,35.2258,-80.8529", "BAL,39.278,-76.6228", "TBY,27.976,-82.5033", 
"IND,39.7601,-86.1638", "MIN,44.9739,-93.2581", 
"ARZ,33.5277,-112.263", "DAL,32.7478,-97.0928", 
"ATL,33.7576,-84.401", "NYGJ,40.8122,-74.077", 
"DEN,39.7439,-105.02", "MIA,25.9579,-80.2388", 
"PHI,39.9008,-75.1675", "CHI,41.8623,-87.6167", 
"NWE,42.0909,-71.2643", "WAS,38.9077,-76.8645", 
"GBY,44.5013,-88.0622", "SDO,32.7831,-117.12", 
"NOR,29.9509,-90.0814", "HOU,29.6848,-95.411", 
"BUF,42.7737,-78.787", "SFO,37.7135,-122.386", 
"JAC,30.3239,-81.6374", "CLE,41.506,-81.6996", 
"OAK,37.7514,-122.201", "KCY,39.0489,-94.484", 
"STL,38.633,-90.1885", "SEA,47.5952,-122.332", 
"CIN,39.0954,-84.516", "DET,42.3402,-83.0458"};

stateAbbreviations = Union[Flatten[stateConnections]];
stateToNumber = MapThread[Rule, {stateAbbreviations, Range[Length[stateAbbreviations]]}];
numberToState = MapThread[ Rule, {Range[Length[stateAbbreviations]], stateAbbreviations}];
allConnections = Flatten[Function[e, Map[UndirectedEdge[First[e], #] &, Rest[e]]] /@ stateConnections];
connections = Union[Sort /@ allConnections];
stateCenters = First[StringSplit[#, ","]] -> ToExpression /@ RotateLeft@Rest[StringSplit[#, ","]] & /@ stateData;
stateCoords = (# & /@ stateAbbreviations) /. stateCenters;
temp = Graph[connections /. stateToNumber];
vertexCoordinates = stateCoords[[VertexList[temp]]];
g = Graph[connections /. stateToNumber, VertexCoordinates -> vertexCoordinates, VertexLabels -> numberToState, VertexShapeFunction -> "Circle", VertexSize -> 1, VertexLabelStyle -> Directive[Black, 7]];

Show[Graphics[{LightGray, CountryData["USA", "Polygon"]}], g, ImageSize -> 1000]
$\endgroup$
1
$\begingroup$

In Mathematica 10 it is easy to do with GeoDistance. Simply replace your g with the following lines

stateToLocation = 
  Rule[First[#], ToExpression[Rest[#]]] & /@ (StringSplit[stateData, 
     ","]);
edgeLabels = 
  Thread[Rule[
    EdgeList[g], (EdgeList[g] /. numberToState /. stateToLocation) /. 
     UndirectedEdge -> GeoDistance]];
g = Graph[connections /. stateToNumber, 
   VertexCoordinates -> vertexCoordinates, 
   VertexLabels -> numberToState, VertexShapeFunction -> "Circle", 
   VertexSize -> 1, VertexLabelStyle -> Directive[Black, 7], 
   EdgeLabels -> edgeLabels];
$\endgroup$

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.