Section 1: Introduction

This Mathematica notebook accompanies the article “Exact lower bounds for monochromatic Schur triples and generalizations” by Christoph Koutschan and Elaine Wong.
See http://www.koutschan.de/data/schur/

Caveat: in some parts of this notebook the notations b1 for s and b2 for t are used.

Section 2: Exact lower bound for monochromatic Schur triples

(* Brute-force approach to find the minimal number of MST's and the optimal coloring(s) *)
Table[
triples=Flatten[Table[{x,y,x+y},{x,n-1},{y,n-x}],1];
colorings=Tuples[{0,1},n-1];
ntrips=Length[Cases[triples/.n->0/.Thread[Range[n-1]->#],{0,0,0}|{1,1,1}]]&/@colorings;
min=Min[ntrips];
pos=Flatten[Position[ntrips,min]];
colorings=Append[#,0]&/@colorings[[pos]];
Print[{n,min,pos,colorings}];
,{n,4,20}]

(* Collect the values found above in a list *)
MMSTbf={0,0,0,0,1,1,2,3,4,6,7,9,11,13,15,18,20,23,26,29};

(* Exact minimal number when n is a multiple of 11, assuming the form of the best coloring. *)
Table[With[{n=11k},
col=Join[Table[0,{4n/11}],Table[1,{6n/11}],Table[0,{n/11}]];
triples=Flatten[Table[{x,y,x+y},{x,n-1},{y,n-x}],1];
Length[Cases[triples/.Thread[Range[n]->col],{0,0,0}|{1,1,1}]]]
,{k,20}]

(* Guess a closed form *)
Table[11k^2-4k,{k,20}]

(* The area function A(s,t) *)
Expand[s^2/2+(t-2s)^2/2+(1-t)^2]

D[%,#]&/@{s,t}

Solve[%==0,{s,t}]

(* NoMST gives the number of monochromatic Schur triples under the coloring R^s B^(t-s) R^(n-t). *)
(* The formula is only valid if 1 ≤ s ≤ t ≤ n and t ≥ 2s and s ≥ n-t hold. *)
NoMST[n_,s_,t_]:=s*(s-1)/2+(t-2s)*(t-2s-1)/2+(n-t)*(n-t-1);
Table[NoMST[n,Floor[(4n)/11],Floor[(10n)/11]],{n,20}]-MMSTbf

We see that just taking Floor does not give the exact correct values for s and t. Next, we look at which positions (relative to {s,t}) the minimum is attained, and play with the initial values of {s,t} until the minimum is at {s,t} for every equivalence class modulo 11 (i.e., until in each line {0,0} appears).

Table[
test=Table[NoMST[n,Floor[(4n+2)/11]+i,Floor[(10n)/11]+j],{i,-1,1},{j,-1,1}];
p@@Prepend[#-{2,2}&/@Position[test,Min[Flatten[test]]],Mod[n,11]]
,{n,77,98}]//TableForm

Now, it seems to be correct:

Table[NoMST[n,Floor[(4n+2)/11],Floor[(10n)/11]],{n,20}]-MMSTbf

However, we want to prove that it is correct. For this purpose, we look at the function value when changing s by i steps and t by j steps. We demonstrate the reasoning in detail for the case n=11k+5. Later we show all cases in a less detailed way.

(* Number of MSTs when we move away from the (conjectured) optimal (s,t) by (i,j). For n=11k+5.*)
Factor[FullSimplify[NoMST[n,Floor[(4n+2)/11]+i,Floor[(10n)/11]+j]/.n->11k+5,Element[k,Integers]]]

(* The optimal choice of s and t in terms of k. *)
FullSimplify[{Floor[(4n+2)/11],Floor[(10n)/11]}/.n->11k+5,Element[k,Integers]]

(* Same as above, but obtained by first simplifying (s,t). *)
Factor[NoMST[11k+5,4k+2+i,10k+4+j]]

We want to show that the following expression is nonnegative for all integers i, j.

diff=Expand[2*(%-(%/.{i->0,j->0}))]

TableForm[Table[diff,{i,-2,2},{j,-2,2}]]

Show[ContourPlot[diff==0,{i,-2.2,2.5},{j,-2.2,2.5},ContourStyle->Directive[Black,Thickness[0.01]],Frame->True,LabelStyle->16],
Graphics[Table[{Disk[{i,j},0.1],Text[Style[diff,16],{i,j}+1/4]},{i,-2,2},{j,-2,2}]]]

For small values of i and j this can be done explicitly, for (i,j) outside of this square, we use symbolic methods. Note that FullSimplify is not able to determine the truth of this formula, but CAD can.

FullSimplify[diff≥0,i≤-2||i≥2||j≤-2||j≥2]

CylindricalDecomposition[Implies[i≤-2||i≥2||j≤-2||j≥2,diff≥0],{i,j}]

CylindricalDecomposition[(-2≤i≤2&&-2≤j≤2)||diff≥0,{i,j}]

(* Do the abobe reasoning for all cases n=11k+ell, 0≤ell≤10. *)
Table[
diff=FullSimplify[NoMST[n,Floor[(4n+2)/11]+i,Floor[(10n)/11]+j]/.n->11k+ell,Element[k,Integers]];
diff=Expand[2*(diff-(diff/.{i->0,j->0}))];
CylindricalDecomposition[(-2≤i≤2&&-2≤j≤2)||diff≥0,{i,j}]&&Min[Table[diff,{i,-2,2},{j,-2,2}]]≥0
,{ell,0,10}]

Now we use our findings on the optimal colorings to derive a closed form formula for the minimal number of monochromatic Schur triples on [n] under any 2-coloring.

Table[Expand[FullSimplify[NoMST[n,Floor[(4n+2)/11],Floor[(10n)/11]]/.n->11k+i,Element[k,Integers]]/.k->(n-i)/11],{i,0,10}]

Expand[%-(n^2-4n)/11]

(* Hence we get the following formula *)
Floor[(n^2-4n+6)/11]//TraditionalForm

(* Test *) 
Table[Floor[(n^2-4n+6)/11]-Min[Flatten[Table[NoMST[n,Floor[(4n+2)/11]+i,Floor[(10n)/11]+j],{i,-1,1},{j,-1,1}]]],{n,1,100}]

(* Test an alternative version of the formula *)
Table[Ceiling[(n^2-4n-1)/11]-Min[Flatten[Table[NoMST[n,Floor[(4n+2)/11]+i,Floor[(10n)/11]+j],{i,-1,1},{j,-1,1}]]],{n,1,100}]

Section 3: Asymptotic lower bound for generalized Schur triples

Define the area A(s,t,a) as a sum of piecewise functions

SchurConditions[a_,b1_,b2_]:=
Module[{cases,cond},
cases={111,222,313,133,333,113,131};
cond=MapIndexed[Insert[#1,{x,y,x+a*y}[[#2[[2]]]],2]&,IntegerDigits[cases]/.{1->{0,b1},2->{b1,b2},3->{b2,1}},{2}];
cond=Or@@(And@@@Apply[LessEqual,cond,{2}]);
Return[cond];
];
MyRegions[a_,b1_,b2_]:=
Graphics[{
Red,
(*111*)
If[a≥1,Polygon[{{0,0},{b1,0},{0,b1/a}}],Polygon[{{0,0},{b1,0},{b1-a*b1,b1},{0,b1}}]],
(*222*)
Which[
(b2-b1)/a≤b1,{},
(b2-b1)/a≤b2,Polygon[{{b1,b1},{b2-a b1,b1},{b1,(b2-b1)/a}}],
True,Polygon[{{b1,b1},{b1,b2},{b2-a*b2,b2},{b2-a*b1,b1}}]
],
(*313*)
If[(1-b2)/a<b1,Polygon[{{1,0},{b2,0},{b2,(1-b2)/a}}],Polygon[{{1,0},{b2,0},{b2,b1},{1-a*b1,b1}}]],
(*133*)
Which[
(*0*) 1/a≤b2,{},
(*1*) 1/a≤1&&1-a*b2≤b1,
Polygon[{{0,b2},{1-a*b2,b2},{0,1/a}}],
(*2*) 1/a≤1,
Polygon[{{0,b2},{b1,b2},{b1,(1-b1)/a},{0,1/a}}],
(*3*) 1-a≤b1&&1-a*b2≤b1,
If[b2/a≤1,
Polygon[{{0,b2/a},{0,1},{1-a,1},{1-a*b2,b2},{b2-a*b2,b2}}],
Polygon[{{b2-a*b2,b2},{b2-a,1},{1-a,1},{1-a*b2,b2}}]
],
(*4*) 1-a≤b1,
If[b2/a≤1,
Polygon[{{0,b2/a},{0,1},{1-a,1},{b1,(1-b1)/a},{b1,b2},{b2-a*b2,b2}}],
Polygon[{{b2-a,1},{1-a,1},{b1,(1-b1)/a},{b1,b2},{b2-a*b2,b2}}]
],
(*5*) True,
Which[
b2/a≤1&&b2-a*b2≤b1,Polygon[{{0,b2/a},{0,1},{b1,1},{b1,b2},{b2-a*b2,b2}}],
b2/a≤1,Polygon[{{0,b2/a},{0,1},{b1,1},{b1,(b2-b1)/a}}],
b2-a≤b1&&b2-a*b2≤b1,Polygon[{{b2-a,1},{b1,1},{b1,b2},{b2-a*b2,b2}}],
b2-a≤b1,Polygon[{{b2-a,1},{b1,1},{b1,(b2-b1)/a}}],
True,{}
]
],
(*333*)
Which[
(1-b2)/a≤b2,{},
(1-b2)/a≤1,Polygon[{{b2,b2},{1-a*b2,b2},{b2,(1-b2)/a}}],
True,Polygon[{{b2,b2},{1-a*b2,b2},{1-a,1},{b2,1}}]
],
(*113*)
If[(b2-b1)/a≤b1,
If[b2-a*b1≥0,
If[(1-b1)/a≥b1,
Polygon[{{b1,(b2-b1)/a},{b1,b1},{b2-a*b1,b1}}],
Polygon[{{b1,(b2-b1)/a},{b1,(1-b1)/a},{1-a*b1,b1},{b2-a*b1,b1}}]
],
If[(1-b1)/a≥b1,
Polygon[{{b1,(b2-b1)/a},{b1,b1},{0,b1},{0,b2/a}}],
If[1-a*b1≥0,
Polygon[{{b1,(b2-b1)/a},{b1,(1-b1)/a},{1-a*b1,b1},{0,b1},{0,b2/a}}],
Polygon[{{b1,(b2-b1)/a},{b1,(1-b1)/a},{0,1/a},{0,b2/a}}]
]
]
],{}],
(*131*)
Which[
b1/a≤b2,{},
b1/a≤1,Polygon[{{0,b2},{0,b1/a},{b1-a*b2,b2}}],
True,Polygon[{{0,b2},{0,1},{b1-a,1},{b1-a*b2,b2}}]
],
Black,
Line[{{0,0},{1,0},{1,1},{0,1},{0,0}}],
Line[{{b1,0},{b1,1}}],Line[{{b2,0},{b2,1}}],Line[{{0,b1},{1,b1}}],Line[{{0,b2},{1,b2}}],
If[b1/a≤1,Line[{{b1,0},{0,b1/a}}],Line[{{b1,0},{b1-a,1}}]],
If[b2/a≤1,Line[{{b2,0},{0,b2/a}}],Line[{{b2,0},{b2-a,1}}]],
If[1/a≤1,Line[{{1,0},{0,1/a}}],Line[{{1,0},{1-a,1}}]]
}];
MyRegionsDotted[a_,b1_,b2_,n_Integer]:=
Module[{col,trps},
col=Join[Table[0,{Round[b1*n]}],Table[1,{i,Round[b1*n]+1,Round[b2*n]}],Table[0,{i,Round[b2*n]+1,n}]];
trps=Flatten[Table[{x,y,Round[x+a*y]},{x,n-1},{y,(n-x)/a}],1];
trps=Select[trps,Length[Union[#/.Thread[Range[n]->col]]]==1&];
Print["Compare areas: ",{N[Length[trps]/n^2],MyArea[a,b1,b2]}];
Return[Show[MyRegions[a,b1,b2],ListPlot[((Most/@trps)-1/2)/n,PlotStyle->Black]]];
];

Manipulate[
aa=a;b1a=b1;b2a=b2;
gr=MyRegions[a,b1,b2],
{{a,1},0.01,3},{{b1,4/11},0,1},{{b2,10/11},0,1}
]

RegionPlot[SchurConditions[aa,b1a,b2a],{x,0,1},{y,0,1},PlotPoints->50]

(* Transform the MyRegions function into one that computes the red area. *)
Clear[fs,MyArea];
(* Extract those commands that draw the polygons. *)
expr=Take[First[MyRegions[a,b1,b2]],{2,8}]/.{If->if,Which->which};
(* Split each polygon into triangles. *)
expr=expr//.{Polygon[{a_,b_,c_}]->Dr[a,b,c],Polygon[{a_,b_,c_,d__}]->Dr[a,b,c]+Polygon[{a,c,d}]};
(* Replace each triangle by its area. *)
expr=expr/.{Dr[a_,b_,c_]:>1/2*Abs[Factor[Det[{b-a,c-a}]]],{}->0};
(* Introduce a placeholder fs for FullSimplify and wrap it around each part. *)
expr=(fs[#,a>0&&0≤b1≤b2≤1]&/@expr);
(* Move fs into the cases of if and which, collecting the respective assumptions. *)
fs[if[c_,a_,b_],a1_]:=if[c,fs[a,a1&&c],fs[b,a1&&Not[c]]];
fs[which[as__],a1_]:=which@@Table[If[OddQ[i],{as}[[i]],fs[{as}[[i]],a1&&{as}[[i-1]]&&(And@@Table[Not[{as}[[j]]],{j,1,i-3,2}])]],{i,Length[{as}]}];
(* FullSimplify doesn't elminate all Abs values (try, e.g., FullSimplify[Abs[x],x<0]), that's why we also use FunctionExpand. *)
expr=expr/.fs[e_,a_]:>FullSimplify[FunctionExpand[e,Assumptions->a]];
(* Define the function MyArea. *)
SetDelayed@@{MyArea[a_,b1_,b2_],Total[expr]/.{if->If,which->Which}};

(* Test MyArea: compare against the piecewise integration of the characteristic function. *)
Timing[test=Table[With[{f=Piecewise[{{1,SchurConditions[a,b1,b2]}}]},Integrate[f,{x,0,1},{y,0,1}]]-MyArea[a,b1,b2],
{a,1/5,3,1/5},{b1,1/20,19/20,1/20},{b2,b1,19/20,1/20}];]
Union[Flatten[test]]

MyRegionsDotted[aa,b1a,b2a,50]

Convert the definition of A(s,t,a) into a single piecewise function

(* Extract all conditions that appear in the definition of MyArea. *)
pwconds=Flatten[Cases[MyArea[a,b1,b2],HoldPattern[Which[a1__]]:>Take[{a1},{1,-3,2}],Infinity]/.And->List];
pwconds=Join[pwconds,Cases[MyArea[a,b1,b2],If[a1_,__]:>a1,Infinity]];
pwconds=Union[Numerator[Together[#1-#2]]&@@@pwconds];
For[i=1,i≤Length[pwconds],i++,pwconds=DeleteCases[pwconds,-pwconds[[i]]]];Clear[i];
pwconds

(* keep the previous order of the conditions *)
With[{old={1-a b1,1-b1-a b1,1-a b1-b2,-a b1+b2,-b1-a b1+b2,1-a b2,1-b1-a b2,1-b2-a b2}},
pwconds=Join[old,Complement[pwconds,old]];
]

There are 16 case distinctions that are made. In order to define a non-nested piecewise function, look at all 2^16 combinations of these conditions being satisfied or not. Of course, many combinations will be contradictory.

(* Slow version. For 2^14 cases this already took almost 1000s. *)
Timing[
cases=Function[v,And@@MapThread[#1[#2]&,{v,Thread[pwconds≥0]}]]/@Tuples[{Identity,Not},Length[pwconds]];
cases=DeleteCases[FullSimplify[#,a>0&&0<b1<b2<1]&/@cases,False];
Length[cases]
]

(* Here is a faster version: we first eliminate all cases that contain a pair of contradictory conditions. *)
Timing[
cases=Function[v,And@@MapThread[#1[#2]&,{v,Thread[pwconds≥0]}]]/@Tuples[{Identity,Not},Length[pwconds]];
cont=Flatten[{#1&&#2,#1&&Not[#2],Not[#1]&&#2,Not[#1]&&Not[#2]}&@@@Subsets[Thread[pwconds≥0],{2}]];
cont=Select[cont,FullSimplify[#,a>0&&0<b1<b2<1]===False&];
Do[
cases=DeleteCases[cases,And[___,cont[[i,1]],___,cont[[i,2]],___]|And[___,cont[[i,2]],___,cont[[i,1]],___]]
,{i,Length[cont]}];
cases=DeleteCases[FullSimplify[#,a>0&&0<b1<b2<1]&/@cases,False];
Length[cases]
]

(* PieceWise expression for the area function in the form {{cond1, f1}, {cond2, f2}, ...} *)
areaPW={#,Together[MyArea[a,b1,b2]//.cond:(_And|_Less|_LessEqual|_Greater|_GreaterEqual):>
(FullSimplify@@{cond,a>0&&0<b1<b2<1&&#}/.{LessEqual->Less,GreaterEqual->Greater})]}&/@cases;

(* Merge regions whose function expressions agree. *)
areaPW=areaPW//.{a1___,{c1_,e_},a2___,{c2_,e_},a3___}:>{a1,{FullSimplify[c1||c2,a>0&&0<b1<b2<1],e},a2,a3};
Length[areaPW]

(* Some simplifications that FullSimplify doesn't do automatically. *)
areaPW=areaPW//.A_||B_:>Which[FullSimplify[Implies[A,B],a>0&&0<b1<b2<1]===True,B,FullSimplify[Implies[B,A],a>0&&0<b1<b2<1]===True,A,True,or[A,B]]/.or->Or;
(* To be on the safe side, we make all inequalities weak. *)
areaPW=areaPW/.{Less->LessEqual,Greater->GreaterEqual};

areaPWconds=(First/@areaPW)/.{a1_≤a2_->a1-a2≤0,a1_≥a2_->a1-a2≥0}//.
{a1_≥0:>If[(p=Position[pwconds,a1])=!={},C[p[[1,1]]],-a1≤0],a1_≤0:>If[(p=Position[pwconds,a1])=!={},Not[C[p[[1,1]]]],-a1≥0]};
areaPWconds=Function[c,SortBy[c,Cases[#,_Integer,Infinity][[1]]&]]/@areaPWconds

(* Sort the areaPW such that the parts relevant for a>1 come first *)
temp=SortBy[Transpose[Prepend[Transpose[areaPW],areaPWconds]],Max[Cases[First[#],C[a_]:>a,Infinity]]&];
areaPW=Rest/@temp;
areaPWconds=First/@temp;

(* Define a function that visualizes the different regions of definition of A(s,t,a) for fixed a. *)
nm[v_]:=If[v.{-1,1}≥0,v,-v]/Norm[v];
PWRegions[aa_,excl_List,opts:((_Rule|_RuleDelayed)...)]:=
Module[{bb=1/15,conds,mids,lines,sols,cc},
conds=((#[[1]]/.a->aa)&&0<b1<b2<1)&/@areaPW;
mids=Function[c,If[(area=Quiet[NIntegrate[If[c,1,0],{b1,0,1},{b2,0,1}]])>10^(-6),(NIntegrate[If[c,#,0],{b1,0,1},{b2,0,1}]&/@{b1,b2})/area,{0,0}]]/@conds;
lines=Function[c,
sols=(Join@@(Solve[{c/.a->aa,#}==0]&/@{b1+bb,b2-1-bb,b1-b2}));
If[sols==={},{},Select[{b1,b2}/.sols,-bb≤#[[1]]&&#[[2]]≤1+bb&]]
]/@pwconds;
lines=Union/@(lines/.{-bb,-aa bb}->{0,0});
Show[
If[Head[RegionPlot/.{opts}]===Symbol,
RegionPlot@@{conds,{b1,0,1},{b2,0,1},opts,PlotPoints->50,Frame->False,Axes->True,PlotRange->{{-3bb,1},{0,1+2bb}}},
Show[RegionPlot/.{opts},Frame->False,Axes->True,PlotRange->{{-3bb,1},{0,1+2bb}}]],
Graphics[{Thick,MapIndexed[If[MemberQ[excl,#2[[1]]],{},{Gray,Line[#1],Black,
Text[Subscript[C,#2[[1]]],Which[
Length[#1]<2,{2,0},
(cc=Cases[#1,{-bb,_?Positive}])=!={},cc[[1]]+If[#2[[1]]>9,bb/2,bb/2]*nm[#1[[1]]-#1[[2]]],
(cc=Cases[#1,{_,1+bb}])=!={},cc[[1]]+(bb/2)*nm[#1[[1]]-#1[[2]]],
True,{2,0}
]]}]&,lines]}],
Graphics[MapIndexed[If[#1==={0,0},{},Text["("<>ToString[#2[[1]]]<>")",#1]]&,mids]],
AxesLabel->{Style[s,12],Style[t,12]},AxesStyle->Arrowheads[{0,0.04}],PlotRange->{{-0.15,1.15},{0,1.12}}
]
];

PWRegions[14/10,{5,15,16}]

PWRegions[44/100,{4,5,16}]

Full piecewise expression for A(s,t,a) (named areaPW)

(* This is the result of the computations in the previous section. *)
areaPW={{a b1≥1,((1+2 b1+(b1^2)-2 b2-2 b1 b2+(b2^2))/(2 a))},{b2≥a b1&&a b2≥1&&a b1+b2≤1,((2 a b1+2 (b1^2)+2 a (b1^2)-2 b1 b2-4 a b1 b2+(b2^2))/(2 a))},{a b1+b2≤1&&b2≤a b1&&a b2≥1,((2 a b1+2 (b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 b1 b2-2 a b1 b2)/(2 a))},{b1+a b1≥1&&b2≥a b1&&a b2≥1,((2 b1+2 a b1+(b1^2)-2 b2-2 b1 b2-2 a b1 b2+2 (b2^2))/(2 a))},{b1+a b1≥1&&b2≤a b1&&a b2≤1,((1+2 b1+2 a b1+(b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2+(b2^2)+(a^2) (b2^2))/(2 a))},{a b1≤1&&b1+a b1≥1&&b2≤a b1&&a b2≥1,((2 b1+2 a b1+(b1^2)-(a^2) (b1^2)-2 b2-2 b1 b2+(b2^2))/(2 a))},{a b2≥1&&a b1+b2≥1&&b2≥a b1&&b1+a b1≤1,((1+2 (b1^2)+2 a (b1^2)+(a^2) (b1^2)-2 b2-2 b1 b2-2 a b1 b2+2 (b2^2))/(2 a))},{b1+a b1≤1&&a b1+b2≥1&&b2≤a b1&&a b2≤1,((2+2 (b1^2)+2 a (b1^2)-2 b2-2 a b2-2 b1 b2+(b2^2)+(a^2) (b2^2))/(2 a))},{b1+a b1≤1&&a b1+b2≥1&&b2≤a b1&&a b2≥1,((1+2 (b1^2)+2 a (b1^2)-2 b2-2 b1 b2+(b2^2))/(2 a))},{b2≥a b1&&a b2≤1&&a b1+b2≤1&&b1+a b2≥1,((1+2 a b1+2 (b1^2)+2 a (b1^2)-2 a b2-2 b1 b2-4 a b1 b2+(b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≤1&&b2≤a b1&&a b2≤1&&b1+a b2≥1,((1+2 a b1+2 (b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-2 a b1 b2+(a^2) (b2^2))/(2 a))},{b2≤a b1&&b2+a b2≤1,((1+2 b1+2 a b1+(b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-4 a b1 b2+(b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2≤a b1&&b1+a b2≤1&&b2+a b2≥1,((2 b1+2 a b1+(b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 b1 b2-4 a b1 b2)/(2 a))},{b2≥a b1&&a≥1&&b2+a b2≤1,((1+2 b1+2 a b1+(b1^2)+2 a (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2≥a b1&&a≥1&&b1+a b2≤1&&b2+a b2≥1,((2 b1+2 a b1+(b1^2)+2 a (b1^2)-2 b1 b2-6 a b1 b2+(b2^2))/(2 a))},{b1+a b1≥1&&b2≥a b1&&a b2≤1&&a≥1,((1+2 b1+2 a b1+(b1^2)-2 b2-2 a b2-2 b1 b2-2 a b1 b2+2 (b2^2)+(a^2) (b2^2))/(2 a))},{a≥1&&a b1+b2≥1&&a b2≤1&&b2≥a b1&&b1+a b1≤1,((2+2 (b1^2)+2 a (b1^2)+(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-2 a b1 b2+2 (b2^2)+(a^2) (b2^2))/(2 a))},{b1+a b1≥1&&b1≥a,((2 a-(a^2)+2 b1+4 a b1+2 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{b1≥a&&b1+a b1≤1&&b1+a b2≥1,((1+2 a-(a^2)+2 a b1+(b1^2)+4 a (b1^2)-2 b2-4 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2+a b2≤1&&a+b1≥1&&b1≥a,((2 a-(a^2)+2 b1+4 a b1+4 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-8 a b1 b2+2 (b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≤1&&b2+a b2≥1&&a+b1≥1&&b1≥a,((-1+2 a-(a^2)+2 b1+4 a b1+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1≥a&&(b2≥b1+a b1||a b1+b2≥1)&&a+b1≥1&&b1+a b2≤1,((2 a-(a^2)+2 b1+2 a b1+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{b2≤a&&a+b1≤1&&b2+a b2≥1,((4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b1 b2-6 a b1 b2+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{b2+a b2≤1&&a+b1≥1&&b1≤a&&b2≥a,((2 a+2 b1+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-8 a b1 b2+2 (b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≥1&&((b1≥a&&b2≤a+b1&&a+b1≤1)||(b2≤b1+a b1&&a+b1≤1)),((1+4 a b1+(b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{b1≥a&&a+b2≤1&&b2≥a+b1,(1/2) (2-2 a+4 b1+4 (b1^2)-a (b1^2)-4 b2-8 b1 b2+4 (b2^2)+a (b2^2))},{b1≥a&&b2≤a+b1&&a+b2≤1,((2 a-(a^2)+6 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-6 a b2-2 b1 b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≥1&&b1≥a&&b2≥a+b1,((1-(a^2)+2 a b1+4 a (b1^2)-2 b2-6 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{a b1+b2≤1&&b2+a b2≥1&&b1≥a&&b2≥a+b1,(1/2) (-a+4 b1+4 (b1^2)-a (b1^2)-8 b1 b2+2 (b2^2))},{b2+a b2≤1&&b1≥a&&a+b2≥1&&b2≥a+b1,((1-(a^2)+4 a b1+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a+b2≤1&&b2≥a+b1&&b1≤a b2,(1/2) (2-a+2 b1+4 (b1^2)-a (b1^2)-4 b2-6 b1 b2+4 (b2^2))},{b1+a b1≥1&&b2≥a&&b1≤a b2,((2 a+2 b1+2 a b1+2 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-2 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{b1+a b1≥1&&b2≤a&&b1≥a b2,((2 a-(a^2)+2 b1+2 a b1+(b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-4 a b1 b2+(b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≥1&&b2≥a+b1&&b1≤a b2,((1+4 a (b1^2)-2 b2-4 a b1 b2+(b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{b2+a b2≥1&&b1≤a&&((b1≥a b2&&b2≤a+b1&&a+b1≤1&&a b1+b2≤1)||(b2≤b1+a b1&&a+b1≤1)),(((a^2)+4 a b1+2 (b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1≤a b2&&b2≥a&&b1+a b1≤1&&b1+a b2≥1,((1+2 a+(b1^2)+4 a (b1^2)-2 b2-4 a b2-2 b1 b2-2 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{b1+a b1≤1&&b1+a b2≥1&&b2≤a&&b1≥a b2,((1+2 a-(a^2)+2 (b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-4 a b1 b2+(b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≤1&&b2+a b2≥1&&b2≥a+b1&&b1≤a b2,(1/2) (2 b1+4 (b1^2)-a (b1^2)-6 b1 b2+2 (b2^2)-a (b2^2))},{a b1+b2≤1&&b2+a b2≥1&&b2≤a&&b1≥a b2,((-1+2 a-(a^2)+2 b1+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b1 b2-8 a b1 b2+2 a (b2^2))/(2 a))},{a+b1≥1&&b1≥a b2&&a b1+b2≤1&&((b2+a b2≥1&&b2≥a&&b1≤a)||b2≥b1+a b1),((-1+2 a+2 b1+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1≤a b2&&b2≥a&&(b2≤b1+a b1||a+b1≥1)&&a b1+b2≤1,((-1+2 a+2 b1+2 a b1+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-6 a b1 b2+(b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{(b1≤a b2||b2≥b1+a b1)&&a≤1&&a+b1≥1&&b2+a b2≤1,((2 a-(a^2)+2 b1+2 a b1+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+(b2^2)+4 a (b2^2))/(2 a))},{b2+a b2≤1&&a+b1≥1&&b2≤a&&b1≥a b2,((2 a-(a^2)+2 b1+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2+a b2≤1&&a+b2≥1&&b2≥a+b1&&b1≤a b2,((1+2 a b1+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-6 a b1 b2+(b2^2)+4 a (b2^2))/(2 a))},{a+b2≤1&&b2≥a&&b2≤a+b1&&b1≤a b2,((2 a+4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-6 a b2-2 b1 b2-6 a b1 b2+(b2^2)+4 a (b2^2))/(2 a))},{b1+a b1≥1&&a≤1&&b2≤a&&b1≤a b2,((2 a-(a^2)+2 b1+2 a b1+2 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-2 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1+a b1≥1&&b1≤a&&b2≥a&&b1≥a b2,((2 a+2 b1+2 a b1+(b1^2)+2 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≥1&&b1+a b2≤1&&b2≤a&&b1≥a b2,((2 a-(a^2)+2 b1+(b1^2)+4 a (b1^2)-2 b2-2 b1 b2-6 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{(b1≤a b2||b2≥b1+a b1)&&b2≤a&&a b1+b2≥1&&b1+a b2≤1,((2 a-(a^2)+2 b1+4 a (b1^2)-2 b2-2 b1 b2-4 a b1 b2+(b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{b1≤a b2&&b2≤a+b1&&a+b1≤1&&a b1+b2≥1,((1+(a^2)+2 a b1+(b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{a b1+b2≥1&&b1≤a&&b2≥a+b1&&b1≥a b2,((1+(b1^2)+4 a (b1^2)-2 b2-6 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1+a b2≥1&&b2≤a&&a≤1&&((b1≤a b2&&b1+a b1≤1)||b2≥b1+a b1),((1+2 a-(a^2)+(b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-2 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{b1+a b2≥1&&b1≥a b2&&b1≤a&&((b2≥a&&b1+a b1≤1)||b2≥b1+a b1),((1+2 a+2 (b1^2)+4 a (b1^2)-2 b2-4 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)+(a^2) (b2^2))/(2 a))},{b1≤a&&a+b2≤1&&b2≥a+b1&&b1≥a b2,((2 a-(a^2)+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-4 a b2-8 a b1 b2+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{b1≥a b2&&b2≤a&&(b2≥b1+a b1||a+b1≤1)&&a+b2≥1,((1+4 a b1+2 (b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a b1+b2≤1&&b2+a b2≥1&&b1≤a&&b2≥a+b1&&b1≥a b2,((2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-8 a b1 b2+2 a (b2^2))/(2 a))},{b2+a b2≤1&&b1≤a&&a+b2≥1&&b2≥a+b1&&b1≥a b2,((1+2 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{b1≤a&&b1≥a b2&&b2≤a+b1&&a+b1≤1&&a b1+b2≥1,((1+(a^2)+2 a b1+2 (b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{b1≤a b2&&b2≥a&&(b2≤b1+a b1||a+b1≥1)&&a b1+b2≥1&&b1+a b2≤1,((2 a+2 b1+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-4 a b1 b2+2 (b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{b1≤a b2&&b2≥a&&b2≤a+b1&&a+b1≤1&&a b1+b2≤1&&b2+a b2≥1,(((a^2)+4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-6 a b1 b2+(b2^2)+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{(b1≤a b2||b2≥b1+a b1)&&b2≤a&&(b2≤b1+a b1||a+b1≥1)&&a≤1&&a b1+b2≤1&&b2+a b2≥1,((-1+2 a-(a^2)+2 b1+2 a b1+4 a (b1^2)-(a^2) (b1^2)-2 b1 b2-6 a b1 b2+2 a (b2^2)-(a^2) (b2^2))/(2 a))},{b1≤a&&b1≥a b2&&(b2≥a||b2≥b1+a b1)&&(b2≤b1+a b1||a+b1≥1)&&a b1+b2≥1&&b1+a b2≤1,((2 a+2 b1+(b1^2)+4 a (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+2 a (b2^2))/(2 a))},{a+b2≥1&&((b1≤a b2&&a+b1≤1&&((b2≤a&&b2+a b2≤1)||b2≤b1+a b1))||(b2≥b1+a b2&&b2≤a&&b2+a b2≤1)),((1+4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-2 a b2-2 b1 b2-6 a b1 b2+(b2^2)+4 a (b2^2))/(2 a))},{b1≤a b2&&(b2≤a||b2≤b1+a b2)&&a+b2≤1,((2 a-(a^2)+4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-4 a b2-2 b1 b2-6 a b1 b2+4 a (b2^2))/(2 a))},{b1≥a b2&&b2≤a&&(b2≥b1+a b2||a+b2≤1),((2 a-(a^2)+4 a b1+2 (b1^2)+4 a (b1^2)-(a^2) (b1^2)-4 a b2-2 b1 b2-8 a b1 b2+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2+a b2≥1&&b1≥a&&a b1+b2≤1&&((b2≤a+b1&&b2≥b1+a b1)||(b2≤b1+a b1&&a+b1≤1)||(b2≥b1+a b1&&b2≤b1+a b2)),((6 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 a b2-2 b1 b2-8 a b1 b2+(b2^2)+2 a (b2^2))/(2 a))},{a+b2≥1&&b1≥a&&b2+a b2≤1&&((b2≥b1+a b2&&b2≤a+b1)||(b2≤b1+a b1&&a+b1≤1)||(b2≥b1+a b1&&b2≤b1+a b2)),((1+6 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-8 a b1 b2+2 (b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{a+b2≥1&&b1≤a&&b2+a b2≤1&&((b1≥a b2&&((b2≥a&&b2≥b1+a b1&&b2≤b1+a b2)||(b2≥b1+a b2&&b2≤a+b1)))||(b2≥a&&b2≤b1+a b1&&a+b1≤1)),((1+(a^2)+4 a b1+2 (b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-8 a b1 b2+2 (b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))},{b2≥a&&b1≤a b2&&b2+a b2≤1&&((a+b2≥1&&b2≤a+b1)||b2≤b1+a b2),((1+(a^2)+4 a b1+(b1^2)+4 a (b1^2)-(a^2) (b1^2)-2 b2-4 a b2-2 b1 b2-6 a b1 b2+2 (b2^2)+4 a (b2^2))/(2 a))},{b2≥a&&b1≤a&&a+b2≤1&&((b1≥a b2&&b2≤a+b1)||b2≤b1+a b2),((2 a+4 a b1+2 (b1^2)+4 a (b1^2)-(a^2) (b1^2)-6 a b2-2 b1 b2-8 a b1 b2+(b2^2)+4 a (b2^2)+(a^2) (b2^2))/(2 a))}};

Determine the minimum of A(s,t,a)

(* Plot the function A(s,t,a) for certain a. *)
pw=Piecewise[Reverse/@areaPW]/.a->0.4;
Plot3D[pw,{b1,0,1},{b2,b1,1},PlotRange->All,PlotPoints->50]

(* We find the local minima by looking at points where the gradient is {0,0} *)
(* For each local minimum we also determine for which range of a it actually occurs. *)
minloc=Function[c,
sol=Quiet[Solve[(D[c[[2]],#]&/@{b1,b2})==0,{b1,b2}][[1]]];
cond=(c[[1]]&&a>0&&0<b1<b2<1)/.sol;
cond=If[Length[sol]==2,CylindricalDecomposition[cond,{a}],FullSimplify[cond]];
{cond,Simplify[{b1,b2}/.sol],c[[2]]}
]/@areaPW;
Length[minloc=DeleteCases[minloc,{False,__}|{_Equal,__}]]

(* Visualize the different domains of occurrence of local minima. *)
Graphics[MapIndexed[Rectangle[{#1[[1]],#2[[1]]/20},{#1[[-1]],(#2[[1]]+1)/20}]&,FullSimplify[0≤a≤2.5&&#[[1]]]&/@N[minloc]],Axes->True,PlotRange->{{0,2.5},{0,1}}]

(* We have several (local) minima *)
pw=Piecewise[{{Together[#3/.Thread[{b1,b2}->#2]],#1}},I]&@@@minloc;
Plot[pw,{a,0,3},PlotPoints->250]

Plot[pw,{a,0.35,0.7}]

Plot[Evaluate[pw[[{1,3,4}]]],{a,1.88,1.93},PlotRange->{0.054,0.056}]

(* Determine the split points, i.e. where we have to split the positive real axis *)
(* in order to achieve a common refinement of all the intervals in minloc. *)
(* We also take into account poles and points where two functions intersect. *)
fus=Together[#3/.Thread[{b1,b2}->#2]]&@@@minloc;
sppts=Table[Root[#,a,i],{i,Exponent[#,a]}]&/@Join[Numerator[Together[(#1-#2)&@@@Subsets[fus,{2}]]],Denominator[fus]];
sppts=Join[Flatten[sppts],Cases[First/@minloc,_?NumericQ,{2}]];
sppts=Append[SortBy[Select[Select[Union[sppts],Element[#,Reals]&],#≥0&],N],Infinity];
Length[sppts]

(* For each of the refined intervals, find out which of the local minima is actually the global minimum. *)
minlocfinal={};
Do[
{v1,v2}=sppts[[{i,i+1}]];
defd=DeleteCases[{CylindricalDecomposition[#1&&v1<a<v2,a],#2,Together[#3/.Thread[{b1,b2}->#2]]}&@@@minloc,{False,__}];
test=Table[CylindricalDecomposition[Implies[v1<a<v2,And@@Thread[defd[[j,3]]≤Delete[Last/@defd,j]]],a],{j,Length[defd]}];
If[Count[test,True]=!=1,Print["Problem at case ",i],AppendTo[minlocfinal,ReplacePart[defd[[Position[test,True][[1,1]]]],1->{v1,v2}]]];
,{i,Length[sppts]-1}];

(* Merge neighboring intervals which have the same definition of the minimum. *)
minlocfinal=minlocfinal//.{a1___,{{v1_,v2_},p_,f_},{{v2_,v3_},p_,f_},a2___}:>{a1,{{v1,v3},p,f},a2};
minlocfinal={#1[[1]]≤a≤#1[[2]],#2,#3}&@@@minlocfinal;
Length[minlocfinal]

(* This is what we obtain: minlocfinal is a piecewise function with 10 cases. *)
(* Each case is stored in the form {cond, {s0,t0}, m}, where {s0,t0} is the location *)
(* of the minimum, and m is the value of the minimum. *)
minlocfinal={{0≤a≤Root[-1+3 #1+((#1)^2)+((#1)^3)&,1],{(((-4+a) a)/(-4-a+(a^3))),((2+4 a-2 (a^2))/(4+a-(a^3)))},((-4+6 a-2 (a^2)+2 (a^3)-(a^4))/(2 (-4-a+(a^3))))},{Root[-1+3 #1+((#1)^2)+((#1)^3)&,1]≤a≤Root[1+#1-9 ((#1)^2)+((#1)^5)&,2],{((a (-3+(a^2)))/(-1-8 a+(a^4))),((-1-5 a+(a^2)+(a^3))/(-1-8 a+(a^4)))},((-2+a-2 (a^2)+(a^3))/(2 (-1-8 a+(a^4))))},{Root[1+#1-9 ((#1)^2)+((#1)^5)&,2]≤a≤Root[1-6 ((#1)^2)-((#1)^3)+2 ((#1)^4)&,3],{((1+2 a-2 (a^3))/(3+8 a-(a^4))),((-2-6 a+(a^2)+2 (a^3))/(-3-8 a+(a^4)))},((-1+4 (a^2)-12 (a^3)+(a^4)+(a^6))/(2 a (-3-8 a+(a^4))))},{Root[1-6 ((#1)^2)-((#1)^3)+2 ((#1)^4)&,3]≤a≤Root[6+5 #1-24 ((#1)^2)-15 ((#1)^3)+12 ((#1)^4)&,3],{((1+a-2 (a^2))/(1+6 a+5 (a^2)-4 (a^3))),((1+4 a+(a^2)-2 (a^3))/(1+6 a+5 (a^2)-4 (a^3)))},((-2+a+2 (a^2)-9 (a^3)+4 (a^4))/(2 (-1-6 a-5 (a^2)+4 (a^3))))},{Root[6+5 #1-24 ((#1)^2)-15 ((#1)^3)+12 ((#1)^4)&,3]≤a≤Root[4-3 #1-8 ((#1)^2)+4 ((#1)^3)&,2],{((1+a+(a^3))/(1+6 a+3 (a^2)-4 (a^3))),((1+4 a+2 (a^2))/(1+6 a+3 (a^2)-4 (a^3)))},((-2+a-4 (a^3)+4 (a^4))/(2 (-1-6 a-3 (a^2)+4 (a^3))))},{Root[4-3 #1-8 ((#1)^2)+4 ((#1)^3)&,2]≤a≤(1/16) (-1+(Sqrt[129])),{-((-1+a+3 (a^2))/(1-4 a-4 (a^2)+4 (a^3))),((1-2 a-4 (a^2))/(1-4 a-4 (a^2)+4 (a^3)))},((2-5 a-4 (a^2)+8 (a^3))/(2 (1-4 a-4 (a^2)+4 (a^3))))},{(1/16) (-1+(Sqrt[129]))≤a≤Root[-1-5 #1+7 ((#1)^3)&,3],{((1+2 a)/(1+7 a)),((1+6 a+8 (a^2))/(1+8 a+7 (a^2)))},((2+3 a-2 (a^2))/(2 (1+a) (1+7 a)))},{Root[-1-5 #1+7 ((#1)^3)&,3]≤a≤1,{((((1+a))^2)/(a (4+7 a))),(((1+a) (1+4 a))/(a (4+7 a)))},((-1-2 a+6 (a^2)+6 (a^3)-7 (a^4))/(2 (a^2) (4+7 a)))},{1≤a≤Root[-3+((#1)^2)+((#1)^3)&,1],{((((1+a))^2)/(3+2 a+3 (a^2)+2 (a^3)+(a^4))),(((1+a) (2+2 a+(a^2)))/(3+2 a+3 (a^2)+2 (a^3)+(a^4)))},((4-2 a-(a^2)+(a^4))/(2 a (3+2 a+3 (a^2)+2 (a^3)+(a^4))))},{Root[-3+((#1)^2)+((#1)^3)&,1]≤a≤∞,{((1+a)/(3+2 a+(a^2))),((2+2 a+(a^2))/(3+2 a+(a^2)))},(1/(2 a (3+2 a+(a^2))))}};

TableForm[N[First/@minlocfinal]]

pw=Piecewise[{{#3,#1}},I]&@@@minlocfinal;
Plot[pw,{a,0,3},PlotPoints->250]

pw=Piecewise[{{#3,#1}},I]&@@@Reverse[minlocfinal];
pwa=Piecewise[{{Together[#3/.Thread[{b1,b2}->#2]],#1}},I]&@@@minloc;
pwa=SortBy[pwa,Append[Position[pw,#[[1,1,1]]],{100}][[1,1]]&];
Show[
Plot[pw,{a,0,3},PlotPoints->250,PlotStyle->Thickness[0.003],Filling->Bottom],
Plot[pwa,{a,0,3},PlotPoints->250,PlotStyle->Thickness[0.003]],
AxesLabel->{a},AxesStyle->Arrowheads[{0,0.02}],PlotRange->{{0,3.1},{0,0.51}}
]

(* We look at all lines defined by pwconds and look for local minima (derivative = 0) on them (in the triangle 0≤b1<b2≤1). *)
(* We need not consider the line b1-b2, since the choice b1=b2 (all numbers colored red!) certainly does not give a minimum. *)
minloc1=Function[c,
v1=Last[Sort[Variables[c]]];
v2=Complement[{b1,b2},{v1}][[1]];
If[(sol=Solve[D[#[[2]],v2]==0,v2])=!={},#/.First[sol],{False,0}]&/@
DeleteCases[{FullSimplify[#1],Together[#2]}&@@@(({#1&&a>0&&0≤b1<b2≤1,#2}&@@@areaPW)/.First[Solve[c==0,v1]]),{False,_}]
]/@Join[DeleteCases[pwconds,1-a],{b1,b2-1}];
minloc1=DeleteCases[{CylindricalDecomposition[#1,a],Together[#2]}&@@@(Join@@minloc1),{False,_}];
Length[minloc1]
minloc1=Union[minloc1]//.{a1___,{c1_,b_},a2___,{c2_,b_},a3___}->{a1,{c1||c2,b},a2,a3};
Length[minloc1]

(* This shows that the function defined by minlocfinal is indeed smaller than all minima on the lines *)
Union[Flatten[Function[f,CylindricalDecomposition[Implies[f[[1]]&&#[[1]],f[[3]]≤#[[2]]],a]&/@minloc1]/@minlocfinal]]

(* This plot confirms the above computation *)
pw=Piecewise[{{#3,#1}},I]&@@@minlocfinal;
pw1=Piecewise[{Reverse[#]},I]&/@DeleteCases[minloc1,{a==_,_}];
Show[
Plot[pw1,{a,0,3},PlotStyle->Directive[Green,Thickness[0.001]],PlotRange->All],
Plot[pw,{a,0,3},PlotStyle->Directive[Red,Thickness[0.002]],PlotPoints->250],
AxesLabel->{a},AxesStyle->Arrowheads[{0,0.02}],PlotRange->{{0,3.1},{0,1.03}}
]

(* We look at all schnittpoints of the lines defined by pwconds, as they are potential locations of minima. *)
lines=Join[DeleteCases[pwconds,1-a],{b1,b2-1}];
spoints=If[(sol=Solve[#==0,{b1,b2}])=!={},{b1,b2}/.First[sol],{}]&/@Select[Subsets[lines,{2}],Sort[Variables[#]]==={a,b1,b2}&];
spoints=DeleteCases[Union[Together[spoints]],{}|{0,0}]; (* the point (0,0) can be excluded *)
spoints=DeleteCases[{FullSimplify[a>0&&0≤#1<#2≤1],{#1,#2}}&@@@spoints,{False,_}];
minloc2=Join@@(Function[sp,DeleteCases[{CylindricalDecomposition[sp[[1]]&&#1,a],Together[#2]}&@@@(areaPW/.Thread[{b1,b2}->sp[[2]]]),{False,_}]]/@spoints);
minloc2=Union[minloc2]//.{a1___,{c1_,b_},a2___,{c2_,b_},a3___}->{a1,{c1||c2,b},a2,a3};
Length[minloc2]

(* This shows that the function defined by minlocfinal is indeed smaller than all values on the spoints *)
Union[Flatten[test=Function[f,CylindricalDecomposition[Implies[f[[1]]&&#[[1]],f[[3]]≤#[[2]]],a]&/@minloc2]/@minlocfinal]]

(* This plot confirms the above computation *)
pw=Piecewise[{{#3,#1}},I]&@@@minlocfinal;
pw2=Piecewise[{Reverse[#]},I]&/@DeleteCases[minloc2,{a==_,_}];
Show[
Plot[pw2,{a,0,3},PlotStyle->Directive[Blue,Thickness[0.001]]],
Plot[pw,{a,0,3},PlotStyle->Directive[Red,Thickness[0.002]],PlotPoints->250],
AxesLabel->{a},AxesStyle->Arrowheads[{0,0.02}],PlotRange->{{0,3.1},{0,1.03}}
]

(* This illustrates the "jump" between a=1 and a=2 *)
jump=Last/@Take[minlocfinal,-2];
Plot[jump,{a,1,3}]

jump/.a->1

(* Animation of the location of the minimum {s0,t0}, depending on the parameter a. *)
(* The lines define the different pieces of definition for A(s,t,a). *)
rot=Thread[{b1,b2}->With[{a=0.1/180*Pi},{{Cos[a],Sin[a]},{-Sin[a],Cos[a]}}].{b1,b2}];
fus=(b2/.Solve[(#/.rot)==0,b2][[1]])&/@DeleteCases[pwconds,1-a];
Manipulate[
ml=Cases[minlocfinal/.a->aa,{True,a1_,_}:>a1][[1]];
fus1=fus/.a->aa;
Show[
Plot[fus1,{b1,-0.1,1.1},PlotRange->{-0.1,1.1},AspectRatio->1],
Graphics[{Red,Disk[ml,0.02]}]]
,{{aa,1},0.001,4}]

(* Visualize the locations of monochromatic triples when {s0,t0} are chosen, depending on a. *)
Manipulate[
{bb1,bb2}=Cases[minlocfinal/.a->aa,{True,a1_,_}:>a1][[1]];
gr=Show[MyRegions[aa,bb1,bb2],Axes->True],
{{aa,1},0.001,3}
]

(* Plot s0 and t0, depending on a. *)
pws=Piecewise[{{#2[[1]],#1}},I]&@@@minlocfinal;
pws=Piecewise[{#2[[1]],#1}&@@@minlocfinal,I];
pwt=Piecewise[{#2[[2]],#1}&@@@minlocfinal,I];
Plot[{pws,pwt},{a,0,3},PlotPoints->100]

Section 4: Exact bounds for generalized Schur triples

General formulas used for all cases

(* Construct all MGSTs of [n] with coloring R^s B^(t-s) R^(n-t) by brute-force testing. *)
MSTtest[n_Integer,s_Integer,t_Integer,a_]:=
Module[{col,trs},
col=Thread[Range[n]->Join[Table[0,{s}],Table[1,{t-s}],Table[0,{n-t}]]];
trs=Flatten[Table[{x,y,Floor[x+a*y]},{y,n},{x,n-Floor[a*y]}],1];
trs=Select[trs,Length[Union[#/.col]]==1&]
];
(* Find the minimum number of MSTs among all colorings of the form R^s B^(t-s) R^(n-t). *)
MinMSTtestAll[n_Integer,a_]:=Min[Table[Length[MSTtest[n,s,t,a]],{s,n},{t,s,n}]];
(* Find the minimum number of MSTs among those colorings R^s B^(t-s) R^(n-t) *)
(* which satisfy the conditions under which the below function MST is applicable *)
MinMSTtestRegion[n_Integer,a_/;a≥1]:=
Module[{pts},
pts=Select[Tuples[Range[n],2],a #[[1]]+#[[2]]≥n && #[[2]]≥a #[[1]] && #[[1]]*(1+a)≤#[[2]]&];
If[pts==={},pts=Select[Tuples[Range[n],2],#[[1]]≤#[[2]]&]];
Return[Min[Length[MSTtest[n,#1,#2,a]]&@@@pts]];
];
(* Construct all MGSTs of [n] with coloring R^s B^(t-s) R^(n-t) by explicit enumeration, *)
(* under the assumption that we are close to (i.e., in the region of) the optimal (s,t). *)
(* For a ≤ Root[x^3+x^2-3,1] = 1.17 we are in the case areaPW[[17]]: as+t≥1 && t≥as && s+as≤1 && at≤1 *)
(* For a ≥ Root[x^3+x^2-3,1] = 1.17 we are in the case areaPW[[7]]:  as+t≥1 && t≥as && s+as≤1 && at≥1 *)
(* Actually, the generation of the triples below is only valid if we additionally assume s+as≤t. *)
(* The reason is that areaPW[[17]] and areaPW[[7]] were each obtained as the union of two areas. *)
MST[n_,s_,t_,a_/;a≥1]:=Join[
(*111*) Flatten[Table[{x,y,x+Floor[a*y]},{y,Floor[s/a]},{x,s-Floor[a*y]}],1],
(*222*) Flatten[Table[{x,y,x+Floor[a*y]},{y,s+1,Floor[(t-s)/a]},{x,s+1,t-Floor[a*y]}],1],
(*313*) Flatten[Table[{x,y,x+Floor[a*y]},{y,Floor[(n-t)/a]},{x,t+1,n-Floor[a*y]}],1],
(*133*) If[a*t≤n,Flatten[Table[{x,y,x+Floor[a*y]},{y,t+1,Floor[n/a]},{x,n-Floor[a*y]}],1],{}]
];
(* Simplification procedure for Floors and Ceilings. This is more efficient than FullSimplify. *)
(* Variables i,j,k are assumed to be integers. *)
MyFCSubs={
Mod[a1_*k+a2_.,a3_]/;Mod[a1,a3]==0:>Mod[a2,a3],
(f:Floor|Ceiling)[a1_.*(v:(k|i|j))+a2_.]/;IntegerQ[a1]:>a1*v+f[a2],
(f:Floor|Ceiling)[a1_?NumericQ+a2_.]/;a1<0||a1≥1:>a1-Mod[a1,1]+f[Mod[a1,1]+a2]};
MyFCSimplify[expr_]:=FixedPoint[ExpandAll[#/.MyFCSubs]&,expr];

(* Test: compare MSTtest and MST for different choices of n and a; for each we test all (s,t) in the (part of the) respective region. *)
Table[
pts=Select[Tuples[Range[n],2],a #[[1]]+#[[2]]≥n && #[[2]]≥a #[[1]] && #[[1]]*(1+a)≤#[[2]]&];
And@@(Sort[MSTtest[n,#1,#2,a]]===Sort[MST[n,#1,#2,a]]&@@@pts),
{n,20,50,7},{a,1,3,0.1}]

(* Direct translation of the above MST function into one that computes only the number of MGSTs. *)
NoMST[n_,s_,t_,a_]:=
(*111*) Sum[1,{y,Floor[s/a]},{x,s-Floor[a*y]}]+
(*222*) Sum[1,{y,s+1,Floor[(t-s)/a]},{x,s+1,t-Floor[a*y]}]+
(*313*) Sum[1,{y,Floor[(n-t)/a]},{x,t+1,n-Floor[a*y]}]+
(*133*) Sum[1,{y,t+1,Floor[n/a]},{x,n-Floor[a*y]}]; 
(* The If in case 133 is not needed, since the Sum also gives zero if we are in the else-branch. *)
(* Be careful when evaluating this function with symbolic parameters. *)

(* Test *)
Table[
pts=Select[Tuples[Range[n],2],a #[[1]]+#[[2]]≥n && #[[2]]≥a #[[1]] && #[[1]]*(1+a)≤#[[2]]&];
And@@(Length[MST[n,#1,#2,a]]===NoMST[n,#1,#2,a]&@@@pts),
{n,20,50,7},{a,1,3,0.1}]

(* For a=1, we get back the formula derived in the previous section. *)
Expand[FullSimplify[NoMST[n,s,t,1],t≤n&&Element[{n,s,t},Integers]]-NoMST[n,s,t]]

a=2

(* We define a special case for a=2. *)
NoMST[n_,s_,t_,2]:=
(*111*) Sum[1,{y,Floor[s/2]},{x,s-2y}]+
(*222*)Sum[1,{y,s+1,Floor[(t-s)/2]},{x,s+1,t-2y}]+
(*313*) Sum[1,{y,Floor[(n-t)/2]},{x,t+1,n-2y}];

(* Test *)
Table[
pts=Select[Tuples[Range[n],2],2*#[[1]]+#[[2]]≥n && #[[2]]≥2*#[[1]] && #[[1]]*3≤#[[2]]&];
And@@(Length[MST[n,#1,#2,2]]===NoMST[n,#1,#2,2]&@@@pts),
{n,20,50}]

(* What does the formula look like? *)
NoMST[n,s,t,2]

(* Simplify the above formula by hand *)
Floor[(n-t)/2]*Floor[(n-t-1)/2]+Floor[s/2]*Floor[(s-1)/2]+Floor[(t-s)/2]*Floor[(t-s-1)/2]+2s^2-s t+s

(* Test *)
test=%-NoMST[n,s,t,2];
Union[Flatten[Table[test,{n,20},{s,n},{t,s,n}]]]

Cases[minlocfinal/.a->2,{True,__}]

(* We study NoMST[n, Floor[(3n+m1)/11]+i, Floor[(10n+m2)/11]+j, 2]. *)
(* We would like a formula that produces the minimum at i=j=0. *) 
(* There is no choice for m1, m2 such that the minimum appears in all 22 cases at {0,0}. *)
(* However, choosing m1=1 and m2=0 reduces our problem such that only one case does not contain {0,0}, notably at n=10. *)
(* That's why we have to introduce a modification at n=10 mod 22 when m1=1 and m2=0. *)
TableForm[Table[
vals=Table[NoMST[n,Floor[(3n+1)/11]+i,Floor[(10n)/11]+j-If[Mod[n,22]==10,1,0],2],{i,-1,1},{j,-1,1}];
p[Position[vals,Min[Flatten[vals]]]-2]
,{n,220,241}]]

(* Now that we have a conjectured formula, we need to prove that it gives the global minimum. *)
(* We perform direct computations locally in an interval around {0,0}. *)
(* Then we employ CAD globally to confirm that our polynomials are always non-negative for all 22 cases. *)
Table[
diff=Flatten[Table[
MyFCSimplify[NoMST[n,Floor[(3n+1)/11]+2i+ii,Floor[(10n)/11]+2j+jj-If[Mod[n,22]==10,1,0],2]/.n->22k+ell],
{ii,0,1},{jj,0,1}]];
diff=diff-(diff[[1]]/.{i->0,j->0});
test=CylindricalDecomposition[(-2≤i≤2&&-2≤j≤2)||#≥0,{i,j}]&/@diff;
(And@@test)&&Min[Table[diff,{i,-2,2},{j,-2,2}]]==0
,{ell,0,21}]

(* Now that we know our formula is correct, we perform simplifications to derive an exact formula. *)
(* First we identify the formulas all 22 cases by substituting n=22k+ell, 0≤ell≤21. *)
(* The higher order terms should be the same. We then have to examine the constants to see if any further modifications need to be made. *)
Table[Expand[MyFCSimplify[NoMST[n,Floor[(3n+1)/11],Floor[(10n)/11]-If[Mod[n,22]==10,1,0],2]/.n->22k+ell]/.k->(n-ell)/22],{ell,0,21}]

(* The constants are nice, in the sense that they are within a range of length one. *)
(* Thus, no further modifications will need to be made. *)
%-(n^2/44-5n/22)

Max[%]

Table[Floor[(n^2-10n+33)/44],{n,80}]

(* For n≥25 we can be sure that the choice s=Floor[(3n+1)/11], t=... *)
(* lie in the admissible region, in which the formula given by NoMST is valid. *)
(* For n<25, the correctness of our formula follows from the explicit computations below. *)
Table[CylindricalDecomposition[(2*b1+b2≥n && b2≥2*b1 && b1*3≤b2)/.{b1->(3n+1)/11+i,b2->10n/11+j},n],{i,-1,0},{j,-2,0}]

(* For each n≤80 determine the minimum number of MSTs for s and t satisfying certain constraints. *)
(* takes about 3 min *)
Table[MinMSTtestRegion[n,2],{n,80}]

(* For each n≤50 determine the minimum number of MSTs for all possible choices of s and t. *)
(* takes about 1 min *)
Table[MinMSTtestAll[n,2],{n,50}]

a=3

(* We define a special case for a=3. *)
NoMST[n_,s_,t_,3]:=
(*111*) Sum[1,{y,Floor[s/3]},{x,s-3y}]+
(*222*)Sum[1,{y,s+1,Floor[(t-s)/3]},{x,s+1,t-3y}]+
(*313*) Sum[1,{y,Floor[(n-t)/3]},{x,t+1,n-3y}];

(* Test *)
Table[
pts=Select[Tuples[Range[n],2],3*#[[1]]+#[[2]]≥n && #[[2]]≥3*#[[1]] && #[[1]]*4≤#[[2]]&];
And@@(Length[MST[n,#1,#2,3]]===NoMST[n,#1,#2,3]&@@@pts),
{n,20,50}]

NoMST[n,s,t,3]

Cases[minlocfinal/.a->3,{True,__}]

(* We study NoMST[n, Floor[(4n+m1)/18]+i, Floor[(17n+m2)/18]+j, 3]. *)
(* We would like a formula that produces the minimum at i=j=0. *) 
(* There is no choice for m1, m2 such that the minimum appears in all 54 cases at {0,0}. *)
(* But choosing m1=0 and m2=0 seems reasonably manageable. *)
(* So for m1=m2=0, we analyze the exceptional cases and introduce modifications. *)
(* To do this efficiently, we first identify the cases for which {0,0} doesn't appear. *)
Table[
vals=Table[NoMST[n,Floor[(4n)/18]+i,Floor[(17n)/18]+j,3],{i,-3,3},{j,-3,3}];
p[n-6 54,Position[vals,Min[Flatten[vals]]]-4]
,{n,6 54,7 54-1}];
a3listnozero=Cases[%,p[_,a_/;Not[MemberQ[a,{0,0}]]]];
a3listnozero//TableForm

(* Here is an example of using modular arithmetic to reduce the number cases. *)
(* We use this example on {0,-1}, which shows up most often (8 times) in the cases above. *)
caselist=First/@Cases[a3listnozero,p[_,a_/;MemberQ[a,{0,-1}]]]
caselistmod=DeleteCases[Table[If[Mod[54,i]==0,Prepend[Mod[caselist,i],i],{}],{i,54}],{}];
caselistmod//TableForm
(* For each divisor of 54, we identify an ideal modulus that we can use to reduce the number of cases in a significant way. *)
Table[Length[DeleteDuplicates[Take[caselistmod[[i]],-(Length[caselist]-1)]]],{i,Length[caselistmod]}]

(* Mod 9 looks perfect, reducing the 8 cases to 4. *)
(* We shift our "j" by -1 at these locations. *)
DeleteDuplicates[Take[caselistmod[[5]],-(Length[caselist]-1)]]//Sort

(* We keep applying the above the technique until we are able to see {0,0} in every case. *)
(* Then, we take the previous formula and make the appropriate modifications. *)
Table[
vals=Table[NoMST[n,Floor[(4n)/18]-If[Mod[n,54]==18,1,0]+i,Floor[(17n)/18]-If[Mod[n,54]==18,2,0]-If[MemberQ[{3,4,7,8},Mod[n,9]],1,0]+j,3],{i,-3,3},{j,-3,3}];
p[n-6 54,Position[vals,Min[Flatten[vals]]]-4]
,{n,6 54,7 54-1}];
(* We check to see which cases does not contain {0,0} and we find the empty set, as desired. *)
Cases[%,p[_,a_/;Not[MemberQ[a,{0,0}]]]]

(* Now that we have a conjectured formula, we need to prove that it gives the global minimum. *)
(* We perform direct computations locally in an interval around {0,0}. *)
(* Then we employ CAD globally to confirm that our polynomials are always non-negative for all 54 cases. *)
Table[
diff=Flatten[Table[
MyFCSimplify[NoMST[n,Floor[(4n)/18]-If[Mod[n,54]==18,1,0]+3i+ii,Floor[(17n)/18]-If[Mod[n,54]==18,2,0]-If[Mod[n,9]==3||Mod[n,9]==4||Mod[n,9]==7||Mod[n,9]==8,1,0]+3j+jj,3]/.n->54k+ell],
{ii,0,2},{jj,0,2}]];
diff=diff-(diff[[1]]/.{i->0,j->0});
test=CylindricalDecomposition[(-2≤i≤2&&-2≤j≤2)||#≥0,{i,j}]&/@diff;
(And@@test)&&Min[Table[diff,{i,-2,2},{j,-2,2}]]==0
,{ell,0,53}]

(* Now that we know our formula is correct, we perform simplifcations to derive an exact formula. *)
(* First we identify the formulas all 54 cases by substituting n=54k+ell for 0≤ell≤53. *)
(* The higher order terms should be the same. We then have to examine the constants to see if any further modifications need to be made. *)
Table[Expand[MyFCSimplify[NoMST[n,Floor[(4n)/18]-If[Mod[n,54]==18,1,0],Floor[(17n)/18]-If[Mod[n,54]==18,2,0]-If[Mod[n,9]==3||Mod[n,9]==4||Mod[n,9]==7||Mod[n,9]==8,1,0],3]/.n->54k+ell]/.k->(n-ell)/54],{ell,0,53}]

%-(n^2/108-n/6)

Sort[%]

(* We can see from the sorted list that there could be (minimally) 3 values that are out of range of 1. *)
(* We identify their positions and then make the modifications to our exact formula accordingly. *)
Position[%%,#]-1&/@{-1/3,1}

(* For n≥54 we can be sure that the above choice of s and t lie *)
(* in the admissible region, in which the formula given by NoMST is valid. *)
(* For n<54, the correctness of our formula follows from the explicit computations below. *)
Table[CylindricalDecomposition[(3*b1+b2≥n && b2≥3*b1 && b1*4≤b2)/.{b1->(4n)/18+i,b2->(17n)/18+j},n],{i,-2,0},{j,-3,0}]

(* The following computations experimentally confirm the correctness of our exact formula. *)

Table[Floor[(n^2-18n+101)/108]+If[Mod[n,54]==36,1,0]-If[Mod[n,54]==30||Mod[n,54]==42,1,0],{n,100}]

(* takes about 5 min *)
Table[MinMSTtestRegion[n,3],{n,100}]

%===%%

(* takes about 3 min *)
Table[MinMSTtestAll[n,3],{n,60}]

a=4

(* We define a special case for a=4. *)
(* WARNING: This was originally a double sum in the other cases.*)
(* But here, we decided to "help" Mathematica by evaluating one of the sums. *)
(* The fact that it had difficulty assessing the symbolic double sum for a more complicated case is a byproduct of the system. *)
(* For example, Mathematica's evaluation of a parametrized sum may only be valid under certain assumptions of the parameters; e.g., Sum[1,{x,a,b}] is simplified to b-a+1, which is only valid if b≥a is assumed. *)
(* THIS IS A VERY SUBTLE POINT. We note that the original double sum did not appear to cause any problems in the a=2,3 cases. *)
NoMST[n_,s_,t_,4]:=
  (*111*) Sum[s-4y,{y,Floor[s/4]}]+
(*222*)Sum[t-4y-s,{y,s+1,Floor[(t-s)/4]}]+
(*313*) Sum[n-4y-t,{y,Floor[(n-t)/4]}];

(* Test *)
Table[
pts=Select[Tuples[Range[n],2],4*#[[1]]+#[[2]]≥n && #[[2]]≥4*#[[1]] && #[[1]]*5≤#[[2]]&];
And@@(Length[MST[n,#1,#2,4]]===NoMST[n,#1,#2,4]&@@@pts),
{n,20,50}]

NoMST[n,s,t,4]

Cases[minlocfinal/.a->4,{True,__}]

(* We study NoMST[n, Floor[(5n+m1)/27]+i, Floor[(26n+m2)/27]+j, 4]. *)
(* We would like a formula that produces the minimum at i=j=0. *) 
(* Since we have 108 cases to consider, we now define a function of (m1,m2), enabling an automation of *)
(* our search for (m1,m2) such that the number of cases that DON'T contain {0,0} is minimized. *)
a4list[m1_,m2_]:=Table[
vals=Table[NoMST[n,Floor[(5n+m1)/27]+i,Floor[(26n+m2)/27]+j,4],{i,-4,4},{j,-4,4}];
p[n-6 108,Position[vals,Min[Flatten[vals]]]-5]
,{n,6 108,7 108-1}];

(* We perform the search in a systematic fashion (using giant steps/baby steps). *)
(* At each stage, we compute the number of cases that don't contain {0,0}. *)
(* We stop searching when we reach a manageable length (in this case, 16). *)
Table[Print[m2];Table[Length[Cases[a4list[m1,m2],p[_,a_/;Not[MemberQ[a,{0,0}]]]]],{m1,-4,-4}],{m2,-35,-30}]

(* These are the optimized (m1,m2) that would give us only 16 conditions to adjust. *)
Flatten[Reverse[#]+{-5,-36}]&/@Position[%,16]

(* Here, we take m1=-4 and m2=-34. *)
(* We look at the places that don't have {0,0} and try to deduce a common pattern in those positions to make adjustments. *)
a4listnozero=Cases[a4list[-4,-34],p[_,a_/;Not[MemberQ[a,{0,0}]]]];
a4listnozero//TableForm
Length[a4listnozero]

(* Trying to find patterns...are we lucky? *)
Cases[a4listnozero,p[_,a_/;MemberQ[a,{1,2}]]]//TableForm
Cases[a4listnozero,p[_,a_/;MemberQ[a,{0,1}]]]//TableForm
Cases[a4listnozero,p[_,a_/;MemberQ[a,{0,-1}]]]//TableForm

(* An example of using modular arithmetic to reduce the number cases containing {0,1}. *)
caselist=First/@Cases[a4listnozero,p[_,a_/;MemberQ[a,{0,1}]]]
caselistmod=DeleteCases[Table[If[Mod[108,i]==0,Prepend[Mod[caselist,i],i],{}],{i,108}],{}];
caselistmod//TableForm
Table[Length[DeleteDuplicates[Take[caselistmod[[i]],-Length[caselist]]]],{i,Length[caselistmod]}]

(* Mod 27 seems best; but note that a reduction from 9 to 7 cases is not an impressive reduction. *)
DeleteDuplicates[Take[caselistmod[[9]],-Length[caselist]]]//Sort

(* For aesthetic purposes, we will use Mod 108 to match the other cases. *)
(* It only adds two more conditions anyway. *)
DeleteDuplicates[Take[caselistmod[[12]],-Length[caselist]]]//Sort

(* We have to be careful when using MemberQ as it evaluates symbolic expressions in ways that we don't like. *)
(* This did not give us any problems when a=3 because there were fewer simplifications to be made. *)
(* We create this little modification to help reduce future complications with the symbolic notation. *)

MyMemberQ[l_List,e_Integer]:=MemberQ[l,e];

(* We now adjust our a4list function for m1=-4 and m2=-34 to get our desired formula. *)
Table[
vals=Table[NoMST[n,Floor[(5n-4)/27]+i-If[Mod[n,108]==28,1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],1,0] ,Floor[(26n-34)/27]+j +If[MyMemberQ[{1,77,78,82,83,88,93,98,104},Mod[n,108]],1,0]-If[MyMemberQ[{28,33,38,43},Mod[n,108]],1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],2,0],4],{i,-4,4},{j,-4,4}];
p[n-6 108,Position[vals,Min[Flatten[vals]]]-5]
,{n,6 108,7 108-1}];
(* We check to see which cases does not contain {0,0} and we find the empty set, as desired. *)
Cases[%,p[_,a_/;Not[MemberQ[a,{0,0}]]]]

(* Now that we have a conjectured formula, we need to prove that it gives the global minimum. *)
(* We perform direct computations locally in an interval around {0,0}. *)
(* Then we employ CAD globally to confirm that our polynomials are always non-negative for all 108 cases. *)
(* To speed up computations, we plug in symbolic s and t into NoMST first. Then direct substitute our formulas. *)
 Table[
diff=Flatten[Table[
MyFCSimplify[
NoMST[n,s,t,4]/.
{s->Floor[(5n-4)/27]-If[Mod[n,108]==28,1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],1,0]+4i+ii,t->Floor[(26n-34)/27] +If[MyMemberQ[{1,77,78,82,83,88,93,98,104},Mod[n,108]],1,0]-If[MyMemberQ[{28,33,38,43},Mod[n,108]],1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],2,0]+4j+jj}
/.n->108k+ell],
{ii,0,3},{jj,0,3}]];
diff=diff-(diff[[1]]/.{i->0,j->0});
test=CylindricalDecomposition[(-4≤i≤4&&-4≤j≤4)||#≥0,{i,j}]&/@diff;
(And@@test)&&Min[Table[diff,{i,-4,4},{j,-4,4}]]==0,
{ell,0,107}]

(* Now that we know our formula is correct, we perform simplifications to derive an exact formula. *)
(* First we identify the formulas all 108 cases by substituting n=108k+ell for 0≤ell≤107. *)
(* The higher order terms should be the same. We then have to examine the constants to see if any further modifications need to be made. *)
a4polyn=Table[Expand[MyFCSimplify[NoMST[n,s,t,4]/.
{s->Floor[(5n-4)/27]-If[Mod[n,108]==28,1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],1,0],t->Floor[(26n-34)/27] +If[MyMemberQ[{1,77,78,82,83,88,93,98,104},Mod[n,108]],1,0]-If[MyMemberQ[{28,33,38,43},Mod[n,108]],1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],2,0]}
/.n->108k+ell]
/.k->(n-ell)/108],
{ell,0,107}]

(* We now try to discover patterns in the deltas in order to guess the correct one that would gives us our exact formula. *)
(* Note that we need to pay attention to points outside of a range of length 1, because that means that the floor or ceiling
could cause a change in the count by a -1 or +1, respectively. *)
(* The delta helps us put the count in a certain "range" and then all extremal cases are treated separately. *)
(* Ideally, the shift would be in such a way that minimizes the number of extreme points (and only in one direction too). *)
(* So we plot the points to see how we can make this decision. *)
a4delta=a4polyn-(n^2/216-7n/54)
a4sorteddelta=Sort[%]

(* Here we count how many points are "out of range" if we choose to modify by a certain delta. We pick the minimal one. *)
Count[a4delta-#,a_/;a≥1||a<0]&/@a4delta
Min[%]

Flatten[Position[%%,19]]
a4delta[[%]]

(* We arbitrarily choose 1/8 from the above list, and shift accordingly. *)
(* We further reduce by 1/108 so that everything stays below 1. *)
(* Total shift: 29/216 *)
ListPlot[a4delta-1/8-1/108]

(* These are the positions that are out of range (below the axis) and will be used to compensate the formula. *)
Flatten[Position[a4delta-29/216,a_/;(a<0)||a≥1]-1]

(* Observe the new delta and the modification. *)
(* 29/216 is the shift correction that gives the fewest out of range points. *)
(* 216/216 is the correction that we add for the fact that the above terms adds an extra 1. *)
(* Total correction: (216+29)/216=245/216 *)
(* We subtract 1 for those that are below the bound. *)
Table[Floor[(n^2/216-7n/54+245/216)]-If[MemberQ[{0,1,27,28,43,47,48,53,58,63,67,68,69,73,78,83,88,89,93},Mod[n,108]],1,0],{n,5 108,6 108-1}]

(* Actual Count *)
Table[NoMST[n,s,t,4]/.
{s->Floor[(5n-4)/27]-If[Mod[n,108]==28,1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],1,0],t->Floor[(26n-34)/27] +If[MyMemberQ[{1,77,78,82,83,88,93,98,104},Mod[n,108]],1,0]-If[MyMemberQ[{28,33,38,43},Mod[n,108]],1,0]+If[MyMemberQ[{0,87,103},Mod[n,108]],2,0]},{n,5 108,6 108-1}]

(* Compare *)
%-%%

(* For n≥80 we can be sure that the above choice of s and t lie *)
(* in the admissible region, in which the formula given by NoMST is valid. *)
(* For n<80, the correctness of our formula follows from the explicit computations below. *)
CylindricalDecomposition[(4*b1+b2≥n && b2≥4*b1 && b1*5≤b2)/.Thread[{b1,b2}->#],n]&/@
Tuples[{{(5n-4)/27-1-1/27,(5n-4)/27+4/27},
{(26n-34)/27-1-19/27,(26n-34)/27+1+13/27}}]

(* The following computations experimentally confirm the correctness of our exact formula. *)

Table[Floor[(n^2-28n+245)/216]-If[MemberQ[{0,1,27,28,43,47,48,53,58,63,67,68,69,73,78,83,88,89,93},Mod[n,108]],1,0],{n,100}]

(* takes about 5 min *)
Table[MinMSTtestRegion[n,4],{n,100}]

(* takes about 10 min *)
Table[MinMSTtestAll[n,4],{n,80}]

a=(1/2)

Cases[minlocfinal/.a->1/2,{True,__}]

(* We are in region ((Subscript[R, 69])). *)
Position[areaPW/.{a->1/2,b1->4/19,b2->12/19},{True,_}]

areaPW[[69]]

FullSimplify[areaPW[[69,1]]/.{a->1/2,b1->s,b2->t,LessEqual->Less},0<s<t<1]

(* We define a special case for a=1/2, valid under the above conditions. *)
(* Discrete conditions on s and t: n/2 ≤ t ≤ 2n/3 && t-s ≤ n/2 && t ≥ 2s *)
NoMST[n_,s_,t_,1/2]:=
(*111*) Sum[1,{y,s},{x,s-Floor[y/2]}]+
(*222*)Sum[1,{y,s+1,t},{x,s+1,t-Floor[y/2]}]+
(*313*) Sum[1,{y,s},{x,t+1,n-Floor[y/2]}]+
(*133*) Sum[1,{y,2*(t-s)+1,n},{x,t+1-Floor[y/2],s}]+
(*333*) Sum[1,{y,t+1,2*(n-t)-1},{x,t+1,n-Floor[y/2]}];

Table[
pts=Select[Tuples[Range[n],2],n/2≤#[[2]]≤2n/3 && #[[2]]-#[[1]]≤n/2 && #[[2]]≥2#[[1]]&];
And@@(Length[MSTtest[n,#1,#2,1/2]]===NoMST[n,#1,#2,1/2]&@@@pts),
{n,19,57}]

TableForm[Table[
vals=Table[NoMST[n,Floor[(4n+7)/19]+If[Mod[n,19]==17,1,0]+i,Floor[(12n+6)/19]+If[Mod[n,19]==4,1,0]+j,1/2],{i,-2,2},{j,-2,2}];
p[n-5 38,Position[vals,Min[Flatten[vals]]]-3]
,{n,5 38,6 38-1}]]

Table[
diff=Flatten[Table[
MyFCSimplify[NoMST[n,Floor[(4n+7)/19]+If[Mod[n,19]==17,1,0]+2i+ii,Floor[(12n+6)/19]+If[Mod[n,19]==4,1,0]+2j+jj,1/2]/.n->38k+ell],
{ii,0,1},{jj,0,1}]];
diff=diff-(diff[[1]]/.{i->0,j->0});
test=CylindricalDecomposition[(-2≤i≤2&&-2≤j≤2)||#≥0,{i,j}]&/@diff;
(And@@test)&&Min[Table[diff,{i,-2,2},{j,-2,2}]]==0
,{ell,0,37}]

Table[Expand[MyFCSimplify[NoMST[n,Floor[(4n+7)/19]+If[Mod[n,19]==17,1,0],Floor[(12n+6)/19]+If[Mod[n,19]==4,1,0],1/2]/.n->38k+ell]/.k->(n-ell)/38],{ell,0,37}]

deltas=%-(15n^2/76)

Sort[deltas]

Position[deltas,a_/;a<-1/19||a≥18/19]-1

(* For n≥38 we can be sure that the above choice of s and t lie *)
(* in the admissible region, in which the formula given by NoMST is valid. *)
(* For n<38, the correctness of our formula follows from the explicit computations below. *)
Table[CylindricalDecomposition[(n/2≤b2≤2n/3&&b2-b1≤n/2&&b2≥2b1)/.{b1->(4n+7)/19+i,b2->(12n+6)/19+j},n],{i,-1,1},{j,-1,1}]

Table[Floor[(15n^2+72)/76]+Which[Mod[n,38]==18||Mod[n,38]==20,1,Mod[n,38]==19,-1,True,0],{n,120}]

(* takes almost one hour *)
Table[
pts=Select[Tuples[Range[n],2],n/2≤#[[2]]≤2n/3-1 && #[[2]]-#[[1]]≤n/2 && #[[2]]≥2#[[1]]&];
If[pts==={}||n<30,pts=Select[Tuples[Range[n],2],#[[1]]≤#[[2]]&]];
Min[Length[MSTtest[n,#1,#2,1/2]]&@@@pts],
{n,120}]

%-%%

Table[
pts=Select[Tuples[Range[n],2],#[[1]]≤#[[2]]&];
Min[Length[MSTtest[n,#1,#2,1/2]]&@@@pts],
{n,40}]

a=(1/2) (experiments to find the true minimum)

(* Brute-force approach to find the minimal number of MGST's and the optimal coloring(s) *)
Table[
triples=Flatten[Table[{x,y,x+Floor[y/2]},{y,n},{x,n-Floor[y/2]}],1];
colorings=Tuples[{0,1},n-1];
ntrips=Length[Cases[triples/.n->0/.Thread[Range[n-1]->#],{0,0,0}|{1,1,1}]]&/@colorings;
min=Min[ntrips];
pos=Flatten[Position[ntrips,min]];
colorings=Append[#,0]&/@colorings[[pos]];
Print[{n,min,pos,colorings}];
,{n,4,20}]

With[{n=30},
triples=Flatten[Table[{x,y,x+Floor[y/2]},{y,n},{x,n-Floor[y/2]}],1];
test=Table[
col=Join[Table[0,{s}],Table[1,{t-s}],Table[0,{u-t}],Table[1,{n-u}]];
Count[triples/.Thread[Range[n]->col],{0,0,0}|{1,1,1}]
,{s,1,n},{t,s+1,n},{u,t+1,n}]];
Position[test,Min[test]]

RegionPlot[{
(1/6≤x≤1/2||x≥5/6)&&(1/6≤y≤1/2||y≥5/6)&&(1/6≤x+y/2≤1/2||5/6≤x+y/2≤1),
(x≤1/6||1/2≤x≤5/6)&&(y≤1/6||1/2≤y≤5/6)&&(x+y/2≤1/6||1/2≤x+y/2≤5/6)},{x,0,1},{y,0,1}]

With[{n=30,s=5,t=15,u=25},
triples=Flatten[Table[{x,y,x+Floor[y/2]},{y,n},{x,n-Floor[y/2]}],1];
col=Join[Table[0,{s}],Table[1,{t-s}],Table[0,{u-t}],Table[1,{n-u}]];
mono=Select[triples,Length[Union[#/.Thread[Range[n]->col]]]===1&];
Show[%,ListPlot[((Most/@mono)-1/2)/n]]
]

MST4[n_,s_,t_,u_]:=Join[
Flatten[Table[{x,y},{y,s},{x,s-Floor[y/2]}],1],
Flatten[Table[{x,y},{y,s+1,t},{x,s+1,t-Floor[y/2]}],1],
Flatten[Table[{x,y},{y,s},{x,t+1,u-Floor[y/2]}],1],
Flatten[Table[{x,y},{y,t+1,2*(u-t)-1},{x,t+1,u-Floor[y/2]}],1],
Flatten[Table[{x,y},{y,2*(t-s+1),u},{x,t+1-Floor[y/2],s}],1],
Flatten[Table[{x,y},{y,s+1,2*(n-u)-1},{x,u+1,n-Floor[y/2]}],1],
Flatten[Table[{x,y},{y,u+1,n},{x,u+1-Floor[y/2],t}],1]
];
ListPlot[MST4[30,5,15,25]]

test=Table[
triples=Flatten[Table[{x,y,x+Floor[y/2]},{y,n},{x,n-Floor[y/2]}],1];
Table[
col=Join[Table[0,{s}],Table[1,{t-s}],Table[0,{u-t}],Table[1,{n-u}]];
mono=Select[triples,Length[Union[#/.Thread[Range[n]->col]]]===1&];
mst4=MST4[n,s,t,u];
Join[Complement[Most/@mono,mst4],Complement[mst4,Most/@mono]]==={}
,{s,Floor[n/6]-1,Ceiling[n/6]+1},{t,Floor[n/2]-1,Ceiling[n/2]},{u,Floor[5/6n]-1,Ceiling[5/6n]+1}]
,{n,24,40}];
Union[Flatten[test]]

NoMST4[n_,s_,t_,u_]:=
Sum[1,{y,s},{x,s-Floor[y/2]}]+
Sum[1,{y,s+1,t},{x,s+1,t-Floor[y/2]}]+
Sum[1,{y,s},{x,t+1,u-Floor[y/2]}]+
Sum[1,{y,t+1,2*(u-t)-1},{x,t+1,u-Floor[y/2]}]+
Sum[1,{y,2*(t-s+1),u},{x,t+1-Floor[y/2],s}]+
Sum[1,{y,s+1,2*(n-u)-1},{x,u+1,n-Floor[y/2]}]+
Sum[1,{y,u+1,n},{x,u+1-Floor[y/2],t}];

Union[Flatten[Table[Length[MST4[n,s,t,u]]-NoMST4[n,s,t,u],
{n,24,40},{s,Floor[n/6]-1,Ceiling[n/6]+1},{t,Floor[n/2]-1,Ceiling[n/2]},{u,Floor[5/6n]-1,Ceiling[5/6n]+1}]]]

TableForm[Table[
test=Table[NoMST4[n,s,t,u],{s,Floor[n/6]-1,Ceiling[n/6]+1},{t,Floor[n/2]-1,Ceiling[n/2]},{u,Floor[5/6n],Ceiling[5/6n]+1}];
p[n,Min[test]===NoMST4[n,Floor[(n+3)/6],Floor[(n+1)/2],Floor[(5n+3)/6]],Position[test,Min[test]]]
,{n,24,40}]]

Table[MyFCSimplify[Simplify[NoMST4@@MyFCSimplify[{n,Floor[(n+3)/6],Floor[(n+1)/2],Floor[(5n+3)/6]}/.n->12k+ell],Assumptions->k≥2]]/.k->(n-ell)/12,{ell,0,11}]

Expand[%-(n^2/6)]

Table[NoMST4[n,Floor[(n+3)/6],Floor[(n+1)/2],Floor[(5n+3)/6]]-Floor[(n^2+5)/6],{n,24,40}]