Discussion between Junaid Aftab and Young

Stack Exchange

16:35

1

ClearAll["Global`*"] G = 0.01; β = 1; ωc = 50; j = 1; ϕ = 0; θ = π/2; integralgamma[ω_, τ_] := 4 G ω Exp[-ω/ωc] ((1 - Cos[ω τ])/ω^(2)) Coth[β ω/2] integraldelta[ω_, τ_] := 4 G ω Exp[-ω/ωc] (Sin[ω τ] - ω τ)/ω^2 δ[τ_] := NIntegrate[integraldelta[ω, τ], {ω, 0, 70000}] γ[τ_] := NIntegrate[int...

Junaid Aftab

Please check my last comment in the comments above.

Your code gives me the error Set::write: Tag Times in f \[Tau]_ is Protected. >>. What could it mean?

Young

@JunaidAftab You need to clear your variables or restart the kernel

Junaid Aftab

Yep, figured it out. Yeah, I'll upvote and accept it. Do the same if you think the question was worth the hassle. Thanks.

Young

@JunaidAftab Done, thanks!

Junaid Aftab

As an option? Plot[..., {PlotPoints->100}]?

By the way, I'm still getting an empty plot using your code. You define additional functions for gamma and tau and don't run nested commands? What could be the issue?

After I run the code, I get an empty plot. No error but the graph shows nothing. What could be the issue?

Young

16:35

@JunaidAftab recopy the answer

Junaid Aftab

I get the most bizarre graph. Probably, I am doing something wrong. I'm taking this to chat.

Code:

ClearAll["Global*"]`

`G = 0.01;
\[Beta] = 1;
\[Omega]c = 50;
J = 1;
\[Phi] = 0;
\[Theta] = \[Pi]/2;
\[Eta] = Exp[I \[Phi]]*Tan[\[Theta]/2];`

`integralgamma[\[Omega]_, \[Tau]_] :=
4 G \[Omega] Exp[-\[Omega]/\[Omega]c] ((1 -
Cos[\[Omega] \[Tau]])/\[Omega]^(2)) Coth[\[Beta] \[Omega]/2];`

Next.

`integraldelta[\[Omega]_, \[Tau]_] :=
4 G \[Omega] Exp[-\[Omega]/\[Omega]c] (Sin[\[Omega] \[Tau]] - \
\[Omega] \[Tau])/\[Omega]^2;`

\[Delta][\[Tau]_] :=
NIntegrate[integraldelta[\[Omega], \[Tau]], {\[Omega], 0, 70000}];
\[Gamma][\[Tau]_] :=
NIntegrate[integraldelta[\[Omega], \[Tau]], {\[Omega], 0, 70000}];

Next.

f[\[Tau]_] := - (1/\[Tau])
Log [(Abs[\[Eta]]/(1 + Abs[\[Eta]]^2) )^(4 J) *
Sum[Binomial[2 J, J + m] * Binomial[2 J, J + p] *
Abs[\[Eta]]^(2 m + 2 p) *
Exp[- \[Gamma][\[Tau]] * (m - p)^2 ] *
Exp[- I * \[Delta][\[Tau]] * (m^2 - p^2)] , {m, -1, 1,
1}, {p, -1, 1, 1}]];

Plot[f[[Tau]], {[Tau], 0, 2}, PlotPoints -> 100]

Lol?

Young

you didn't recopy the whole thing

ClearAll["Global`*"]

G = 0.01;
\[Beta] = 1;
\[Omega]c = 50;
j = 1;
\[Phi] = 0;
\[Theta] = \[Pi]/2;

integralgamma[\[Omega]_, \[Tau]_] :=
4 G \[Omega] Exp[-\[Omega]/\[Omega]c] ((1 -
Cos[\[Omega] \[Tau]])/\[Omega]^(2)) Coth[\[Beta] \[Omega]/2]

integraldelta[\[Omega]_, \[Tau]_] :=
4 G \[Omega] Exp[-\[Omega]/\[Omega]c] (Sin[\[Omega] \[Tau]] - \
\[Omega] \[Tau])/\[Omega]^2

\[Delta][\[Tau]_] :=
NIntegrate[integraldelta[\[Omega], \[Tau]], {\[Omega], 0, 70000}]
\[Gamma][\[Tau]_] :=
NIntegrate[integralgamma[\[Omega], \[Tau]], {\[Omega], 0, 70000}]

Junaid Aftab

I seem to have everything. Wait, let me send pictures of my notebook.

Still missing somethigng?

Young

gamma tau calls integraldelta instead of integralgamma

Junaid Aftab

Oh.

Thanks so much for pointing the error.

Silly me.

Young

16:44

no problem ... glad to help

You could probably delete your comments on the answer ... just to clean things up ... it's up to you

Junaid Aftab

I have been running the amended code for about 12 minutes but it isn't showing the output.

Any way to speed things up?

I have make quite a few such graphs and 3D plots.

Young

oh and use Method -> "LocalAdaptive", MaxRecursion -> 15 in the NIntegrate

use PlotPoints -> 80, MaxRecursion -> 0 in Plot

takes 43.8051 seconds on my machine

Junaid Aftab

17:08

Code and graph.

Why is the peak so above now? I made two changes that you suggested above.

What's going on? -.-

I'm wary of making my own graphs now because the replication of the graphs gives this awkward result.

Young

MaxRecursion is 15 for NIntegrate and 0 for the Plot

\[Delta][\[Tau]_] :=
NIntegrate[integraldelta[\[Omega], \[Tau]], {\[Omega], 0, 70000},
Method -> "LocalAdaptive", MaxRecursion -> 15]
\[Gamma][\[Tau]_] :=
NIntegrate[integralgamma[\[Omega], \[Tau]], {\[Omega], 0, 70000},
Method -> "LocalAdaptive", MaxRecursion -> 15]

Plot[f[\[Tau]], {\[Tau], 0.01, 2.01}, PlotRange -> {0, 3},
PlotPoints -> 100, MaxRecursion -> 0]

Junaid Aftab

Works amazingly now.

Awesome.

Thanks so much.

Young

No problem

I need to go now

bye

Junaid Aftab

I'm basically learning Mathematica for the purposes I need it for, and I have no idea about these common trics: increasing computational speed etc.

Sure,

Thanks. :)

