# Maximum Flow in a directed graph of a system of nonlinear ordinary differential equations

Let $$G=(V,E)$$ be a directed graph with $$n$$ vertices, $$V$$, and a set of $$m$$ edges, $$E$$. Each edge is a function of two unknown parameters, $$[t(i,j),a(i,j)]$$ and a given value for $$x(i)$$. If the two parameters are known, then one can apply Mathematica's NetworkFlow[] to find the maximum flow between any two vertices $$(s,t)$$ because the edge weights of $$G$$ are real numbers. However, in my case, each edge weight is a function of the two unknown parameters, for example, the edge weight of a directed path from $$i$$ to $$j$$ is $$[t(i,j) a(j,i) x(i)]$$.

As an example, suppose that vertex 1 sends information to vertex 5. $$t(1,5)$$ denotes the transfer attention of vertex 1, which is allocated for sending information to vertex 5. On the other hand, vertex 5 allocates some of its attention, denoted by $$a(5,1)$$, to absorb the incoming information from vertex 1. Therefore, the edge weight for the flow from vertex 1 to 5 becomes equal to $$[t(1,5)*a(5,1)*x(1)]$$, where $$x(1)$$ stands for the total information stock of vertex 1, which is distributed across vertices with which vertex 1 has binary links. The entire network is constructed using this logic.

I want to find the optimal values of all the unknown parameters in the network. This problem boils down to the case that I have to run NetworkFlow[] $$n(n-1)$$ times in the worst case.

My formal question to the community is:

How can I automate the formulation of this network flow problem (like a linear programming problem) and find the optimal distribution of $${t[i,j],a(j,i)}$$ for each pathway from $$s$$ to $$t$$ in the network? One may think of the pathway from $$s$$ to $$t$$ as a subgraph of $$G$$.

Here is a manually constructed maximization problem for s = 1 to t = 5. In larger digraphs of the above type, I cannot handle to prepare the max problems for each pathway from s to t. I want to formalize the following max problem using Mathematica functionality. Eventually, I should be able to get the optimal distribution of the parameters for each path.

Clear[nn, adjM, eCap, infoNet, wG];
nn = 5;  (* number of vertices *)
adjM = {{0, 1 , 1, 1, 0}, {0, 0, 0, 1, 1}, {0, 0, 0, 0, 1}, {0, 0, 0,
0, 1}, {0, 0, 0, 0, 0}};
eCap = Table[
Subscript[t, i, j]*Subscript[a, j, i]*Subscript[x, i], {i, 1,
nn}, {j, 1, nn}];  (* edge capacity *)
infoNet = adjM*eCap; (* a matrix of info flow *)
infoNet // MatrixForm
wG = WeightedAdjacencyGraph[infoNet /. {0 -> Infinity},
DirectedEdges -> True,
VertexLabels -> "Name"]  (* a weighted digraph of "infoNet" *)

(* Find Maximum Flow between vertices 1 and 5 *)
Clear[objFn, const];
objFn = Total[infoNet[[1]]] // Simplify;
const = {
1 >= Subscript[t, 1, 2] > 0,
1 >= Subscript[t, 1, 3] > 0,
1 >= Subscript[t, 1, 4] > 0,
1 >= Subscript[t, 2, 4] > 0,
1 >= Subscript[t, 2, 5] > 0,
1 >= Subscript[t, 3, 5] > 0,
1 >= Subscript[t, 4, 5] > 0,
1 >= Subscript[a, 2, 1] > 0,
1 >= Subscript[a, 3, 1] > 0,
1 >= Subscript[a, 4, 1] > 0,
1 >= Subscript[a, 4, 2] > 0,
1 >= Subscript[a, 5, 2] > 0,
1 >= Subscript[a, 5, 3] > 0,
1 >= Subscript[a, 5, 4] > 0,
Subscript[TT, 1] ==
Subscript[t, 1, 2] + Subscript[t, 1, 3] + Subscript[t, 1, 4],
Subscript[TT, 2] == Subscript[t, 2, 4] + Subscript[t, 2, 5],
Subscript[TT, 3] == Subscript[t, 3, 5],
Subscript[TT, 4] == Subscript[t, 4, 5],
Subscript[AA, 2] == Subscript[a, 2, 1],
Subscript[AA, 3] == Subscript[a, 3, 1],
Subscript[AA, 4] == Subscript[a, 4, 1] + Subscript[a, 4, 2],
Subscript[AA, 5] ==
Subscript[a, 5, 2] + Subscript[a, 5, 3] + Subscript[a, 5, 4],
Subscript[t, 1, 2]*Subscript[a, 2, 1]*Subscript[x,
1] - (Subscript[t, 2, 5]*Subscript[a, 5, 2] +
Subscript[t, 2, 4]*Subscript[a, 4, 2])*Subscript[x, 2] == 0,
Subscript[t, 1, 2]*Subscript[a, 2, 1]*Subscript[x, 1] <= Subscript[
x, 2],
Subscript[t, 1, 3]*Subscript[a, 3, 1]*Subscript[x, 1] -
Subscript[t, 3, 5]*Subscript[a, 5, 3]*Subscript[x, 3] == 0,
Subscript[t, 1, 3]*Subscript[a, 3, 1]*Subscript[x, 1] <= Subscript[
x, 3],
Subscript[t, 1, 4]*Subscript[a, 4, 1]*Subscript[x, 1] +
Subscript[t, 2, 4]*Subscript[a, 4, 2]*Subscript[x, 2] -
Subscript[t, 4, 5]*Subscript[a, 5, 4]*Subscript[x, 4] == 0,
Subscript[t, 1, 4]*Subscript[a, 4, 1]*Subscript[x, 1] +
Subscript[t, 2, 4]*Subscript[a, 4, 2]*Subscript[x, 2] <=
Subscript[x, 4]
};


Choose Random numbers to numerically solve the above max-flow problem:

Clear[x, TT, AA];
SeedRandom[01];
Table[Subscript[x, i] = RandomInteger[{1, 5}], {i, 1,
nn}];  (* given info carrying capacity *)
Table[Subscript[TT, i] = RandomReal[], {i, 1,
nn}];  (* given total Transfer attention *)
Table[Subscript[AA, i] = RandomReal[], {i, 1,
nn}];  (* given total Absorption attention *)

Maximize[{objFn, const}, {Subscript[t, 1, 2], Subscript[t, 1, 3],
Subscript[t, 1, 4], Subscript[t, 2, 4], Subscript[t, 2, 5],
Subscript[t, 3, 5], Subscript[t, 4, 5], Subscript[a, 2, 1],
Subscript[a, 3, 1], Subscript[a, 4, 1], Subscript[a, 4, 2],
Subscript[a, 5, 2], Subscript[a, 5, 3], Subscript[a, 5, 4]}]


(* solution *)

{2.7306, {Subscript[t, 1, 2] -> 0.428477,
Subscript[t, 1, 3] -> 0.322034,
Subscript[t, 1, 4] -> 6.61845*10^-10,
Subscript[t, 2, 4] -> 3.02959*10^-9, Subscript[t, 2, 5] -> 0.98254,
Subscript[t, 3, 5] -> 0.502337, Subscript[t, 4, 5] -> 0.46809,
Subscript[a, 2, 1] -> 0.698087, Subscript[a, 3, 1] -> 0.767014,
Subscript[a, 4, 1] -> 0.513681, Subscript[a, 4, 2] -> 0.10456,
Subscript[a, 5, 2] -> 0.507382, Subscript[a, 5, 3] -> 0.491711,
Subscript[a, 5, 4] -> 5.42932*10^-9}}