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$
0

1 Answer 1

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$
4
  • $\begingroup$ Absolute lifesaver! Thank you :) $\endgroup$
    – Melav
    Dec 20, 2019 at 3:15
  • $\begingroup$ You are welcome! $\endgroup$
    – Alx
    Dec 20, 2019 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, 2019 at 3:24
  • $\begingroup$ Please, see my edit for plotting derivatives. $\endgroup$
    – Alx
    Dec 20, 2019 at 4:11

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.