Message Boards Message Boards

Remove strange line in animation

Posted 9 years ago

Hello, I am trying to run some animation from intothecontinuum-blog, and in 2 animations I got a little problem, this here for example:

SquareLattice[t_] := 
Graphics[{Table[
Rectangle[{i + t, j + t}], {i, -2, 42, 2}, {j, -2, 42, 2}], 
Table[Rectangle[{i + 1 + t, j + 1 + t}], {i, -2, 42, 2}, {j, -2, 
 42, 2}]}, PlotRange -> {{0, 40}, {0, 40}}, ImageSize -> 500]

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}

ListAnimate[
Table[ImageTransformation[SquareLattice[t], f[#[[1]], #[[2]]] &, 
DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 0, .9, .1}]]

The gif in the blog seems to be fine, but if I evaluate the code, I got a thin line on the left (I try to attach a picture). This phenomen I already have recognized in another animation....but why is it there? Whatever I try, I am not able to get it away...does anyone have a little hint for me how to remove it?

Many thanks already! enter image description here

POSTED BY: Michael Steffen
13 Replies

Solved, thats it, you're awesome! Tried around without 'rasterize' and some resampling-options, but it only seems to work with 'Nearestleft' - but with bad quality. But when I do it with 'Rasterize', I am able to set better resamplng-options, too - without that annoying line! Very good, now I can do further experiments :)

POSTED BY: Michael Steffen

I am using 10 (or 10.1?) - the latest available for the Raspberry.

Minutes ago I've tried the next one from that blog,

VHStripes[t_] := 
 Graphics[{Thickness[.01], 
   Line[Table[{{j + t, 22 + t}, {j + t, -2 + t}}, {j, -2, 22, 1}]], 
   Line[Table[{{22 + t, i + t}, {-2 + t, i + t}}, {i, -2, 22, 1}]]}, 
  PlotRange -> {{-.5, 20.5}, {-.5, 20.5}}, ImageSize -> 500]

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}

ListAnimate[
 Table[ImageTransformation[VHStripes[t], f[#[[1]], #[[2]]] &, 
   DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 0, .9, .3}]]

(with the same result) where

 f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}

seems to be neccessary - so I assume the general problem could only be in the

DataRange -> {{-Pi, Pi}, {-Pi, Pi}}

or am I missing something?

