0
$\begingroup$

I have a two-variable function $g(x,y)$ with $0<x\leq\frac{\pi}2$ and $\frac32<y<5$. I am looking for $y=f(x)$ for which $g(x,y)=0$. Using ContourPlot

g[x_,y_]= -4 (-44 + 
     8 Abs[-2 (Sin[x/2 - (3 y)/2] - 
          3 Sin[x/2 + y/2]) (2 Sin[x/2 - (7 y)/2] + 
          Sin[(3 x)/2 - (5 y)/2] - 5 Sin[x/2 - (3 y)/2] - 
          3 Sin[(3 x)/2 - y/2] + 3 Sin[x/2 + y/2] + 
          6 Sin[x/2 + (5 y)/2])] + 
     4 Abs[6 + 9 Cos[2 x] + Cos[2 x - 4 y] - 4 Cos[x - 3 y] - 
        6 Cos[2 x - 2 y] + 8 Cos[x - y] - 10 Cos[2 y] + 
        12 Cos[x + y]] + -27 Cos[2 x] - Cos[2 x - 8 y] + 
     6 Cos[2 x - 6 y] - 11 Cos[2 x - 4 y] - 16 Cos[x - 3 y] + 
     12 Cos[2 x - 2 y] + 32 Cos[x - y] + 70 Cos[2 y] - 60 Cos[4 y] + 
     18 Cos[6 y] + 48 Cos[x + y] + 54 Cos[2 (x + y)] - 
     81 Cos[2 x + 4 y]);


p1 = ContourPlot[{g[x,y]== 0 }  , {x, 0, \[Pi]/2}, {y, 3/2, 5}, 
   PlotPoints -> 90 , FrameLabel -> Automatic , AspectRatio -> 3];
p2 = ContourPlot[{y == \[Pi]/2, y == 3 \[Pi]/2}  , {x, 0, \[Pi]/
    2}, {y, 3/2, 5}, ContourStyle -> Red, FrameLabel -> Automatic , 
   AspectRatio -> 3];
Show[{p1, p2}]

I obtain this plot

enter image description here

My question. Is there any hope to find the explicit expressions for the functions describing those blue curves in the form of $y=f(x)$? those red lines are $y=\frac{\pi}2$ and $3\frac{\pi}2$. I use Solve[g[x,y]==0 ,y] and Reduce[g[x,y]==0 ,y] and after an hour it is still running.

P.S. More precisely, I want to compute the area enclosed between the red and blue curves analytically. (numerically, I can compute it using NIntegrate[Boole[...]])

$\endgroup$
3
  • 2
    $\begingroup$ It does not seem to be a simple thing. Actually, there are no other ways than those you indicated. Further, even if these ways bring you to a solution after a long calculation, it will probably be cumbersome. What I would do in this case, is solve the problem numerically in several points. After that, I would try to fit the numerical solution with some simple analytical function. $\endgroup$ Mar 7, 2023 at 15:03
  • $\begingroup$ Thank you for the comment. Dealing numerically sounds complicated too; that long blue curve is a bit scary to be approximated numerically! $\endgroup$
    – charmin
    Mar 7, 2023 at 15:26
  • 1
    $\begingroup$ Reduce[g[x, y] == 0 && 0 <= x <= \[Pi]/2, y, Reals] actually does return something, but it's so big that there's no way you can realistically do something with it. $\endgroup$ Mar 7, 2023 at 15:39

1 Answer 1

1
$\begingroup$

Here my numerical solution (inspired by @AlexeiBoulbitch useful comment):

upper contour

contUP=cont = ContourPlot[{g[x, y] == 0}, {x, 0, \[Pi]/2}, {y, 3 , 5},PlotPoints -> 90, FrameLabel -> Automatic, AspectRatio -> 3] 

enter image description here

get the points

pi = contUP[[1, 1]][[1]];

points pi form a polygon, the enclosed area follows to

Area[Polygon[pi]]
(*0.76061*)

lower contour might be solved similarely (lower area gives 0.437233)

Hope it helps!

$\endgroup$
1
  • $\begingroup$ Thanks, it confirms the result I had obtained by NIntegrate but it is still numeric' so, probably there is no hope to find analytic solutions. $\endgroup$
    – charmin
    Mar 8, 2023 at 23:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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