New in Wolfram
Mathematica
8: Graph & Network Analysis
◄
previous
|
next
►
Application Areas
Analyze Large and Complex Networks
The United States railroad graph connects major railroad systems.
In[1]:=
X
ports[v_] := v[[2, 2, {1, -1}]];
In[2]:=
X
connections[v_, w_] := Intersection[ports[v], ports[w]]
In[3]:=
X
maxMember[func_, g_] := Last[GatherBy[SortBy[Transpose[{VertexList[g], func[g]}], Last], Last]][[All, 1]];
In[4]:=
X
railroads = First @ Import["http://exampledata.wolfram.com/usamap.zip", "Data"];
In[5]:=
X
line = "Geometry" /. railroads;
In[6]:=
X
links[nodes_, v_, index_] := With[{c = Select[Drop[nodes, index], Length[connections[v, #]] != 0 &]}, UndirectedEdge[v[[1]], #] & /@ c[[All, 1]]]
In[7]:=
X
nodes = MapIndexed[ Property[First[#2], "TerminalsCoordinates" -> First[#1] ] &, line];
In[8]:=
X
roads = Union[ Join @@ MapIndexed[links[nodes, #1, First[#2]] &, nodes]];
In[9]:=
X
g = Graph[nodes, roads];
In[10]:=
X
maps = Show[Import["http://exampledata.wolfram.com/usamap.zip"], ImageSize -> 400];
In[11]:=
X
titles = Style[#, 11, FontFamily -> "Verdana"] & /@ {"Total number of roads:", "Total number of connections:", "Most linked roads:"};
In[12]:=
X
Grid[Join[{{maps, SpanFromLeft}}, {{}}, Transpose[{titles, {VertexCount[g], EdgeCount[g], maxMember[VertexDegree, g]}}]], ItemSize -> {{16, 18}, 1}, Alignment -> Left]
Out[12]=