nldmut:

Friday Flash #1, on Friday May 24th at 6pm, is the first in a monthly series of evening programs of eye-popping animation and motion-based art presented on the LED screen at the corner of 14th and Champa in Downtown Denver, Colorado.
www.denverdigerati.com
Denver Digerati on Facebook


Some of our intothecontinuum experiments in the spirit of circles and lines will be displayed tomorrow evening on a huge LED screen in downtown Denver, Colorado! Check it out if you happen to be in the area!

nldmut:

Friday Flash #1, on Friday May 24th at 6pm, is the first in a monthly series of evening programs of eye-popping animation and motion-based art presented on the LED screen at the corner of 14th and Champa in Downtown Denver, Colorado.

www.denverdigerati.com

Denver Digerati on Facebook

Some of our intothecontinuum experiments in the spirit of circles and lines will be displayed tomorrow evening on a huge LED screen in downtown Denver, Colorado! Check it out if you happen to be in the area!

An even number of (at least 8) regular tetrahedra can be connected along their edges to form a ring in a way that allows them to be continuously rotated “inside-out” without disconnecting. Such configurations are commonly referred to as kaleidocycles. Shown above are kaleidocycles with 8, 10, and 12 tetrahedra exhibiting 4, 5, and 6-fold rotational symmetry, respectively. There has to be at least 8 regular tetrahedra, because any less would result in the tetrahedra colliding into each other at certain instances of the rotation. You can even make your own paper model using this guide.

Mathematica code:

v1[t_] := 
{Cos[t], 0, Sin[t]}

v2[t_, a_] :=
1/Sqrt[1 + Sin[t]^2 Tan[a]^2] {-Sin[t], -Sin[t] Tan[a], Cos[t]}

v3[t_, a_] :=
1/Sqrt[1 + Sin[t]^2 Tan[a]^2] {-Sin[t]^2 Tan[a], 1, Cos[t] Sin[t] Tan[a]}

P[t_, a_] :=
{v3[t, a][[2]]/Tan[a] - v3[t, a][[1]], 0, -v3[t, a][[3]]/2}

Q[t_, a_] :=
{v3[t, a][[2]]/Tan[a], v3[t, a][[2]], v3[t, a][[3]]/2}

vertices[t_, a_] :=
{P[t, a] - Sqrt[2]/2 v1[t], P[t, a] + Sqrt[2]/2 v1[t],
Q[t, a] - Sqrt[2]/2 v2[t, a], Q[t, a] + Sqrt[2]/2 v2[t, a]}

Tetrahedron[T_, t_, a_, o_] :=
Table[
{FaceForm[White], Opacity[o], EdgeForm[Thick],
Polygon[
Table[
T[vertices[t, a][[1 + Mod[i + j, 4]]]], {i, 1, 3, 1}]]},
{j, 0, 3, 1}]

Kaleidocycle[pr_, t_, n_, o_, A_] := Graphics3D[
Rotate[
Table[
Rotate[
Table[
Tetrahedron[T, t, 2 Pi/n, o],
{T, {TransformationFunction[IdentityMatrix[4]],
ReflectionTransform[{-Sin[2 Pi/n], Cos[2 Pi/n], 0}]}}],
r*4 Pi/n, {0, 0, 1}],
{r, 0, n - 1, 1}],
A*Sin[t], {0, 1, 0}],
PlotRange -> pr, ImageSize -> 500, Axes -> False, Boxed -> False,
Lighting -> "Neutral", ViewPoint -> {0, 0, 2}, Background -> White ]

Manipulate[
Kaleidocycle[pr, t, n, o, A],
{pr, 1.5, 50}, {t, 0, 2 Pi}, {n, 8, 16, 1},{o, 1, 0}, {{A, 0}, 0, 2 Pi}]


Made in response to a recent question posted at the  Mathematica Stack Exchange.

Mathematica code:
img = 
 ImageCrop@DensityPlot[
    Sin[2 x - 20 Log[2 (Sin[y]^2 + 1), 2]],
 {x, 0, 16 Pi}, {y, 0, 32 Pi},
 PlotPoints -> 250, ColorFunction -> "SunsetColors", 
 Frame -> False, ImageSize -> 600]LogPolar[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}d = ImageDimensions[img][[1]]
