Animation of a geometric transformation

Question

This code:

t = .25;
RegionPlot[TransformedRegion[Rectangle[{-1, -1}, {1, 1}], {Indexed[#1, {1}]
(1 + t ( Indexed[#1, {2}]^2 - 1)) + 2 t,Indexed[#1, {2}] (1 + t ( Indexed[#1, 
{1}]^2 - 1)) + 2 t} &], PlotRange -> {{-0.5, 1.5}, {-0.5, 1.5}}]

gives me this:

Now, when I animate this transformation:

Animate[RegionPlot[TransformedRegion[Rectangle[{-1, -1}, {1, 1}], 
{Indexed[#1, {1}] (1 + t ( Indexed[#1, {2}]^2 - 1)) + 2 t, 
Indexed[#1, {2}] (1 + t ( Indexed[#1, {1}]^2 - 1)) + 2 t} &], 
PlotRange -> {{-0.5, 1.5}, {-0.5, 1.5}}], {t, .25, .5}]

This is what I get:

I tried setting the "AnimationRunning" option for "Animate" to "False". When I do this, I get the transformation for the first value of "t", but the same thing happens when I try to get the figure by dynamically changing "t".

Any help is highly appreciated. Thanks in advance.

Answer 1

The issue at least on my machine (Linux, M10.1) is that the plots take a long time to generate and so creating a smooth animation with on-the-fly generated plots is, well, impossible. You could generate the plots beforehand, though. Here's some code to show you the progress of plot generation as well.

Assuming that you have defined a function f[t] that generates the plot:

Clear[t];
Monitor[
  (* using rationals as suggested by @Taiki *)
  (plots = Table[f[t], {t, 25/100, 50/100, 1/100}]),
  ProgressIndicator[t, {25/100, 50/100}]] // AbsoluteTiming

On my machine, it took over 2 minutes to generate them all!

Then you have to use the ListAnimate function:

ListAnimate[plots, DefaultDuration -> 2.5]

Answer 2

I guess there is some floating-point-related issue here...

This works:

f[t_] := RegionPlot[
  TransformedRegion[
    Rectangle[{-1, -1}, {1, 1}],
    {
      Indexed[#1, {1}] (1 + t (Indexed[#1, {2}]^2 - 1)) + 2 t, 
      Indexed[#1, {2}] (1 + t (Indexed[#1, {1}]^2 - 1)) + 2 t
    } &
  ], 
  PlotRange -> {{-1 + 2 t, 1 + 2 t}, {-1 + 2 t, 1 + 2 t}}
]
Animate[f[t], {t, 25/100, 50/100, 1/100}]

The animation should look similar to this:

Issue #1

The following doesn't work:

Animate[f[t], {t, 0.25, 0.50, 0.01}]

There are actually other strange issues as well.

Issue #2

The first frame that

Animate[f[t], {t, 25/100, 50/100, 1/100}]

shows is

Issue #3

The following produces a list of plots I expect (the frames of the animation above):

Table[f[t], {t, 25/100, 50/100, 1/100}]

But if I substitute the definition of f[t] for f[t], i.e.

Table[RegionPlot[...], {t, 25/100, 50/100, 1/100}]

the plots are incorrect (apart from the first one).

I'm using Mathematica 10.0.2 for Mac by the way.