Building graph based on the cities connection?

Revised answer

This uses the connectivity between states to create the graph, and uses the coordinates of the center of each state rather than the cities. I couldn't find a way to get these easily from Mathematica or from WolframAlpha (I'm no Harry Potter, and failed to discover the correct incantation for the latter). But I found a table somewhere:

stateConnections = {{"NV", "CA", "AZ", "UT", "ID", "OR"}, {"OR", "CA",
     "NV", "ID", "WA"}, {"TX", "OK", "LA", "NM", "AR"}, {"DC", "VA", 
    "MD"}, {"FL", "GA", "AL"}, {"RI", "MA", "CT"}, {"SC", "GA", 
    "NC"}, {"WA", "OR", "ID"}, {"CA", "NV", "OR", "AZ"}, {"CT", "RI", 
    "MA", "NY"}, {"DE", "MD", "PA", "NJ"}, {"LA", "TX", "MS", 
    "AR"}, {"MI", "IN", "OH", "WI"}, {"ND", "SD", "MN", "MT"}, {"NH", 
    "ME", "VT", "MA"}, {"NJ", "NY", "PA", "DE"}, {"VT", "NH", "MA", 
    "NY"}, {"AL", "GA", "MS", "TN", "FL"}, {"AZ", "CA", "NM", "UT", 
    "NV"}, {"IN", "OH", "MI", "IL", "KY"}, {"KS", "OK", "CO", "MO", 
    "NE"}, {"MD", "DE", "PA", "VA", "WV"}, {"MN", "WI", "IA", "SD", 
    "ND"}, {"MS", "AL", "LA", "AR", "TN"}, {"MT", "ID", "WY", "SD", 
    "ND"}, {"NC", "SC", "VA", "TN", "GA"}, {"NM", "TX", "AZ", "CO", 
    "OK"}, {"WI", "IL", "MI", "IA", "MN"}, {"GA", "FL", "SC", "NC", 
    "AL", "TN"}, {"IL", "IA", "WI", "IN", "KY", "MO"}, {"MA", "VT", 
    "NH", "NY", "RI", "CT"}, {"NV", "CA", "AZ", "UT", "ID", 
    "OR"}, {"NY", "NJ", "VT", "PA", "MA", "CT"}, {"OH", "IN", "WV", 
    "PA", "KY", "MI"}, {"UT", "CO", "WY", "ID", "NV", "AZ"}, {"VA", 
    "WV", "MD", "NC", "TN", "KY"}, {"WV", "VA", "OH", "PA", "MD", 
    "KY"}, {"AR", "TX", "LA", "OK", "MO", "TN", "MS"}, {"CO", "UT", 
    "WY", "NM", "NE", "KS", "OK"}, {"IA", "IL", "WI", "MN", "SD", 
    "NE", "MO"}, {"ID", "WA", "OR", "NV", "UT", "WY", "MT"}, {"NE", 
    "KS", "CO", "WY", "SD", "IA", "MO"}, {"OK", "TX", "CO", "KS", 
    "NM", "AR", "MO"}, {"PA", "WV", "DE", "MD", "NJ", "NY", 
    "OH"}, {"SD", "ND", "MT", "WY", "NE", "IA", "MN"}, {"WY", "MT", 
    "ID", "UT", "CO", "NE", "SD"}, {"KY", "IL", "MO", "TN", "VA", 
    "WV", "OH", "IN"}, {"MO", "IA", "NE", "KS", "OK", "AR", "TN", 
    "KY", "IL"}, {"TN", "KY", "MO", "AR", "MS", "AL", "GA", "NC", 
    "VA"}, {"ME", "NH"}}; 

