n = 18;
regionCons =
1/3 - x/Sqrt[2] - y/Sqrt[6] > 0 && 1/3 + x/Sqrt[2] - y/Sqrt[6] > 0
&&
1/3 + Sqrt[2/3] y > 0;
entropyCons = -(1/3 + Sqrt[2/3] y) Log[
1/3 + Sqrt[2/3] y] - (1/3 - x/Sqrt[2] - y/Sqrt[6]) Log[
1/3 - x/Sqrt[2] - y/Sqrt[6]] - (1/3 + x/Sqrt[2] - y/Sqrt[
6]) Log[1/3 + x/Sqrt[2] - y/Sqrt[6]] > Log[2];
obj = Log[
n!/((n (1/3 - x/Sqrt[2] - y/Sqrt[6]))! (n (1/3 + x/Sqrt[2] - y/
Sqrt[6]))! (n (1/3 + Sqrt[2/3] y))!)];
{x1, x2, y1, y2} = {-.7, .7, -.6, 1};
plot1 = RegionPlot[
regionCons && entropyCons, {x, x1, x2}, {y, y1, y2}];
plot2 = ContourPlot @@ {Boole[regionCons] Log[obj], {x, x1, x2}, {y,
y1, y2}, ContourShading -> None};
Show[plot1, plot2]
FindMinimum[{obj, regionCons && entropyCons}, {x, x1, x2}, {y, y1,
y2}]
NMinimize[{obj,
regionCons && entropyCons}, {{x, x1, x2}, {y, y1, y2}}]
Motivation: this is trying to find the smallest trinomial coefficient
(positive, real valued components) for n=18 whose entropy is larger
than entropy of coefficient 9,9,0