Obtaining the boundary line of a RegionPlot

Question

I have the following code

Clear[Rg3, SetRg3, Ig3, SetIg3, κ1, Setκ1, Γ, SetΓ, κ2, Setκ2, g1, Setg1, g2, Setg2, r1]
Setκ1 = 1; SetΓ = 0.01; Setκ2 = 20;
r1 = RegionPlot[SetRg3 = 0; SetIg3 = 0; 
NMG3 = {{-Γ/
  2, -I*g1, -I*Rg3 + Ig3}, {-I*g1, -κ1/
  2, -I*g2}, {-I*Rg3 - Ig3, - I*g2, -κ2/2}} /. {Rg3 -> 
  SetRg3, Ig3 -> SetIg3, κ1 -> 
  Setκ1, Γ -> 
  SetΓ, κ2 -> Setκ2, g1 -> Setg1, 
 g2 -> Setg2};
EigensysNMG3 = Eigensystem[NMG3, Cubics -> True]; {Chop[Min[{((Abs[
       Normalize[
         EigensysNMG3[[2]][[1]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}]), ((Abs[
       Normalize[
         EigensysNMG3[[2]][[2]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}]), ((Abs[

       Normalize[
         EigensysNMG3[[2]][[3]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}])}] >= 
 RankedMax[{((Abs[
        Normalize[
          EigensysNMG3[[2]][[1]]] /. {κ1 -> 
           Setκ1, Γ -> 
           SetΓ, κ2 -> Setκ2, 
          g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[
    1]], ((Abs[
        Normalize[
          EigensysNMG3[[2]][[2]]] /. {κ1 -> 
           Setκ1, Γ -> 
           SetΓ, κ2 -> Setκ2, 
          g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[
    1]], ((Abs[
        Normalize[
          EigensysNMG3[[2]][[3]]] /. {κ1 -> 
           Setκ1, Γ -> 
           SetΓ, κ2 -> Setκ2, 
          g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[1]]}, 
  2]]}, {Setg1, 0.01, 10}, {Setg2, 0.01, 12}, PlotRange -> Full, PlotLegends -> Automatic, PlotPoints -> Automatic, PlotStyle -> Directive[Red, Opacity[0.35]], PlotRangePadding -> None, BoundaryStyle -> {Black, Thick}]

which generates the following region plot

My goal is to only plot the line bounding the red and white region. How should I go about going that? I tried using ContourPlot and threw in the following in addition to the code above:

ContourPlot[{Chop[Min[{((Abs[
      Normalize[
        EigensysNMG3[[2]][[1]]] /. {κ1 -> 
         Setκ1, Γ -> 
         SetΓ, κ2 -> Setκ2, 
        g3 -> Setg3}]).Transpose[{{1, 0, 0}}]), ((Abs[
      Normalize[
        EigensysNMG3[[2]][[2]]] /. {κ1 -> 
         Setκ1, Γ -> 
         SetΓ, κ2 -> Setκ2, 
        g3 -> Setg3}]).Transpose[{{1, 0, 0}}]), ((Abs[
      Normalize[
        EigensysNMG3[[2]][[3]]] /. {κ1 -> 
         Setκ1, Γ -> 
         SetΓ, κ2 -> Setκ2, 
        g3 -> Setg3}]).Transpose[{{1, 0, 0}}])}] == 
RankedMax[{((Abs[
       Normalize[
         EigensysNMG3[[2]][[1]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[1]], ((Abs[
       Normalize[
         EigensysNMG3[[2]][[2]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[1]], ((Abs[

       Normalize[
         EigensysNMG3[[2]][[3]]] /. {κ1 -> 
          Setκ1, Γ -> 
          SetΓ, κ2 -> Setκ2, 
         g3 -> Setg3}]).Transpose[{{1, 0, 0}}])[[1]]}, 
 2]]}, {Setg1, 0.01, 10}, {Setg2, 0.01, 12}, PlotPoints -> Automatic]

but I was returned with a white blank plot. The inequality for the RegionPlot was a >= and I tried doing the ContourPlot for =. Appreciate any constructive help that I can take. Thanks for reading.

Answer 1

Your code contains a lot of duplication and odd usage. I want to propose a complete rewrite that, incidentally, executes FAR faster than your code:

ClearAll["Global`*"]

Setκ1 = 1;
SetΓ = 1/100;
Setκ2 = 20;
SetRg3 = 0;
SetIg3 = 0;
NMG3 = {
         {-Γ/2, -I*g1, -I*Rg3 + Ig3},
         {-I*g1, -κ1/2, -I*g2},
         {-I*Rg3 - Ig3, -I*g2, -κ2/2}
       } /. {Rg3 -> SetRg3, Ig3 -> SetIg3, 
              κ1 -> Setκ1,    Γ -> SetΓ,
              κ2 -> Setκ2,   g1 -> Setg1, g2 -> Setg2};

ClearAll[components]
components[Setg1_, Setg2_] :=
 Sort[
   (Abs@Eigenvectors[NMG3 /. {κ1 -> Setκ1, Γ -> SetΓ, κ2 -> Setκ2, g3 -> Setg3}])[[All, 1]]
 ][[;; 2]]


RegionPlot[
  GreaterEqual @@ components[Setg1, Setg2],
  {Setg1, 0, 10}, {Setg2, 0, 12},
  PlotStyle -> None,
  PlotRangePadding -> None, BoundaryStyle -> Directive[Thick, Black]
]

A summary of changes:

• You do not use the eigenvalues, so you can just calculate the Eigenvectors directly.
• Eigenvectors of a numerical matrix are returned normalized, so you do not need to normalize them if you calculate them only after substituting numerical values.
• Using list.Transpose[{{1, 0, 0}}] is the same as taking the first element of that list (i.e. list[[1]]) , just much harder to read.
• If you do things repeatedly, try to write them only once and vectorize; this is also good to reduce the possibility of errors when you have to modify your code.
• your Min, RankedMax calculate the second and third elements of the list returned by Sort, so it is easier to Sort, then select the elements you want.

Finally, the unresolved issue: you will notice that the region you originally had in red turns out to be where the two expressions you are comparing are actually equal. It is difficult to pick out only the "bottom" one of those boundaries, because they are all defined by equality.