3
$\begingroup$

I have a very complicated function $f(u,v)$ in the complex $u,v$ plane which has several contours with the same value $x$, so that when I draw a ContourPlot of the equation $f(u,v)=x$ I get several lines (far too many, it crowds the graphic).

However, I am actually only interested in those contours that cross a given point $(u_0,v_0)$ of my function. Consider the following minimal working example:

ContourPlot[u Cos[v] == 1, {u, -3, 3}, {v, -3, 3}, Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}]

Full Contour

I would like to single out the contour which crosses the point $(1,0)$ (indicated by the red dot) and throw the other contours away:

Desired outcome

How do I implement the condition that the contour must cross a given point?

NB: For the MWE above, it is simple to exclude the unwanted contours by specifying $x<0$. I am not interested in that. I have a very messy function and the only criteria that separates the contour of interest from the others is that it crosses a point of interest.


EDIT:

So I have come up with an example that reproduces my issue with klgr's very good solution: all contours disappear, even the one of interest.

If I come up with a slightly more complicated function where the contours touch then this method cannot choose the line which crosses the point of interest:

ContourPlot[1/x Cos[y] == 1, {x, -3, 3}, {y, -3, 3},MaxRecursion -> 6, Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}]

more complicated example

If I use klgr's method however,

Normal[ContourPlot[1/x Cos[y] == 1, {x, -3, 3}, {y, -3, 3}, MaxRecursion -> 6, Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}]] /. l_Line :> If[RegionMember[l, {1, 0}], l, Nothing]

not working example

then all contours vanish!

$\endgroup$
3
$\begingroup$

One way is to post-process to remove the contour lines that do not pass through {1,0}:

Normal[ContourPlot[u Cos[v] == 1, {u, -3, 3}, {v, -3, 3}, 
   Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}] ] /. 
    l_Line :> If[RegionMember[l, {1, 0}], l, Nothing]

enter image description here

Update: You can add the option PlotPoints -> 100 to get something that works for both examples in OP:

cp1 = ContourPlot[1/x Cos[y] == 1, {x, -3, 3}, {y, -3, 3}, 
   PlotPoints -> 100, 
   Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}, 
   ImageSize -> Small];
Row[{cp1, 
  Normal[cp1] /. l_Line :> If[RegionMember[l, {1, 0}], l, Nothing]}]

enter image description here

If we color the three pieces of the contour individually:

i = 1; cp2 = 
 ContourPlot[1/x Cos[y] == 1, {x, -3, 3}, {y, -3, 3}, 
   PlotPoints -> 100, 
   Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}, 
   ImageSize -> Small] /. l_Line :> {ColorData[97][i++], l};
Row[{cp2, 
  Normal[cp2] /. l_Line :> If[RegionMember[l, {1, 0}], l, Nothing]}]

enter image description here

With Exlusions -> None one of the pieces is a closed curve:

i = 1;
cp3 = ContourPlot[1/x Cos[y] == 1, {x, -3, 3}, {y, -3, 3}, 
    Exclusions -> None, PlotPoints -> 100, 
    Epilog -> {Red, PointSize[Medium], Point[{1, 0}]}, 
    ImageSize -> Small] /. l_Line :> {ColorData[97][i++], l};
Row[{cp3, 
  Normal[cp3] /. l_Line :> If[RegionMember[l, {1, 0}], l, Nothing]}]

enter image description here

$Version

"11.3.0 for Microsoft Windows (64-bit) (March 7, 2018)"

$\endgroup$
  • $\begingroup$ So this solution seems to work for the MWE. However, in my code the method rules out all contour lines. I'm thinking the issue might be to do with Accuracy or Precision between ContourPlot and how I specify my point but I haven't found a work around. Any suggestions? $\endgroup$ – OldTomMorris Jan 30 at 10:26
  • 1
    $\begingroup$ @OldTomMorris, maybe something like l_Line :> If[RegionDisjoint[l, Disk[{1, 0}, .001]], Nothing, l] in ReplaceAll? $\endgroup$ – kglr Jan 30 at 10:40
  • $\begingroup$ The only issue being I am running Mathematica 10.3 and not 11.1! $\endgroup$ – OldTomMorris Jan 30 at 10:50
  • $\begingroup$ @OldTomMorris, have you tried increasing PlotPoints and MaxRecursion? $\endgroup$ – kglr Jan 30 at 10:55
  • $\begingroup$ Yes. PlotPoints -> 50 and MaxRecursion -> 4 give me nothing too. I also tried a variant of the RegionDisjoint using Element but that didn't sem to work either. $\endgroup$ – OldTomMorris Jan 30 at 11:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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