# How to create a 'shortest-path link matrix'?

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, 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}}] 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

• I just added my full code: The Problem I am referring to is the variable "test" in the "Loop" function – Julian Aug 26 '14 at 9:31

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_] :=
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]; 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}] • 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 '14 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 '14 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 '14 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 '14 at 12:13
• @ Teake: now it works like charm. Tahnk You very much – Julian Aug 26 '14 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] • 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 '14 at 11:26