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$
1
  • $\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$
    – apg
    Mar 1, 2018 at 20:28

1 Answer 1

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$
8
  • $\begingroup$ Perhaps I just look at the variance of the samples on vertical strips, and then plot against the respective strips Euclidean distance? $\endgroup$
    – apg
    Mar 1, 2018 at 20:40
  • 1
    $\begingroup$ Now it's graph distance (with respect to the Euclidean edge lengths) vs. Euclidean distance (chord distance). $\endgroup$ Mar 1, 2018 at 20:43
  • 1
    $\begingroup$ Good to hear that this may help you! $\endgroup$ Mar 1, 2018 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$ Mar 1, 2018 at 21:42
  • 1
    $\begingroup$ You're welcome! $\endgroup$ Mar 1, 2018 at 22:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.