Posts tagged: circles

ryansalge:

A collaboration between myself and intothecontinuum who created all the moving parts you see in the gif. You can check out his tumblr here.


in collaboration with Ryan Salge!
read more for code
[[MORE]]

Mathematica code:
RyanID = ImageData[ImageResize[Import["Ryan.jpg"], 500], DataReversed -> True]B[x_, y_, r_, c_, o_] :={GrayLevel[c], Opacity[o], Disk[{x, y}, r]}rr[Q_] := (SeedRandom[Q]; RandomReal[])Beam[IS_, f_, a_, w_, b_, o_, c_, T_, M_, t_, g_, R_, z_, zr_] := Graphics[  Table[   Table[    B[     IS/2 + (w + a (Mod[t + s + c*rr[R*4 Q], c]))^2 (-1)^(Round[rr[Q]]) (.2 IS*rr[R*2 Q] Sin[f*2 Pi ((t + s)/c + rr[R*3 Q])]),     b + Mod[t + s + c*rr[R*4 Q], c],     (z + zr*rr[R*5 Q]) (.5 + .5 Abs[Sin[f*Pi ((t + s)/c + rr[R*3 Q])]]),     g + 1 rr[R*6 Q],     If[Mod[t + s + c*rr[R*4 Q], c] < 100, o*Mod[t + s + c*rr[R*4 Q], c]/150, o]],    {s, 0, c (1 - 1/T), c/T}],   {Q, 1, M, 1}],  Prolog -> Raster[RyanID],  PlotRange -> {{0, IS}, {0, IS*648/500}}, ImageSize -> IS]Manipulate[Beam[500, 3, .0025, .6, 320, .3, 350, 10, 160, t, .2, 7, 2, 6],{t, 0, 35 - 35/8, 35/8}]

ryansalge:

A collaboration between myself and intothecontinuum who created all the moving parts you see in the gif. You can check out his tumblr here.

in collaboration with Ryan Salge!

read more for code

Read More

Imagine throwing a bunch of balls up into the air at just the right place, at just the right time, with just the right speed, so that all the balls reach their maximum height at the same exact time and form a picture. Simulated here is the tumblr logo, a smiley face, and a more complicated face. Can you recognize who?

Some unrealistic physical assumptions:
- The balls don’t collide into each other.
- The balls only bounce straight up and down.

Inspired by this.

Read more for code:

Read More

circles moving in circles


Mathematica code:
Circles[color_, X_, Y_, s_, r_, IS_] := Graphics[  Table[   {color,    Disk[{x, y} + s, r]},   {x, -X, X}, {y, -Y, Y}],  ImageSize -> IS]W[x_, y_, w_, a_, t_] :=  w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 PiManipulate[ Show[  Circles[Black, X, Y, 0, r, 500],  Circles[White, X, Y,   .25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]}, r/2, 500]  ],{X, 10, 100, 1}, {Y, 10, 100, 1},{{r, .5}, .1, 1}, {{w, 1}, 0, 1}, {a, 0, 2 Pi},{t, 0, 1}]Manipulate[ Show[  Circles[Black, 10, 10, 0, .6+ .2Cos[t*2Pi/4], 500],  Circles[White, 10, 10,   .25 (.6+ .2Cos[t*2Pi/4])*{Cos[W[x, y, .75, 3Pi/2, t]], Sin[W[x, y, .75, 3Pi/2, t]]},   (.6+ .2Cos[t*2Pi/4])/2, 500] ],{t, 0, 4}]
circles moving in circles

Mathematica code:

Circles[color_, X_, Y_, s_, r_, IS_] :=
Graphics[
Table[
{color,
Disk[{x, y} + s, r]},
{x, -X, X}, {y, -Y, Y}],
ImageSize -> IS]

W[x_, y_, w_, a_, t_] :=
w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 Pi

Manipulate[
Show[
Circles[Black, X, Y, 0, r, 500],
Circles[White, X, Y,
.25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]}, r/2, 500]
],
{X, 10, 100, 1}, {Y, 10, 100, 1},
{{r, .5}, .1, 1}, {{w, 1}, 0, 1}, {a, 0, 2 Pi},
{t, 0, 1}]

