#waterfall plot

[abramovicinstitute]

Mathematica code:

S[n_, t_] := Sin[n*3 Pi/50 + t]; Manipulate[ Show[   Table[    Plot[     100 - n + (20*Abs[S[n,t]] + .02)*Exp[-(x - 4*S[n, t])^2/Abs[S[n,t]]],     {x, -10, 10},    PlotStyle -> Directive[White, Thick], PlotRange -> {{-7, 7}, {0, 100}},    Filling -> Axis, FillingStyle -> White, Axes -> False, AspectRatio -> Full,    ImageSize -> {500, 750}, Background -> RGBColor[54/255, 70/255, 93/255]],  {n, 1, 100, 1}]], {t, .001, 2 Pi + .001, (2 Pi + .001)/30}]

[intothecontinuum]

Best if viewed on your Tumblr dashboard

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[White, AbsoluteThickness[3]], PlotRange -> {{0, 4 Pi}, {-.3, Y}}, Axes -> False, AspectRatio -> 5/7, ImageSize -> {700, 500}, Background -> RGBColor[53/255, 70/255, 94/255]] Manipulate[ ImageRotate[ P[.35, 1, 28, .6, 57, 35, t], -Pi/2], {t, 2 Pi, Pi/10, -Pi/10}]

[intothecontinuum]

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}]

[intothecontinuum]

Some more inspiration from Bridget Riley -- think Blaze 1 (1962). The first image is what you get after transforming the second image into log-polar coordinates.

Mathematica code:

WfPlot[ t_ ] := Graphics[ Table[ {AbsoluteThickness[3], Line[ Table[ {i + If[Mod[i, 2] == 0, .5*Sin[j*2 Pi/66 + t], 0], (-1)^i*.5 + .4*j},  {i, 1, 19}]]}, {j, 1, 69, 1}], PlotRange -> {{1, 19}, {.8, 27.2}}, ImageSize -> {500, 500}] Manipulate[ WfPlot[ t ], {t, 0, 2Pi}] LogPolar[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]} Manipulate[ ImageTransformtion[ WfPlot[ t ], LogPolar[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t,0,2Pi}]

[intothecontinuum]

Mathematica code:

WPlot[x_, y_, h_, k_, N_, R_, m_, s_, w_, v_, t_, px_, py_] := Graphics[ Table[ {AbsoluteThickness[k], Line[ Table[ {x*i + If[Mod[i, 2] == m, s*x*Sin[j*2 Pi/w + i*2 Pi/v + t], 0], (-1)^i*y + h*j},  {i, 1, N}]]}, {j, 1, R, 1}], PlotRange -> {{x + px, N*x - px}, {h - y + py, R*h - y}}, ImageSize -> {500, 700} ] P={1, 0.5, 0.4, 4., 19, 66, 0, 0.434, 0.89, 0.32, 3.34365, 0.09, 0.418} Manipulate[ WPlot[P[[1]], P[[2]], P[[3]], P[[4]], P[[5]], P[[6]], P[[7]], P[[8]], P[[9]], P[[10]], t, P[[12]], P[[13]]], {t, 2Pi, 0}]

[intothecontinuum]

Inspired by Bridget Riley - Descending (1965)

Mathematica code:

WPlot[x_, y_, h_, k_, N_, R_, m_, s_, w_, v_, t_, px_, py_] := Graphics[ Table[ {AbsoluteThickness[k], Line[Table[{x*i + If[Mod[i, 2] == m, s*x*Sin[j*2 Pi/w + i*2 Pi/v + t], 0],  (-1)^i*y + h*j}, {i, 1, N}]]}, {j, 1, R, 1}], PlotRange -> {{x + px, N*x - px}, {h - y + py, R*h - y}}, ImageSize -> {500, 700} ] P={1, 0.5, 0.4, 4, 19, 66, 0, 0.5, 0.99, 0.94, 2.12749, 0., 0.644} Manipulate[ WPlot[P[[1]], P[[2]], P[[3]], P[[4]], P[[5]], P[[6]], P[[7]], P[[8]], P[[9]], P[[10]], t, P[[12]], P[[13]]], {t, 0, 2 Pi}]

[nnneurosisss]

[intothecontinuum]

Mathematica code:

R[n_] := (SeedRandom[n]; RandomReal[]) G[A_, s_, c_, T_, x_] := A*T*Exp[-(x - c)^2/s] ListAnimate[ Show[ Table[ Plot[ 100 - n + Sum[G[20, 5, 100*R[2n], Sum[G[1, .15, k - R[4 n], 1, m/100 + t], {k, -3, 3, 1}], x], {n, 1, 30, 1}], {x, -10, 110}], PlotStyle -> Directive[Black], PlotRange -> {{0, 90}, {0, 100.5}}, Filling -> Axis, FillingStyle -> White, Axes -> False, AspectRatio -> Full, ImageSize -> {450, 600}], {n, 0, 100, 1}]], {t, 0, 14/15, 1/15}, AnimationRunning->False]