Relative Neighbourhood Graph

Ad-hoc implementation of Relative Neighborhood Graph (RNG)

Under the heuristic assumption that that each vertex in a RelativeNeighborhoodGraph will have at most valence 6, this could be a way to exploit Nearest to compute it:

ClearAll[RelativeNeighborhoodGraph];
RelativeNeighborhoodGraph[pts_?((MatrixQ[#] && Dimensions[#][[2]] == 2) &)] := 
 Module[{nf, i, j, p, q, edgelengths, edges},
  nf = Nearest[pts -> Automatic];
  i = Join @@ Rest[Transpose[nf[pts, {7, ∞}]]];
  j = Join @@ ConstantArray[Range[Length[pts]], 6];
  edges = DeleteDuplicates[Sort /@ Transpose[{i, j}]];
  
  {i, j} = Transpose[edges];
  p = pts[[i]];
  q = pts[[j]];
  edgelengths = Sqrt[Dot[Subtract[p, q]^2, ConstantArray[1., 2]]];
  edges = Pick[
    edges,
    MapThread[
     {x, y, d} \[Function] Length[Intersection[nf[x, {∞, d}], nf[y, {∞, d}]]],
     {p, q, edgelengths + 100 $MachineEpsilon}
     ],
    2
    ];
  Graph[Range[Length[pts]], UndirectedEdge @@@ edges, VertexCoordinates -> pts]
  ]

Usage example:

SeedRandom[20181008];
pts = RandomReal[{-1, 1}, {1000, 2}]
RelativeNeighborhoodGraph[pts]

enter image description here

Implementation of $\beta$-Skeleton for $\beta \geq 1$

The $2$-Skeleton is precisely the RNG. So we can try to compute this one.

The strategy is the same as above: First sieving out a list of edges that a as-small-as-possible superset of the $\beta$-Skeleton's edge list. For $\beta \geq 1$, we may exploit that the $\beta$-Skeleton is a subgraph of the edge-graph of the Delaunay triangulation. So we may skip the heuristic sieving argument from above and start from the edges of DelaunayMesh[pts].

ClearAll[BetaSkeleton];
BetaSkeleton[
  pts_?((MatrixQ[#] && Dimensions[#][[2]] == 2) &),
  β_ /; β >= 1
  ] := Module[{nf, i, j, p, q, r, edgelengths, edges},
  nf = Nearest[pts -> Automatic];
  edges = 
   MeshCells[DelaunayMesh[pts], 1, "Multicells" -> True][[1, 1]];
  {i, j} = Transpose[edges];
  p = pts[[i]];
  q = pts[[j]];
  r = 0.5 β;
  edgelengths = Sqrt[Dot[Subtract[p, q]^2, ConstantArray[1., 2]]];
  edges = 
   Pick[edges, 
    MapThread[
     {x, y, d} \[Function] Length[
      Intersection[
       nf[x + (r - 1) (x - y), {∞, d}], 
       nf[y + (r - 1) (y - x), {∞, d}]
       ]
      ], 
     {p, q, r (edgelengths + 100 $MachineEpsilon)}
     ],
    2
    ];
  Graph[Range[Length[pts]], UndirectedEdge @@@ edges, VertexCoordinates -> pts]
  ]

Examples:

BetaSkeleton[pts, 2.0]

enter image description here

BetaSkeleton[pts, 2.5]

enter image description here


IGraph/M now has functions for computing a few types of proximity graphs, including the relative neighbourhood graph and β-skeletons.

IGRelativeNeighborhoodGraph@RandomPoint[Disk[], 1000]

enter image description here

This is still a work-in-progress and performance optimizations, as well as generalizations, are possible in the future.