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?

Improve this question
$\endgroup$
5
  • $\begingroup$ Have you tried the Exclusions->None option? $\endgroup$
    – Roman
    Commented Mar 3, 2019 at 8:55
  • $\begingroup$ Thanks, @Roman. This does not work, unfortunately. $\endgroup$
    – H. Kenan
    Commented Mar 3, 2019 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
    Commented Mar 3, 2019 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
    Commented Mar 3, 2019 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
    Commented Mar 3, 2019 at 23:46

0

Reset to default

Your Answer

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

Browse other questions tagged or ask your own question.