恒等写像

さらにこちらでは

intothecontinuum

Animated GIF (500x500)
Created with Mathematica

Image source data taken from this photo of Erwin Schrödinger:

Inspired by @bigblueboo

Mathematica code:

Erwin = Import["ErwinsFace.jpg"];

L = ImageDimensions[Erwin][[1]];

F = 40;

pts = Block[{n = 100},

   	Table[{Cos[2 π k/n], Sin[2 π k/n]}, {k, 0, n - 1}]];

Edisk[T_] := Scale[

   {Texture@Erwin, EdgeForm@None,

    Polygon[pts, VertexTextureCoordinates -> (pts/2 + .5)],

    Black, Thick, {White, Circle[]}}, T];

imgdata = Table[

   ImageData[

    Graphics[{ Edisk[(t + 1)^3], Edisk[t^3]},

     PlotRange -> {{-1, 1}, {-1, 1}} , ImageSize -> L],

     "Byte", DataReversed -> True],

    {t, .2 + 1/F, 1.2, 1/F}];

f[M_, t_, F_, T_] := 1 - imgdata[[T,

      Ceiling[L/2 (1 + t*Sin[2 Pi (M*t - T/F)])],

      Ceiling[L/2 (1 + t*Cos[2 Pi (M*t - T/F)])], 1]]/255;



Manipulate[With[{A = .025, B = 120, M = 24},

  ParametricPlot[

   (t + A*f[M, t, F, T] Sin[B*2*Pi*M*t^2])*{Cos[2 Pi (M*t - T/F)], Sin[2 Pi (M*t - T/F)]},

  {t, 0, 1},

   PlotRange -> {{-1, 1}, {-1, 1}}, PlotPoints -> 100 ,

    PlotStyle -> {Black, Thickness[.002]},

   Axes -> False, ImageSize -> 500]],

 {T, 1, F, 1}]

アプリの完璧さをご確認ください。

さらにこちらでは