# Expected graph distance in random graph

I am trying to use the functionality of Expectation and Probability for random graphs, in particular for percolation models.

For example, I would like to be able to compute the expected graph distance between two fixed vertices in a complete graph with independent exponential edge weights. The following naive code does not work.

n = 5;
Expectation[
GraphDistance[
CompleteGraph[n,EdgeWeight -> Table[ew[m], {m,1,(n (n-1))/2}]], 1, 2],
Table[ew[m] \[Distributed] ExponentialDistribution, {m,1,(n(n-1))/2}]
]//FullForm


yields

GraphDistance[Graph[List[1,2,3,4,5],List[Null,SparseArray[Automatic,List[5,5],0,List[1,List[List[0,4,8,12,16,20],List[List,List,List,List,List,List,List,List,List,List,List,List,List,List,List,List,List,List,List,List]],Pattern]]],List[Rule[EdgeWeight,List[ew,ew,ew,ew,ew,ew,ew,ew,ew,ew]],Rule[GraphLayout,"CircularEmbedding"]]],1,2]


indicating that the random weights are not actually assigned to the edges.

A similar example would be the computation of the probability that two fixed vertices in a complete graph are in the same connected component after edges are deleted with probability $1-p$ and retained with probability $p$. Again the following naive code does not work.

n = 5; p = 1/3;
Probability[
GraphDistance[
CompleteGraph[n, EdgeWeight -> Table[ew[m], {m, 1, (n(n-1))/2}]], 1, 2] == 0,
Table[ew[m] \[Distributed] EmpiricalDistribution[{1-p, p} -> {1, 0}], {m,1,(n(n-1))/2}]
]


Ideally, I would like to be able to compute this probability (a polynomial in $p$) for symbolic $p$. Of course I would also be grateful for other approaches to the problem, but using Expectation and Probability would feel very intuitive to me.

Update:

The problem can be circumvented by computing the probability of a generic event which is only specified after Probability has been applied:

Clear[f, g]
n = 5;
f[ewarray_] :=
GraphDistance[CompleteGraph[n, EdgeWeight -> ewarray], 1, 2]
Probability[
g[Table[ew[m], {m, 1, (n(n-1))/2}]] == 0, Table[ew[m] \[Distributed] BernoulliDistribution[1-p], {m, 1, (n(n-1))/2}]
] /. g -> f // Simplify


The results are the same as @ubpdqn's MC calculations. I have experimented with Hold and Release to avoid the use of the extra function f but do not know enough those functions to make it work.

I may have misunderstood the aims, If so, I apologize.

For the first question:

f[n_] := GraphDistance[CompleteGraph[5, EdgeWeight -> #], 1, 2] & /@
RandomVariate[ExponentialDistribution, {n, 10}];


: This generates a sample of size n of graph distances between vertex 1 and 2.

You can visualize:

Histogram[f] Estimating expectation using Mean,e.g,:

Mean[f]


yields:0.533386

For the second aim:

In the following let p be probability that edge/link/connection exists at an instant in the complete graph (5). The probability nodes 1 and 2 will be connected can be estimated as follows:

func[p_, n_] := (N[
Total@Unitize[#]/
Length@#]) &@((GraphDistance[
Graph[Range, Pick[EdgeList[CompleteGraph], #, 1]], 1,
2] & /@ RandomVariate[
BernoulliDistribution[p], {n, 10}]) /. {Infinity -> 0})


Visualizing relationship between p and probability 1 and 2 connected:

lp = ListPlot[Table[{j, func[j, 1000]}, {j, 0, 1, 0.01}],
Frame -> True,
FrameLabel -> {"p",
"fraction of graphs with path\n bewteen 1 and 2"},
BaseStyle -> 16] Visualizing some example graphs:

vis[p_, n_, m_] :=
Grid[Partition[
HighlightGraph[CompleteGraph[5, VertexLabels -> "Name"],
Style[Pick[EdgeList[CompleteGraph], #, 1], Red, Thick],
ImageSize -> 100] & /@
RandomVariate[BernoulliDistribution[p], {n, 10}], m],
Frame -> All]


For example:

vis[0.5, 25, 5] Again, I apologize if I have misunderstood. Experts will have better answers. Perhaps, this will kickstart. Note this could be generalized to other nodes and the sample and visualization could be combined to allow calculations and visualizations. I do not have time to tidy up at present.

• Thanks, this is a beautiful Monte-Carlo approach to the problem. I am mainly interested in symbolic calculations, though. Aug 11 '14 at 10:01