5
$\begingroup$

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[1], {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[2],List[3],List[4],List[5],List[1],List[3],List[4],List[5],List[1],List[2],List[4],List[5],List[1],List[2],List[3],List[5],List[1],List[2],List[3],List[4]]],Pattern]]],List[Rule[EdgeWeight,List[ew[1],ew[2],ew[3],ew[4],ew[5],ew[6],ew[7],ew[8],ew[9],ew[10]]],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.

$\endgroup$

1 Answer 1

7
$\begingroup$

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

For the first question:

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

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

You can visualize:

Histogram[f[10000]]

enter image description here

Estimating expectation using Mean,e.g,:

Mean[f[1000]]

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[5], Pick[EdgeList[CompleteGraph[5]], #, 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]

enter image description here

Visualizing some example graphs:

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

For example:

vis[0.5, 25, 5]

enter image description here

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.

$\endgroup$
1
  • $\begingroup$ Thanks, this is a beautiful Monte-Carlo approach to the problem. I am mainly interested in symbolic calculations, though. $\endgroup$
    – Eckhard
    Aug 11, 2014 at 10:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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