Skip to main content

graphics - Dual complex integral over implicit path using contour plot


Context


I am interested in doing double contour integral over paths which are defined implicitly. For the sake of debugging, let's assume its $$\oint_{\cal C}\oint_{\cal C} \frac{1}{u\, x} d u d x$$ where $\cal C$ is defined implicitly as the zero of a function (here for instance $x^4+y^4- x y/2=1$).


I would like to make use of the ContourPlot function of Mathematica to extract the contour path for me.
(The motivation is to implement the so called "saddle point method" in the complex plane while integrating over contours of null imaginary part of some given function)


Question



How to extract smooth enough contours to not mess up the double complex integral?




Attempt


I first extract the path


pl = ContourPlot[x^4 + y^4 - 1/2 x y == 1, {x, -2, 2}, {y, -2, 2}, PlotPoints -> 25];
dat = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]] // Chop // Rest // Transpose;
dat = GaussianFilter[#, 0] & /@ dat;nn = Length[dat[[1]]];rg = (Range[nn] - 1.)/(nn - 1);
dat = Transpose /@ Partition[Riffle[{rg, rg}, dat], 2];
path = Interpolation[#, InterpolationOrder -> 1] & /@ dat;
path = Function[t, path[[1]][t] + I path[[2]][t] // Release];

(ignore the GaussianFilter for now) which looks like this



{ParametricPlot[path[t] // {Re[#], Im[#]} & // Release, {t, 0, 1},ImageSize -> 200],
Plot[path[t] // {Re[#], Im[#]} & // Release, {t, 0, 1}, ImageSize -> 200]} // Row

Mathematica graphics


For reference let us also define an explicit (circular) path


path0[t_] = Exp[2 Pi I t];

Let's now start with a simple contour integration in the complex plane, using NContourIntegrate defined by


   NContourIntegrate[f_, par : (z_ -> g_), {t_, a_, b_}, opts : OptionsPattern[]] := 
NIntegrate[Evaluate[D[g, t] (f /. par) /. t -> t1], {t1, a, b},opts]


:


NContourIntegrate[1/x, x -> path0[t], {t, 0, 1}, PrecisionGoal -> 3] // Chop
NContourIntegrate[1/x, x -> path[t], {t, 0, 1}, PrecisionGoal -> 3] // Chop

(* 0. +6.28319 I -0.00291648-6.27423 I *)

(the negative $2\pi\imath$ reflects a wrong orientation of the implicit path which is not relevant to my problem).


Now moving on to double integration, first with the explicit path (where I divide the answer by the expected answer $(2 \imath \pi)^2$)


 Clear[h]; h[u_?NumberQ] := NContourIntegrate[1/x/u, x -> path0[t], {t, 0, 1}, PrecisionGoal -> 3]; 

NContourIntegrate[h[u], u -> path0[t], {t, 0, 1},PrecisionGoal -> 3]/(2 I Pi)^2 // Chop

(* 1.*)

and finally for the implicit path


Clear[h]; h[u_?NumberQ] := NContourIntegrate[1/x/u, x -> path[t], {t, 0, 1}, PrecisionGoal -> 3];
NContourIntegrate[h[u], u -> path[t], {t, 0, 1}, PrecisionGoal -> 3]/(2 I Pi)^2 // Chop

(* 1.53254 +0.00796458 I *)


which is a terrible answer!


Now in the code above I replace the useless command dat = GaussianFilter[#, 0] & /@ dat; by


dat = GaussianFilter[#, 4] & /@ dat;

I get


 (* 1.00097 +0.00168785 I *)

which is better.


I strongly suspect that the problem lies with the contour extraction which produces dat containing duplicates such as {{-1., 0} {-1., 0} {-1., 0} {-1., 0} {-0.990251, 0.0735841} {-0.988311, 0.0833333} {-0.987415, 0.0959183}} which in turn as suppressed by the Gaussian filtering.


Indeed, while the contour itself seems unaffected, its components in red and pink are less jaggy:



Mathematica graphics


and this apparently small amount of noise (and/or duplicates) completely mess up the integral.



Is it possible to tweak the ContourPlot routine or its output to avoid duplicates and get good accuracy on this type of integrals?



EDIT


The improvement involved with the GaussianFilter is actually critical because if I extend this problem to a triple integral, $$\oint_{\cal C}\oint_{\cal C}\oint_{\cal C} \frac{1}{u \,v\, x } d u d v d x$$ via


Clear[h1]; h1[u_?NumberQ, v_?NumberQ] := NContourIntegrate[1/(x u v), x -> path[t], {t, 0, 1}];
Clear[h2]; h2[v_?NumberQ] := NContourIntegrate[h1[u, v], u -> path[t], {t, 0, 1}]
NContourIntegrate[h2[v], v -> path[t], {t, 0, 1}]/( 2I Pi)^3


I get


(* -0.975052-0.00767858 I *) 

compared to


(* -2.91536 -0.040382 I *)

without!


EDIT 2


To be more specific about the core of the problem, this curve is too jaggy:



pl = ContourPlot[x^4 + y^4 - 1/2 x y == 1, {x, -2, 2}, {y, -2, 2}, PlotPoints -> 25];
dat = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]] // Chop // Rest // Transpose;
dat = GaussianFilter[#, 0.] & /@ dat;nn = Length[dat[[1]]];rg = (Range[nn] - 1.)/(nn - 1);
dat = Transpose /@ Partition[Riffle[{rg, rg}, dat], 2];dat[[1]] // ListLinePlot

Mathematica graphics


I can make it less jaggy by changing the option to PlotPoints -> 125 but it actually makes the contour integration worse!



Answer



The problem is that the same symbol t1 is used in the NIntegrate call within NContourIntegrate. When more than one NContourIntegrate are nested, each uses the same symbol t1, which means in the innermost integral, all the variables have been replaced by t1. [Edit: More accurately, the outer integral effectively blocks t1 and replaces it by a numerical value, so that all the replacements t -> t1 in the inner integral(s) replace the symbol represented by t by the same numerical value.] Hence the integral does not calculate what was intended. Localizing t1 in Module is a solution.


pl = ContourPlot[x^4 + y^4 - 1/2 x y == 1, {x, -2, 2}, {y, -2, 2}, PlotPoints -> 25];

dat = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]] (*//Rest*) // Transpose;
dat = GaussianFilter[#, 0] & /@ dat;
nn = Length[dat[[1]]]; rg = (Range[nn] - 1.)/(nn - 1);
dat = Transpose /@ Partition[Riffle[{rg, rg}, dat], 2];
path = Interpolation[#, InterpolationOrder -> 1] & /@ dat;
path = Function[t, path[[1]][t] + I path[[2]][t] // Release];

Clear[NContourIntegrate];
NContourIntegrate[f_, par : (z_ -> g_), {t_, a_, b_}, opts : OptionsPattern[]] :=
Module[{t1},

NIntegrate[Evaluate[D[g, t] (f /. par) /. t -> t1], {t1, a, b}, opts]]

The integration works, but it is slow.


Clear[h]; 
h[u_?NumberQ] := NContourIntegrate[1/x/u, x -> path[t], {t, 0, 1}, PrecisionGoal -> 3];
NContourIntegrate[h[u], u -> path[t], {t, 0, 1}, PrecisionGoal -> 3]/(2 I Pi)^2 //
Chop // AbsoluteTiming
(* {1800.94, 1.} *)

One can directly do the path integral in NIntegrate without the piecewise linear parametrization, and it's a bit faster.



Clear[h];
pts = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]].{1, I};
h[u_?NumberQ] := NIntegrate[1/x/u, Evaluate@{x, Sequence @@ pts}, PrecisionGoal -> 3];
NIntegrate[h[u], Evaluate@{u, Sequence @@ pts}, PrecisionGoal -> 3]/(2 I Pi)^2 //
Chop // AbsoluteTiming
(* {682.515, 1.} *)

With fewer points, it is much faster still. As long as the integrand is meromorphic and the original and new paths of integration do not contain a pole of the integrand, then the results will be the same.


pl = ContourPlot[x^4 + y^4 - 1/2 x y == 1, {x, -2, 2}, {y, -2, 2}, MaxRecursion -> 0];
pts = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]].{1, I};

NIntegrate[1/x/u, Evaluate@{x, Sequence @@ pts}, Evaluate@{u, Sequence @@ pts},
PrecisionGoal -> 3]/(2 I Pi)^2 // Chop // AbsoluteTiming
(* {0.555472, 1.} *)

Note: The OP's original code used Rest, which resulted in a path that wasn't closed. This introduces a slight error in the integral which can be avoided by omitting Rest.


This works also with triple integrals


pl = ContourPlot[x^4 + y^4 - 1/2 x y == 1, {x, -2, 2}, {y, -2, 2}, 
MaxRecursion -> 0];
pts = Cases[pl // Normal, Line[a_] :> a, Infinity][[1]].{1, I};
NIntegrate[1/x/u/v, Evaluate@{x, Sequence @@ pts},

Evaluate@{u, Sequence @@ pts},
Evaluate@{v, Sequence @@ pts}, PrecisionGoal -> 2]/(2 I Pi)^3 //
Chop // AbsoluteTiming

(* {19.964775,-1.} *)

Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...