archery

$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!

Notes: 107 1/17/13 — 6:01pm Filed under: #GIF #Mathematica #physics #Image processing #portrait #circles #Erwin Schrödinger

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

Notes: 793 11/12/12 — 7:00pm Filed under: #GIF #Mathematica #circles #wavy #phase

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

Notes: 1452 11/12/12 — 5:02pm Filed under: #GIF #Mathematica #circles #wavy

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

Notes: 1023 11/11/12 — 6:30pm Filed under: #GIF #Mathematica #circles #wavy

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

Notes: 1020 10/9/12 — 7:09pm Filed under: #GIF #Mathematica #Flying Lotus #Cosmogramma #album covers #circles

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

Notes: 213 10/3/12 — 6:01pm Filed under: #GIF #point lattice #circles #Mathematica

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

Notes: 232 9/30/12 — 6:00pm Filed under: #C11 #C5 #C7 #C9 #GIF #Mathematica #circles #let your vision blur #point lattice #quasicrystal #halftone

For Mr. Gif in exchange for some stereoscopic magic.

To see Mathematica code:

Notes: 102 9/28/12 — 6:21pm Filed under: #GIF #Image processing #Mathematica #Mr. Gif #circles #point lattice #sorta3D? #steroscopic #halftone

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

Notes: 108 9/26/12 — 5:30pm Filed under: #GIF #Mathematica #circles #image processing #point lattice #subtle-body #halftone #portrait

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

Notes: 54 9/23/12 — 5:50pm Filed under: #Erwin Schrödinger #GIF #Mathematica #circles #image processing #point lattice #halftone #portrait

The 8₂₁ 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}]

Notes: 444 9/16/12 — 5:57pm Filed under: #8_21 #GIF #Lissajous knot #Mathematica #lissajous curve #knot theory #circles

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

Notes: 1022 9/14/12 — 4:54pm Filed under: #5000 #GIF #Mathematica #thx 4 following! #circles

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

Notes: 1376 9/7/12 — 5:26pm Filed under: #GIF #Mathematica #Lissajous curve #circles

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

?

Notes: 105 9/7/12 — 4:35pm Filed under: #GIF #Mathematica #infinity #∞ #Lissajous curve #circles