Manipulate[
Show[
Circles[Black, 10, 10, 0, .6+ .2Cos[t*2Pi/4], 500],
Circles[White, 10, 10,
.25 (.6+ .2Cos[t*2Pi/4])*{Cos[W[x, y, .75, 3Pi/2, t]], Sin[W[x, y, .75, 3Pi/2, t]]},
  (.6+ .2Cos[t*2Pi/4])/2, 500]
],
{t, 0, 4}]
Mathematica code:
Circles[Ccolor_, BGcolor_, X_, Y_, s_, r_, IS_] := Graphics[  Table[   {Ccolor,    Disk[{x, y} + s, r]},   {x, -X, X}, {y, -Y, Y}],  ImageSize -> IS, Background -> BGcolor,   PlotRange -> {{-X-1, X+1}, {-Y-1, Y+1}}]W[x_, y_, w_, a_, t_] :=  w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 PiManipulate[Circles[ If[color==0,White, Black],If[color==0, Black, White], X, Y, .25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]},  r/2, IS],{color,0,1,1}, {IS, {{500}, {500, 700}}},{X, 10, 100, 1}, {Y, 10, 100, 1},{{r, .5}, .1, 1},{{w, 1}, 0, 1},{a, 0, 2 Pi},{t, 0, 1}]Manipulate[ Circles[  White, Black, 10, 14,  .25 (.8)*{Cos[W[x, y, .6, 3Pi/2, t]], Sin[W[x, y, .6, 3Pi/2, t]]},  .8/2, {500,700}],{t, 0, 1}]

Mathematica code:

Circles[Ccolor_, BGcolor_, X_, Y_, s_, r_, IS_] :=
Graphics[
Table[
{Ccolor,
Disk[{x, y} + s, r]},
{x, -X, X}, {y, -Y, Y}],
ImageSize -> IS, Background -> BGcolor,
PlotRange -> {{-X-1, X+1}, {-Y-1, Y+1}}]

W[x_, y_, w_, a_, t_] :=
w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 Pi

Manipulate[
Circles[
If[color==0,White, Black],If[color==0, Black, White], X, Y,
.25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]},
r/2, IS],
{color,0,1,1}, {IS, {{500}, {500, 700}}},
{X, 10, 100, 1}, {Y, 10, 100, 1},
{{r, .5}, .1, 1},{{w, 1}, 0, 1},{a, 0, 2 Pi},
{t, 0, 1}]

Manipulate[
Circles[
White, Black, 10, 14,
 .25 (.8)*{Cos[W[x, y, .6, 3Pi/2, t]], Sin[W[x, y, .6, 3Pi/2, t]]},
.8/2, {500,700}],
{t, 0, 1}]

Mathematica code:
Circles[Ccolor_, BGcolor_, X_, Y_, s_, r_, IS_] := Graphics[  Table[   {Ccolor,    Disk[{x, y} + s, r]},   {x, -X, X}, {y, -Y, Y}],  ImageSize -> IS, Background -> BGcolor,   PlotRange -> {{-X-1, X+1}, {-Y-1, Y+1}}]W[x_, y_, w_, a_, t_] :=  w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 PiManipulate[Circles[ If[color==0,White, Black],If[color==0, Black, White], X, Y, .25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]},  r/2, IS],{color,0,1,1}, {IS, {{500}, {500, 700}}},{X, 10, 100, 1}, {Y, 10, 100, 1},{{r, .5}, .1, 1},{{w, 1}, 0, 1},{a, 0, 2 Pi},{t, 0, 1}]Manipulate[ Circles[  White, Black, 10, 14,  .25 (.5)*{Cos[W[x, y, .25, 3Pi/2, t]], Sin[W[x, y, .25, 3Pi/2, t]]},  .5/2, {500,700}],{t, 0, 1}]

Mathematica code:

Circles[Ccolor_, BGcolor_, X_, Y_, s_, r_, IS_] :=
Graphics[
Table[
{Ccolor,
Disk[{x, y} + s, r]},
{x, -X, X}, {y, -Y, Y}],
ImageSize -> IS, Background -> BGcolor,
PlotRange -> {{-X-1, X+1}, {-Y-1, Y+1}}]

W[x_, y_, w_, a_, t_] :=
w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 Pi

Manipulate[
Circles[
If[color==0,White, Black],If[color==0, Black, White], X, Y,
.25 r*{Cos[W[x, y, w, a, t]], Sin[W[x, y, w, a, t]]},
r/2, IS],
{color,0,1,1}, {IS, {{500}, {500, 700}}},
{X, 10, 100, 1}, {Y, 10, 100, 1},
{{r, .5}, .1, 1},{{w, 1}, 0, 1},{a, 0, 2 Pi},
{t, 0, 1}]

