# How do I plot the solutions to an integral equation defined over a 2D region?

I have a hexagonal region R (in the x-y plane) defined by the following 6 points:

R = Polygon[{{4Pi/3, 0}, {2Pi/3, 2Pi/Sqrt[3]}, {-2Pi/3, 2Pi/Sqrt[3]}, {-4 Pi/3, 0}, {-2Pi/3, -2Pi/Sqrt[3]}, {2Pi/3, -2Pi/Sqrt[3]}}];

I would like to obtain a plot showing the value of m (from say U=0 to U=10) which satisfies the following equation:

$$1 = A*U\iint_R \frac{1}{\sqrt{U^2m^2+f(x,y)}}$$

where $$f(x,y)= 3+ 2\cos\left[\frac{\sqrt3}{2}y +\frac{x}{2}\right]+2\cos\left[\frac{\sqrt3}{2}y -\frac{x}{2}\right] + 2\cos[x],$$

$$A=\frac{3\sqrt{3}}{8\pi^2},$$

and the integral is over all points {x,y} within R. Can anyone suggest how this can be done? Thanks for any help.

• Have you tried evaluating the integral symbolically? More in general, what have you tried so far? – MarcoB Mar 10 '17 at 5:06

## 3 Answers

First define functions to characterize your Polygon R:

    f1[x_] = 2 Pi/Sqrt[3]/(-2 Pi/3 - (-4 Pi/3)) (x + 4 Pi/3)

f2[x_] = -2 Pi/Sqrt[3]/(-2 Pi/3 - (-4 Pi/3)) (x + 4 Pi/3)

f3[x_] = 2 Pi/Sqrt[3]

f4[x_] = -2 Pi/Sqrt[3]

f5[x_] = -2 Pi/Sqrt[3]/(-2 Pi/3 - (-4 Pi/3)) (x - 4 Pi/3)

f6[x_] = 2 Pi/Sqrt[3]/(-2 Pi/3 - (-4 Pi/3)) (x - 4 Pi/3)

func1[x_] =
Piecewise[{{f1[x], -4 Pi/3 <= x <= -2 Pi/3}, {f3[x], -2 Pi/3 < x <
2 Pi/3}, {f5[x], 2 Pi/3 <= x <= 4 Pi/3}}, 0]

func2[x_] =
Piecewise[{{f2[x], -4 Pi/3 <= x <= -2 Pi/3}, {f4[x], -2 Pi/3 < x <
2 Pi/3}, {f6[x], 2 Pi/3 <= x <= 4 Pi/3}}, 0]


Test it

   Plot[{func1[x], func2[x]}, {x, -5, 5}, Epilog -> Point[Identity @@ R]]


Define your integration and FindRoot for m with given U:

    f[x_, y_] =
3 + 2 Cos[Sqrt[3]/2 y + x/2] + 2 Cos[Sqrt[3]/2 y - x/2] + 2 Cos[x]

int[U_?NumericQ, m_?NumericQ] :=
NIntegrate[
1/Sqrt[U^2 m^2 + f[x, y]], {x, -4 Pi/3, 4 Pi/3}, {y, func2[x],
func1[x]}, MaxRecursion -> 100] // Quiet

mfr[U_] :=
m /. FindRoot[A U int[U, m] == 1, {m, 0, 10}, MaxIterations -> 2000]

mfrneg[U_] :=
m /. FindRoot[A U int[U, m] == 1, {m, -10, 0}, MaxIterations -> 2000]


With Plot you see, that a positive and a negitive m fullfil the condition, but only for U > 0.371841

    Manipulate[
Plot[{1, A U int[U, m]}, {m, -6, 6}, PlotRange -> {0, 3}], {U, 10,
0}]

FindRoot[A U int[U, 0] == 1, {U, 0, 1},
MaxIterations -> 2000]

(*   {U -> 0.371841}   *)


Plot the two m as a function of U

    pl = Plot[{mfr[U], mfrneg[U]}, {U, .4, 10},
PlotRange -> {{0, 10}, {-3.5, 3.5}}]


Here is one possible solution:

 R = Polygon[{{4 Pi/3, 0}, {2 Pi/3, 2 Pi/Sqrt[3]}, {-2 Pi/3,
2 Pi/Sqrt[3]}, {-4 Pi/3,
0}, {-2 Pi/3, -2 Pi/Sqrt[3]}, {2 Pi/3, -2 Pi/Sqrt[3]}}];
A = 3*Sqrt[3]/8/\[Pi]^2;
f[x_, y_] := 3 + 2*Cos[Sqrt[3]/2*y + x/2] + 2*Cos[Sqrt[3]/2*y - x/2] + 2*Cos[x];
int[U_?NumericQ][m_?NumericQ] := A*U*NIntegrate[1/Sqrt[U^2*m^2 + f[x, y]], {x, y} \[Element] R]

data = Table[{U, m /. FindRoot[int[U][m] == 1, {m, 2}]}, {U, 0, 10}] // Quiet


(* result {{0, 2.}, {1, 2.53439}, {2, 2.87748}, {3, 2.94495}, {4, 2.96891}, {5, 2.98007}, {6, 2.98614}, {7, 2.98981}, {8, 2.9922}, {9, 2.99383}, {10, 2.995}} *)

 ListLinePlot[data, Epilog -> {Red, PointSize[0.02], Point[data]}, PlotRange -> {{0, 10}, {2, 3}}, PlotRangePadding -> {{0, 0}, {0, 0.2}}, Frame -> True, GridLines -> Automatic, FrameLabel -> {"U", "m"}]


This is using the region as defined by @Akku14, but notice you do not need to use FindRoot. Eval the integral in terms of the parameter m U , solve for U and make your plot parametrically:

int[mu_?NumericQ] :=
NIntegrate[
1/Sqrt[mu^2 + f[x, y]], {x, -4 Pi/3, 4 Pi/3}, {y, func2[x],
func1[x]}, MaxRecursion -> 100] // Quiet
U[mu_] := 1/int[mu]/A
ParametricPlot[{{{#, mu/#}, {#, -mu/#}} &@U[mu]}, {mu, 0, 30},
AspectRatio -> 1/GoldenRatio, PlotRange -> All]


note we can also do the integral like this

reg = Polygon[{{4 Pi/3, 0}, {2 Pi/3, 2 Pi/Sqrt[3]}, {-2 Pi/3,
2 Pi/Sqrt[3]}, {-4 Pi/3,
0}, {-2 Pi/3, -2 Pi/Sqrt[3]}, {2 Pi/3, -2 Pi/Sqrt[3]}}];
int[mu_?NumericQ] :=
NIntegrate[1/Sqrt[mu^2 + f[x, y]], Element[{x, y}, reg]]


but it is a good bit slower (oddly)