Junaid Aftab

18:03

Paper: arxiv.org/abs/1402.5228

Also, up for discussing a Mathematica problem? I don't know how to tackle a numerical problem.

Young

18:30

thanks for the link

Junaid Aftab

18:44

up for discussing a Mathematica problem? I don't know how to tackle a numerical problem.

Young

19:02

sure

you can post your question here

or on SE and I'll work on it

Junaid Aftab

19:35

Okay, so in the previous code, the function in the Log has the function of being a probability.

Call it h.

Now I have another such function, of a probability.

Call it g.

The difference is that if you see the code for h, I have specified the values of theta and phi.

For g, I won't specify any value.

I want to calculate value(s) of new angles, call them chi and alpha,

which maximize the difference g - h.

Before running an optimization problem, I want to do the following.

Make a 3D plot of g -h, chi and alpha.

But note that g - h evolves with time, tau.

So I'll have to specify a time for it.

Ideally, I think we should do the following: at each time, optimize and find the values of the new angles for the new state. Or make a graph and see the values that max the diff. The value that we choose for tau would determine the instantaneous optimal values of the new angles. Not sure if its possible to do in Mathematica.

There are an infinity of times in an interval!

Is there a way to go about it this problem rather than having to specify a SINGLE time

and then doing the analysis.

Any other computational method that comes close to what I want to do.

I'm not sure if there'd be a utility of plotting the graph at a fixed time? More so, at which fixed times? I'm tempted to plot it for times at which the two peaks take place,

Young

I'm not sure I completely follow, maybe it's best to write it out as a question for the forum

Junaid Aftab

but I'm not so sure. Still trying to physically/qualitatively reason it out.

Take it another stab. Too tired to write up a question for now. Will do in the morning. If you can contribute over here,

fell free to do so.

Or anyone else for that matter.

Transcript for

Discussion between Junaid Aftab and Y…