0
$\begingroup$

I'm trying to calculate the variance of the passage time over various distances in a random geometric graph.

I am able to quickly generate a random geometric graph with e.g. SpatialGraphDistribution. I then set the EdgeWeights as the respective Euclidean length...

r0 = 0.2;    
density = 100;
Ngraphs = 100;
n = RandomVariate[PoissonDistribution[density], Ngraphs];
ed[rg_] := 
  EuclideanDistance @@@ 
   Map[PropertyValue[{rg, #}, VertexCoordinates] &, EdgeList[rg], {2}];
graph6 = Table[
    RandomGraph[SpatialGraphDistribution[n[[k]], r0]], {k, 1, 
     Ngraphs}]; // AbsoluteTiming
graph6 = SetProperty[#, EdgeWeight -> ed[#]] & /@ 
    graph6; // AbsoluteTiming

It is a bit slow setting the weights! But, for now...

Define the passage time $T(x,y)$ to be the Euclidean length of a shortest path between vertices $x$ and $y$.

I need to plot the variance of the passage time $\text{Var}\left(T(x,y)\right)$ against $||x-y||$, which shows how this variance changes as the path spans an increasing distance. The conjecture I have is that this variance converges to a positive constant as $||x-y|| \to \infty$. The difficulty is I can't fix two vertices at $||x-y||$ in the graph using this SpatialGraphDistribution method. So I sample many pairs, and for each record 1) their Euclidean separation, and 2) the passage time $T$ along the geodesic running between them.

Is there a way I can then quickly take these samples of the passage time for e.g. uniformly random pairs, say 5% of all pairs in a graph, and then produce a plot of $T(||x-y||)$ vs $||x-y||$?

At the moment I am binning the distances of random pairs, but it is inelegant.

$\endgroup$
  • $\begingroup$ I can also generate the graphs without using SpatialGraphDistribution, thanks to excellent help in another question mathematica.stackexchange.com/questions/166732/…. For now I am more concerned with this problem of efficiently sampling the passage time. However, the two questions are entwined! $\endgroup$ – Alexander Kartun-Giles Mar 1 '18 at 20:28
1
$\begingroup$

Does this function approximate what you are looking for?

distanceplot[G_Graph] := Module[{pts, A, B},
  pts = PropertyValue[G, VertexCoordinates];
  A = Flatten[
    DeleteCases[UpperTriangularize[GraphDistanceMatrix[G], 1], 
     0., {2}]];
  B = Flatten[
    DeleteCases[UpperTriangularize[DistanceMatrix[pts, pts], 1], 
     0., {2}]];
  ListPlot[Transpose[{B, A}], AxesLabel -> {"EuclideanDistance", "GraphDistanceMatrix"}]
  ]

distanceplot[graph6[[1]]]

enter image description here

$\endgroup$
  • $\begingroup$ Perhaps I just look at the variance of the samples on vertical strips, and then plot against the respective strips Euclidean distance? $\endgroup$ – Alexander Kartun-Giles Mar 1 '18 at 20:40
  • 1
    $\begingroup$ Now it's graph distance (with respect to the Euclidean edge lengths) vs. Euclidean distance (chord distance). $\endgroup$ – Henrik Schumacher Mar 1 '18 at 20:43
  • 1
    $\begingroup$ Good to hear that this may help you! $\endgroup$ – Henrik Schumacher Mar 1 '18 at 21:03
  • 1
    $\begingroup$ Try SortBy[Transpose[{B,A}],First] for sorting. Binning can maybe done with the tree-argument variant of BinLists. $\endgroup$ – Henrik Schumacher Mar 1 '18 at 21:42
  • 1
    $\begingroup$ You're welcome! $\endgroup$ – Henrik Schumacher Mar 1 '18 at 22:18

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.