# 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[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}}]


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 Commented Aug 26, 2014 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? Commented Aug 26, 2014 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. Commented Aug 26, 2014 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. Commented Aug 26, 2014 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. Commented Aug 26, 2014 at 12:13
• @ Teake: now it works like charm. Tahnk You very much Commented Aug 26, 2014 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. Commented Aug 26, 2014 at 11:26