Manipulate[
Circles[
White, Black, 10, 14,
 .25 (.5)*{Cos[W[x, y, .25, 3Pi/2, t]], Sin[W[x, y, .25, 3Pi/2, t]]},
.5/2, {500,700}],
{t, 0, 1}]
Flying Lotus released a brilliant and beautiful album the other week,but I still can’t get over how good the last release “Cosmogramma” was. This animation in an interpretation of that album cover.
Mathematica code:
rr[n_] := (SeedRandom[n]; RandomReal[])Rays[Q_, h_, a_, b_, N_, s_, PR_] := Graphics[   Table[    {AbsoluteThickness[h],     Line[      {{a*Cos[(n + s*rr[Q*n])*2 Pi/N], a*Sin[(n + s*rr[Q*n])*2 Pi/N]},        {b*Cos[(n + s*rr[Q*n])*2 Pi/N], b*Sin[(n + s*rr[Q*n])*2 Pi/N]}}           ]},  {n, 1, N, 1}],  PlotRange -> PR, ImageSize -> 500]Spheres[U_, R_, op_, z_, p_, w_, D_, PR_] := Graphics[  Table[   {Opacity[op],    Disk[      Mod[z + R*rr[3*U*d], R]*{Cos[2 Pi*rr[U*d]], Sin[2 Pi*rr[U*d]]},     Mod[z + R*rr[3*U*d], R]^p*w]},  {d, 1, D, 1}], PlotRange -> PR, ImageSize->500]Manipulate[ Show[  Rays[t, 1.75, .1, 3, 225, 1, 1],  Spheres[18, 1.3, 1, 1.3 t/12, 1.5, .11, 15, 1]], {t, 1, 12, 1}]

Flying Lotus released a brilliant and beautiful album the other week,
but I still can’t get over how good the last release “Cosmogramma” was.
This animation in an interpretation of that album cover.

Mathematica code:

rr[n_] := (SeedRandom[n]; RandomReal[])

Rays[Q_, h_, a_, b_, N_, s_, PR_] :=
Graphics[
Table[
{AbsoluteThickness[h],
Line[
{{a*Cos[(n + s*rr[Q*n])*2 Pi/N], a*Sin[(n + s*rr[Q*n])*2 Pi/N]},
{b*Cos[(n + s*rr[Q*n])*2 Pi/N], b*Sin[(n + s*rr[Q*n])*2 Pi/N]}}
]},
{n, 1, N, 1}],
PlotRange -> PR, ImageSize -> 500]

Spheres[U_, R_, op_, z_, p_, w_, D_, PR_] :=
Graphics[
Table[
{Opacity[op],
Disk[
Mod[z + R*rr[3*U*d], R]*{Cos[2 Pi*rr[U*d]], Sin[2 Pi*rr[U*d]]},
 Mod[z + R*rr[3*U*d], R]^p*w]},
{d, 1, D, 1}],
PlotRange -> PR, ImageSize->500]

Manipulate[
Show[
Rays[t, 1.75, .1, 3, 225, 1, 1],
Spheres[18, 1.3, 1, 1.3 t/12, 1.5, .11, 15, 1]],
{t, 1, 12, 1}]

none of the circles are actually moving downwards
Mathematica code:
Manipulate[ Graphics[  Table[   Disk[    {x, y},    .4*(1 + Sin[Pi*x - y + t]/2)],   {x, 1, 30, 1}, {y, 1, 43, 1}],  ImageSize -> {500,700}],{t, 19 Pi/10, 0, -Pi/10}]

none of the circles are actually moving downwards

Mathematica code:

Manipulate[
Graphics[
Table[
Disk[
{x, y},
.4*(1 + Sin[Pi*x - y + t]/2)],
{x, 1, 30, 1}, {y, 1, 43, 1}],
ImageSize -> {500,700}],
{t, 19 Pi/10, 0, -Pi/10}]
Quasicrystalline patterns with 5, 7, 9, and 11-fold rotational symmetry.

Mathematica code:

S[x_, y_, w_, a_, t_] := 
Sin[w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2 Pi]

G[N_, t_,] :=
Graphics[
Table[
Disk[
{x, y},
.55*(1 + Sum[S[x, y, w, a*2 Pi/N, t], {a, 0, N - 1, 1}]/(2 N))],
{x, -25, 25, 1}, {y, -25, 25, 1}],
PlotRange -> 25.85, ImageSize -> 500]

