(*This file has the main computations from Chapter 4.
  In particular, the file manufactures the polynomials
  which come up in the Polynomial Lemma*)



(*Here is the energy function*)
eta[x_,y_]:=2 Max[{x x,y y}]/(x+y);


(*Here is parametrization of Omega*)
MapToOmega[{X_,Y_,Z_}]:=(
Clear[a,b,c,d,e];
r=(1+Sqrt[5])/4;
U = 4 X/3;
bhat=(1-Y) r U + Y U;
c=2 bhat bhat/U -bhat;
d=2 c c/U -c;
e=2 d d/U -d;
b=bhat (1-Z);
a=2 b b/U -b;
{a,b,c,d,e})


(*These routines check that the routine
MapToOmega really maps the unit cube
into Omega.  We prove this in the paper,
but it seems worthwhile to have a numerical
confirmation. CheckOmega[] outputs a 1 if the 
5-tuple is in Omega, and otherwise a 0. *)

CheckOmega[{b_,c_,d_,e_,f_}]:=(
u1=Max[{0,Sign[c]}];
u2=Max[{0,Sign[d]}];
u3=1-Sign[Abs[Chop[eta[b,c]-eta[c,d]]]];
u4=1-Sign[Abs[Chop[eta[e,f]-eta[c,d]]]];
u5=Sign[e];
u6=Max[{Sign[d-e],Sign[Chop[eta[c,d]-eta[d,e]]],0}];
u1 u2 u3 u4 u5 u6)

(*The routine checks if the routine MapToOmega[]
really maps a random point in the unit cube to Omega.
The output is a 1 if yes and a 0 if no.*)

RandomCheck[]:=(ran=Table[Random[],{3}];
{CheckOmega[MapToOmega[ran]],ran})

(*This routine invokes RandomCheck[] k times*)
ManyChecks[k_]:=(list=Table[RandomCheck[],{k}];Sort[list])




(*This routine creates the polynomials from Chapter 4.
One should check that DR, the denominator, is negative,
for some value, like {X,Y,Z}={1/2,1/2,1/2}*)

ComputePolynomials[]:=(
Clear[X,Y,Z];
{a,b,c,d,e}=MapToOmega[{X,Y,Z}];
Fc = Together[-2/(1+2*c)+(1+a)/(1+a-b^2+c+a*c)-
     (2*c)/(1+b-c^2+d+b*d)+(1+e)/(1+c-d^2+e+c*e)];
P=Expand[Numerator[Fc]/X/X];
Q=Denominator[Fc];
P0=Coefficient[P,Z,0];
hatP0=Expand[Factor[P0/(1-Y)]];
P1=Coefficient[P,Z,1];
P2=Coefficient[P,Z,2];
P3=Coefficient[P,Z,3];
Pi1=Expand[P0+P1+P2/2];
Pi2=Expand[P0+P1+P2+P3/2];
hatP3=Expand[P3/X];
)

(*This file tests the positive dominance condition
for the polynomials hatP0,P1,hatP3,Q1,Q2*)


ComputePolynomials[];

(*Positive dominance test*)

GetCoeff[Q_,i_,j_]:=Coefficient[Coefficient[Q,Y,i],X,j];
CoeffList[Q_]:=Table[Table[GetCoeff[Q,i,j],{i,0,19}],{j,0,4}];

(*This list takes the partial sums of a rectangular array*)
PartialSum[L_,i_,j_]:=Sum[Sum[L[[ii]][[jj]],{ii,1,i}],{jj,1,j}];

(*Here is the test for positive dominance*)
DominanceTest[Q_]:=(list=CoeffList[Q];
SUM=Table[Table[Table[PartialSum[list,i,j]],{i,1,5}],{j,1,20}];
Min[SUM])

(*The final answer*)
{DominanceTest[hatP0],
 DominanceTest[P1], DominanceTest[hatP3],
 DominanceTest[Pi1], DominanceTest[Pi2]}

