Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm trying to implement an application which uses random geometric graphs in Mathematica, but it seems Mathematica lacks the functionality. I need the following functionalities:

  1. Generate a set of uniformly distributed vertices on $[0,1]^2$ with certain properties (this really helps)
  2. Add an edge in between the vertices that are closer than a given radius $d$
  3. Display the graph (this is not like a regular graph display since the location of each vertex is important)
  4. Generate some random source-destination pairs and find the shortest path between them
  5. Highlight the path on the displayed graph.

Note that, Mathematica has all of the required functionality for non-geometric graphs. However, when it comes to the geo-graphs, the functionality is quite useless. Here is the code I already have:

Module[
 {nOld, kOld, v, edges},
 nOld = -1;
 kOld = -1;
 Manipulate[
  If[
   n != nOld,
   v = RandomReal[{0, 1}, {n, 2}];
   nOld = n
   ];

  edges = 
   Select[Flatten[Table[{a, b}, {a, v}, {b, v}], 
     1], (#[[1, 1]] > #[[2, 1]] && 
       EuclideanDistance[#[[1]], #[[2]]] < d) &];

  Graphics[
   {Red, Point[v],
    Blue, Thin, Line /@ edges
    }
   ]
  ,
  {n, 10, 100, 10},
  {d, 0, 1}
  ]
 ]

Mathematica graphics

It generates and shows the random graph. But generating and highlighting the shortest paths are not so simple since I don't have any data-structure to keep the graph. What is the best way to implement a geo-graph in Mathematica? Sparse matrices or System`Graph or Combinatorica`Graph? Can I use some of the built-in graph functions of Mathematica to implement geo-graphs?

share|improve this question
    
Would a Delaunay triangulation of a random set of points on the plane help? –  Szabolcs May 15 '12 at 21:03

3 Answers 3

up vote 8 down vote accepted

Slight modification of your code allows using Graph and all options that come with it:

 Module[{nOld, kOld, v, vertices, edges}, nOld = -1; kOld = -1;
 Manipulate[If[n != nOld, v = RandomReal[{0, 1}, {n, 2}];
 nOld = n]; vertices = Range@n;
 edges =   Select[Flatten[Table[{a, b}, {a, v}, {b, v}], 1],
   (#[[1, 1]] > #[[2, 1]] &&  EuclideanDistance[#[[1]], #[[2]]] < d) &];
 edgelst = Map[Rule[First@First@Position[v, #[[1]]], 
     First@First@Position[v, #[[2]]]] &, edges];
 Graph[vertices, edgelst, VertexCoordinates -> v, 
    DirectedEdges -> False], {n, 10, 100, 10}, {d, 0, 1}]]

screenshot:

enter image description here

EDIT: Adding RandomSample, HighlightGraph and ShortestPath:

Module[{nOld, kOld, v, vertices, edges, edgelst}, nOld = -1;  kOld = -1;
Manipulate[If[n != nOld, v = RandomReal[{0, 1}, {n, 2}]; 
  vertices = Range@n; {source, destination} = RandomSample[vertices, 2];
   nOld = n];
edges = Select[Flatten[Table[{a, b}, {a, v}, {b, v}], 1], 
    (#[[1, 1]] > #[[2, 1]] && EuclideanDistance[#[[1]], #[[2]]] < d) &];
edgelst =  Map[Rule[First@First@Position[v, #[[1]]], 
  First@First@Position[v, #[[2]]]] &, edges];
gr = Graph[vertices, edgelst, VertexCoordinates -> v,  DirectedEdges -> False]; 
HighlightGraph[gr, 
  PathGraph[FindShortestPath[gr, vrtx1, vrtx2]]], 
{n, 10, 100, 10}, {d, 0, 1}, Delimiter,  Style["shortestPath", "Subsection"], 
{{vrtx1, source, "fromVertex"}, vertices}, 
{{vrtx2, destination, "toVertex"}, vertices}]]

screenshot:

enter image description here

share|improve this answer
    
To take the lengths of the edges into account when calculating the shortest path you could set the option EdgeWeight -> weights in gr where weights is a list of the lengths of the edges. –  Heike May 16 '12 at 7:55
    
Thank you @Heike. Good point. I will add the Edgeweight option. –  kguler May 16 '12 at 8:20
    
You need to be careful when adding EdgeWeight. It seems that there is a bug which causes Mathematica to crash when evaluating FindShortestPath[gr, a, b] for a weighted graph gr in the case that there is no path between a and b. To be on the safe side you could check whether GraphDistance[gr, vrtx1, vrtx2] < Infinity first before trying to find the shortest path. –  Heike May 16 '12 at 9:57
1  
@Mohsen you can use Style for that, e.g. HighlightGraph[CompleteGraph[6], {Style[PathGraph[{1, 2, 3, 4}], Green], Style[PathGraph[{2, 6, 3}], {Red, Dashed}]}] –  Heike May 17 '12 at 7:13
1  
@Mohsen, FindShortestPath returns a single path; for multiple shortest paths pls see the answers to this question. Once you find the shortest paths, highlighting them with different styles is easy: For example, you can try something like: HighlightGraph[PetersenGraph[5, 2], {Style[PathGraph[FindShortestPath[PetersenGraph[5, 2], 10, 1]],{Thick, Purple}], Style[PathGraph[FindShortestPath[PetersenGraph[5, 2], 2, 9]], Directive[Thick, Cyan]]}]. –  kguler May 17 '12 at 7:18

In the latest version of Mathematica, SpatialGraphDistribution can be use to generate random geometric graphs:

n = 30; d = 0.5;
g = RandomGraph[SpatialGraphDistribution[n, d]];
{source, target} = RandomInteger[{1, n}, 2];
path = FindShortestPath[g, source, target];
HighlightGraph[g, PathGraph[path]]
share|improve this answer

Change your edges to the indices:

edges = Select[Flatten[Table[{a, b}, {a, n}, {b, a + 1, n}], 1],
    (EuclideanDistance[v[[#[[1]]]], v[[#[[2]]]]] < d) &];

And then tell the Graph where to locate the vertices:

g = Graph[Range[n], edges, VertexCoordinates -> v];

A shortest path display can be taken straight from the help:

HighlightGraph[g, PathGraph[FindShortestPath[g,
   RandomInteger[{1, n}], RandomInteger[{1, n}]]]]
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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