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 am currently struggling with a problem in Mathematica.

I have a randomly generated weighted Barabasi-Albert graph and a corresponding demand matrix of the same size. I'm generating the graph with the following code:

generateBarabasiAlbertGraph[n_, l_] /; n >= 3 := 
 Module[{g = CycleGraph[3], vc, vl, el},
 Do[
 vc = VertexCount[g];
 vl = VertexList[g];
 el = EdgeList[g];
 ec = EdgeCount[g];
 wl = RandomInteger[{5, 20}, {ec}];
 graph = Graph[el, EdgeWeight -> wl, EdgeWeight -> "EdgeWeight"];
 el = Map[UndirectedEdge[vc + 1, #] &, 
   RandomSample[VertexDegree[g] -> vl, Min[l, vc]]
   ];
 g = Graph[Join[EdgeList[g], el], 
   VertexLabels -> Placed["Name", Before]], {n - 3}];
   g; 
];
v = RandomInteger[{5, 10}];
l = RandomInteger[{1, 2}];
generateBarabasiAlbertGraph[v, l];

I then calculate the shortest path from each vertex a to vertex b if vertex a has a demand from vertex b.

Now I would like to create a shortest-path link matrix for all shortest paths in the graph. (A similar graph appears in this paper by Kelly).

This is what I already figured out:

TableForm[Array[0 &, {EdgeCount[graph], 1}], TableHeadings -> {EdgeList[graph], {sp}}]

enter image description here

As you can see, I have the shortest-path 3-1-4 and need to replace the 0 at the corresponding row if this edge is used in the shortest path. So in this case I need a 1 in row 3 and 4

Any ideas?

Best, Julian

share|improve this question
    
I just added my full code: The Problem I am referring to is the variable "test" in the "Loop" function –  Julian Aug 26 at 9:31

2 Answers 2

Judging from the paper you linked to and your own comments, I think what you really want is a directed Barabasi–Albert graph whose opposite edges have different weight. (Thus e.g. edge 1 -> 2 should have a different weight than 2 -> 1).

The code you posted generates an undirected BA graph, so allow me to suggest an alternative generating function based on the built-in command BarabasiAlbertGraphDistribution:

RandomDirectedWeightedBAGraph[n_, k_] :=
  WeightedAdjacencyGraph @ Replace[
    Normal @ AdjacencyMatrix @ RandomGraph @ BarabasiAlbertGraphDistribution[n, k],
    {1 :> RandomInteger[{n, 4n}], 0 -> Infinity},
    {2}
  ];

This first generates a random Barabasi–Albert graph, gets its AdjacencyMatrix, and replaces the non-zero entries with random weights, and uses that to construct a new graph.

We can now generate a (very simple) graph as follows:

graph = RandomDirectedWeightedBAGraph[3, 2];

Mathematica graphics

It's not obvious from the graphical representation, but the edges do have different weights, as we can check with WeightedAdjacencyMatrix:

Normal @ WeightedAdjacencyMatrix @ graph
{
  {0,  6, 3}, 
  {3,  0, 7}, 
  {7, 10, 0}
}

Thus edge 1 -> 2 has weight 6, and edge 2 -> 1 has weight 3.

Since I don't know what your definition of 'demand' is, I'll compute the shortest paths for all possible vertex combinations:

allVertexPairs = Permutations[VertexList @ graph, {2}]
{{1, 2}, {1, 3}, {2, 1}, {2, 3}, {3, 1}, {3, 2}}
shortestPaths = FindShortestPath[graph, All, All] @@@ allVertexPairs
{{1, 2}, {1, 3}, {2, 1}, {2, 1, 3}, {3, 1}, {3, 2}}

Notice that the shortest path from vertex 2 to 3 is not simply 2 -> 3, but 2 -> 1 -> 3. This is because FindShortestPath takes the edge weight into account. The former path has distance 7, the latter 3 + 3.

We can now proceed to compute the 'shortest path link matrix':

shortestPathLinkMatrix = Outer[
  Boole @ MemberQ[#2, #1] &,
  EdgeList[graph],
  DirectedEdge @@@ Partition[#, 2, 1] & /@ shortestPaths,
  1
]
{
  {1, 0, 0, 0, 0, 0}, 
  {0, 1, 0, 1, 0, 0}, 
  {0, 0, 1, 1, 0, 0}, 
  {0, 0, 0, 0, 0, 0},
  {0, 0, 0, 0, 1, 0},
  {0, 0, 0, 0, 0, 1}
}

This can finally be plugged into TableForm to give the desired result:

 TableForm[shortestPathLinkMatrix, TableHeadings -> {EdgeList @ graph, shortestPaths}]

Mathematica graphics

share|improve this answer
    
Dear Teake, this is really great and works quite nicely on my project. However, there is one mistake. If the shortestpath is calculated based on a weighted undirected graph, I only see the 1 at the edge Position of the first edge and not for rest. I changed the code above with the new one. Any ideas? –  Julian Aug 26 at 11:18
    
@Julian Sorry, I don't know what you mean here. It would help if you give a small explicit weighted undirected graph in your question, along with the set of shortest paths and wanted output. The generating code you have at the moment is not so useful. –  Teake Nutma Aug 26 at 11:28
    
@ Teake, I added the weighted undirected graph too my question. The wanted output still remains the same, your solution was already perfect. It just does not work with my graph object. –  Julian Aug 26 at 11:54
    
@Julian I added a missing call to Sort in the code for shortestpathlinkmatrix; try it again and see if it works now. –  Teake Nutma Aug 26 at 12:13
    
@ Teake: now it works like charm. Tahnk You very much –  Julian Aug 26 at 12:16

Taking an example of a shortest-path vertex list and an edgelist from your code:

spvertices = {4, 2, 1, 5};
edges = {1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 3, 
         2 \[UndirectedEdge] 3, 4 \[UndirectedEdge] 2, 
         5 \[UndirectedEdge] 1, 6 \[UndirectedEdge] 2, 
         7 \[UndirectedEdge] 3, 8 \[UndirectedEdge] 2};
spath = Partition[spvertices, 2, 1];
(* {{4,2},{2,1},{1,5}} *)
xx =  Tr /@ Outer[Boole[Equal[##]] &, Sort /@ List @@@ edges, Sort /@ spath, 1];
(* or xx =Tr /@ Outer[Boole[Complement[##] == {}] &, List @@@ edges, spath, 1]; *)
(* {1,0,0,1,1,0,0,0} *)
TableForm[List /@ xx, TableHeadings -> {edges, {{4, 2, 1, 5}}}, TableAlignments ->Center]

enter image description here

share|improve this answer
    
Dear kguler, thanks for your help, but I guess I need a more dynamic version in which I don't have to specifiy all the edges. So far Teake's solution workd fine for me, except that I need to figure out the new problem described above. –  Julian Aug 26 at 11:26

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.