0
$\begingroup$

I have the following code leading to a broken plot. However, I physical intuition (based on the problem I am dealing with) says that there should be a continuous curve.

    A[ϕ_, Ω_, γ_] = √(1 - 
    2 Ω Cos[ϕ] + Ω^2 - \
γ^2);(*= √(|1-Ω Exp[I \
ϕ](|^2)-γ^2)=√(J^2-γ^2). If J>γ \
system is PT symmetric, otherwise its not.*)
alpha[ϕ_, Ω_, γ_, t_] = 
 Cos[A[ϕ, Ω, γ]* t] - γ/
   A[ϕ, Ω, γ] Sin[
    A[ϕ, Ω, γ] *t]; 
beta[ϕ_, Ω_, γ_, t_] = -I (
   1 - Ω* Exp[-I ϕ])/
   A[ϕ, Ω, γ] Sin[
    A[ϕ, Ω, γ]* t];

rho[ϕ_, Ω_, γ_, 
   t_] = (1/(
    Abs[alpha[ϕ, Ω, γ, t]]^2 + 
     Abs[beta[ϕ, Ω, γ, t]]^2) ) {{Abs[
      alpha[ϕ, Ω, γ, t]]^2, 
     alpha[ϕ, Ω, γ, t]*
      Conjugate[
       beta[ϕ, Ω, γ, 
        t]]}, {beta[ϕ, Ω, γ, t]*
      Conjugate[alpha[ϕ, Ω, γ, t]], 
     Abs[beta[ϕ, Ω, γ, t]]^2}};
p[ϕ_, Ω_, γ_, t_] = 
  rho[ϕ, Ω, γ, t][[2]][[2]];
x[ϕ_, Ω_, γ_, t_] = 
  rho[ϕ, Ω, γ, t][[1]][[2]];

