# 3D Plot with the Manipulate Command

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},
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},
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:

• Remove the underscores from new[...] and old[...] in your plot to start Commented Jul 21, 2016 at 19:58
• Rendering any Plot3D[] will take a long time here, Manipulate[] isn't the way to go. Commented Jul 21, 2016 at 20:09
• @J_Nat Edited. Check the code. I get a similar error. See the edited post. Commented Jul 21, 2016 at 20:14
• @Feyre Any suggestions? Commented Jul 21, 2016 at 20:14
• 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. Commented Jul 21, 2016 at 20:18 ## 3 Answers 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}] $j=2\$

• 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? Commented Jul 22, 2016 at 7:16
• 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? Commented Jul 22, 2016 at 8:27
• @JunaidAftab As you can see here, alpha does nog affect the graph. Commented Jul 22, 2016 at 9:11
• @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. :/ Commented Jul 22, 2016 at 9:24
• 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 τ. Commented Jul 22, 2016 at 9:27

One way of plotting 4d data is with:

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


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[]

• 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. Commented Jul 22, 2016 at 9:52
• @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 {χ,α,τ} Commented Jul 22, 2016 at 10:55
• 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? Commented Jul 22, 2016 at 10:59
• 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. Commented Jul 22, 2016 at 11:04
• 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? Commented Jul 22, 2016 at 11:34

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

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


Manipulate[

• 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 Commented Jul 21, 2016 at 21:38