1
$\begingroup$

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 enter image description here

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.

$\endgroup$
2
  • 1
    $\begingroup$ use PlotStyle -> None in RegionPlot? $\endgroup$
    – kglr
    May 24, 2020 at 0:28
  • $\begingroup$ Right. I guess tunnel visioning got to me. Thanks @kglr $\endgroup$
    – kowalski
    May 24, 2020 at 0:35

1 Answer 1

2
$\begingroup$

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]
]

plot without red background

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.

$\endgroup$
3
  • $\begingroup$ This is drastically simpler than I thought. Thanks for smoothing out the code. A follow up question: How do I only make the line in the middle black and thick without demanding that the boundary around it is also the same? $\endgroup$
    – kowalski
    May 24, 2020 at 0:36
  • 1
    $\begingroup$ @kowalski That is still a bit of an issue, because I was surprised to find that, in your original red region, the two expressions are actually equal to each other. You can check that by replacing GreaterEqual with Equal in my code above. I am not sure how you would define the bottom of that region. I did not see an immediate solution to that. You may have to pick apart the line generated by RegionPlot by post-processing. $\endgroup$
    – MarcoB
    May 24, 2020 at 0:42
  • $\begingroup$ A humble recommendation to the OP: Post the minimum representative example. Did you really need dozens of lines of code, eigenvalues, etc., etc., etc.? Of course not. You'll get more help this way, and are more likely to solve it on your own. $\endgroup$ May 24, 2020 at 1:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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