Failure to plot a subset of curves using ParametricPlot

Question

I wish to plot a parametric curve with parameters Γ,Δ,ϵ such that

Γ^4 Δ^2 + 16 (Δ^2 + ϵ^2)^3 + Γ^2 (8 Δ^4 - 20 Δ^2 ϵ^2 - ϵ^4) = 0

My attempt is of the following: I intend to plot a series of parametric curves with ϵ on the x-axis and Δ on the y-axis. So, my parameterization is such that x = ϵ and y = Δ with Γ = 0.1. As such, I will need to solve the equation above for Δ in terms of ϵ (Γ = 0.1). Reordering the equation above and grouping terms of Δ, we have that:

16 Δ^6 - Γ^2 ϵ^4 + 16 ϵ^6 + Δ^4 (8 Γ^2 + 48 ϵ^2) + Δ^2 (Γ^4 - 20 Γ^2 ϵ^2 + 48 ϵ^4) = 0

Where Δ is a polynomial of order 6. Defining the polynomial as

poly = 16 Δ^6 - Γ^2 ϵ^4 + 16 ϵ^6 + Δ^4 (8 Γ^2 + 48 ϵ^2) + Δ^2 (Γ^4 - 20 Γ^2 ϵ^2 + 48 ϵ^4)

and doing

Solve[poly == 0, Δ]

returns six solutions of Δ (I will not list the solutions here since it is really long but it can be checked in Mathematica). Three of which the solutions are simply the negative of the other Three. Without loss of generality, I name my solutions Δ1p, Δ2p, Δ3p where the p denotes the positive solutions and Δ1n, Δ2n, Δ3n denoting the negative solutions of the respective positive ones.

I proceed to do my parametric plot for all (six) solutions going from ϵ = 0 to ϵ = 0.05:

ParametricPlot[{{ϵ, Δ1p}, {ϵ, Δ1n}, {ϵ, Δ2p}, {ϵ, Δ2n}, {ϵ, Δ3p}, {ϵ, Δ3n}}, {ϵ, 0, 0.05}, PlotRange -> All, PlotPoints -> 10^4, Exclusions -> None]

and I was returned a plot like so

The problem here is that the green and red curves do not connect (they were predicted to be). Moreover, since there are 6 curves, there should be 6 curves of different color. But there are only 4 separate colors in this instance. I investigated further and decided to plot the 3rd solution (Δ3p):

ParametricPlot[{{ϵ, Δ3p}}, {ϵ, 0, 0.05}, PlotRange -> All, PlotPoints -> 10^4, Exclusions -> None]

and was returned with a blank graph (and so by symmetry, plotting for Δ3n also returns a blank graph. This explains the missing two colors). Why is this happening?, what is special about Δ3p?

Answer 1

Use exact numbers for Γ and add the option WorkingPrecision -> 20 to ParametricPlot:

Γ = 1/10;
exp = Γ^4 Δ^2 +  16 (Δ^2 + ϵ^2)^3 + Γ^2 (8 Δ^4 -     20 Δ^2 ϵ^2 - ϵ^4);
{Δ1p, Δ2p, Δ3p, Δ1n, Δ2n, Δ3n} =  Δ /. Solve[exp == 0, Δ];
ParametricPlot[{{ϵ, Δ1p}, {ϵ,  Δ1n}, {ϵ, Δ2p}, {ϵ, Δ2n}, {ϵ, Δ3p}, {ϵ,     Δ3n}}, 
  {ϵ, 0, 0.05}, PlotRange -> All, PlotLegends -> "Expressions",
  PlotPoints -> 100, Exclusions -> None, WorkingPrecision -> 20]

Since the last four solutions have complex elements

FreeQ[_Complex] /@ {Δ1p, Δ2p,  Δ3p, Δ1n, Δ2n,  Δ3n}

{True, True, False, False, False, False}

you can plot the real parts:

ParametricPlot[Evaluate[{{ϵ, Re@Δ1p}, {ϵ,  Re@Δ1n}, {ϵ, Re@Δ2p}, {ϵ, Re@Δ2n}, 
 {ϵ, Re@Δ3p}, {ϵ, Re@Δ3n}}], {ϵ, 0, 0.05}, PlotRange -> All, 
 PlotPoints -> 100, Exclusions -> None, WorkingPrecision -> 20, 
 PlotLegends -> {"{ϵ, Re@Δ1p}", "{ϵ, Re@Δ1n}", "{ϵ, Re@Δ2p}", 
   "{ϵ, Re@Δ2n}", "{ϵ, Re@Δ3p}", "{ϵ, Re@Δ3n}"} ] 

or the imaginary parts (replacing Re with Im above):