3
$\begingroup$

Could anyone help me find the exact value of

Maximize[Min[1, 1 - Cos[2 x], 1 + Cos[2 x], 1 - Cos[2 x - 2 y], 
  1 + Cos[2 x - 2 y], 1 - Cos[2 y], 1 + Cos[2 y], 1 - Sin[2 x], 
  1 + Sin[2 x], 1 - Sin[2 y], 1 + Sin[2 y]], {x, y}]

by Mathematica or rigorous reasoning or proof? Thanks a lot

$\endgroup$
1
  • $\begingroup$ Your comments to the answers indicate that you are not looking for the exact value found by Mathematica or rigourous reasoning or proof, but for a rigourous proof from Mathematica or rigorous reasoning, which is different. math.stackexchange might be better suited for your needs. $\endgroup$ – anderstood Nov 1 '20 at 16:58
6
$\begingroup$

Your function has many symmetries:

f[x_, y_] = Min[1,
                1 - Cos[2 x],
                1 + Cos[2 x],
                1 - Cos[2 x - 2 y], 
                1 + Cos[2 x - 2 y],
                1 - Cos[2 y],
                1 + Cos[2 y],
                1 - Sin[2 x], 
                1 + Sin[2 x],
                1 - Sin[2 y],
                1 + Sin[2 y]];

f[x + π/2, y] == f[x, y] // FullSimplify
(*    True    *)

f[x, y + π/2] == f[x, y] // FullSimplify
(*    True    *)

f[π/2 - x, π/2 - y] == f[x, y] // FullSimplify
(*    True    *)

f[y, x] == f[x, y] // FullSimplify
(*    True    *)

From these, plus a graphical representation

DensityPlot[f[x, y], {x, 0, π/2}, {y, 0, π/2}, PlotRange -> All, Exclusions -> None]

enter image description here

the maxima are clearly at $(x,y)=(\frac{3\pi}{8},\frac{\pi}{8})$ or any point equivalent by the above symmetries:

f[3*π/8, π/8]
(*    1 - 1/Sqrt[2]    *)
$\endgroup$
4
  • $\begingroup$ Thank you for the non-rigorous answer. But could you produce the exact value by the Mathematica command in the question or do you have any rigorous proof for the exact value? Thanks. $\endgroup$ – Steiner Oct 31 '20 at 13:21
  • 1
    $\begingroup$ @Steiner you are on the wrong forum for rigorous math. Please ask on the math stackexchange. $\endgroup$ – Roman Oct 31 '20 at 13:23
  • $\begingroup$ But I paid nearly $2000 for Mathematica, which should not be just for numerical calculations, and since the function has many symmetries as you said, why couldn't Mathematica produce the exact value for it? Thanks. $\endgroup$ – Steiner Oct 31 '20 at 14:24
  • 8
    $\begingroup$ Mathematica is a tool, not an oracle. $\endgroup$ – Roman Oct 31 '20 at 14:35
5
$\begingroup$
Clear["Global`*"]

f[x_, y_] = 
  Min[1, 1 - Cos[2 x], 1 + Cos[2 x], 1 - Cos[2 x - 2 y], 1 + Cos[2 x - 2 y], 
   1 - Cos[2 y], 1 + Cos[2 y], 1 - Sin[2 x], 1 + Sin[2 x], 1 - Sin[2 y], 
   1 + Sin[2 y]];

Plotting,

Plot3D[f[x, y],
 {x, -π/2, π/2}, {y, -π/2, π/2},
 PlotRange -> All,
 Exclusions -> None,
 PlotLegends -> Automatic,
 PlotPoints -> 100,
 MaxRecursion -> 5,
 AxesLabel -> Automatic]

enter image description here

Maximize is unable to find the maximum because the function is not smooth. Using NMaximize

max = NMaximize[{f[x, y], -π/2 < x < π/2, -π/2 < y < π/2}, {x,
    y}]

(* {0.292893, {x -> -1.1781, y -> -0.392699}} *)

max2 = ReplacePart[max, {
   1 -> RootApproximant[max[[1]]] // Simplify,
   2 -> (max[[2]] /. (t_Real :> π*RootApproximant[t/π]))}]

(* {1 - 1/Sqrt[2], {x -> -((3 π)/8), y -> -(π/8)}} *)

max[[1]] == N[max2[[1]], 15]

(* True *)

({x, y} /. max[[2]]) == ({x, y} /. max2[[2]])

(* True *)
$\endgroup$
3
  • $\begingroup$ Thank you for the non-rigorous answer. But could you produce the exact value by the Mathematica command in the question on a supercomputer or any other symbolic computation software or tools or do you have any rigorous proof for the exact value? Thanks. $\endgroup$ – Steiner Oct 31 '20 at 14:52
  • $\begingroup$ Evaluate (Sqrt[12803520241] - 45779)/230028 < 1 - 1/Sqrt[2] $\endgroup$ – Bob Hanlon Oct 31 '20 at 15:04
  • $\begingroup$ I am not asking about the irrational number in the LHS, but could you produce the exact value by the Mathematica command in the question on a supercomputer or any other symbolic computation software or tool, or do you have any rigorous proof for the exact value? Thanks a lot. $\endgroup$ – Steiner Oct 31 '20 at 15:15
5
$\begingroup$

The reduction of trig functions to polynomials does the job:

Maximize[{Min[1, 1 - cx, 1 + cx, 1 - cx*cy - sx*sy, 1 + cx*cy + sx*sy,
1 - cy, 1 + cy, 1 - sx, 1 + sx, 1 - sy, 1 + sy], 
sx^2 + cx^2 == 1 && sy^2 + cy^2 == 1}, {sx, cx, sy, cy}]
(*{1 - 1/Sqrt[2], {sx -> -(1/Sqrt[2]), cx -> 1/Sqrt[2], sy -> -(1/Sqrt[2]), cy -> -(1/Sqrt[2])}}*)

The rest is left on your own.

$\endgroup$
3
  • $\begingroup$ Thank you for your answer. Just wondering, do you know the procedures, steps or algorithms in Maximize[{Min[1, 1 - cx, 1 + cx, 1 - cxcy - sxsy, 1 + cxcy + sxsy, 1 - cy, 1 + cy, 1 - sx, 1 + sx, 1 - sy, 1 + sy], sx^2 + cx^2 == 1 && sy^2 + cy^2 == 1}, {sx, cx, sy, cy}] in Mathematica? Thanks a lot. $\endgroup$ – Steiner Oct 31 '20 at 15:42
  • $\begingroup$ @Steiner: No, I don't know it. $\endgroup$ – user64494 Oct 31 '20 at 15:48
  • $\begingroup$ @Steiner You need to replace cxcy with cx*cy or cx cy. $\endgroup$ – expression Nov 1 '20 at 6:10

Not the answer you're looking for? Browse other questions tagged or ask your own question.