Manipulate[
G[N,t],
{N,{5,7,9,11}}, {t, 0, .95, .05}]

For Mr. Gif in exchange for some stereoscopic magic.

To see Mathematica code:

Read More

Original images (x1, x2) courtesy of Lola Lee.
Follow her wonderful blog at subtle-body!

Mathematica code:

raster[img_] := 
ImageData[Rasterize[
ImageResize[ColorConvert[
Import[img],
  "GrayLevel"], 100],
RasterSize -> 64], "Byte"]

LY := raster["LolaYellow.jpg"]

LR := raster["LolaRed.jpg"]

waves[x_, y_, w_, a_, t_] :=
Sin[w ((Cos[a] + Sin[a]) x + (Sin[a] - Cos[a]) y) + t*2Pi]

G[ImgData_, IS_, R_, C_, X1_, X2_, Y1_, Y2_, N_, w_, A_, t_] :=
Graphics[
Table[
Disk[
{x, -y},
.4 (1 - Part[ImgData, y + 1, x + 1, 1]/255)*
A (1 + Sum[waves[x, y, w, a*2 Pi/N, t], {a, 0, N - 1, 1}]/(2 N))],
{x, 0, R, 1}, {y, 0, C, 1}],
PlotRange -> {{X1, X2}, {Y1, Y2}}, ImageSize -> IS]

Manipulate[
G[LY, 460, 90, 125, -1, 91, 1, -126, 1, .03, .7, t],
{t, 0, 29/30, 1/30}]

AbortProtect@
Manipulate[
G[LR, 420, 75, 130, 5, 75, -15, -130, 9, 1.6, 1.7, t],
{t, 0, 19/20, 1/20}]
I have a working hypothesis: Given enough circles you can make them look like anything.
For example here is the man himself, Erwin Schrödinger.
Maybe you recognize the face as the one that accompanies intothecontinuum posts on your dashboard.
Mathematica code:
Erwin:= ImageData[  Rasterize[   Import["Erwinsface.jpg"],   RasterSize -> 64],  "Byte"]Manipulate[   Graphics[   Table[    Disk[     {r, -c},      Sin[s] (1 - Part[Erwin, 2 c + 1, 2 r + 1, 1]/255)],   {r, 0, 63, 1}, {c, 0, 63, 1}],  ImageSize -> 500],{s, 0, Pi, Pi/40}]

I have a working hypothesis:
 Given enough circles you can make them look like anything.

For example here is the man himself, Erwin Schrödinger.

Maybe you recognize the face as the one that accompanies intothecontinuum posts on your dashboard.

Mathematica code:

Erwin:=
ImageData[
Rasterize[
Import["Erwinsface.jpg"],
RasterSize -> 64],
"Byte"]

Manipulate[
Graphics[
Table[
Disk[
{r, -c},
Sin[s] (1 - Part[Erwin, 2 c + 1, 2 r + 1, 1]/255)],
{r, 0, 63, 1}, {c, 0, 63, 1}],
 ImageSize -> 500],
{s, 0, Pi, Pi/40}]
The 821 knot parametrized as a Lissajous curve.
Mathematica code:
Manipulate[  Graphics[  Table[    Disk[     {Cos[3 (.1*t + n)*2 Pi/100 + .1], Cos[4 (.1*t + n)*2 Pi/100 + .7]},      .03*Cos[7 (.1*t + n)*2 Pi/100] + .05],   {n, 1, 100}],  PlotRange -> 1.1, ImageSize -> 500],{t,1,10,1}]

The 821 knot parametrized as a Lissajous curve.

Mathematica code:

Manipulate[ 
Graphics[
Table[
Disk[
{Cos[3 (.1*t + n)*2 Pi/100 + .1], Cos[4 (.1*t + n)*2 Pi/100 + .7]},
.03*Cos[7 (.1*t + n)*2 Pi/100] + .05],
{n, 1, 100}],
PlotRange -> 1.1, ImageSize -> 500],
{t,1,10,1}]
5000 points: one for each of you!
Try to pick one and follow it for as long as you can.
Mathematica code:
G[p_, q_, a_, b_, c_, t_] := Graphics[  Table[   {Opacity[.7],    Disk[     {.71*Cos[a (.04*t + n)*2 Pi/1000 + p],       Cos[b (.04*t + n)*2 Pi/1000 + q]},       .002*Cos[c (.04*t + n)*2 Pi/1000] + .005]},   {n, 1, 1000}],  PlotRange -> {{-.715, .715}, {-1.005, 1.005}}, ImageSize -> 500]Manipulate[    Show[    G[0, .2, 29, 13, 11, t],    G[0, .2, 19, 31, 9, t],    G[.3, .29, 3, 23, 17, t],    G[0, .3, 43, 7, 3, t],    G[.1, .13, 31, 19, 2, t]],{t,1,25,1}]

