Sums of Solutions of a Linear System

Question

I have a system of equations/inequalities involving 36 numbers $p_{11},p_{12},...,p_{16},p_{21},...,p_{66}$.

I have some equations/inequalities, such as

(i) $0\le p_{i,j}\le 1$ for all $i,j$.

(ii) the sum of all the terms $$\sum_{i,j=1}^{6}p_{ij}\le 1,$$

(iii) the sum along each of the 6 rows $$\sum_{j=1}^6p_{1j}=\frac{4}{15},\sum_{j=1}^6p_{2j}=\frac{2}{15},\sum_{j=1}^6p_{3j}=\frac{4}{45},\sum_{j=1}^6p_{4j}=\frac{1}{15},\sum_{j=1}^6p_{5j}=\frac{4}{75},\sum_{j=1}^6p_{6j}=\frac{2}{45},$$

and

(iv) the sum along each of the 6 columns $$\sum_{i=1}^6p_{i1}\le\frac{1}{6},\sum_{i=1}^6p_{i2}\le \frac{1}{6},\sum_{i=1}^6p_{i3}\le\frac{1}{6},\sum_{i=1}^6p_{i4}\le\frac{1}{6},\sum_{i=1}^6p_{i5}\le1/6,\sum_{i=1}^6p_{i6}\le\frac{1}{6}.$$

I am trying to estimate certain sums of the $p_{i,j}$'s. For example, I am interested in whether $p_{14}+p_{16}+p_{34}+p_{54}+p_{56}>\frac{1}{6}.$

Perhaps there is not not info in this particular case to make a conclusion, but I would like to learn how to implement this in Mathematica in case I use a different list of entries.

Is there a way to answer such questions on Mathematica?

Answer 1

Yes, this is a standard sort of linear programming problem.

Here is the basic setup.

pmat = Array[p, {6, 6}];
vars = Flatten[pmat];
c1 = Map[0 <= # <= 1 &, vars];
c2 = Thread[Total[pmat] <= 1/6];
c3 = Thread[
   Total[pmat, {2}] == {4/15, 2/15, 4/45, 1/15, 4/75, 2/45}];
constraints = Join[c1, c2, c3];

Form the objective function.

posns = {{1, 4}, {1, 6}, {3, 4}, {5, 4}, {5, 6}};
obj = Total[Apply[p, posns, {1}]]

(* Out[992]= p[1, 4] + p[1, 6] + p[3, 4] + p[5, 4] + p[5, 6] *)

See if it can exceed 1/6 (method: find its max).

Maximize[{obj, constraints}, vars]

(* Out[1005]=
 {1/3, {p[1, 1] -> 19/450, p[1, 2] -> 1/30, p[1, 3] -> 0, 
  p[1, 4] -> 11/450, p[1, 5] -> 0, p[1, 6] -> 1/6, p[2, 1] -> 0, 
  p[2, 2] -> 2/15, p[2, 3] -> 0, p[2, 4] -> 0, p[2, 5] -> 0, 
  p[2, 6] -> 0, p[3, 1] -> 0, p[3, 2] -> 0, p[3, 3] -> 0, 
  p[3, 4] -> 4/45, p[3, 5] -> 0, p[3, 6] -> 0, p[4, 1] -> 0, 
  p[4, 2] -> 0, p[4, 3] -> 1/15, p[4, 4] -> 0, p[4, 5] -> 0, 
  p[4, 6] -> 0, p[5, 1] -> 0, p[5, 2] -> 0, p[5, 3] -> 0, 
  p[5, 4] -> 4/75, p[5, 5] -> 0, p[5, 6] -> 0, p[6, 1] -> 0, 
  p[6, 2] -> 0, p[6, 3] -> 2/45, p[6, 4] -> 0, p[6, 5] -> 0, 
  p[6, 6] -> 0}} *)

So that sum can be as large as 1/3 which answers in the affirmative that it can exceed 1/6. Is it of necessity greater? That can be answered with a minimization.

Minimize[{obj, constraints}, vars]

(* Out[1042]= {0, {p[1, 1] -> 1/6, p[1, 2] -> 1/10, p[1, 3] -> 0, 
  p[1, 4] -> 0, p[1, 5] -> 0, p[1, 6] -> 0, p[2, 1] -> 0, 
  p[2, 2] -> 1/15, p[2, 3] -> 11/450, p[2, 4] -> 19/450, p[2, 5] -> 0,
   p[2, 6] -> 0, p[3, 1] -> 0, p[3, 2] -> 0, p[3, 3] -> 4/45, 
  p[3, 4] -> 0, p[3, 5] -> 0, p[3, 6] -> 0, p[4, 1] -> 0, 
  p[4, 2] -> 0, p[4, 3] -> 0, p[4, 4] -> 1/15, p[4, 5] -> 0, 
  p[4, 6] -> 0, p[5, 1] -> 0, p[5, 2] -> 0, p[5, 3] -> 4/75, 
  p[5, 4] -> 0, p[5, 5] -> 0, p[5, 6] -> 0, p[6, 1] -> 0, 
  p[6, 2] -> 0, p[6, 3] -> 0, p[6, 4] -> 2/45, p[6, 5] -> 0, 
  p[6, 6] -> 0}} *)

So this sum can indeed be smaller than 1/6.