Contour plot doesn't look right

Question

I have an implicit function expression

F[x, y] := 
  -E^(-2 a) (-1 + (c (1 - 1/y^2))/a) 
    (-1 + (b (1 - 1/y^2))/(2 a)) + (1 + (c (1 - 1/y^2))/a) (1 + (b (1 - 1/y^2))/(2 a))

where

a = Sqrt[x^2 - (1 - 1/y^2) y^2]

b = Sqrt[x^2 - 2 y^2]

c = Sqrt[x^2 - y^2]

I plot the expression F[x, y] == 0 with ContourPlot, and I get something like this:

I need to obtain a plot like this:

If I try to plot Re[F[x,y]]==0 and the result looks like this:

But there is one more solution(branch in the left) that I don't need. How can I separate there solutions?

Answer 1

The plot is correct: the dashed line lies outside the domain of definition of the function.

Let's first clean up the syntax. Capitalized names are reserved and you ought to delay evaluation using := instead of =. It's also a good idea to make a, b, and c local:

g[x_, y_] := 
  With[{a = Sqrt[x^2 - (1 - 1/y^2) y^2], b = Sqrt[x^2 - 2 y^2], c = Sqrt[x^2 - y^2]}, 
  -E^(-2 a) (-1 + (c (1 - 1/y^2))/a) 
     (-1 + (b (1 - 1/y^2))/(2 a)) + (1 + (c (1 - 1/y^2))/a) (1 + (b (1 - 1/y^2))/(2 a))];

The square roots can cause a problem: when their arguments are negative, g might not have a real value, and when their arguments are zero, g can be undefined (due to zeros in the denominators). One automatic way to check is to look for all roots in the definition of g, collect them, and plot the region where they are simultaneously non-negative:

Show[
 RegionPlot[
  And @@ Union[Last[Last[Reap[g[x, y] /. Sqrt[z__] :> Sow[z >= 0]]]]] // Evaluate, 
   {x, 0, 5}, {y, 0, 1}],
 ContourPlot[g[x, y] == 0, {x, 0, 5}, {y, 0, 1}, ContourStyle -> Thick]
 ]

With a similar technique--use Together // Denominator to extract just the bottom of g after expressing it as a fraction--you can verify that g[x,y] is singular along the left boundary of this region. Thus the zero contour should not include the dashed line in the question.

---

Response to the Edit

To separate the branches, you can use @Jens' solution along with the RegionFunction defined here: its negation selects the other branch. Because we will need it twice, let's compute this function once and for all:

rf[x_, y_] := 
  Evaluate[And @@ Union[Last[Last[Reap[g[x, y] /. Sqrt[w__] :> Sow[w >= 0]]]]] // FullSimplify]

Here are the two plots (with MaxRecursion increased in the second one to show more detail near the origin):

Show[ContourPlot[Re[g[x, y]] == 0, {x, -2, 2}, {y, 0, 3/4}, 
  ContourStyle -> {Thick, Darker[Blue], Dashed},  
  RegionFunction -> Function[{x, y, z}, rf[x, y]]], 
 ContourPlot[Re[g[x, y]] == 0, {x, -1, 1}, {y, 0, 3/4}, 
  ContourStyle -> {Thick, Darker[Red]},  MaxRecursion -> 5, 
  RegionFunction -> Function[{x, y, z}, ! rf[x, y]]]]

Answer 2

From the sketch in the question, one could also surmise that the goal is to take the real part of the function. In that case, after correcting the definition of F, I would get this:

With[{
  a = Sqrt[x^2 - (1 - 1/y^2) y^2], b = Sqrt[x^2 - 2 y^2], 
  c = Sqrt[x^2 - y^2]
  },

 F[x_, y_] := -E^(-2 a) (-1 + (c (1 - 1/y^2))/a)
    (-1 + (b (1 - 1/y^2))/(2 a)) + (1 + (c (1 - 1/y^2))/
       a) (1 + (b (1 - 1/y^2))/(2 a))
 ]

ContourPlot[Re[F[x, y]] == 0, {x, 0, 5}, {y, 0, 1}, PlotPoints -> 100]