Mathematica Asked by eemg on November 29, 2020
I have been creating animations in two different ways: 1)using Animate
2)using Table
to create a list of plots at different times.
1)Let’s start with Animate
. The function I want to animate is the following
ψTimeDep[x_, r_, ϕ_, α_, t_] :=
1/Sqrt[Cosh[r]]*((m ω)/(π h))^(1/4) *
Exp[-((m ω)/(2 h))*x^2 -
Conjugate[α]/
2 (α + Conjugate[α] E^(I ϕ)*Tanh[r]) -
I*ω*t - (m ω)/h E^(I ϕ) Tanh[r]*
E^(-2*I*ω*t)*
x^2 + (α + Conjugate[α] E^(I ϕ) Tanh[r])*
E^(-I*ω*t)*Sqrt[(2 m ω)/h] x -
1/2*(E^(-I*ω*
t)*(α + Conjugate[α] E^(I ϕ) Tanh[r]) -
E^(-2*I*ω*t)*Sqrt[(2 m ω)/h] E^(I ϕ)
Tanh[r] x)^2 -
Log[1 - E^(I ϕ) Tanh[r]*E^(-2*I*ω*t)]/
2 - ((E^(I ϕ) Tanh[r]*E^(-2*I*ω*t))/(
1 - E^(I ϕ) Tanh[r]*E^(-2*I*ω*t))) *1/
2*(E^(-I*ω*
t)*(α + Conjugate[α] E^(I ϕ) Tanh[r]) -
E^(-2*I*ω*t)*Sqrt[(2 m ω)/h] E^(I ϕ)
Tanh[r] x)^2]
It is a pretty complicated function, but the thing I’m interested in plotting for now is ψTimeDep[x,-3,0,0,t]
. When I run
animation1 =
Animate[Plot[Re[ψTimeDep[x, -3, 0, 0, t]], {x, -100, 100},
PlotRange -> {-0.3, 0.3}, PlotStyle -> {Thickness[0.0042], Blue},
Axes -> {False, False},
FrameStyle -> Directive[Black, Thick], FrameTicks -> LinTicks,
FrameTicksStyle -> Directive[Thick, FontSize -> 20], Frame -> True,
PlotPoints -> 100,
PlotLegends ->
Placed[Framed[LineLegend[{Automatic}, {"r=0,α=0"}]],
ImageScaled[{0.8, 0.9}]]], {t, 0, 6, 0.01},
AnimationRate -> 0.15, AnimationRunning -> False]
it animates the plot quickly. However, the problem is that when I try to export it as a .swf file I cannot play it on my computer (I have already asked this in another forum), but more importantly Flash Player will be disabled on December 31st, 2020, so exporting to .swf file is not a good long-term solution.
2)Next, I can create a list of plots at different times using Table
, as mentioned here, and export them as a gif. Following the advice of this post I created the following code
animation3 =
Table[Plot[Re[ψTimeDep[x, -3, 0, 0, t]], {x, -100, 100},
PlotRange -> {-0.3, 0.3}, PlotStyle -> {Thickness[0.0042], Blue},
Axes -> {False, False},
Frame -> True, PlotPoints -> 100,
PlotLegends ->
Placed[Framed[LineLegend[{Automatic}, {"r=-3,α=0"}]],
ImageScaled[{0.8, 0.9}]]], {t, 0, 8, 0.1}];
This solution works, but it takes a lot of time to run this piece of code (my computer is 6 years old). I had to remove the FrameTicks
, FrameStyle
, FrameTicksStyle
options to make it run in a considerable amount of time.
I have been using option 2), but I would really like to reduce the amount of time it takes to create my animation. Does anybody know any other way I can create an animation and exporting it in the least possible amount of time?
EDIT: I set ω=1
, m=1
and h=1
Replace :=
by =
and define a new f
.
Clear["`*"];
f[x_, t_] =
1/Sqrt[Cosh[r]]*((m ω)/(π h))^(1/4)*
Exp[-((m ω)/(2 h))*x^2 -
Conjugate[α]/
2 (α + Conjugate[α] E^(I ϕ)*Tanh[r]) -
I*ω*t - (m ω)/h E^(I ϕ) Tanh[r]*
E^(-2*I*ω*t)*
x^2 + (α + Conjugate[α] E^(I ϕ) Tanh[r])*
E^(-I*ω*t)*Sqrt[(2 m ω)/h] x -
1/2*(E^(-I*ω*t)*(α +
Conjugate[α] E^(I ϕ) Tanh[r]) -
E^(-2*I*ω*t)*
Sqrt[(2 m ω)/h] E^(I ϕ) Tanh[r] x)^2 -
Log[1 - E^(I ϕ) Tanh[r]*E^(-2*I*ω*t)]/
2 - ((E^(I ϕ) Tanh[r]*E^(-2*I*ω*t))/(1 -
E^(I ϕ) Tanh[r]*E^(-2*I*ω*t)))*1/
2*(E^(-I*ω*t)*(α +
Conjugate[α] E^(I ϕ) Tanh[r]) -
E^(-2*I*ω*t)*
Sqrt[(2 m ω)/h] E^(I ϕ) Tanh[
r] x)^2] /. {r -> -3, ϕ -> 0, α -> 0, m -> 1,
h -> 1, ω -> 1} // Re
animation1 =
Animate[Plot[f[x, t], {x, -100, 100}, PlotRange -> {-0.3, 0.3},
PlotStyle -> {Thickness[0.0042], Blue}, Axes -> {False, False},
FrameStyle -> Directive[Black, Thick],
FrameTicksStyle -> Directive[Thick, FontSize -> 20], Frame -> True,
PlotPoints -> 100,
PlotLegends ->
Placed[Framed[LineLegend[{Automatic}, {"r=0,α=0"}]],
ImageScaled[{0.8, 0.9}]]], {t, 0, 6, 0.01},
AnimationRate -> 0.15, AnimationRunning -> False]
(*
animation3 =
Table[Plot[f[x,t], {x, -100, 100}, PlotRange -> {-0.3, 0.3},
PlotStyle -> {Thickness[0.0042], Blue}, Axes -> {False, False},
Frame -> True, PlotPoints -> 100,
PlotLegends ->
Placed[Framed[LineLegend[{Automatic}, {"r=-3,α=0"}]],
ImageScaled[{0.8, 0.9}]]], {t, 0, 8, 0.1}] *)
Answered by cvgmt on November 29, 2020
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP