random geometric graph generation problem

Question

I'm new to Mathematica. I'm trying to generate a random geometric graph in which to have a secure link between any two arbitrary nodes they should share a common key in their key rings (have assigned some keys to each node) in order to get a random key graph but when I write ShowGraph[g] I'm unable to plot the graph. Here is my code.

v = {};
If[Length[v] == 0,
 n = 100,(*Total number of nodes*)
 n = Length[v];(*For pre-defined topologies*)
 ]
nprime = 20;(*Average number of neighbours per node*)rc = 
 N[Sqrt[(nprime + 1)/(n*\[Pi])]]    (*Transmission range*)
rs = rc;(*Sensory range*)K = 4;(*Key ring size*)
Pstart = 10;(*Initial key pool size*)
Pend = 10;(*Last key pool size*)
If[Length[v] == 0,
 nsim = 50,(*Number of iterations per P*)
 nsim = 1;(*Only makes sense to simulate once for a fixed topology*)
 ];
edist[xi_, yi_, xj_, yj_] := {Sqrt[(xi - xj)^2 + (yi - yj)^2], xi, yi};

If[euclidean == True, 
  dist[xi_, yi_, xj_, yj_] := edist[xi, yi, xj, yj], 
  dist[xi_, yi_, xj_, yj_] := tdist[xi, yi, xj, yj]];

(* * * * * * * * * * * Main calculation * * * * * * * * * **)