The really strange thing for me is, that these 2 anims running fine in the blog and in the .cdf-file.....some other animations on the same blog have that problem visible, too - but not these 2 ones. Have the creators faked them? (Edit: And one example in Alexey Popkov's link some postings higher resulting in the same problem here)

Strange stuff for a non-mathematician..........

However, I'll try one of the other way shown. But it would be great if someone could explain this problem a bit more....I did not proof it, but I do not think that the guy who made these anims posted the answer in the link above, too. And 2 people posting something, which presumably worked for them - but not here?

POSTED BY: Michael Steffen

It is because it does resampling close to the x-line where there is a jump in the plane. Using ImageTransformations it will subsample and average and all kinds of things, to avoid this, you could set:

VHStripes[t_]:=Graphics[Style[{Thickness[.01],Line[Table[{{j+t,22+t},{j+t,-2+t}},{j,-2,22,1}]],Line[Table[{{22+t,i+t},{-2+t,i+t}},{i,-2,22,1}]]},Antialiasing->False],PlotRange->{{-.5,20.5},{-.5,20.5}},ImageSize->500]

f[x_,y_]:={Log[Sqrt[(x)^2+(y)^2]],ArcTan[x,y]}

ListAnimate[Table[ImageTransformation[Rasterize[VHStripes[t],"Image"],f[#[[1]],#[[2]]]&,DataRange->{{-Pi,Pi},{-Pi,Pi}},Resampling->"NearestLeft"],{t,0,.9,.3}]]

which works for me.

POSTED BY: Sander Huisman

This

ClearAll[DashedCircle]
DashedCircle[rs:{ri_,ro_},n_Integer,\[Theta]_:0]:=Annulus[{0,0},rs,#+\[Theta]]&/@Partition[Subdivide[0,2\[Pi],2n],2]
L={0.1,100,40};
M=20;
\[Lambda]=PowerRange[#1,#2,(#2/#1)^(1/#3)]&@@L;
\[Lambda]=Partition[\[Lambda],2,1];
Graphics[MapThread[DashedCircle[#1,M,#2 \[Pi]/M]&,{\[Lambda],Mod[Range[Length[\[Lambda]]],2,0]}]]

result in lots of "Subdivide is not a Graphics primitive or directive"-errors here...

Regarding my first post

SquareLattice[t_] := 
Graphics[{Table[
Rectangle[{i + t, j + t}], {i, -2, 42, 2}, {j, -2, 42, 2}], 
Table[Rectangle[{i + 1 + t, j + 1 + t}], {i, -2, 42, 2}, {j, -2, 
 42, 2}]}, PlotRange -> {{0, 40}, {0, 40}}, ImageSize -> 500]

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}

ListAnimate[
Table[ImageTransformation[SquareLattice[t], f[#[[1]], #[[2]]] &, 
DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 0, .9, .1}]]

and

Why does that line exist?

Look at the Plot of ArcTan[x, y], which defines how the y coordinate is obtained:

Plot3D[ArcTan[x, y], {x, -Pi, Pi}, {y, -Pi, Pi}] There is a discontinuity where that line exists in your image. I imagine it has some numerical difficultly there.

I found out, that

Plot3D[ArcTan[x, y], {x, -Pi, Pi}, {y, -Pi, Pi}]

seems not to be part of the correct code.

What I've not found is a solution...the ready animation included in the .CDF-file available there (Link) seems to be fine - but if I evaluate it in Mathematica by myself, I'll get that line......

POSTED BY: Michael Steffen

Regarding the error; what version of Mathematica do you have? This needs 10.2 or higher for the Annulus command.

POSTED BY: Sander Huisman

Many thanks, I'll play around with it when the other animation I am waiting for is ready...and post it here when I have had success, and how (but I think this will take a few days cause the actual one stopped today as a reason of insufficent memory...started it again with a change some hours ago...Raspberry isn't the fastest :) )

POSTED BY: Michael Steffen

Perhaps set $HistoryLength = 2 so it doesn't save all the intermediate steps. In Mathematica the default is infinity. So it saves all the output, which you can access by Out[1], Out[2]... or %, %%, %%% et cetera.

POSTED BY: Sander Huisman

Thanks, but does it make a difference if I only load a small codesnippet and evaluate it? Does it affect evaluation anyhow? Look like it is only relevant for the notebook to me / useless for me in view of memoryusage in an evaluation.

POSTED BY: Michael Steffen

Unless you use %, %%, %%% or Out[...] a lot, it has no difference, it just only saves the last n outputs instead of everything!

POSTED BY: Sander Huisman

I think the real answer here is to do it differently, to avoid this. Why not make Parts of annuluses yourself? I spent a few minutes to get this:

ClearAll[DashedCircle]
DashedCircle[rs:{ri_,ro_},n_Integer,\[Theta]_:0]:=Annulus[{0,0},rs,#+\[Theta]]&/@Partition[Subdivide[0,2\[Pi],2n],2]
L={0.1,100,40};
M=20;
\[Lambda]=PowerRange[#1,#2,(#2/#1)^(1/#3)]&@@L;
\[Lambda]=Partition[\[Lambda],2,1];
Graphics[MapThread[DashedCircle[#1,M,#2 \[Pi]/M]&,{\[Lambda],Mod[Range[Length[\[Lambda]]],2,0]}]]

Giving:

enter image description here

Adding the motion should not be too hard, I will leave that as an exercise... Perhaps you could just set the PlotRange slightly different each time to zoom in...

POSTED BY: Sander Huisman
Posted 9 years ago

Related Mathematica.SE thread: "How can this type of optical illusion be created in Mathematica?"

This thread contains some other methods allowing creation of such figures.

POSTED BY: Alexey Popkov

Very interesting, many thanks....but if I try

     tile := Module[{KeyHole}, 
     KeyHole[base_] := 
      Sequence[Disk[{0, 1/3} + base, 1/10], 
       Rectangle[{-1/30, 1/15} + base, {1/30, 1/3} + base]];
     Image@
      Rasterize@
       Graphics[{Orange, Rectangle[{0, 0}, {1, 1}], Blue, 
         Rectangle[{0, 0}, {1/2, 1/2}], Rectangle[{1/2, 1/2}, {1, 1}],
          Black, KeyHole[{0, 0}], KeyHole[{1/2, 1/2}], 
         KeyHole[{1, 0}], White, KeyHole[{0, 1/2}], KeyHole[{1/2, 0}],
          KeyHole[{1, 1/2}]}, PlotRange -> {{0, 1}, {0, 1}}]]

    floortex := 
   ImagePad[ImageRotate[#, Right], 5 First@ImageDimensions[#], 
        "Periodic"] &[tile]

     LogPolar[{x_, y_}] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}; 
 ImageTransformation[floortex, LogPolar, 
  PlotRange -> {{-1, 1}, {-1, 1}}, 
  DataRange -> {{-2 \[Pi], 0}, {-\[Pi], \[Pi]}}, Padding -> White]

for example, I get the same problem. A visible white line on the left....

Seems I need to try one of the other ways shown.....(but as I read there, they-re up to 9 times slower....and the Raspberry already is very slow!).

POSTED BY: Michael Steffen

Why does that line exist?

Look at the Plot of ArcTan[x, y], which defines how the y coordinate is obtained:

Plot3D[ArcTan[x, y], {x, -Pi, Pi}, {y, -Pi, Pi}]

There is a discontinuity where that line exists in your image. I imagine it has some numerical difficultly there.

POSTED BY: Sean Clarke
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract