Flow in pipeline graph

Question

I have pipeline directed graph which has one source and several sinks

getWeights = Function[{g},
   res = {};
   s = Flatten[{#1} & @@@ g, 1];
   For[i = 1, i <= Length[s], i++, 
    AppendTo[res, 1/Count[Flatten[{#1} & @@@ g, 1], s[[i]]]];];
   res
   ];

egdes = {0 -> 1, 0 -> 2, 0 -> 3, 1 -> 4, 1 -> 5, 1 -> 6, 3 -> 6, 
  3 -> 7 , 2 -> 5, 2 -> 6, 4 -> 8, 5 -> 8, 5 -> 9, 6 -> 9, 7 -> 9, 
 5 -> 10, 7 -> 10};
wghts = getWeights[egdes]
Graph[egdes, EdgeWeight -> wghts, 
 VertexLabels -> Placed["Name", Center], VertexSize -> Medium, 
 EdgeLabels -> Table[egdes[[i]] -> wghts[[i]], {i, Length[egdes]}]]
sinks = Complement[DeleteDuplicates[Flatten[{#2} & @@@ egdes, 1]], 
  DeleteDuplicates[Flatten[{#1} & @@@ egdes, 1]]]
sources= Complement[DeleteDuplicates[Flatten[{#1} & @@@ egdes, 1]], 
  DeleteDuplicates[Flatten[{#2} & @@@ egdes, 1]]]

Now I would like to calculate the the flow in sinks assuming the flow at source is equal to 1. I did it by finding all paths from source to sink and then summing the products of all edges weight in the path for all paths. My code is rather ugly and slow for large graphs so I do not put it here. I hope that someone could help me to find more elegant and fast decision. For the case in the figure there are three sinks {5,6,7} I found flows {3/8,1/4,3/8}

Answer 1

The following algorithm finds all paths from vertex s to vertex t in a directed graph represented by the adjacency matrix a (note that here s and t are for vertex positions and not vertex names!).

findPaths[a_?MatrixQ, s_Integer, t_Integer] := Module[{child, find},
     child[v_] := Flatten@Position[a[[v]], Except@0, 1, Heads -> False];
     find[v_, list_] := Scan[If[# === t, Sow[Append[list, #]], 
            If[FreeQ[list, #], find[#, Append[list, #]]]] &, child@v];
     If[# =!= {}, First@#, {}] &@Last@Reap@find[s, {s}]
];

First, collect all the sources and sinks in a more functional way:

edges = {0->1, 1->5, 1->6, 0->2, 2->7, 0->3, 3->5, 0->4, 4->6, 4->7};
weights = Thread[edges -> Block[{s = First /@ edges}, 1/Count[s, #] & /@ s]];
g = Graph[edges, EdgeWeight -> weights];
nodes = VertexList@g;
{sources, sinks} = Pick[nodes, #@g, 0] & /@ {VertexInDegree, VertexOutDegree}

{{0}, {5, 6, 7}}

Now apply findPaths to the graph's adjacency matrix (with properly converting vertex labels to vertex positions according to VertexList@g):

convert = Thread[nodes -> Range@Length@nodes];
paths = First@Outer[findPaths[Normal@AdjacencyMatrix@g, #1, #2] &,
        sources /. convert, sinks /. convert] /. Reverse/@convert;

Grid@Partition[HighlightGraph[g, #, PlotLabel -> #] & /@ 
        Flatten[Map[Rule @@@ Partition[#, 2, 1] &, paths, {2}], 1], 3]

pathWeights = Map[Rule @@@ Partition[#, 2, 1] &, paths, {2}] /. weights
Total /@ Apply[Times, pathWeights, {2}]

{3/8, 1/4, 3/8}

Answer 2

I accept this question is answered. I just observe that this question could be formulated as A discrete Markov process (sinks as absorbing states):

edges = {0 -> 1, 1 -> 5, 1 -> 6, 0 -> 2, 2 -> 7, 0 -> 3, 3 -> 5, 
   0 -> 4, 4 -> 6, 4 -> 7, 7 -> 7, 5 -> 5, 6 -> 6};
g = Graph[Range[0, 7, 1], edges, 
  VertexLabels -> Placed["Name", Center], VertexLabelStyle -> 20, 
  VertexSize -> 0.4]

Setting up:

 ma = DiscreteMarkovProcess[{1, 0, 0, 0, 0, 0, 0, 0}, 
      Normal[#/Total[#] & /@ AdjacencyMatrix[g]]];
Graph[ma, 
 VertexLabels -> (#1 -> Placed[#2, Center] & @@@ (Thread[
      Range[8] -> Range[8] - 1])), VertexSize -> 0.5, 
 VertexLabelStyle -> 20, 
 EdgeLabels -> 
  With[{sm = MarkovProcessProperties[ma, "TransitionMatrix"]}, 
   Cases[Flatten@
     Table[DirectedEdge[i, j] -> sm[[i, j]], {i, 8}, {j, 8}], 
    Except[_ -> 0]]]]

Stationary distribution can determine "flow":

stat = StationaryDistribution[ma]

Note distribution is consistent with desired result (vertex label=vertex-1):

ProbabilityDistribution[
 3/8 Boole[\[FormalX] == 6] + 1/4 Boole[\[FormalX] == 7] + 
  3/8 Boole[\[FormalX] == 8], {\[FormalX], 1, 8, 1}]

Directly:

Probability[x == #, x \[Distributed] stat] & /@ {6, 7, 8}

yields:

{3/8, 1/4, 3/8}

Answer 3

You can try with FindMaximumFlow:

g = Graph[egdes, EdgeWeight -> wghts, VertexLabels -> Placed["Name", Center],  
     VertexSize -> Medium]

op = FindMaximumFlow[g, sources, sinks, "OptimumFlowData", EdgeCapacity -> EdgeWeight];

elabels = # -> Framed[Row[{PropertyValue[{g, #}, EdgeWeight], " / ", 
    NumberForm[op[#], 2]}], Background -> White] & /@ op["EdgeList"];

SetProperty[op["FlowGraph"], {EdgeLabels -> elabels, ImagePadding -> 10}]ImagePadding -> 10}]