Is it possible to calculate the desired area analytically?

Question

I have the three two-variable curves $f,g,h$ with $0\leq x\leq \frac {\pi}{2} $ and $0 \leq y \leq \pi$

I use ContourPlot as

f := Cos[x] + 2 Cos[x - 2 y];
 g := Cos[x - y] + 2 Cos[x + y];
 h := Cos[2 x - y] + 2 Cos[y];

ContourPlot[{f == 0, g == 0, h == 0}, {x, 0, \[Pi]/2}, {y, 0, \[Pi]}]

and I get the attached plot. I want to calculate the area between these curves (the upper part, the lower part, and the area between the middle curves).

My question:

Is it possible to do that analytically?

Answer 1

Partial answer here.

This is quite a brute force method. Nevertheless it gives a partial analytic result. Will give the generating expression and results, instead of showing all the work to avoid clutter.

Setup

1. Find the analytic expressions for the curves. Solving for f, g, h

   • Solve[f == 0] gave 8 results. Manually picked/simplified for your two blue curves.
     • y0 = -ArcCos[-(1/2) Sqrt[2 - Cos[x]^2 - Sqrt[4 - 5 Cos[x]^2 + Cos[x]^4]]]
     • y3 = ArcCos[-(1/2) Sqrt[2 - Cos[x]^2 - Sqrt[4 - 5 Cos[x]^2 + Cos[x]^4]]]
   • Solve[g == 0] gave 4 results. Manually picked/simplified for your yellow curve.
     • y1 = -ArcCos[-(Sqrt[Sin[x]^2]/Sqrt[1 + 8 Cos[x]^2])]
   • Solve[h == 0, y] gave 4 results. Manually picked/simplified for your green curve.
     • y2 = ArcCos[-(Sin[2 x]/Sqrt[5 + 4 Cos[2 x]])]

2. Find the one intersection for f and g

   • Solve[{f == 0, g == 0}] gave 12 results.
   • But, only only result satisfying the intersection near (0.66,1.32) is (xfg, yfg)
     • xfg = ArcTan[Sqrt[3/5]]
     • yfg = ArcTan[Sqrt[15]])

3. Now it is straightforward to perform the analytical integration using Mathematica.

Solving for Area

Abox = \[Pi]/2*\[Pi];
AUnderY3 = Integrate[FullSimplify@y3, {x, 0, xmax}];
AUnderY2 = Integrate[FullSimplify@y2, {x, 0, xmax}];
ABweenY1Y0 = Integrate[FullSimplify@(y1 - y0), {x, 0, xfg}];
ABweenY0Y1 = Integrate[FullSimplify@(y0 - y1), {x, xfg, xmax}];

Only one of the above expressions gave a closed form analytical expression.

AUnderY2 = 1/12 (4 \[Pi]^2 - 3 (2 Log[2]^2 + PolyLog[2, 1/4]))

All the other expressions failed to resolve to anything in a closed form. However, if you evaluate the following expression numerically, you get the correct result that @cvgmt posted.

N@(Abox - AUnderY3 + AUnderY2 - ABweenY1Y0 - ABweenY0Y1) = 3.15374

Maybe there are ways to simplify/integrate other area expressions to get closed forms as well. The problematic functions are y0 and y3. y1 and y2 both have closed forms for straight-up integration.

Answer 2

You can get analytical expressions for all integrals if you solve curves f and g for x[y] and h for y[x].

Have a look at the plot.

f = Cos[x] + 2 Cos[x - 2 y];
g = Cos[x - y] + 2 Cos[x + y];
h = Cos[2 x - y] + 2 Cos[y];

ContourPlot[{f == 0, g == 0, h == 0}, {x, 0, \[Pi]/2}, {y, 0, \[Pi]}, 
ContourStyle -> {Red, Green, Blue}, 
GridLines -> (gl = 
Evaluate@{Table[i, {i, 0, Pi/2, Pi/6}], 
  Table[i, {i, 0, Pi, Pi/6}]}), FrameTicks -> gl]

For simplification i eliminated Sin or Cos in equations.

eli11 = Eliminate[{TrigExpand[f] == 0, Sin[x]^2 + Cos[x]^2 == 1, 
Sin[y]^2 + Cos[y]^2 == 1}, {Sin[x], Sin[y]}]

sol11a = First@
Solve[eli11 && 0 < x < Pi/2 && 2/3 Pi < y < Pi, x, Reals] // 
ToRadicals

int11a = Integrate[x /. sol11a, {y, 2/3 Pi, Pi}]

(*   1/36 (4 \[Pi]^2 - 9 Log[2]^2 - 9 PolyLog[2, -(1/2) (-1)^(2/3)] - 
 9 PolyLog[2, 1/4 + (I Sqrt[3])/4])   *)

sol11b = First@
Solve[eli11 && 0 < x < Pi/2 && Pi/3 < y < Pi/2, x, Reals] // 
ToRadicals

int11b = Integrate[x /. sol11b, {y, Pi/3, Pi/2}]

(*   1/72 (5 \[Pi]^2 + 36 PolyLog[2, -(1/2)] - 
 18 PolyLog[2, 1/2 (-1)^(1/3)] - 18 PolyLog[2, 1/4 (1 -  I Sqrt[3])])   *)

eli12 = Eliminate[{TrigExpand[g] == 0, Sin[x]^2 + Cos[x]^2 == 1, 
Sin[y]^2 + Cos[y]^2 == 1}, {Sin[x], Sin[y]}]

sol12 = First@Solve[eli12 && 0 < x < Pi/2 && 0 < y < Pi/2, x, Reals]

int12 = Integrate[x /. sol12, {y, 0, Pi/2}]

(*   1/12 (2 \[Pi]^2 - 3 Log[2]^2 - 6 PolyLog[2, -(1/2)])   *)

eli13 = Eliminate[{TrigExpand[h] == 0, Sin[x]^2 + Cos[x]^2 == 1, 
Sin[y]^2 + Cos[y]^2 == 1}, {Sin[x], Cos[y]}]

sol13 = First@
Solve[eli13 && 0 < x < Pi/2 && Pi/2 < y < 2/3 Pi, y, Reals] // 
ToRadicals

int13 = Integrate[y /. sol13, {x, 0, Pi/2}]

(*   1/24 (7 \[Pi]^2 - 6 Log[2]^2 - 12 PolyLog[2, -(1/2)])   *)

I leave it to you to integrate til the intersection point and to subtract.