TransWikia.com

Most efficient way of creating and exporting animations

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

One Answer

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

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP