2
$\begingroup$

I can very quickly generate random geometric graphs with

density = 1600; r0 = 0.05; Ngraphs = 100;
n = RandomVariate[PoissonDistribution[density], Ngraphs];

graphs = Table[
    RandomGraph[SpatialGraphDistribution[n[[k]], r0]], {k, 1, 
     Ngraphs}]; // AbsoluteTiming

{0.890343, Null}

but would like to add a vertex at the exact center position {0.5,0.5} in each graph, and then connect it to all vertices within range r0.

I have used

pts = PropertyValue[graphs[[1]], VertexCoordinates]; // AbsoluteTiming
Nearest[pts, {0.5, 0.5}] // AbsoluteTiming

{0.000062, Null}

{0.000145, {{0.507425, 0.491059}}}

but then EdgeAdd is quite slow since I have to use Position to find the name of the vertex at those coordinates. Is there some efficient way to do this?

My problem has been that this SpatialGraphDistribution technique is the fastest way to generate large graphs, but I need to fix vertices at a specific Euclidean separation in order to measure the graph distance/Euclidean distance relation.

Note: Slyvniak's Theorem is related to this idea of conditioning the graph to contain a vertex at a point, though that refers to the Poisson point process specifically.

$\endgroup$
4
$\begingroup$

You can use the fourth input form in the Nearest documentation:

Nearest[pts -> "Index", {0.5, 0.5}]

{989}

It will return the vertex position instead of the coordinate.

Also I recommend you to use GraphEmbedding instead of PropertyValue[graphs[[1]], VertexCoordinates]:

pts1 = PropertyValue[graphs[[1]], VertexCoordinates]; // AbsoluteTiming
pts2 = GraphEmbedding[graphs[[1]]]; // AbsoluteTiming

{0.000039, Null}

{4.*10^-6, Null}

pts1 == pts2

True

Adding edges with new coordinates:

edges = Thread[UndirectedEdge["center",
               Nearest[pts -> VertexList[graphs[[1]]], {0.5, 0.5}, {Infinity, r0}]]];

newg = Graph[VertexList[graphs[[1]]], 
  Join[EdgeList[graphs[[1]]], edges], 
  VertexCoordinates -> Append[pts, {0.5, 0.5}]]
$\endgroup$
  • $\begingroup$ If I use Nearest[Thread[pts -> Range[Length[pts]]], {0.5, 0.5}, {Infinity, r0}], can I then add a vertex at {0.5,0.5}? $\endgroup$ – Alexander Kartun-Giles Mar 8 '18 at 14:17
  • $\begingroup$ Your comments and advice here would be appreciated. $\endgroup$ – Szabolcs Mar 8 '18 at 14:53
  • 2
    $\begingroup$ halmir, no need to Thread the rules for Nearest, at least from version 11 onwards: Nearest[pts -> Range[Length[pts]], {0.5, 0.5}] works as well and is much faster (internally, the list of rules has to be decomposed and packed again into two seperate arrays). Note also that this is equivalent to Nearest[pts -> Automatic, {0.5, 0.5}] and Nearest[pts -> "Index", {0.5, 0.5}] (the latter only available in version 11.2. $\endgroup$ – Henrik Schumacher Mar 8 '18 at 18:42
  • $\begingroup$ @Henrik Schumacher good catch. Thanks $\endgroup$ – halmir Mar 8 '18 at 18:46
1
$\begingroup$

To complete halmir's answer, I used:

  ed[rg_] :=  EuclideanDistance @@@ 
  Map[PropertyValue[{rg,#},VertexCoordinates] &, EdgeList[rg], {2}]

  addvert[gr_, coord_, range_] := Module[{pts, nl, vv, ee},
  pts = GraphEmbedding[gr];
  vv = VertexList@gr;
  nl = Length@vv + 1;
  vv = Join[vv, {nl}];
  ee = Join[
    Thread[nl <-> 
      Nearest[Thread[pts -> Range[Length[pts]]], 
       coord, {Infinity, range}]], EdgeList@gr];
  Graph[vv, ee, VertexCoordinates -> Join[pts, {coord}]]
  ]

density = 5; r0 = 0.7; Ngraphs = 1;
n = RandomVariate[PoissonDistribution[density], Ngraphs];
graphs = Table[
    RandomGraph[SpatialGraphDistribution[n[[k]], r0]], {k, 1, 
     Ngraphs}]; // AbsoluteTiming
graphs = Parallelize[
    SetProperty[#, EdgeWeight -> ed[#]] & /@ 
     graphs]; // AbsoluteTiming

then run

graphs[[1]] = addvert[graphs[[1]], {0.5, 0.5}, r0]; // AbsoluteTiming

to simultaneously add a new vertex at {0.5,0.5}, and attach it to all those vertices of the graph within a distance of r0. The timing is

{0.000527, Null}

So it is quite fast. The VertexAdd and EdgeAdd method was difficult to use, since the VertexCoodinates get renamed as Automatic for some reason.

$\endgroup$

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.