0
$\begingroup$

After much help from this community, I finally have a way to plot the real solutions to the determinant. However, this may seem like a stupid request, I want to combine both figures that result from this code into one with a legend for each w.

k = 9.; l = 12.; m = 2.; M = 4.;
mat = {{m*w^2 - 2*k, k, k*zeta}, {k, M*w^2 - (l + k), 
l}, {-k*zeta, l, M*w^2 - (k - l)}};
mydet = ExpToTrig[Det[mat]];
sol = Solve[mydet == 0, w];
funcs = Chop[w /. sol /. {zeta -> Exp[-3I ka]} // FullSimplify];
Show[Table[Plot[Max[0, (funcs[[k]] + Conjugate[funcs[[k]]])/2], {ka, 0, \[Pi]}, PlotStyle -> Black], {k, 1, Length[funcs]}], PlotRange -> All]
Show[Table[Plot[Max[0, (funcs[[k]] - Conjugate[funcs[[k]]])/(2 I)], {ka, 
 0, \[Pi]}, PlotStyle -> Blue], {k, 1, Length[funcs]}], PlotRange -> All]

I hope someone can answer this so I can finally be done with this project.

$\endgroup$
2
$\begingroup$
re = Plot[
  Evaluate[Max[0, (funcs[[#]] + Conjugate[funcs[[#]]])/2] & /@ 
    Range[Length[funcs]]], {ka, 0, \[Pi]}, 
  PlotStyle -> (ColorData[3] /@ Range[Length[funcs]]), 
  PlotLegends -> (Row[{"Re\[ThinSpace]", 
        HoldForm@Subscript[w, #]}] & /@ Range[Length[funcs]])]

enter image description here

im = Plot[
  Evaluate[Max[0, (funcs[[#]] - Conjugate[funcs[[#]]])/(2 I)] & /@ 
    Range[Length[funcs]]], {ka, 0, \[Pi]}, 
  PlotStyle -> Thread[{Dashed, ColorData[3] /@ Range[Length[funcs]]}],
   PlotLegends -> (Row[{"Im\[ThinSpace]", 
        HoldForm@Subscript[w, #]}] & /@ Range[Length[funcs]])]

enter image description here

You can combine both, but it looks not so good for me:

Show[re, im]

enter image description here

EDIT

To answer question in comment about plotting derivatives:

Plot[Evaluate[
  Evaluate[UnitStep[Re@funcs[[#]]] Re@D[funcs[[#]], ka]/ka &] /@ 
   Range[Length[funcs]]], {ka, 0, \[Pi]}, 
 PlotStyle -> (ColorData[3] /@ Range[Length[funcs]]), Frame -> True, 
 PlotLegends -> (Row[{"Re'\[ThinSpace]", 
       HoldForm@Subscript[w, #]}] & /@ Range[Length[funcs]])]

enter image description here

and for imaginary part:

Plot[Evaluate[
  Evaluate[UnitStep[Im@funcs[[#]]] Im@D[funcs[[#]], ka]/ka &] /@ 
   Range[Length[funcs]]], {ka, 0, \[Pi]}, 
 PlotStyle -> (ColorData[3] /@ Range[Length[funcs]]), Frame -> True, 
 PlotLegends -> (Row[{"Im'\[ThinSpace]", 
       HoldForm@Subscript[w, #]}] & /@ Range[Length[funcs]])]

enter image description here

You can adjust vertical PlotRange if needed. The main idea is to plot derivatives only when corresponding function (Re or Im of funcs[[i]]) is positive, that is achieved by using UnitStep[x] function which is 0 for x < 0 and 1 for x >= 0.

$\endgroup$
  • $\begingroup$ Absolute lifesaver! Thank you :) $\endgroup$ – Melav Dec 20 '19 at 3:15
  • $\begingroup$ You are welcome! $\endgroup$ – Alx Dec 20 '19 at 3:17
  • $\begingroup$ I have to find the derivative of all the positive solutions now and unfortunately I am stuck again. Do you know how I could do that? so far I have n = Pi/ka; dkdw = D[funcs,ka]; dNdw = n/Pi * dkdw and then I need to plot them $\endgroup$ – Melav Dec 20 '19 at 3:24
  • $\begingroup$ Please, see my edit for plotting derivatives. $\endgroup$ – Alx Dec 20 '19 at 4:11

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.