4
$\begingroup$

How to estimate or calculate the area enclosed by the implicit equation.

$$x^{\frac{1}{x+\frac{1}{x}}}+y^{\frac{1}{y+\frac{1}{y}}}=\mathrm{e}$$

It is possible to prove that the area is between $13$ and $15$?

I draw the curve by Asymptote(http://asymptote.ualberta.ca/).

import graph;
import contour;
size(200);
real f(real x){return x^(1/(1/x + x));};
real g(real x, real y) {return f(x)+f(y);}
draw(contour(g,(.1,.1),(8,8),new real[]{exp(1)},operator ..),blue+2);
xaxis("$x$",BottomTop,LeftTicks);
yaxis("$y$",LeftRight,RightTicks);

enter image description here enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Your plot has the wrong exponents: wolframalpha.com/input/… $\endgroup$ Commented Jan 3, 2022 at 10:04
  • $\begingroup$ Looks like a predator-prey phase diagram. $\endgroup$ Commented Nov 8, 2022 at 11:03

1 Answer 1

Reset to default
5
$\begingroup$

You have probably already solved it, but since it might be useful for someone else I write a couple of strategies using Wolfram Mathematica 13.0; obviously everyone can use any other spreadsheet.

Monte Carlo method

The basic idea is to bombard with 10^n balls the square of area $A_q$ which encloses the region of plane D of interest which goes from vertex (2,2) to vertex (7,7) and to count the m balls that also fall internally to D. The area of D is therefore estimated by $A_q\,m/10^n$. It goes without saying that a good pseudorandom real number generator is crucial here:

Table[m = 0; Do[{x, y} = RandomReal[{2, 7}, 2];
      If[x^(1/(x + 1/x)) + y^(1/(y + 1/y)) > E, ++m], {10^n}];
      25. m / 10^n, {n, 7}]

{12.5, 12.25, 13.675, 13.77, 13.7047, 13.7454, 13.7577}

or more efficiently:

Table[z = RandomReal[{2, 7}, {2, 10^n}];
      25. Total@Boole@Thread[Total[z^(1/(z + 1/z))] > E] / 10^n, {n, 8}]

{15., 15.5, 13.725, 13.87, 13.726, 13.7676, 13.7607, 13.7615}

The calculated area is the better the larger it's n.

Discrete Fourier Transform + Gauss-Green theorem

First, I tabulate the coordinates of some points of the boundary proceeding counterclockwise:

f[x_, y_] := x^(1/(x + 1/x)) + y^(1/(y + 1/y))

pts = Table[FindRoot[f[ρ Cos[θ] + 4, ρ Sin[θ] + 4] == E,
            {ρ, 1}][[1, 2]] {Cos[θ], Sin[θ]} + {4, 4},
            {θ, 0, 2 π, π/50}];

Through Discrete Fourier Transform, I determine a trigonometric fit of least squares to the data:

TrigFit[v_, m_, {x_, x0_, x1_}] := Module[{fc, fs, i, imax, j, n, t},
  n = Length[v]; imax = Min[m, Floor[(n - 1) / 2]]; t = 2 π (x - x0)/(x1 - x0);
  fc = Table[Sum[v[[j + 1]] Cos[2 π i j / n] / n, {j, 0, n - 1}], {i, 0, imax}];
  fs = Table[Sum[v[[j + 1]] Sin[2 π i j / n] / n, {j, 0, n - 1}], {i, 0, imax}];
  fc[[1]] + 2 Sum[fc[[i + 1]] Cos[i t] + fs[[i + 1]] Sin[i t], {i, 1, imax}]]

{x[t_], y[t_]} = TrigFit[pts, 50, {t, 0, 2 π}];

Finally, I calculate the area enclosed by this parametric curve using the Gauss-Green theorem:

NIntegrate[x[t] y'[t], {t, 0, 2 π}]

13.7592

If you want to check, it's also possible to superimpose the implicit curve on the parametric one:

Show[ParametricPlot[{x[t], y[t]}, {t, 0, 2 π}, PlotStyle -> Directive[Thick, Red]],
     ContourPlot[f[x, y] == E, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 100]]

enter image description here

where it's evident that they overlap perfectly, so the calculated area is very close to the exact one!

$\endgroup$
2
  • $\begingroup$ Is it possible to get an analytical answer? $\endgroup$ Commented Nov 10, 2022 at 12:20
  • 1
    $\begingroup$ If only pursue numerical solutions, we can use NIntegrate[Boole[x^(1/(x+1/x))+y^(1/(y+1/y))>=E],{x,0,7},{y,0,7},Method->"LocalAdaptive"] directly $\endgroup$ Commented Nov 10, 2022 at 12:23

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.