myfun[ϕ_, Ω_, γ_, 
   t_] = -(((-1 + 
          p[ϕ, Ω, γ, 
           t]) ((-1 + 
             p[ϕ, Ω, γ, 
              t]) p[ϕ, Ω, γ, t] + 
          Abs[x[ϕ, Ω, γ, t]]^2) Log[((-1 + 
            p[ϕ, Ω, γ, 
             t]) ((-1 + 
               p[ϕ, Ω, γ, 
                t]) p[ϕ, Ω, γ, t] + 
            Abs[x[ϕ, Ω, γ, t]]^2))/(
         2 ((-1 + p[ϕ, Ω, γ, t])^2 + 
            2 Abs[x[ϕ, Ω, γ, 
               t]]^2))])/(((-1 + 
            p[ϕ, Ω, γ, t])^2 + 
          2 Abs[x[ϕ, Ω, γ, t]]^2) Log[
         2])) - 1/
    Log[2] (-1 + 
      Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
       2 Abs[x[ϕ, Ω, γ, t]]^2]) Log[
     1/2 (1 - 
        Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
         2 Abs[x[ϕ, Ω, γ, t]]^2])] + 
   1/Log[2] (1 + 
      Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
       2 Abs[x[ϕ, Ω, γ, t]]^2]) Log[
     1/2 (1 + 
        Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
         2 Abs[x[ϕ, Ω, γ, t]]^2])] - ((1 - 
        5 p[ϕ, Ω, γ, t] + 
        10 p[ϕ, Ω, γ, t]^2 - 
        10 p[ϕ, Ω, γ, t]^3 + 
        5 p[ϕ, Ω, γ, t]^4 - 
        p[ϕ, Ω, γ, t]^5 + 
        5 Abs[x[ϕ, Ω, γ, t]]^2 - 
        13 p[ϕ, Ω, γ, t] Abs[
          x[ϕ, Ω, γ, t]]^2 + 
        11 p[ϕ, Ω, γ, t]^2 Abs[
          x[ϕ, Ω, γ, t]]^2 - 
        3 p[ϕ, Ω, γ, t]^3 Abs[
          x[ϕ, Ω, γ, t]]^2 + 
        6 Abs[x[ϕ, Ω, γ, t]]^4 - 
        2 p[ϕ, Ω, γ, t] Abs[
          x[ϕ, Ω, γ, t]]^4 + 
        Sqrt[((-1 + p[ϕ, Ω, γ, t])^2 + 
          2 Abs[x[ϕ, Ω, γ, t]]^2)^5]) Log[
       1/(2 ((-1 + p[ϕ, Ω, γ, t])^2 + 
           2 Abs[x[ϕ, Ω, γ, t]]^2)^2) (1 - 
          5 p[ϕ, Ω, γ, t] + 
          10 p[ϕ, Ω, γ, t]^2 - 
          10 p[ϕ, Ω, γ, t]^3 + 
          5 p[ϕ, Ω, γ, t]^4 - 
          p[ϕ, Ω, γ, t]^5 + 
          5 Abs[x[ϕ, Ω, γ, t]]^2 - 
          13 p[ϕ, Ω, γ, t] Abs[
            x[ϕ, Ω, γ, t]]^2 + 
          11 p[ϕ, Ω, γ, t]^2 Abs[
            x[ϕ, Ω, γ, t]]^2 - 
          3 p[ϕ, Ω, γ, t]^3 Abs[
            x[ϕ, Ω, γ, t]]^2 + 
          6 Abs[x[ϕ, Ω, γ, t]]^4 - 
          2 p[ϕ, Ω, γ, t] Abs[
            x[ϕ, Ω, γ, t]]^4 + 
          Sqrt[((-1 + p[ϕ, Ω, γ, t])^2 + 
            2 Abs[x[ϕ, Ω, γ, 
               t]]^2)^5])])/(2 ((-1 + 
          p[ϕ, Ω, γ, t])^2 + 
        2 Abs[x[ϕ, Ω, γ, t]]^2)^2 Log[
       2]) + ((-1 + 5 p[ϕ, Ω, γ, t] - 
        10 p[ϕ, Ω, γ, t]^2 + 
        10 p[ϕ, Ω, γ, t]^3 - 
        5 p[ϕ, Ω, γ, t]^4 + 
        p[ϕ, Ω, γ, t]^5 - 
        5 Abs[x[ϕ, Ω, γ, t]]^2 + 
        13 p[ϕ, Ω, γ, t] Abs[
          x[ϕ, Ω, γ, t]]^2 - 
        11 p[ϕ, Ω, γ, t]^2 Abs[
          x[ϕ, Ω, γ, t]]^2 + 
        3 p[ϕ, Ω, γ, t]^3 Abs[
          x[ϕ, Ω, γ, t]]^2 - 
        6 Abs[x[ϕ, Ω, γ, t]]^4 + 
        2 p[ϕ, Ω, γ, t] Abs[
          x[ϕ, Ω, γ, t]]^4 + 
        Sqrt[((-1 + p[ϕ, Ω, γ, t])^2 + 
          2 Abs[x[ϕ, Ω, γ, t]]^2)^5]) Log[-(
         1/(2 ((-1 + p[ϕ, Ω, γ, t])^2 + 
            2 Abs[x[ϕ, Ω, γ, 
               t]]^2)^2)) (-1 + 
          5 p[ϕ, Ω, γ, t] - 
          10 p[ϕ, Ω, γ, t]^2 + 
          10 p[ϕ, Ω, γ, t]^3 - 
          5 p[ϕ, Ω, γ, t]^4 + 
          p[ϕ, Ω, γ, t]^5 - 
          5 Abs[x[ϕ, Ω, γ, t]]^2 + 
          13 p[ϕ, Ω, γ, t] Abs[
            x[ϕ, Ω, γ, t]]^2 - 
          11 p[ϕ, Ω, γ, t]^2 Abs[
            x[ϕ, Ω, γ, t]]^2 + 
          3 p[ϕ, Ω, γ, t]^3 Abs[
            x[ϕ, Ω, γ, t]]^2 - 
          6 Abs[x[ϕ, Ω, γ, t]]^4 + 
          2 p[ϕ, Ω, γ, t] Abs[
            x[ϕ, Ω, γ, t]]^4 + 
          Sqrt[((-1 + p[ϕ, Ω, γ, t])^2 + 
            2 Abs[x[ϕ, Ω, γ, 
               t]]^2)^5])])/(2 ((-1 + 
          p[ϕ, Ω, γ, t])^2 + 
        2 Abs[x[ϕ, Ω, γ, t]]^2)^2 Log[2]) + 
   1/Log[4] (-4 ArcTanh[
        Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
         2 Abs[x[ϕ, Ω, γ, t]]^2]] Sqrt[(-1 +
           p[ϕ, Ω, γ, t])^2 + 
        2 Abs[x[ϕ, Ω, γ, t]]^2] + 
      2 ArcTanh[
        Sqrt[(1 - 2 p[ϕ, Ω, γ, t])^2 + 
         4 Abs[x[ϕ, Ω, γ, t]]^2]] Sqrt[(1 - 
          2 p[ϕ, Ω, γ, t])^2 + 
        4 Abs[x[ϕ, Ω, γ, t]]^2] + Log[4] - 
      2 Log[1 - 
         Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
          2 Abs[x[ϕ, Ω, γ, t]]^2]] - 
      2 Log[1 + 
         Sqrt[(-1 + p[ϕ, Ω, γ, t])^2 + 
          2 Abs[x[ϕ, Ω, γ, t]]^2]] + 
      Log[1 - Sqrt[(1 - 
           2 p[ϕ, Ω, γ, t])^2 + 
         4 Abs[x[ϕ, Ω, γ, t]]^2]] + 
      Log[1 + Sqrt[(1 - 
           2 p[ϕ, Ω, γ, t])^2 + 
         4 Abs[x[ϕ, Ω, γ, t]]^2]]) ;

Plot[{Re[myfun[0, 0.4, 0.5, t]]}, {t, 0, 10}, 
 PlotRange -> All, PlotStyle -> {Blue, Thick}, AxesOrigin -> {0, 0}]

How can one resolve the issue?

$\endgroup$
5
  • $\begingroup$ Have you tried the Exclusions->None option? $\endgroup$ – Roman Mar 3 '19 at 8:55
  • $\begingroup$ Thanks, @Roman. This does not work, unfortunately. $\endgroup$ – H. Kenan Mar 3 '19 at 9:09
  • 3
    $\begingroup$ It looks like your function is actually Indeterminate for all values of t, I suspect because of a 0/0 division. The reason why you get at least some points plotted is because of numerical luck. Maybe simplifying your formula for myfun could help: use Simplify, FullSimplify, etc. $\endgroup$ – Roman Mar 3 '19 at 9:32
  • $\begingroup$ You've got a Log[0.] or two, plus some ArcTanh[1.], all of which evaluate to Indeterminate. Maybe these are suppose to cancel out, but they're too complicated for even Mathematica to figure it out. Try Trace[ myfun[0, 0.4, 0.5, 1], _Log ] $\endgroup$ – Michael E2 Mar 3 '19 at 23:20
  • $\begingroup$ In particular, you have a term that you take the ArcTanh of that appears to always be Sqrt[(1 - 2 pp)^2 + 4 xx^2] = 1. This accounts for most of the Indeterminate results (but not all) and is in the end of your function. $\endgroup$ – MikeY Mar 3 '19 at 23:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.