Remove strange line in animation

mst · October 29, 2015, 12:26pm

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!

seanc · October 29, 2015, 4:10pm

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.

sghuisman · October 30, 2015, 12:35am

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:

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…

mst · October 31, 2015, 3:19am

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 )

sghuisman · October 31, 2015, 12:18pm

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.

mst · November 6, 2015, 12:30am

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…

mst · November 6, 2015, 12:39am

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.

lehinp · November 6, 2015, 3:23pm

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.

sghuisman · November 7, 2015, 11:04pm

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

mst · November 8, 2015, 1:54am

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?

mst · November 8, 2015, 2:17am

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!).

sghuisman · November 8, 2015, 11:12am

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.

mst · November 8, 2015, 9:39pm

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

sghuisman · November 9, 2015, 1:42pm

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

Topic		Replies	Views
Generate smooth animations? Questions mathematica , graphics-and-visualization , interface-construction	3	7178	May 11, 2020
Animation won't show moving lines, only their endpoints Questions mathematica , graphics-and-visualization , modeling	1	16273	December 11, 2013
Can others run the below code in Mathematica? Shift-Enter does nothing. Questions mathematica , graphics-and-visualization	6	9306	February 23, 2014
Curve smoothness disappear while Animate is running Questions geometry , graphics-and-visualization	4	4610	February 12, 2022
String art of using radon transforms and the generation process for continuous string layout Staff Picks image-processing , fun-and-play , computational-arts , geometry , graphics-and-visualization , modeling , 3d-printing , staff-pick , computational-humanities	8	4587	June 15, 2025

Remove strange line in animation

Related topics