0
$\begingroup$

I'm trying to make a 3D Plot using the Manipulate command. The code is:

ClearAll["Global`*"]

G = 0.01;
β = 1;
ωc = 50;
J = 1;
ϕ = 0;
θ = π/2;
η = Exp[I ϕ]*Tan[θ/2];

integralgamma[ω_, τ_] := 
  4 G ω Exp[-ω/ωc] ((1 - 
    Cos[ω τ])/ω^(2)) Coth[β ω/2]; 

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

ψ = Exp[I α] * Tan[χ/2];

old[τ_] :=    (Abs[η]/(1 + Abs[η]^2) )^(4 J) * 
 Sum[Binomial[2 J, J + m] * Binomial[2 J, J + p] * 
  Abs[η]^(2 m + 2 p) * 
   Exp[-NIntegrate[
    integralgamma[ω, τ], {ω, 0, 70000}, 
     Method -> "LocalAdaptive", MaxRecursion -> 15]* (m - p)^2] * 
      Exp[- I * 
       NIntegrate[
        integraldelta[ω, τ], {ω, 0, 70000}, 
         Method -> "LocalAdaptive", 
          MaxRecursion -> 15]* (m^2 - p^2)]  , {m, -1, 1, 1}, {p, -1, 
           1, 1}];

new[\[Alpha]_, \[Chi]_, \[Tau]_] := (Abs[ψ]/(1 + 
 Abs[ψ]^2) )^(2 J)*(Abs[η]/(1 + 
  Abs[η]^2) )^(2 J) * 
   Sum[Binomial[2 J, J + m] * Binomial[2 J, J + p] * 
    Abs[ψ]^(2 m + 2 p) * Abs[η]^(2 m + 2 p) * 
     Exp[-NIntegrate[
      integralgamma[ω, τ], {ω, 0, 70000}, 
       Method -> "LocalAdaptive", MaxRecursion -> 15]* (m - p)^2] * 
        Exp[- I * 
         NIntegrate[
          integraldelta[ω, τ], {ω, 0, 70000}, 
           Method -> "LocalAdaptive", 
            MaxRecursion -> 15]* (m^2 - p^2)]  , {m, -1, 1, 1}, {p, -1, 
             1, 1}];

Manipulate[
 Plot3D[Evaluate[new[\[Alpha], \[Chi], \[Tau]]] - 
  Evaluate[old[\[Tau]]], {\[Alpha], 0, 2 \[Pi]}, {\[Chi], 
   0, \[Pi]}], {\[Tau], 0, 1}]

I get the result:

enter image description here

Help, please. Thanks.

$\endgroup$
17
  • 1
    $\begingroup$ Remove the underscores from new[...] and old[...] in your plot to start $\endgroup$
    – J_Nat
    Jul 21, 2016 at 19:58
  • $\begingroup$ Rendering any Plot3D[] will take a long time here, Manipulate[] isn't the way to go. $\endgroup$
    – Feyre
    Jul 21, 2016 at 20:09
  • $\begingroup$ @J_Nat Edited. Check the code. I get a similar error. See the edited post. $\endgroup$ Jul 21, 2016 at 20:14
  • $\begingroup$ @Feyre Any suggestions? $\endgroup$ Jul 21, 2016 at 20:14
  • $\begingroup$ I got no errors, just $Aborted in place of the plot which backs up Feyre's comment that it takes too long in the current state. $\endgroup$
    – J_Nat
    Jul 21, 2016 at 20:18

3 Answers 3

2
$\begingroup$

Updated using mem: as suggested by Simon Woods.

Perhaps using Plot3D at a couple of intervals of tau will be enlightening. The results seems plausible based on the fact that old is a 1D function.

ClearAll["Global`*"]

G = 0.01;
β = 1;
ωc = 50;
j = 1;
ϕ = 0;
θ = π/2;

η = Exp[I ϕ] Tan[θ/2];

Clear[ψ]
ψ[α_, χ_] := Exp[I α]*Tan[χ/2];

integralgamma[ω_, τ_] := 4 G ω Exp[-ω/ωc] ((1 - Cos[ω τ])/ω^(2)) Coth[β ω/2] 
integraldelta[ω_, τ_] := 4 G ω Exp[-ω/ωc] (Sin[ω τ] - ω τ)/ω^2

mem :δ[τ_]:= mem=NIntegrate[integraldelta[ω, τ], {ω, 0, Infinity}, PrecisionGoal -> 3]
mem :γ[τ_]:= mem=NIntegrate[integralgamma[ω, τ], {ω, 0, Infinity}, PrecisionGoal -> 3]

old[τ_] := -(1/τ) Log[
  (Abs[η]/(1 + Abs[η]^2))^(4 j) 
   Sum[Abs[η]^(2 m + 2 p) 
   Binomial[2 j, j + m] Binomial[2 j, j + p] 
   Exp[-I δ[τ] (m^2 - p^2)] Exp[-γ[τ] (m - p)^2], 
   {m, -j, j, 1}, {p, -j, j, 1}]]

new[α_, χ_, τ_] := -(1/τ) Log[
 (Abs[ψ[α, χ]]/(1 + Abs[ψ[α, χ]]^2))^(4 j)  (Abs[η]/(1 + Abs[η]^2))^(2 j)
  Sum[Abs[η]^(2 m + 2 p) Abs[ψ[α, χ]]^(2 m + 2 p) 
  Binomial[2 j, j + m] Binomial[2 j,j + p] 
  Exp[-I δ[τ] (m^2 - p^2)] Exp[-γ[τ] (m - p)^2], 
  {m, -j, j, 1}, {p, -j, j, 1}]]

Table Plots:

Table[Plot3D[
  Re[new[α, χ, τ] - old[τ]], {α, 0, 2 π}, {χ, 0, π}, 
   PlotPoints -> 20, MaxRecursion -> 0,
   ColorFunction -> (ColorData["Rainbow"][Rescale[#3, {-2, 8}]] &),
   ColorFunctionScaling -> False, PlotRange -> {-2, 8}], {τ, 0.2, 2.0, 0.1}]

enter image description here

$j=2$

enter image description here

$\endgroup$
10
  • $\begingroup$ What about the other graphs for the other times, tau? I'm assuming this graph is for one fixed time, tau. Also, why are there two branches/surfaces in the graph. I want to calculate the difference of the two functions -- so shouldn't there be one surface? $\endgroup$ Jul 22, 2016 at 7:16
  • $\begingroup$ I ran the command with {\[Tau], 0.5, 1}. I got one graph. Shouldn't I be getting two graphs -- one that computes the difference, new - old, for \[Tau] = 0.5 and the other that does the same for \[Tau] = 1? $\endgroup$ Jul 22, 2016 at 8:27
  • $\begingroup$ @JunaidAftab As you can see here, alpha does nog affect the graph. $\endgroup$
    – Feyre
    Jul 22, 2016 at 9:11
  • $\begingroup$ @Feyre I'm not sure what's on the axes then - Cho which is till 2pi. What about the other axes? I expect the axes representing the difference to be between - 1 and 1. :/ $\endgroup$ Jul 22, 2016 at 9:24
  • $\begingroup$ You can see from the fact he is using {α, 0, 2 π}, {χ, 0, π}. The z axis is the value for the functions of two different values of τ. $\endgroup$
    – Feyre
    Jul 22, 2016 at 9:27
1
$\begingroup$

One way of plotting 4d data is with:

DensityPlot3D[
 Re[new[α, χ, τ] - old[τ]], {χ, 
  0, π}, {α, 0, 2 π}, {τ, 0.1, 1}, 
 PlotPoints -> 11]

enter image description here

To do this with manipulate, it is wise to do all the calculations first, and storing the values in a dataset.

data = Table[
   Table[{α, χ, 
     Re[new[α, χ, τ] - old[τ]]}, {χ, π/
      16, π, π/8}, {α, 0, 2 π, π/4}], {τ, 
    0.1, 1, 0.1}];

This creates a file for values and coordinates α, χ. Note, this takes a while to create.

Manipulate[
 ListPlot3D[Flatten[data[[τ, All, All, All]], 1]], {τ, 1, 
  Length[data[[All, 1, 1, 1]]], 1}]

This plots the data where you can change τ like you requested as a Manipulate[]

enter image description here

$\endgroup$
8
  • $\begingroup$ Can you please share the interpretation of this graph? I'm looking at it for the first time. I can identify which axis is which -- and the difference between new and old is between 0 and 1 so that's good. $\endgroup$ Jul 22, 2016 at 9:52
  • $\begingroup$ @JunaidAftab This is a Densityplot, that means every point in the space here has a value, this is the value of the function new[α, χ, τ] - old[τ] at the triplet {χ,α,τ} $\endgroup$
    – Feyre
    Jul 22, 2016 at 10:55
  • $\begingroup$ So the axes represent chi and alpha. At each point, what is the value of tau? I don't get it. Also, at each triplet, how do I interpret the value of new - old? What do the different colours in the plot represent? $\endgroup$ Jul 22, 2016 at 10:59
  • $\begingroup$ In this case τ is the vertical-axis. You can add , PlotLegends -> Automatic to show a numerical value for the various colours. I can think of one way to actually plot this in the original way you intended, I'll add it soon. $\endgroup$
    – Feyre
    Jul 22, 2016 at 11:04
  • $\begingroup$ So the horizontal axes represent chi and alpha and the veto ticks axis represents tau. My question still is: 1) how is tau modelled in the graph? Is tau discrete or does it take a continuum of values between 0 and 1? 2) how do I interpret the value of new - old at each triplet -- what do the colours represent? $\endgroup$ Jul 22, 2016 at 11:34
0
$\begingroup$

The command given before editing the question and before my answer was:

Manipulate[
 Plot3D[new[α_, χ_, τ_] - old[τ_], {α, 0, 2 π}, {χ, 0, π}], {τ, 0, 1}]

My answer is:

Manipulate[
 Plot3D[Evaluate[new[τ, α, χ]] - Evaluate[old[τ]], {α, 0, 2 π}, {χ,0, π}], {τ, 0, 2}]

enter image description here

$\endgroup$
16
  • $\begingroup$ Edited. Check the code. I get a similar error. See the edited post. $\endgroup$ Jul 21, 2016 at 20:14
  • $\begingroup$ What is w? I haven't defined it. $\endgroup$ Jul 21, 2016 at 20:35
  • $\begingroup$ Why are you taking omega to be between 0 and 70? I am already numerically integrating over it and it is no longer a variable that appears in my function in the Plot command. $\endgroup$ Jul 21, 2016 at 20:38
  • $\begingroup$ I do the calculation with [Omega] from 0 to 70 just for getting lower time of calculation. In your code is from 0 to 70000 $\endgroup$
    – Kamel
    Jul 21, 2016 at 20:38
  • 1
    $\begingroup$ You can format inline code and code blocks by selecting the code and clicking the {} button above the edit window. The edit window help button ? is also useful for learning how to format your questions and answers. You may also find this meta Q&A helpful $\endgroup$
    – Michael E2
    Jul 21, 2016 at 21:38

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.