# Small Worlds

August 25, 2016

I'm exploring some graph theory today. It's a fun little branch of pure mathematics. I think that's why I like it--it's so simple but also deceptively complex at scale.

In 1998, Duncan J. Watts and Steven H. Strogatz published an article in the journal Nature that described an interesting type of social network, popularly associated with Frigyes Karinthy's 1929 concept of "six degrees of separation," or more recently, "six degrees of Kevin Bacon." It's pretty fun to play around with, but the concept of "small worlds" has intrigued researchers, including myself.

Watts was apparently working on a synchronization problem involving chirping crickets. When I was learning simple regression, we used this problem to predict frequency of cricket chirps as a response variable of outdoor temperature. Neat. At any rate, they had little knowledge of social networks or graph theory but dropped the crickets project to try to find something that looked like a small world network.

To model a small world graph, we're basically randomly constructing graphs with varying probabilities of vertices sharing an edge.

There are numerous examples of these types of networks out there in the world. Some examples are the neural networks in the worm Caenorhabditis elegans and transportation networks.

That's all fascinating, but let's make some visualizations.

First, let's generate a small world graph with 300 vertices at .05 probability (we should totally adjust this for later analysis, of course)

Cool, we have our small world graph now. Let's look at centrality, i.e. which vertices are most connected by edges, or, how many nodes have connections (This is a simplified explanation of methods. Contact me if you want to discuss the mathematics.)

Let's scale vertices by influence.

Interesting. Larger nodes seemingly have greater ability to do something like spread information.

Let's find a clique in the network.

This is kind of fascinating. What does the subgraph look like?

Now, let's look at the graph center.

If you increase the probability of vertices sharing edges, you get something like this. As the color gradient changes, probability of degrees changes.

So let's now look at some clustering based on degree, vertices, and edges. Remember geometry? Me neither.

Awesome. I've had to re-familiarize myself with math over the past several years, or at least how math is taught.

That said, and as much as I do not take his words as gospel, it's something to keep in mind. He had some cool ideas.

Whoa. So cool. We can see how there is some overlap between two of the groups. That's fascinating. We can also see how some of our outliers in the network may act as bridges between communities here. That's totally interesting, not to nerd out here beyond making a blog post about graph theory and networks.

Let's visualize this with a different algorithm.

Whoa! Way cool. We have clustered and visualized a bunch of vectors. That's kind of neat, from a math standpoint.

But let's visualize this slightly differently to better see how edges are connected.

Kind of awesome. I really like that through graph theory we can visualize the social world and also try to explain it. For certain, I am no mathematician, but it's more than interesting to incorporate theory from other disciplines, or just to be plain anti-disciplinary.

Here is some code in Wolfram Language for use in Mathematica.

**generate random small world graph

smallworld =
RandomGraph[WattsStrogatzGraphDistribution[300, 0.05, 5],
Background -> Black, ImageSize -> Large]

**status centrality with scaled vertices

StatusCentrality[smallworld];

HighlightGraph[smallworld, VertexList[smallworld],
ImageSize -> Large]

**find clique

FindClique[smallworld]

**cluster/community plot

CommunityGraphPlot[#, FindGraphCommunities[#],
CommunityRegionStyle -> Directive[Opacity[.1], Gray],
CommunityBoundaryStyle -> Directive[Orange, Dotted],
EdgeStyle -> Orange, Method -> "Hierarchical",
ImageSize -> Full] &@smallworld

**spring electrical method

CommunityGraphPlot[#, FindGraphCommunities[#],
CommunityRegionStyle -> Directive[Opacity[.1], Gray],
CommunityBoundaryStyle -> Directive[Orange, Dotted],
EdgeStyle -> Orange, Method -> "SpringElectrical",
ImageSize -> Full] &@smallworld

**graphs by density

{graphs, coeffs} =
Transpose[
SortBy[{#, GlobalClusteringCoefficient[#]} & /@
RandomGraph[
WattsStrogatzGraphDistribution[200, 0.1, 3], {10000}], Last]];
min = Min[coeffs]; max = Max[coeffs];
nf = Nearest[coeffs -> graphs];
values = Range[min, max, (max - min)/(6^2 - 1)];
Grid[Partition[
Map[SetProperty[
First[nf[#]] 1, {VertexStyle ->
Directive[White, EdgeForm[White]], EdgeStyle -> White,
Background ->
ColorData[{"GrayTones", "Reversed"}, Rescale[#, {min, max}]],
ImageSize -> {200, 200}}] &, values], 4]]