stateData = {"AK,61.3850,-152.2683", "AL,32.7990,-86.8073", 
   "AR,34.9513,-92.3809", "AZ,33.7712,-111.3877", 
   "CA,36.1700,-119.7462", "CO,39.0646,-105.3272", 
   "CT,41.5834,-72.7622", "DC,38.8964,-77.0262", 
   "DE,39.3498,-75.5148", "FL,27.8333,-81.7170", 
   "GA,32.9866,-83.6487", "HI,21.1098,-157.5311", 
   "IA,42.0046,-93.2140", "ID,44.2394,-114.5103", 
   "IL,40.3363,-89.0022", "IN,39.8647,-86.2604", 
   "KS,38.5111,-96.8005", "KY,37.6690,-84.6514", 
   "LA,31.1801,-91.8749", "MA,42.2373,-71.5314", 
   "MD,39.0724,-76.7902", "ME,44.6074,-69.3977", 
   "MI,43.3504,-84.5603", "MN,45.7326,-93.9196", 
   "MO,38.4623,-92.3020", "MS,32.7673,-89.6812", 
   "MT,46.9048,-110.3261", "NC,35.6411,-79.8431", 
   "ND,47.5362,-99.7930", "NE,41.1289,-98.2883", 
   "NH,43.4108,-71.5653", "NJ,40.3140,-74.5089", 
   "NM,34.8375,-106.2371", "NV,38.4199,-117.1219", 
   "NY,42.1497,-74.9384", "OH,40.3736,-82.7755", 
   "OK,35.5376,-96.9247", "OR,44.5672,-122.1269", 
   "PA,40.5773,-77.2640", "RI,41.6772,-71.5101", 
   "SC,33.8191,-80.9066", "SD,44.2853,-99.4632", 
   "TN,35.7449,-86.7489", "TX,31.1060,-97.6475", 
   "UT,40.1135,-111.8535", "VA,37.7680,-78.2057", 
   "VT,44.0407,-72.7093", "WA,47.3917,-121.5708", 
   "WI,44.2563,-89.6385", "WV,38.4680,-80.9696", 
   "WY,42.7475,-107.2085"} ;

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 -> "Square",
   VertexSize -> 3,
   VertexLabelStyle -> Directive[Black, 12]];

Show[Graphics[{LightGray, CountryData["USA", "Polygon"]}], g, 
 ImageSize -> 700]

graph of the usa

Apparently the order of the vertices is required from the graph before you can draw the vertices at the right coordinates on the graph - hence the weird use of temp = Graph[connections /. stateToNumber] before creating the graph again for real.


I think what you are after is a Delaunay triangulation of the city coordinates. For example:

Graphics`Mesh`MeshInit[];

Graph[
 Range[Length[uScityCoords]],
 UndirectedEdge @@@ Delaunay[Reverse[uScityCoords, 2]]["Edges"],
 VertexCoordinates -> Reverse[uScityCoords, 2],
 VertexStyle -> Red, 
 Prolog -> {LightBrown, CountryData["USA", "FullPolygon"]}, 
 ImageSize -> 650
]

enter image description here


Revised:

First, let's get some map data. This is an 8MB file and you might want to save it locally.

map = First@
   Import["http://www2.census.gov/geo/tiger/TIGER2009/tl_2009_us_\
state.zip", "Data"];

Then, look at the answers that are better than yours (nod nod cormullion), and steal from them. I'm taking the stateConnections and stateData he defines. I won't reprint them here.

shape = "Geometry" /. map;
names = "STUSPS" /. "LabeledData" /. map[[4]] // Quiet;
cshape = shape[[DeleteCases[Range[56], 
     Alternatives @@ {1, 5, 7, 19, 27, 28, 33, 38}]]];
cnames = names[[DeleteCases[Range[56], 
    Alternatives @@ {1, 5, 7, 19, 27, 28, 33, 38}]]]; shape = 
 "Geometry" /. map;
names = "STUSPS" /. "LabeledData" /. map[[4]] // Quiet;
themap = Show[
   MapThread[
    Graphics@{EdgeForm[{White, Thick}], FaceForm[LightGray], 
       Tooltip[#1, #2]} &, {cshape, cnames}]];

(* Make map points with Cormullion's data *)

cpoint2 = Reverse /@ Flatten[ToExpression[
       Cases[
        Map[StringSplit[#, ","] &, 
         stateData], {#, x__, y__} -> {x, y}]] & /@ cnames, 1];

(* Make adjacency matrix with Cormullion's data *)

Table[Map[{i, #} &, 
   Flatten@Position[cnames, 
     Alternatives @@ 
      Cases[stateConnections, x_ /; x[[1]] == cnames[[i]]][[1, 
        2 ;;]]]], {i, 1, 48}];
sam2 = SparseArray[Flatten[%, 1] -> 1];

(* Make adjacency graph *)

graph = AdjacencyGraph[Range[Length[cpoint2]], sam2, 
   VertexCoordinates -> cpoint2];
Show[themap, graph, Background -> LightBlue]

Here's what we get:

connection map