Recursive calculation of the normalization constant and the throughputs for arbitrary trees
Author: J. Virtamo, 5.12.2002

Some explanation of the internal workings of the program

Functions
tree[n]			forms recursively a data structure representing a subtree from link n downwards using a list-form tree representation TreeList as the starting point.
			The data structure is a list consisting of three elements:
			- list of all links in this tree
			- the capacity of link n (root of this tree)
			- list of all subtrees (with the same structure) of the root
offered[t,ind] 		gives recursively the rate offered by tree t when the active flows are those in the index set ind: minimum of the capacity of the root and
			the sum of offered traffic rates of all the subtrees plus the rate of the greedy direct source (if any)
saturated[t,ind]		gives recursively a list-form output of three elements, which is {Null, Null, False} if none of the links of the subtree t is saturated when the active flows
			are those in the index set ind; otherwise the ouput is {ind', c, True}, where ind' is subset of active flows that use the saturated link (one of them) and 
			c is the capacity of the saturated link.
Global variables
tt			structured tree representation of the whole tree
tr			root of the tree
flows			active flows
nfl			number of flows
G, H			recursively calculated sums (H is a vector, one component for each flow)
g,h			variables to store the calculated valuesin the recursion

The programs

There are three programs:

NormalizationConstant:		Returns the normalization constant
Throughputs				Returns a list {normalization constant, {throughputs}, {flows}}
TreeGraph				Forms graphics for drawing the tree (shown by Show)

All the programs have as their argument TreeList, which is a predecessor list representation of the tree (see Examples)

KSubsets[
        l_List, 0] := {{}}
KSubsets[l_List, 1] := Partition[l, 1]
KSubsets[l_List, 
        k_Integer?Positive] := {l} /; (k == Length[l])
KSubsets[l_List, 
        k_Integer?Positive] := {} /; (k > Length[l])
KSubsets[l_List, k_Integer?Positive] := 
      Join[Map[(Prepend[#, First[l]]) &, KSubsets[Rest[l], k - 1]], 
        KSubsets[Rest[l], k]]

\(NormalizationConstant[TreeList_] := 
      Module[{tree, uses, offered, saturated, recursion, flows, nfl, isets, 
          rt, tt, g, G, a}, \ 
 (*\ 
          Definitions\ *) \ 
tree[
            n_] := {Flatten[{n, \((\(\(tree[#]\)[\([1]\)] &\)\  /@ \ 
                    Flatten[\ 
                      Position[
                        TreeList, {n, __}]])\)}], \(TreeList[\([n]\)]\)[\([2]\)], 
tree\  /@ \ 
              Flatten[\ 
                Position[TreeList, {n, __}]]}\ ; 
offered[
            t_, ind_] := \ \ Min[t[\([2]\)], 
            If[MemberQ[ind, t[\([1, 1]\)]\ ], Infinity\ , 0] + 
              Plus\  @@ \ \((\(offered[#, ind] &\)\  /@ \ 
                    Last[t])\)]; 
saturated[{}, 
            ind_] := {Null, Null, False}; 
saturated[t_, 
            ind_] := If[
            offered[t, ind] == 
              t[\([2]\)], {Intersection[ind, t[\([1]\)]], t[\([2]\)], True}, 
            If[\((i = 
                    Position[\(Last[saturated[#, ind]] &\)\  /@ \ Last[t], 
                      True])\) == {}, {Null, Null, 
                False}, 
saturated[\(Last[
                    t]\)[\([\(i // First\) // First]\)], 
                ind]\ ]]; 
recursion[ind_] := 
          Module[{sat, ii, iii, r, gg, c}, 
{ii, c} = 
              Drop[saturated[tt, 
                  ind], \(-1\)]; 
iii = \(Complement[
                    ind, {#}] &\)\  /@ \ ii; 
gg = \ 
              g\  /@ \ iii; \ 
hh = \ 
              h\  /@ \ iii; 
r = 
              Last\  /@ \ TreeList[\([ii]\)]\ ; 
c -= 
              Plus @@ r; 
gg = 
              r . gg/c\ ]; 
 (*\ 
          Initializations\ *) ; 
flows = 
          Position[TreeList, {_, _, _}] // Flatten; \ 
        nfl = Length[flows]; 
isets = 
          Table[KSubsets[flows, k], {k, nfl}] // 
            Flatten[#, 1] &; 
rt = \(Position[
                TreeList, {Null, __}] // First\) // 
            First; 
tt = tree[rt]; 
 (*\ 
          Actual\ recursion\ *) 
G\  = \ \(g[{}] = 
            1\); 
\(G += \((g[#] = 
                  recursion[#])\) &\)\  /@ \ isets; 
G // 
          Simplify]
\)
Throughputs[TreeList_] := 
      Module[{tree, uses, offered, saturated, recursion, flows, nfl, isets, 
          rt, tt, g, h, G, H, i},  
 (* 
          Definitions *)  
tree[
            n_] := {Flatten[{n, (tree[#][[1]] &  /@  
                    Flatten[ 
                      Position[
                        TreeList, {n, __}]])}], TreeList[[n]][[2]], 
tree  /@  
              Flatten[ 
                Position[TreeList, {n, __}]]} ; 
offered[
            t_, ind_] :=   Min[t[[2]], 
            If[MemberQ[ind, t[[1, 1]] ], Infinity , 0] + 
              Plus  @@  (offered[#, ind] &  /@  
                    Last[t])]; 
saturated[{}, 
            ind_] := {Null, Null, False}; 
saturated[t_, 
            ind_] := If[
            offered[t, ind] == 
              t[[2]], {Intersection[ind, t[[1]]], t[[2]], True}, 
            If[(i = 
                    Position[Last[saturated[#, ind]] &  /@  Last[t], 
                      True]) == {}, {Null, Null, 
                False}, 
saturated[Last[
                    t][[i // First // First]], 
                ind] ]]; 
recursion[ind_] := 
          Module[{sat, ii, iii, r, gg, c}, 
{ii, c} = 
              Drop[saturated[tt, 
                  ind], -1]; 
iii = Complement[
                    ind, {#}] &  /@  ii; 
gg =  
              g  /@  iii;  
hh =  
              h  /@  iii; 
r = 
              Last  /@  TreeList[[ii]] ; 
c -= 
              Plus @@ r; 
gg = 
              r . gg/c; 
hh = (If[MemberQ[ii, #], 
                          gg + g[Complement[ind, {#}]], 0] &  /@  flows + 
                    r . hh)/c; 
{gg, 
              hh} ]; 
 (* 
          Initializations *) ; 
flows = 
          Position[TreeList, {_, _, _}] // Flatten;  
        nfl = Length[flows]; 
isets = 
          Table[KSubsets[flows, k], {k, nfl}] // 
            Flatten[#, 1] &; 
rt = Position[
                TreeList, {Null, __}] // First // 
            First; 
tt = tree[rt]; 
 (* 
          Actual recursion *) 
{G, 
            H}  =  {g[{}], h[{}]} = {1, 
              Table[0, {i, nfl}]}; 
{G, 
                H} += ({g[#], h[#]} = recursion[#]) &  /@  
          isets; 
{G,  (G/H), flows} // 
          Simplify]

TreeGraph[TreeList_] := 
      Module[{link, tree, tg, rt, tt, 
          d = 0.6}, 
link[b_, t_] := 
          Module[{a = 0.125, s, 
              p} , 
s = {-1, -a/2} + 
                b; 
p = {{0, 0}, {1, 0}, {1, a}, {0, 
                    a}, {0, 0}} + {s, s, s, s, s}; 
{{Hue[
                  0.5], Polygon[p]}, Line[p], 
              Text[t, {1/2, 2  a} + s], {GrayLevel[1], 
                Point[{0, 3  a} + s]}}]; 
tree[
            n_] := {{Max[d, 
                  If[Length[TreeList[[n]]] == 3, d, 0] + 
                    Plus @@  (tree[#][[1, 1]] &  /@  
                          Flatten[ Position[TreeList, {n, __}]])], n, 
                TreeList[[n]]} // Flatten, 
tree  /@  
              Flatten[ 
                Position[TreeList, {n, __}]]} ; 
tg[t_, 
            b_] := Module[{bb = b, bbb, a = t[[1, 1]], aa, tt = Last[t], 
              lst = {}}, 
{link[bb, 
                StringJoin["C", First[t][[2]] // 
                    ToString, "=", First[t][[4]] // 
                    ToString]], 
bb -= {2, a/2}; 
              aa = If[tt == {}, 0, tt[[1, 1, 1]] ]/
                  2; 
tg[#, aa = #[[1, 1]]/2; 
                    bbb = bb += {0, aa}; lst = {lst, Line[{b - {1, 0}, bb}]}; 
                    bb += {0, aa}; bbb] &  /@  tt, lst, 
              If[Length[t[[1]]] == 
                  5, 
bb += {0, 
                    d/2}; {Line[{b - {1, 0}, bb}], 
                  Text[StringJoin["x", First[t][[2]] // 
                        ToString], 
                    bb - { .2, 
                        0}]}, {}]}]; 
rt = Position[
                TreeList, {Null, __}] // First // 
            First; 
tt = 
          tree[rt]; 
{tg[tt, {0, 0}], 
          Line[{{0, 0}, {1, 0}}]}]

How to use the program

The tree is defined as a predecessor list. To make such a list 
1.	Number the links in the tree as you wish
2.	Make a list of the links in the order of the numbering.
   	 For each link in the list give the following elements:
   	 a) The number of the predecessor link in the tree (for the root write Null)
   	 b) The capacity of the link (must be numerical value)
   	 c) If the link has direct input, give as a third value the load ρ of that input (can be either symbol or number)

Example 1. A 2-branch tree

Define the tree as a predecessor list. Loads are here given a symbols.

treelist = {{3, 3, (Subscript[ρ, 1])}, {3, 5, (Subscript[ρ, 2])}, {Null, 
            7}};

Draw the tree.

Show[
        Graphics[{TreeGraph[treelist]}, 
          AspectRatio -> Automatic]];

If you want only the normalization constant, use

NormalizationConstant[treelist]

Using the Throughputs function you  get both the normalization constant, the throughputs, and a list of flows

Throughputs[treelist] // MatrixForm

Example 2. A 3-branch tree

Define the tree as a predecessor list. Loads are here given a symbols.

treelist = {{4, 9, (Subscript[ρ, 1])}, {4, 6, (Subscript[ρ, 2])}, {4, 
            2, (Subscript[ρ, 3])}, {Null, 10}};

Draw the tree.

Show[
        Graphics[{TreeGraph[treelist]}, 
          AspectRatio -> Automatic]];

If you want only the normalization constant, use

NormalizationConstant[treelist]

Using the Throughputs function you  get both the normalization constant, the throughputs, and a list of flows

t = Throughputs[treelist]

The throughputs as a function of (Subscript[ρ, 1]) alone when (Subscript[ρ, 2])  =  3  and (Subscript[ρ, 3])  =  1:

t[[2]] /. {(Subscript[ρ, 2]) -> 3, (Subscript[ρ, 3]) -> 1}

Example 3. A 3-level tree

Define the tree as a predecessor list. One of the loads is given symbolically, others are given numerically.

treelist = {{5, 3, 1}, {4, 2, (Subscript[ρ, 2])}, {4, 4, 2}, {5, 5}, {Null, 
          6}}

Draw the tree.

Show[
        Graphics[{TreeGraph[treelist]}, 
          AspectRatio -> Automatic]];

If you want only the normalization constant, use

NormalizationConstant[treelist]

Using the Throughputs function you  get both the normalization constant, the throughputs, and thea of flows

(t = Throughputs[treelist]) // MatrixForm

Plot the throughput of class 3 as a function of the load of class 2

Plot[t[[2, 3]], {(Subscript[ρ, 2]), 0, 3}];

Example 4. A larger tree

Define the tree as a predecessor list. All the loads are equal to one.

treelist = {{Null, 14, 1}, {1, 3, 1} , {1, 12}, {3, 4, 1}, {3, 2, 
            1}, {3, 2, 1}, {3, 6, 1}, {3, 3, 1}, {7, 2, 1}, {7, 2, 1}, {7, 3, 
            1}};

Draw the tree.

Show[
        Graphics[{TreeGraph[treelist]}, 
          AspectRatio -> Automatic]];

Using the Throughputs  function you  get both the normalization constant, the throughputs, and a list of flows

(t = Throughputs[treelist]) // MatrixForm

Approximate values of the throughputs:

t[[2]] // N