Progress in Graphs & Networks

Jaebum Jung, Wolfram Research

(RowDefault[, (Spacer1), , (Spacer1), ])  #WolframTechConf

Overview

Building Graphs

Computation and Analysis

Visualization

Building Graphs

Graphs can be constructed in a variety of ways. They can be built from vertices and edges directly in a symbolic form. They can come from built-in curated collections of theoretical or empirical graphs. They can be imported from numerous supported file formats.

Import and Export

Import["ExampleData/bigdipper.gml"]

Dataset[{#,Import["ExampleData/bigdipper.gml", #]}&/@Import["ExampleData/bigdipper.gml", "Elements"]]

Supported Graph Format

Dataset[Association@{"Format"->#1, "Extension"->#2}&@@@{{"Graphlet (*.gml)","gml"},{"DOT (*.gv,.dot)","gv, dot"},{"GraphML (*.graphml)","graphml"},{"GXL (*.gxl)","gxl"},{"DIMACS (*.col,*.col.b)","col, col.b"},{"Graph6 (*.g6)","g6"},{"Sparse6 (*.s6)","s6"},{"LEDA (*.gw), *.lgr","gw"}}]

Import the data and build the friend/foe social network emerging from Slashdot, a technology-related news website known for its specific user community:

data=Import["http://snap.stanford.edu/data/soc-Slashdot0902.txt.gz","Table"];

Column[data[[;;10]]]

g=Graph[DirectedEdge@@@data[[5;;]]];

{VertexCount[g],EdgeCount[g]}

Build the graph from the CSV data format:

data=Import["https://dhs.stanford.edu/dh/gephi/dh11_edges.csv"];

Grid[data[[;;10]],Frame->All ]

edges=DirectedEdge@@@data[[2;;,;;2]];

weight=data[[2;;,-1]];

Graph[edges,EdgeWeight->weight]

Import the data and build the Amazon product co-purchasing network from March 2, 2003:

data=Import["https://graphchallenge.s3.amazonaws.com/snap/amazon0302/amazon0302_adj.tsv"];

<dataset-name>_adj.tsv—(Row, Col, Value) tuple describing the adjacency matrix of the graph in tab-separated format.

Adjacency matrix is of size Num_vertices × Num_vertices:

data[[;;10]]

adj=SparseArray[{#1,#2}->#3&@@@data]

g=AdjacencyGraph[adj];

Through[{VertexCount,EdgeCount,EulerianGraphQ}[g]]

ExampleData

Load-on-demand extensible collection of empirical networks:

ExampleData["NetworkGraph"]//Shallow

ExampleData[{"NetworkGraph","LesMiserables"},"LongDescription"]

ExampleData[{"NetworkGraph","LesMiserables"}]

ResourceData

The Wolfram Data Repository is a public resource that hosts an expanding collection of computable datasets, curated and structured to be suitable for immediate use in computation, visualization, analysis and more.

Marvel Universe Social Network

g=ResourceData["Marvel Universe Social Network"];

ResourceData["Marvel Universe Social Network", "Summary"]

Length/@ConnectedComponents[g]

sg=First[ConnectedGraphComponents[g]];

Marvel Universe Social Network

Neighbors of comic vertices are heroes in that comic.

BipartiteGraphQ[sg]

vert={6487,6572,1,1999,6459,6463,6464,6471,2399,6460,13,6469,6473,6461,6472};
ssg=Subgraph[sg, vert, PlotTheme->"Minimal",GraphLayout->{"VertexLayout"->"BipartiteEmbedding", "EdgeLayout"->"DividedEdgeBundling"}, VertexLabels->Thread[vert->AnnotationValue[{sg,vert}, "Name"]], ImageSize->600];coords=GraphEmbedding[ssg];
Show[{Graphics[{Opacity[.5],RGBColor["#2596be"],StadiumShape[coords[[;;2]], .2],RGBColor["#B89B82"],StadiumShape[{coords[[3]],coords[[-1]]}, .2]}],ssg},ImageSize->600]

Use patterns to select a subset of vertices which are Comic types:

comics=VertexList[sg, x_/;AnnotationValue[{sg,x},"Type"]=="Comic"];

Let’s get heroes in each comic.

herosInComics=AdjacencyList[sg,#]&/@comics;

Heroes in the same comics will be connected each other.

pairs=UndirectedEdge@@Sort[#]&/@Flatten[Subsets[#,{2}]&/@herosInComics,1];

counts=Counts[pairs];

Limit the edge with more than 50 appearances.

selectededges=Select[counts,#>50&];

sg=Graph[Keys[selectededges], EdgeWeight->Values[selectededges]];

Change the vertex with real names.

smallMarvelGraph=VertexReplace[sg,Thread[VertexList[sg]->AnnotationValue[{g,VertexList[sg]},"Name"]]]

VertexList[smallMarvelGraph]//Short

Computation and Analysis

Social networks represent relationships involving social entities such as friendships among individuals, communication in a group, or transactions between corporations. Finding important actors, discovering cohesive groups or communities, or identifying actors that are similar in some way are all examples of analysis that can be done for social networks.

The Wolfram System has extensive graph computation capabilities, including finding paths, cycles, and subgraphs based on connectivity to direct support for traversal-based programming.

Centrality and Prestige

Extensive support for centrality and prestige measure to characterize networks

TextGrid[Partition[Style[#,22, Bold]&/@{DegreeCentrality,ClosenessCentrality,BetweennessCentrality,EigenvectorCentrality,KatzCentrality,PageRankCentrality,HITSCentrality,StatusCentrality,RadialityCentrality,EccentricityCentrality,EdgeBetweennessCentrality},3,3,1,Null],Frame->All,Spacings->2]

The medici family position of centrality crucial for communication, brokering deals,...

g = ExampleData[{"NetworkGraph", "FlorentineFamilies"}];

centralities = {BetweennessCentrality, ClosenessCentrality, EccentricityCentrality, EigenvectorCentrality};
values = Through[centralities[g]] ;

highlight[g_,cc_]:=
Module[{a,b,f},
{b,a}=Part[VertexList[g],Ordering[cc,-2]];
f={Red,EdgeForm[],Disk[#1,#3],Thick,Circle[#1,2#3]}&;
HighlightGraph[g,{a, b},
VertexSize->Thread[VertexList[g]->Rescale[cc, MinMax[cc],{.05, 1/3}]],
VertexLabels->{_->None,a-> Placed[a,Above],b-> Placed[b,Above]},GraphHighlightStyle->"Shadow", PerformanceGoal->"Quality"]
];

labels =centralities;
data = Transpose[{highlight[g,#]&/@values,labels}];
Grid[Partition[Annotate[#1, {PlotLabel->Style[#2,15,Bold],ImagePadding->10}] & @@@ data, 2, 2, 1, {}], Frame->All]

Reciprocity and Transitivity

GraphReciprocity • GlobalClusteringCoefficient • MeanClusteringCoefficient • LocalClusteringCoefficient

Examples

Local clustering coefficients of the internet at the level of autonomous systems:

g=ExampleData[{"NetworkGraph","Internet"}];

c=LocalClusteringCoefficient[g];
Histogram[c]

Homophily, Assortative Mixing, and Similarity

Homophily according to scalar characteristics or enumerative characteristics

Assortativity mixing, mean degree connectivity, ...

Examples

A friendship network at a high school with vertices color-coded by race.

g=;
Legended[SetProperty[g,ImageSize->800],SwatchLegend[{Black,White,Gray},{"Black","White","Others"},LegendMarkers->"Bubble",LabelStyle->{FontSize->18}]]

Highly social students are friends with other highly social students.

N[GraphAssortativity[g]]

Measure the tendency for students to associate with others of the same race.

N[GraphAssortativity[g,"Race"]]

Cohesive groups

FindClique • FindKClique • FindKClan • FindKClub • FindKPlex • LuccioSamiComponents • LambdaComponents • KCoreComponents

Examples

Analyze the social network emerging from Slashdot, a technology-related news website known for its specific user community:

Import the data and build the friend/foe network:

data=Import["http://snap.stanford.edu/data/soc-Slashdot0902.txt.gz","Table"];
graph=Graph[DirectedEdge@@@data[[5;;]]];

Find the basic statistics:

g=Subgraph[graph,First[WeaklyConnectedComponents[graph]]];
h=Subgraph[graph,Last[SortBy[ConnectedComponents[graph],Length]]];
statGrid[graph,g,h]

Statistical Analysis

RandomGraph • GraphPropertyDistribution • BarabasiAlbertGraphDistribution • WattsStrogatzGraphDistribution • NProbability • EstimatedDistribution • EmpiricalDistribution • PriceGraphDistribution

Examples

Analyze the in-degree distribution:

data=Import["http://snap.stanford.edu/data/soc-Slashdot0902.txt.gz","Table"];
graph=Graph[DirectedEdge@@@data[[5;;]]];

indegree=VertexInDegree[graph];
lndist=EstimatedDistribution[indegree,LogNormalDistribution[mu,si]];
pdist=EstimatedDistribution[indegree,ParetoDistribution[k,al]];
emdist=EmpiricalDistribution[indegree];

distPlot[emdist,lndist,pdist]

GraphBLAS

GraphBLAS is an API specification that defines standard building blocks for graph algorithms in the language of linear algebra. GraphBLAS is built upon the notion that a sparse matrix can be used to represent graphs as either an adjacency matrix or an incidence matrix.

Group graphs by vertex count

Graphs by edge count

g=ResourceData["Marvel Universe Social Network"];

PageRankCentrality[g, Method->"PowerMethod"]//Short//AbsoluteTiming

PageRankCentrality[g, Method->"LAGraph"]//Short//AbsoluteTiming

FindShortestTour

FindShortestTour[CountryData["Europe"]->"Elements",Entity["Country","Albania"],Entity["Country","Montenegro"]]

GeoGraphics[{Thick,Red,GeoPath[%]}]

FindShortestTour[CountryData["Europe"]->All,Entity["Country","Albania"],Entity["Country","Montenegro"]]

Visualization

Graph Styles

Positioning Vertices

VertexCoordinate

AdjacencyGraph[ChemicalData["Caffeine","AdjacencyMatrix"],VertexCoordinates->ChemicalData["Caffeine","VertexCoordinates"]]

GraphLayout

Graph[{1\[DirectedEdge]5,5\[DirectedEdge]2,1\[DirectedEdge]6,6\[DirectedEdge]2,2\[DirectedEdge]7,7\[DirectedEdge]3,2\[DirectedEdge]8,8\[DirectedEdge]3,2\[DirectedEdge]9,9\[DirectedEdge]3,3\[DirectedEdge]10,10\[DirectedEdge]4,3\[DirectedEdge]11,11\[DirectedEdge]4,3\[DirectedEdge]12,12\[DirectedEdge]4,3\[DirectedEdge]13,13\[DirectedEdge]4}, GraphLayout->"LayeredDigraphEmbedding",VertexShapeFunction->"Rectangle", VertexSize->1]

Graph[{1\[DirectedEdge]5,5\[DirectedEdge]2,1\[DirectedEdge]6,6\[DirectedEdge]2,2\[DirectedEdge]7,7\[DirectedEdge]3,2\[DirectedEdge]8,8\[DirectedEdge]3,2\[DirectedEdge]9,9\[DirectedEdge]3,3\[DirectedEdge]10,10\[DirectedEdge]4,3\[DirectedEdge]11,11\[DirectedEdge]4,3\[DirectedEdge]12,12\[DirectedEdge]4,3\[DirectedEdge]13,13\[DirectedEdge]4}, GraphLayout->{"LayeredDigraphEmbedding","VertexSizes"->{2, .8}},VertexShapeFunction->"Rectangle", VertexSize->1]

Styling Vertices

VertexStyle

VertexLabels

VertexShapeFunction

VertexShape

Manipulate[PetersenGraph[ {VertexStyle->EdgeForm[Directive[AbsoluteThickness[3],GrayLevel[0.5, 1]]],EdgeStyle->Directive[AbsoluteThickness[3],GrayLevel[0.5, 1]],VertexShapeFunction->{1->(DynamicModule[{col = {}}, 
   {EventHandler[{Dynamic[col, ImageSizeCache -> 
        {34., {5.10891259765625, 17.254375}}], Disk[#1, #3]}, 
    "MouseClicked" :> (col = col /. {Red -> Green, Green -> {}, 
         {} -> Red}), Method -> "Preemptive", 
     PassEventsDown -> Automatic, PassEventsUp -> True]}, 
   DynamicModuleValues :> {}] & ),2->vertexshapefunction},VertexSize->{0.3`}, VertexShape->{3->vertexshape}}], {vertexshapefunction,{"Circle","Rectangle", "Diamond"} },{vertexshape,{, , } }]

spark[center_,_,{dx_,dy_}, size_:8]:= {Directive[EdgeForm[],ColorData[6,RandomInteger[{1,9}]]],
Dynamic@Table[Polygon[(#+center)&/@ With[{rp2=RandomReal[{.4,size}]dx, it=Clock[{0,1},RandomInteger[{10,30}]]},
{(RandomReal[{.1,.3}]dx){ Cos[t], Sin[t]},it rp2{ Cos[t], Sin[t]},
(it rp2 1.02){ Cos[t+.04], Sin[t+.04]},it rp2{ Cos[t+.08], Sin[t+.08]}}],
VertexColors->{White}],{t,0,2 Pi,.5}]};
PetersenGraph[ VertexShapeFunction->(spark[##,30]&), EdgeStyle->Directive[Opacity[.25],Thickness[.005], White], Background->Black, ImageSize->{600,600}, PlotRange->{{-3,3},{-2,2.5}}]

Styling Edges

EdgeStyle

EdgeLabels

EdgeShapeFunction

Manipulate[PetersenGraph[ {VertexStyle->EdgeForm[Directive[AbsoluteThickness[3],GrayLevel[0.5, 1]]],EdgeStyle->Directive[AbsoluteThickness[3],GrayLevel[0.5, 1]],EdgeShapeFunction->edgeshapefunction,VertexSize->{0.3`}}], {edgeshapefunction,{"Line","CarvedArrow", "FilledArcArrow"} }]

CompleteGraph[ 3,EdgeShapeFunction->(Inset[Dynamic[Row[RotateRight[MapIndexed[
           Style[#1,FontFamily->"Brush Script MT",White, 30] & , 
           Characters["Wolfram Technology Conference 2022  "]], Clock[{1, 15, 1}, 7]], 
         Spacer[2]]], Mean[#1],Automatic,Automatic,#[[1]]-#[[2]]] & ),EdgeStyle->DropShadowing[{0,0},16,Magenta], Background->Black, ImageSize->{600,600}, PlotRange->{{-3,3},{-2,2.5}}]

PlotTheme

PlotTheme is an option to Graph and related objects that specifies styles to use for the different graph elements.

Multicolumn[Framed[Graph[#,ImageSize->{200,200}],RoundingRadius->3,FrameStyle->GrayLevel[.6]]&/@{CompleteGraph[5, PlotTheme->"Minimal",VertexSize->0.1],GridGraph[{4,4}, PlotTheme->"Web",VertexSize->0.1],WheelGraph[10,PlotTheme->"Scientific",VertexSize->0.2],PetersenGraph[5,3,PlotTheme->"Monochrome",VertexSize->0.2],TuranGraph[5,4, PlotTheme->"IndexLabeled", VertexSize->0.5],ButterflyGraph[2, PlotTheme->"Marketing"],HypercubeGraph[3, PlotTheme->"ThickEdge"],Graph[GraphData[{"CrossedPrism",6},"EdgeList"],VertexSize->.5, PlotTheme->"SmallNetwork"],CirculantGraph[10,{2,4}, PlotTheme->"BackgroundBlue"]},3]

Highlighting Graph

HighlightGraph[g,{(Subscript[a, 1]),(Subscript[a, 2]),…}] highlights the (Subscript[a, i]) that can be vertices, edges, or subgraphs of g.

g=ExampleData[{"NetworkGraph","DolphinSocialNetwork"}];
Multicolumn[Framed[HighlightGraph[g,PathGraph[FindShortestPath[g,"SN90","SN4"]],VertexSize->1.2, Background->GrayLevel[.9], GraphHighlightStyle->#, ImageSize->450],RoundingRadius->3,FrameStyle->GrayLevel[.6]]&/@{"Thick","Dashed", "VertexDiamond", "DehighlightGray", "Shadow","BlackShadow"},2]

Examples

Marvel Universe Social Network

smallMarvelGraph=;

vlist=VertexList[smallMarvelGraph];
centrality=VertexDegree[smallMarvelGraph];

top3=vlist[[Reverse@Ordering[centrality]]][[;;3]]

Graph[smallMarvelGraph,VertexSize->Thread[vlist->Rescale[centrality,MinMax[centrality],{1,4}]], VertexLabels->Thread[top3->Placed["Name", Below]], VertexLabelStyle->Directive[11,Italic, Bold,], EdgeStyle->Directive[Opacity[.3], White], VertexStyle->{Directive[White,Opacity[.5], EdgeForm[]], Sequence@@Thread[top3->Directive[Opacity[1],DropShadowing[{0,0},16,White],White,EdgeForm[{White}]]]}, GraphLayout->{"RenderingOrder"->Join[EdgeList[smallMarvelGraph],Complement[vlist,top3],top3]},PerformanceGoal->"Quality", ImageSize->{950,800}, Background->Black]

SNAP [link]

fbData=;

fbData[1]

feature comparison chart

featureBar[{{xmin_,xmax_},{ymin_,ymax_}},y_,{0}]:=
Rectangle[{xmin,ymin},{xmax,ymax}]

featureBar[{{xmin_,xmax_},{ymin_,ymax_}},y_,{1}]:=
{{Opacity[1],Black,HalfLine[{(xmin+xmax)/2, ymax},{0,1} ]},Rectangle[{xmin,ymin},{xmax,ymax}]}

topBarChart[data_, graph_,cent_,opts___]:=
Block[{g, names, total, tfeature, maxt, top},
g=data[graph,"Graph"];
names=Normal[data[graph,"FeatureNames"]];
total=Total[AnnotationValue[{g,#}, "Feature"]&/@VertexList[g]];
maxt=Max[total];
top=VertexList[g][[Ordering[cent[g]][[-1]]]];
tfeature=AnnotationValue[{g,top}, "Feature"];
BarChart[Thread[total->tfeature],ChartLabels->Placed[names,Tooltip],opts,BarSpacing->0,ChartStyle->"FallColors" ,ChartElementFunction->featureBar, Axes->False,PlotRange->{{-Length[total]0.1, Length[total]1.1},{-maxt .05,maxt 1.1}}, Background->Directive[Opacity[.5],GrayLevel[.8]]]
]

topBarChart[fbData,"facebook/3980",VertexDegree]

measure summary

graphSummeray[g_]:=Dataset[<|"node"->VertexCount[g],"edges"->EdgeCount[g],"clustering coefficient"->N[GlobalClusteringCoefficient[g]],"overall clustering coefficient"->N[MeanClusteringCoefficient[g]],"assortativity coefficient"->N[GraphAssortativity[g]],"diameter"->Max[GraphDiameter/@ConnectedGraphComponents[g]],"Number of triangles"->Total[Diagonal[MatrixPower[AdjacencyMatrix[g],3]]]/6|>, ItemSize->10, DatasetTheme->"Detailed"]

graphSummeray[fbData[1,"Graph"]]

centrality plot

centralityPlot[g_, cent_, circle_List,opts:OptionsPattern[]]:=
Block[{colors, top3, top3order, gcolor,i=1},
top3order=Ordering[cent[g]][[{-1,-2,-3}]];
top3=VertexList[g][[top3order]];
If[Length[circle]==0,colors=ColorData[{"SolarColors","Reverse"}]/@Rescale[cent[g]];
colors=ReplacePart[colors,Thread[top3order->Table[Directive[DropShadowing[{0,0},20,White],EdgeForm[White],White, AbsolutePointSize[10-i]],{i,3}]]],
colors=ConstantArray[ColorData["BrightBands"][0],{VertexCount[g]}];
gcolor=ColorData["BrightBands"]/@(Range[Length[circle]]/Length[circle]);
colors = ReplacePart[colors,Flatten[MapThread[Thread[#1->#2]&,{Normal[VertexIndex[g,#]&/@circle],gcolor}]]];
i=1;colors=MapAt[Directive[DropShadowing[{0,0},20,White],EdgeForm[#],#, AbsolutePointSize[10-i++]]&,colors,List/@top3order];
];
GraphPlot[Graph[g , GraphLayout->{"RenderingOrder"->Join[EdgeList[g],Complement[VertexList[g],top3],top3]},VertexStyle->Thread[VertexList[g]->colors]], opts, VertexShapeFunction->"Point",EdgeShapeFunction->(Line[#]&),EdgeStyle->Directive[Thin,RGBColor["#99c1de"]], Background->RGBColor["#00509d"], BaseStyle->AbsolutePointSize[4]]
]

centralityPlot[fbData[1,"Graph"], VertexDegree,{}]

centralityPlot[fbData[1,"Graph"], VertexDegree,Normal[fbData[1,"Circle"]]]

combine together

DynamicModule[{feature,color, summary},Manipulate[Block[{cg,circles},cg=fbData[graph,"Graph"];
If[color==="by circles",circles=Normal[fbData[graph,"Circle"]],circles={}];
Overlay[{Overlay[{centralityPlot[cg, cent,circles,ImageSize->{1000,750}],If[feature,Panel[topBarChart[fbData,graph,cent,ImageSize->350]],Nothing]}, All, 2,Alignment->{.9,-.9}],If[summary,Panel[graphSummeray[fbData[graph,"Graph"]]],Nothing]}, All, 1,Alignment->{-.9,.9}]], {graph,Normal[Keys[fbData]]}, {{cent, VertexDegree,"centrality"},{VertexDegree,BetweennessCentrality,ClosenessCentrality,EigenvectorCentrality,PageRankCentrality}},Row[{Control[{feature, {False,True}}],Spacer[20],Control[{summary, {False,True}}],Spacer[20],Control[{color,{"by centrality", "by circles"} }]}], SaveDefinitions->True]
]

Graph Plots

GraphPlot

g=RandomGraph[{800,12000}]

GraphPlot[g]

GraphPlot3D

GraphPlot3D[SimpleGraph[Table[i\[UndirectedEdge]Mod[i^2,75],{i,75}]],EdgeShapeFunction->({Cylinder[#1,0.1]}&),VertexShapeFunction->({Sphere[#,0.3]}&)]

LayeredGraphPlot

LayeredGraphPlot[{"John"->"plants","lion"->"John","tiger"->"John","tiger"->"deer","lion"->"deer","deer"->"plants","mosquito"->"lion","frog"->"mosquito","mosquito"->"tiger","John"->"cow","cow"->"plants","mosquito"->"deer","mosquito"->"John","snake"->"frog","vulture"->"snake"},Left, PlotTheme->"DiagramGreen"]

LayeredGraphPlot3D

LayeredGraphPlot3D[{"John"->"plants","lion"->"John","tiger"->"John","tiger"->"deer","lion"->"deer","deer"->"plants","mosquito"->"lion","frog"->"mosquito","mosquito"->"tiger","John"->"cow","cow"->"plants","mosquito"->"deer","mosquito"->"John","snake"->"frog","vulture"->"snake"},Left, VertexShapeFunction->"Cuboid", VertexLabels->Automatic, EdgeStyle->Arrowheads[Small],VertexStyle->"Layered"]

TreePlot

TreePlot[Table[j->FromDigits[Drop[IntegerDigits[j,2],-1],2],{j,0,2^8-1}],Center]

CommunityGraphPlot

CommunityGraphPlot[g] generates a plot showing the community structure of the graph g.

g=ExampleData[{"NetworkGraph","ZacharyKarateClub"}]

CommunityGraphPlot[g]

GraphValuePlot

g=GridGraph[{11,11}];GraphValuePlot[g,{"VertexList"->EigenvectorCentrality[g]}]

g=HasseGraph[Subsets[{1,2,3}],All,SubsetQ[#2,#1]&, VertexLabels->Automatic]

GraphValuePlot[g, "VerticalLayers"]

What’s New in Geometry      
Thursday 3:30 PM CDT

Region Reconstructions: Uses and Techniques      
Thursday 4:20 PM CDT

Office Hour: Geometry
Friday 8:30 AM CDT

Office Hour: Graphs & Networks
Friday 2:00 PM CDT

(RowDefault[, (Spacer1), , (Spacer1), ])  #WolframTechConf