Hilbert chasers: two lines following rotated curves​
​by Sander Huisman
I wanted to make an animation for which a line is following a Hilbert curve. Since a Hilbert curve is not closed, I decided to join two of them:
Join two rotated Hilbert curves of n iterations:
In[]:=
n=4;​​δ=2^n-1;​​invδ=1/δ;​​rm=RotationMatrix[Pi/2];​​hc=First@HilbertCurve[n,DataRange->{{-1,1},{-1,1}}];​​hc1=(rm.#)&/@hc;​​hc2=(-rm.#+{2+2invδ,0})&/@hc;​​hc=Join[hc1,hc2,Take[hc1,1]];​​Graphics[Line[hc,VertexColors->(ColorData["Rainbow"]/@Subdivide[Length[hc]-1])],FrameTrue]
Out[]=
Turn the path into interpolation functions, and make a function that draws the line:
In[]:=
len=Length[hc];​​dist=Prepend[Accumulate[Norm/@Differences[hc]],0.0];​​totdist=Last[dist];​​ipx=Interpolation[Transpose[{dist,hc[[All,1]]}],InterpolationOrder1];​​ipy=Interpolation[Transpose[{dist,hc[[All,2]]}],InterpolationOrder1];​​ClearAll[ipf]​​ipf[d_]:={ipx[Mod[d,totdist]],ipy[Mod[d,totdist]]}​​ClearAll[MakeLine,MakeScene]​​MakeLine[τ_]:=Module[{loopdist,d1,d2,id,beginindex,endindex,midpoints,pts},​​loopdist=Join[dist,dist+totdist];​​d1=τtotdist;​​d2=(τ+0.5)totdist;​​beginindex=LengthWhile[loopdist,LessEqualThan[d1]];​​endindex=LengthWhile[loopdist,LessThan[d2]];​​midpoints=Take[loopdist,{beginindex+1,endindex}];​​pts=ipf/@Join[{d1},midpoints,{d2}];​​Line[pts]​​]​​ϵ=0.05;​​MakeScene[τ_]:=Graphics[​​{Thickness[0.51/δ],​​CMYKColor[1,0.63,0,0.02],MakeLine[τ],​​CMYKColor[0,0.02,1],MakeLine[τ+0.5]​​},​​PlotRange{{-1-(1-ϵ)invδ,3+(3-ϵ)invδ},{-1-(1-ϵ)invδ,1+(1-ϵ)invδ}},​​ImageSize400​​]​​MakeScene[0.333]
Out[]=
Make all the frames:
In[]:=
imgs=ParallelTable[Rasterize[MakeScene[t],RasterSize300],{t,Most@Subdivide[600]}];
Export as a video:
In[]:=
ai=AnimatedImage[imgs,"FrameRate"->30];​​SetDirectory[NotebookDirectory[]];​​Export["5050.mp4",ai]
Out[]=
5050.mp4
Export as a gif:
In[]:=
SetDirectory[NotebookDirectory[]];​​Export["5050.gif",imgs,"DisplayDurations"->1/30]
Out[]=
5050.gif