5000 points: one for each of you!

Try to pick one and follow it for as long as you can.

Mathematica code:

G[p_, q_, a_, b_, c_, t_] :=
Graphics[
Table[
{Opacity[.7],
Disk[
{.71*Cos[a (.04*t + n)*2 Pi/1000 + p],
Cos[b (.04*t + n)*2 Pi/1000 + q]},
.002*Cos[c (.04*t + n)*2 Pi/1000] + .005]},
{n, 1, 1000}],
PlotRange -> {{-.715, .715}, {-1.005, 1.005}}, ImageSize -> 500]

Manipulate[
Show[
G[0, .2, 29, 13, 11, t],
G[0, .2, 19, 31, 9, t],
G[.3, .29, 3, 23, 17, t],
G[0, .3, 43, 7, 3, t],
G[.1, .13, 31, 19, 2, t]],
{t,1,25,1}]
Mathematica code:
G[X_, Y_, Z_, S_, p_, q_, r_, a_, b_, c_, N_, e_, t_, PR_, IS_] :=Graphics[ Table[    Disk[     {X*Cos[a (e*t + n)*2 Pi/N + p], Y*Cos[b (e*t + n)*2 Pi/N + q]},      Z*Cos[c (e*t + n)*2 Pi/N + r*t*2 Pi] + S], {n, 1, N}],PlotRange -> PR, ImageSize -> IS]Manipulate[ G[.75, 1, .02, .03, 0, Pi/2, .04, 3, 1, 4, 100, .08, t,   {{-.857, .857}, {-1.2, 1.2}}, 500],{t, 1, 25, 1}]

Mathematica code:

G[X_, Y_, Z_, S_, p_, q_, r_, a_, b_, c_, N_, e_, t_, PR_, IS_] :=
Graphics[
Table[
Disk[
{X*Cos[a (e*t + n)*2 Pi/N + p], Y*Cos[b (e*t + n)*2 Pi/N + q]},
Z*Cos[c (e*t + n)*2 Pi/N + r*t*2 Pi] + S],
{n, 1, N}],
PlotRange -> PR, ImageSize -> IS]

Manipulate[
G[.75, 1, .02, .03, 0, Pi/2, .04, 3, 1, 4, 100, .08, t,
{{-.857, .857}, {-1.2, 1.2}}, 500],
{t, 1, 25, 1}]
How could you possibly turn infinity on its side?


Mathematica code:
G[X_, Y_, Z_, S_, p_, q_, r_, a_, b_, c_, N_, e_, t_, PR_, IS_] :=Graphics[ Table[    Disk[     {X*Cos[a (e*t + n)*2 Pi/N + p], Y*Cos[b (e*t + n)*2 Pi/N + q]},      Z*Cos[c (e*t + n)*2 Pi/N + r*t*2 Pi] + S], {n, 1, N}],PlotRange -> PR, ImageSize -> IS]Manipulate[ G[.5, 1, .02, .03, 0, Pi/4, -.05, 2, 1, 1, 40, 1, .1, t,  {{-.786, .786}, {-1.1, 1.1}}, 500],{t, 1, 20, 1}]?

How could you possibly turn infinity on its side?

Mathematica code:

G[X_, Y_, Z_, S_, p_, q_, r_, a_, b_, c_, N_, e_, t_, PR_, IS_] :=
Graphics[
Table[
Disk[
{X*Cos[a (e*t + n)*2 Pi/N + p], Y*Cos[b (e*t + n)*2 Pi/N + q]},
Z*Cos[c (e*t + n)*2 Pi/N + r*t*2 Pi] + S],
{n, 1, N}],
PlotRange -> PR, ImageSize -> IS]

Manipulate[
G[.5, 1, .02, .03, 0, Pi/4, -.05, 2, 1, 1, 40, 1, .1, t,
{{-.786, .786}, {-1.1, 1.1}}, 500],
{t, 1, 20, 1}]

?