Manipulate[
  ImageResize[
   ImageTransformation[
    ImageTake[
     img, 
    {1, 14*d/16}, {1 + (2 - 2 t)*d/32, (32 - 2 t)*d/32}], 
    LogPolar[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}],
   500],
  {t, 0, 6/7, 1/7}]

Made in response to a recent question posted at the Mathematica Stack Exchange.

Mathematica code:

img = 
 ImageCrop@DensityPlot[
    Sin[2 x - 20 Log[2 (Sin[y]^2 + 1), 2]],
 {x, 0, 16 Pi}, {y, 0, 32 Pi},
 PlotPoints -> 250, ColorFunction -> "SunsetColors", 
 Frame -> False, ImageSize -> 600]

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

d = ImageDimensions[img][[1]]
Manipulate
[ ImageResize[ ImageTransformation[ ImageTake[ img, {1, 14*d/16}, {1 + (2 - 2 t)*d/32, (32 - 2 t)*d/32}], LogPolar[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], 500], {t, 0, 6/7, 1/7}]
Mathematica code:
ID = ImageData[Binarize[Rasterize[Import["Erwin.jpg"], RasterSize -> 100], .7], DataReversed -> True]Tile[k_, rx_, ry_, x_, y_, r_] :=Table[ Translate[  Rotate[   {AbsoluteThickness[k],    Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},   r, {.5, .5}],  {x, y}], {i, 0, 1, 1}]Parquet[IS_, X_, Y_, u_, v_, k_, rx1_, rx2_, ry1_, ry2_, f_, t_] :=Graphics[ Table[  Tile[ k, rx1 + rx2*x/X, ry1 + ry2/2*(1 + Sin[2 Pi (f*y/Y - t)]), x, y,  ID[[1 + v*y, 1 + u*x]] Pi/2],  {x, 3, X, 1}, {y, 5, Y, 1}], ImageSize -> IS, PlotRange -> {{3, X + 1}, {5, Y + 1}}]Manipulate[Parquet[500, 56, 60, 2, 2, 2, .5, 0, 0, .5, .5, t],{t, 0, 17/18, 1/18}]

Mathematica code:

ID = ImageData[
Binarize[Rasterize[
Import["Erwin.jpg"],
RasterSize -> 100], .7],
DataReversed -> True]

Tile[k_, rx_, ry_, x_, y_, r_] :=
Table[
Translate[
Rotate[
{AbsoluteThickness[k],
Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},
r, {.5, .5}],
{x, y}],
{i, 0, 1, 1}]

Parquet[IS_, X_, Y_, u_, v_, k_, rx1_, rx2_, ry1_, ry2_, f_, t_] :=
Graphics[
Table[
Tile[
k,
rx1 + rx2*x/X,
ry1 + ry2/2*(1 + Sin[2 Pi (f*y/Y - t)]),
x, y,
ID[[1 + v*y, 1 + u*x]] Pi/2],
{x, 3, X, 1}, {y, 5, Y, 1}],
ImageSize -> IS, PlotRange -> {{3, X + 1}, {5, Y + 1}}]

Manipulate[
Parquet[500, 56, 60, 2, 2, 2, .5, 0, 0, .5, .5, t],
{t, 0, 17/18, 1/18}]

In a previous post we experienced what a Truchet tiling looks like. This time, the animations above show what it might be like to look down on a Truchet tiling, but while moving along it in a straight line.

In each of the animations the tiling is really only shifting in one direction (the direction corresponding to “up” when viewed on your screen) as made apparent in the following simple Truchet tiling:

For an increased dramatic effect, the rate of this upward movement in the animations is made to correspond with the frame rate of the GIF in such a way where precisely one row of the tiling leaves our view every frame. This makes the smoothly translating tiling just shown look like this instead:

This explains why the individual tiles seem to be changing orientations in place, and why there appears to be a static grid of horizontal and vertical lines outlining the tiles. Together with the geometry of the configurations in the tilings, this also explains why there seems to be motion is several different directions for any given tiling. Perhaps one might be able to realistically create a similar effect if they manage to run along such a tiling at a rate which corresponds to the “frame rate” of human vision.

Mathematica code:

T[r_, x_, y_] :=
Translate[
Rotate[
{EdgeForm[Thickness[0]], Polygon[{{1, 0}, {0, 0}, {0, 1}}]},
r, {.5, .5}],
{x, y}]

Manipulate[
Graphics[
Table[
T[Mod[a*x + b*y, m] Pi/2, x + h, y + v],
{x, 1, X, 1}, {y, 1, Y + 60, 1}],
PlotRange -> {{1, X}, {1, Y - .1}}, ImageSize -> 500],
{{X, 23}, 1, 100, 1}, {{Y, 23}, 1, 100, 1},
{{m, 11}, 1, 100, 1},
{{a, 18}, 1, 100, 1},
{{b, 14}, 1, 100, 1},
{h, 0, 14},
{v, 0, 14}]

Consider tiling the plane using only square tiles like this:

The 4-fold rotational symmetry of the square allows a tile to be placed in the 4 different orientations shown here:

Despite these constraints there are still a lot of different ways to tile the plane. Shown above are a few examples constructed with an algorithm using modular arithmetic. This essentially makes the tiles along different rows follow the same sequence but shifted over by some amount.

Each of the tilings shown are actually periodic and can tile the entire plane.
(e.g. 1, 2, 3, 4)

Tilings of this variety are called Truchet tilings.

Mathematica code:

T[r_, x_, y_] :=
Translate[
Rotate[
{EdgeForm[Thickness[0]], Polygon[{{1, 0}, {0, 0}, {0, 1}}]},
r, {.5, .5}],
{x, y}]

Manipulate[
Graphics[
Table[
T[Mod[a*x + b*y, m] Pi/2, x, y],
{x, 1, X, 1}, {y, 1, Y, 1}],
PlotRange -> {{1, X}, {1, Y - .1}}, ImageSize -> 500],
{{X, 29}, 1, 100, 1}, {{Y, 29}, 1, 100, 1},
{{m, 14}, 1, 100, 1},
{{a, 5}, 1, 100, 1},
{{b, 5}, 1, 100, 1}]
Anonymous
asks:
Could you please post your profile picture?

Here is the icon:

image

which is a crop from this photo of Erwin Schrödinger:

image

I do not know any other details such as who took it, where it was taken, and when. If anyone does know, please let me know.

Mathematica code:
P[A_, f_, w_, h_, M_, Y_, t_] := Plot[  Table[   A*Sin[f*x + t + n*2 Pi/w] + h*n,   {n, 1, M, 1}], {x, 0, 4 Pi},   PlotStyle -> Directive[Black, AbsoluteThickness[3]],   PlotRange -> {{0, 4 Pi}, {-.3, Y}}, Axes -> False,  AspectRatio -> 5/7, ImageSize -> {700, 500}]Manipulate[ ImageRotate[  P[.35, 1, 28, .6, 57, 35, t],  -Pi/2], {t, 2 Pi, Pi/10, -Pi/10}]

Mathematica code:

P[A_, f_, w_, h_, M_, Y_, t_] :=
Plot[
Table[
A*Sin[f*x + t + n*2 Pi/w] + h*n,
{n, 1, M, 1}],
{x, 0, 4 Pi},
PlotStyle -> Directive[Black, AbsoluteThickness[3]],
PlotRange -> {{0, 4 Pi}, {-.3, Y}}, Axes -> False,
AspectRatio -> 5/7, ImageSize -> {700, 500}]

Manipulate[
ImageRotate[
P[.35, 1, 28, .6, 57, 35, t],
-Pi/2],
{t, 2 Pi, Pi/10, -Pi/10}]

Inspired by Vasilj Godzh

Mathematica code:
s[q_] := (SeedRandom[q]; RandomReal[])r[S_, a_, v_, w_, t_] :=  S (1 + .05 Sin[v*a] Cos[w*a] + .1 Cos[8*a] + .025 Sin[a + t])F[Q_, S_, M_, v_, w_, th_, t_] := {EdgeForm[{AbsoluteThickness[th], Black}], FaceForm[White],  Polygon[   Table[    {{0, 0},     {r[S, (a + s[Q*a]) 2 Pi/M, v, w, t] Cos[(a + s[Q*a]) 2 Pi/M],      r[S, (a + s[Q*a]) 2 Pi/M, v, w, t] Sin[(a + s[Q*a]) 2 Pi/M]},     {r[S, (a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M, v, w, t] Cos[(a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M],      r[S, (a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M, v, w, t] Sin[(a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M]}},    {a, 1, M, 1}]]}Manipulate[ Graphics[  Table[   Translate[    Reverse@     Table[      F[i*j, (1 + .3 i^1.7), 125 + 25 i,          3 + Round[9 s[i*j]], 3 + Round[9 s[2 i*j]],        .6, t + s[j] 2 Pi],      {i, 1, 4, 1}],    {17*s[j], 23.8*s[2 j]}],   {j, 1, 46, 1}],  PlotRange -> {{.5, 17.5}, {-1.2, 22.6}},   ImageSize -> {500, 700}], {t, 0, 2Pi}]

Inspired by Vasilj Godzh

Mathematica code:

s[q_] := (SeedRandom[q]; RandomReal[])

r[S_, a_, v_, w_, t_] :=
S (1 + .05 Sin[v*a] Cos[w*a] + .1 Cos[8*a] + .025 Sin[a + t])

F[Q_, S_, M_, v_, w_, th_, t_] :=
{EdgeForm[{AbsoluteThickness[th], Black}], FaceForm[White],
Polygon[
Table[
{{0, 0},
{r[S, (a + s[Q*a]) 2 Pi/M, v, w, t] Cos[(a + s[Q*a]) 2 Pi/M],
r[S, (a + s[Q*a]) 2 Pi/M, v, w, t] Sin[(a + s[Q*a]) 2 Pi/M]},
{r[S, (a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M, v, w, t] Cos[(a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M],
r[S, (a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M, v, w, t] Sin[(a + 1 + s[Q (Mod[a, M] + 1)]) 2 Pi/M]}},
{a, 1, M, 1}]]}

Manipulate[
Graphics[
Table[
Translate[
Reverse@
Table[
F[i*j, (1 + .3 i^1.7), 125 + 25 i,
3 + Round[9 s[i*j]], 3 + Round[9 s[2 i*j]],
.6, t + s[j] 2 Pi],
{i, 1, 4, 1}],
{17*s[j], 23.8*s[2 j]}],
{j, 1, 46, 1}],
PlotRange -> {{.5, 17.5}, {-1.2, 22.6}},
ImageSize -> {500, 700}],
{t, 0, 2Pi}]

Mathematica code:


G[A_, B_, s_, N_, T_, t_, th_, pr_, u_, v_] :=
Graphics[
{EdgeForm[{AbsoluteThickness[th], Black}], FaceForm[White],
Polygon[
Table[
{{0, 0},
{(Cos[u*a+t]Sin[v*a+t])Cos[a+t], (Cos[u*a+t]Sin[v*a+t])Sin[a+t]},
{(Cos[u*a+s+t]Sin[v*a+s+t])Cos[a+s+t], (Cos[u*a+s+t]Sin[v*a+s+t])Sin[a+s+t]}},
{a, B + T, A + T, 2 Pi/N}]]},
PlotRange -> {{-1.5 pr, 1.5 pr}, {-pr, pr}}, ImageSize -> 400]

Manipulate[
G[2Pi, 0, .5, 200, 0, t, .3, .7, 1, v],
{v, {3,4,5}},
{t,0,2Pi}]

Mathematica code:
G[A_, B_, s_, N_, T_, t_, pr_, th_] := Graphics[  {EdgeForm[{AbsoluteThickness[th], Black}], FaceForm[White],    Polygon[    Table[     {{0, 0},      {(Cos[4a+s*t]+Sin[4a+s*t])Cos[a+s*t], (Cos[4a+s*t]+Sin[4a+s*t]) Sin[a+s*t]},      {(Cos[4a+s+s*t]+Sin[4a+s+s*t])Cos[a+s+s*t], (Cos[4a+s+s*t]+Sin[4a+s+s*t]) Sin[a+s+s*t]}},     {a, B + T, A + T, 2 Pi/N}]]},   PlotRange -> pr, ImageSize -> 500]Manipulate[G[2Pi, 0, .75, 200, T, 0, 1.5, .3],{T,0,2Pi}]

Mathematica code:


G[A_, B_, s_, N_, T_, t_, pr_, th_] :=
Graphics[
{EdgeForm[{AbsoluteThickness[th], Black}], FaceForm[White],
Polygon[
Table[
{{0, 0},
{(Cos[4a+s*t]+Sin[4a+s*t])Cos[a+s*t], (Cos[4a+s*t]+Sin[4a+s*t]) Sin[a+s*t]},
{(Cos[4a+s+s*t]+Sin[4a+s+s*t])Cos[a+s+s*t], (Cos[4a+s+s*t]+Sin[4a+s+s*t]) Sin[a+s+s*t]}},
{a, B + T, A + T, 2 Pi/N}]]},
PlotRange -> pr, ImageSize -> 500]

Manipulate[
G[2Pi, 0, .75, 200, T, 0, 1.5, .3],
{T,0,2Pi}]

Inspired by this
Mathematica code:
Manipulate[ Graphics[  Table[   Table[    {EdgeForm[{Black, AbsoluteThickness[2.5]}], FaceForm[White],     Translate[      Polygon[       Table[{         {3.9 Sin[Pi/8 (t + V)]          + i/8 ((-1)^S*(1 + Abs[3.9 Sin[Pi/8 (t + V)]]) - 3.9 Sin[Pi/8 (t + V)]),          i/8},         {-3.9 Sin[Pi/8 (t + V)]           + i/8 ((-1)^S*(1 + Abs[3.9 Sin[Pi/8 (t + V)]]) + 3.9 Sin[Pi/8 (t + V)]),         2 - i/8},         {(-1)^S* 6 - (-1)^S*i/8, 2 - i/8},         {(-1)^S*6 - (-1)^S*i/8, i/8}},        {i, 0, 8, 1}]],      {0, -2 V}]},    {S, 0, 1}],   {V, 0, 7, 1}], ImageSize -> 500], {t, 0, 16}]

Inspired by this

Mathematica code:

Manipulate[
Graphics[
Table[
Table[
{EdgeForm[{Black, AbsoluteThickness[2.5]}], FaceForm[White],
Translate[
Polygon[
Table[{
{3.9 Sin[Pi/8 (t + V)]
+ i/8 ((-1)^S*(1 + Abs[3.9 Sin[Pi/8 (t + V)]]) - 3.9 Sin[Pi/8 (t + V)]),
i/8},
{-3.9 Sin[Pi/8 (t + V)]
+ i/8 ((-1)^S*(1 + Abs[3.9 Sin[Pi/8 (t + V)]]) + 3.9 Sin[Pi/8 (t + V)]),
2 - i/8},
{(-1)^S* 6 - (-1)^S*i/8, 2 - i/8},
{(-1)^S*6 - (-1)^S*i/8, i/8}},
{i, 0, 8, 1}]],
{0, -2 V}]},
{S, 0, 1}],
{V, 0, 7, 1}],
ImageSize -> 500],
{t, 0, 16}]
Mathematica code:
Tile[k_, rx_, ry_, x_, y_, r_] := Table[  Translate[   Rotate[    {AbsoluteThickness[k],     Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},    r, {.5, .5}],   {x, y}],  {i, 0, 1, 1}]rr[Q_] := (SeedRandom[Q]; RandomReal[])GCOS[k_, rx1_, rx2_, ry1_, ry2_, X_, Y_, Q_, t_] := Graphics[  Table[    Tile[k,        .75 + .25 Cos[2 Pi*Mod[rx1 + rx2*x/X + t, 1]],        .75 + .25 Cos[2 Pi*Mod[ry1 + ry2*y/Y + t, 1]],        x, y, Floor[3*rr[Q*x*y]] Pi/2],   {x, 1, X, 1}, {y, 1, Y, 1}],  ImageSize -> 500, PlotRange -> {{1, X + 1}, {1, Y + 1}}]Manipulate[   GCOS[2, .5, .5, .5, .5, 30, 42, 4, t],{t, .05, 1, .05}]

Mathematica code:

Tile[k_, rx_, ry_, x_, y_, r_] :=
Table[
Translate[
Rotate[
{AbsoluteThickness[k],
Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},
r, {.5, .5}],
{x, y}],
{i, 0, 1, 1}]

rr[Q_] := (SeedRandom[Q]; RandomReal[])

GCOS[k_, rx1_, rx2_, ry1_, ry2_, X_, Y_, Q_, t_] :=
 Graphics[
Table[
Tile[k,
 .75 + .25 Cos[2 Pi*Mod[rx1 + rx2*x/X + t, 1]],
 .75 + .25 Cos[2 Pi*Mod[ry1 + ry2*y/Y + t, 1]],
 x, y, Floor[3*rr[Q*x*y]] Pi/2],
{x, 1, X, 1}, {y, 1, Y, 1}],
ImageSize -> 500, PlotRange -> {{1, X + 1}, {1, Y + 1}}]

Manipulate[
GCOS[2, .5, .5, .5, .5, 30, 42, 4, t],
{t, .05, 1, .05}]
1000x1000
Mathematica code:
Tile[k_, rx_, ry_, x_, y_, r_] := Table[  Translate[   Rotate[    {AbsoluteThickness[k],     Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},    r, {.5, .5}],   {x, y}],  {i, 0, 1, 1}]rr[Q_] := (SeedRandom[Q]; RandomReal[])Manipulate[Graphics[ Table[  Tile[4, .5 + .5*x/1000, y/1000, x, y, Floor[3*rr[x*y]] Pi/2],  {x, 1, 100, 1}, {y, 1, 100, 1}], ImageSize -> 1000, PlotRange -> {{1, 101}, {1, 101}}],{r, 0, 1, .25}]

1000x1000

Mathematica code:

Tile[k_, rx_, ry_, x_, y_, r_] :=
Table[
Translate[
Rotate[
{AbsoluteThickness[k],
Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},
r, {.5, .5}],
{x, y}],
{i, 0, 1, 1}]

rr[Q_] := (SeedRandom[Q]; RandomReal[])

Manipulate[
Graphics[
Table[
Tile[4, .5 + .5*x/1000, y/1000, x, y, Floor[3*rr[x*y]] Pi/2],
{x, 1, 100, 1}, {y, 1, 100, 1}],
ImageSize -> 1000, PlotRange -> {{1, 101}, {1, 101}}],
{r, 0, 1, .25}]
Testing the new panorama feature on Tumblr with a parquet deformation—a kind of “geometrical tessellating metamorphosis”. Douglas Hofstadter has a bit to say about them in Metamagical Themas.
Click the image to view in panorama mode. The original image is 4000 pixels wide.
more variants: 1, 2, 3
Mathematica code:
Tile[k_, rx_, ry_, x_, y_, r_] := Table[  Translate[   Rotate[    {AbsoluteThickness[k],     Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},    r, {.5, .5}],   {x, y}],  {i, 0, 1, 1}]rr[Q_] := (SeedRandom[Q]; RandomReal[])Manipulate[Graphics[ Table[  Tile[4, .5 + .5*x/200, r , x, y, Floor[3*rr[x*y]] Pi/2],  {x, 1, 200, 1}, {y, 1, 20, 1}], ImageSize -> 4000, PlotRange -> {{1, 201}, {1, 21}}],{r, 0, 1, .25}]

Testing the new panorama feature on Tumblr with a parquet deformation—a kind of “geometrical tessellating metamorphosis”. Douglas Hofstadter has a bit to say about them in Metamagical Themas.

Click the image to view in panorama mode. The original image is 4000 pixels wide.

more variants: 1, 2, 3

Mathematica code:

Tile[k_, rx_, ry_, x_, y_, r_] :=
Table[
Translate[
Rotate[
{AbsoluteThickness[k],
Circle[{i, i}, {rx, ry}, {i*Pi, Pi/2 + i*Pi}]},
r, {.5, .5}],
{x, y}],
{i, 0, 1, 1}]

rr[Q_] := (SeedRandom[Q]; RandomReal[])

Manipulate[
Graphics[
Table[
Tile[4, .5 + .5*x/200, r , x, y, Floor[3*rr[x*y]] Pi/2],
{x, 1, 200, 1}, {y, 1, 20, 1}],
ImageSize -> 4000, PlotRange -> {{1, 201}, {1, 21}}],
{r, 0, 1, .25}]