(* * * * * * * * * * * * Main calculation * * * * * * * * * * * *)
For[P = Pstart, P <= Pend, P++,
For[sim = 1, sim <= nsim, sim++,
    SeedRandom[sim];
(* Generate vertices if not using a fixed topology {{{ *)
    If[Length[v] == 0 || sim > 1,
            v = {};
            For[i = 1, i <= n, i++, v = Append[v, {{Random[], Random[]}}]];
        ];
    g = Graph[{}, v];
    Print["Vertices: ", v]; (* Debug *)

(* Distribute keys randomly {{{ *)
    keyrings = {};
    For[i = 1, i <= n, i++,
            keyring = {};
            If[P == K, 
                For[k = 1, Length[keyring] < K, k++,
                    keyring = Append[keyring, k]
                ],
                (* P > K *)
                For[k = 1, Length[keyring] < K, k++,
                    key = Random[Integer, {1, P}];
                    If[MemberQ[keyring, key] == False,
                        keyring = Append[keyring, key]
                    ]
                ]
            ];
            keyrings = Append[keyrings, keyring];
        ];
    Print["Key rings: ", keyrings]; (* Debug *)

(* Determine edges {{{ *)
    For[i = 1, i <= n, i++,
            For[j = i + 1, j <= n, j++, 
                xi = Extract[Extract[Extract[v, i], 1], 1];
                xj = Extract[Extract[Extract[v, j], 1], 1];
                yi = Extract[Extract[Extract[v, i], 1], 2];
                yj = Extract[Extract[Extract[v, j], 1], 2];
                If[dist[xi, yi, xj, yj][[1]] < rc, 

  If[Extract[keyrings, {i}] \[Intersection] 
     Extract[keyrings, {j}] != {},
                        g = AddEdge[g, {{i, j}}],
                        (* Else *)
                        Print["No secure link between ",  i, " ", j]
                    ]
                ]
            ]
        ];
(*g=Graph[vertices,edgelst,VertexCoordinates\[Rule]v,
DirectedEdges\[Rule]False];*)
    ShowGraph[g];
]
];

What’s the problem? Can anyone help?

Answer 1

You should evaluate Needs["Combinatorica`"] prior to run your main evaluation code. If so, you should see your Graph by doing ShowGraph.

And here's another code you can do with System graph functionality:

Options[RandomKeyGeoGraph] = Join[Options[Graph], {DistanceFunction -> Automatic}];

RandomKeyGeoGraph[n_, r_, keyrings_List, opt : OptionsPattern[]] :=
 Block[{g,dist,opts},
  If[Length[keyrings] != n || ! VectorQ[keyrings, ListQ], Return["Invalid Keyrings."]];
  dist = OptionValue[DistanceFunction];
  opts = FilterRules[{opt}, Options[Graph]];

  g = RandomGraph[SpatialGraphDistribution[n, r, DistanceFunction -> dist], opts];
  EdgeDelete[g, 
   EdgeList[g, x_ \[UndirectedEdge] y_ /; Length[Intersection @@ keyrings[[{x, y}]]] == 0]]
 ]

RandomKeyGeoGraph[n_, r_, kpsize_Integer: 10, krsize_Integer: 4, opt : OptionsPattern[]] :=
 Block[{keypool, keyrings},
   keypool = Range[kpsize];
   keyrings = Table[RandomSample[keypool, krsize], {i, 1, n}];
   RandomKeyGeoGraph[n, r, keyrings, opt]
 ]

With Vitaliy's Manipulate:

Manipulate[ 
 If[p < k, k = p];
 keyrings = Table[RandomSample[Range[p], k], {i, 1, n}];
 SeedRandom[s];
 g = RandomKeyGeoGraph[n, r, keyrings, VertexSize -> {"Scaled", .01}, 
    VertexStyle -> Red, PlotRange -> {{-.01, 1.01}, {-.01, 1.01}}];
 vcoord = GraphEmbedding[g];

 Overlay[{If[range, 
    ClickPane[
       Graphics[{Dynamic[rangeCircle[pt, r, vcoord], 
            TrackedSymbols :> {vcoord, pt, r}]}, 
            PlotRange -> {{-.01, 1.01}, {-.01, 1.01}}], (pt = #) &], 
    Graphics[{}]], g}, All, 1],

{keyrings, ControlType -> None},
{vcoord, ControlType -> None},
{g, ControlType -> None},
{{pt, {1/2, 1/2}}, ControlType -> None},
{{s, 2, "configuration"}, 1, 100, 1,  Appearance -> "Labeled"}, 
{{k, 4, "keyring size"}, 1, 10, 1, Appearance -> "Labeled"}, 
{{p, 10, "key pool size"}, 1, 50, 1, Appearance -> "Labeled"}, 
{{n, 256, "points number"}, 10, 500, 1, Appearance -> "Labeled"},
{{r, .1, "nearest radius"}, .001, .5, Appearance -> "Labeled"},
{{range, False, "show range disk"}, {True, False}},
Initialization -> {
  rangeCircle[c_List, r_, vcoord_List] :=
    Block[{center},
       center = First[Nearest[vcoord, c, 1]];
       {Yellow, Disk[center, r], Green, 
          Disk[#, .015] & /@ Rest[Nearest[vcoord, center, {Infinity, r}]],
          Orange, Disk[center, .015]}
    ];
   rangeCircle[___] := {}
 }]

Answer 2

Random geometric graphs are built-in in Mathematica:

RandomGraph[SpatialGraphDistribution[256, .1]]

Compare to Wikipedia: random geometric graph.

?SpatialGraphDistribution

If you want an exercise to do it old school, here is functional code:

Manipulate[

 SeedRandom[s];

 vts = Thread[Rule[RandomReal[1, {#, 2}], Range[#]]] &[n];

 edgs = DeleteCases[
   Union[Sort /@ 
     Flatten[Thread[
         UndirectedEdge[#1, #2]] & @@@ (({#, 
             Nearest[vts[[All, 1]], #, {Infinity, r}]} & /@ 
           vts[[All, 1]]) /. vts)]], x_ \[UndirectedEdge] x_];

 Graph[Range[n], edgs, VertexCoordinates -> vts[[All, 1]], 
  VertexStyle -> Red, VertexSize -> {"Scaled", .01}, 
  PlotRange -> {{0, 1}, {0, 1}}]


 , {vts, ControlType -> None}
 , {edgs, ControlType -> None}
 , {{s, 2, "configuration"}, 1, 100, 1, Appearance -> "Labeled"}
 , {{n, 256, "points number"}, 10, 500, 1, Appearance -> "Labeled"}
 , {{r, .1, "nearest radius"}, .001, .5, Appearance -> "Labeled"}
 ]