Op-art Graphic Images

Question

This image comes from Michael Trott's Mathematica Guidebook for Programming. It's just a chapter image though, and he doesn't show the code. I was wondering what would be the best approach to reproduce it.

Answer 1

Trott does give the code for this image in another volume of the series. Look on page 21 of his Mathematica Guidebook for Graphics.

Answer 2

To make this thread self-contained, here's a reimplementation of Trott's method to produce art in the style of Vasarely:

Module[{e = 6, h = 8, r = 5, s = 7, circRes = 25, sqrRes = 25, circle, square, R, x}, 
       square = Apply[Join, 
                      Map[{sqrRes - #, #}/sqrRes &, Range[0, sqrRes]].# & /@ 
                      N[Partition[{-{1, 1}, {1, -1}, {1, 1}, {-1, 1}}/2, 2, 1, 1]]];
       circle = N[Composition[Through, {Cos, Sin}] /@ Range[0, 2 Pi, 2 Pi/circRes]]/4;
       x = r^2/h // N; R = x (x + h);
       Graphics[Table[{{If[EvenQ[j + k], Black, White],
                        Polygon[TranslationTransform[{j, k}] /@ square]},
                       {If[EvenQ[j + k], White, Black],
                        Polygon[TranslationTransform[{j, k}] /@ circle]}},
                      {j, -s, s}, {k, -s, s}]] /. 
        v_ /; VectorQ[v, NumericQ] :>
        Block[{nn = Norm[v], z},
              z = If[nn < r, Sqrt[R - nn^2] - x, 0]; v (1 - (e - z)/(h - z))]
       ]

It should not be too hard to modify the code given to produce an animated version like this one; this extension is left as an exercise for the interested reader (hint: nn = Norm[v - {x0, y0}]).

Answer 3

A slightly different approach,

f[t_] := t - 2 t^3
g[r_] := With[{R = 4}, If[r < R, 1 - Sqrt[1 - (r/R)^2]/3, 1]]
RegionPlot[
 f[Times @@ Cos[Pi {x, y} g[Sqrt[x^2 + y^2]]]] > 0, {x, -5.5, 
  5.5}, {y, -5.5, 5.5}, PlotPoints -> 100]

which comes from the following.

The little dots aren't precisely circles, but: meh.

Answer 4

I started a different approach, but I didn't anticipate perspective issues...:)

grid = Graphics[{
   EdgeForm[Black],
   Table[{
     Black,
     Rectangle[{ x + Mod[y, 2] - .5, y  - .5}, {x + Mod[y, 2] + .5, 
       y  + .5}], 
     White,
      Disk[{x + Mod[y, 2], y}, .25]}, 
    {x, 1, 10, 2}, {y, 1, 10}],
   Table[{
     White,
     Rectangle[{ x + Mod[y, 2] - .5, y  - .5}, {x + Mod[y, 2] + .5, 
       y  + .5}], 
     Black,
     Disk[{x + Mod[y, 2], y}, .25]},
    {x, 2, 9, 2}, {y, 1, 10}]
   }];
 ParametricPlot3D[{Cos[u] Sin[ v], Sin[u] Sin[v], Cos[v]}, 
   {u, 0, 2 Pi}, {v, 0, Pi}, Mesh -> None, Boxed -> False, 
   Axes -> None, SphericalRegion -> True, PlotPoints -> 120, 
   Lighting -> "Neutral", PlotStyle -> Texture[grid], 
   Prolog -> Inset[grid]]

Answer 5

How about this approach:

img = Import[
   "http://gethighnow.com/wp-content/uploads/2009/07/hermmanns-grid.jpg"];

f[x_, y_] := 
  With[{r = N@Sqrt[(x - .5)^2 + (y - .5)^2], 
    a = ArcTan[x - .5, y - .5], R = .3}, rn = r*r/R;
   {rn*Cos[a] + .5, rn*Sin[a] + .5}];

dist = ImageTransformation[img, f[#[[1]], #[[2]]] &];

mask[img_] := 
 Graphics[{White, Rectangle[{0, 0}, {320, 320}], Black, 
   Disk[{160, 160}, 100]}, ImageSize -> ImageDimensions[img], 
  Background -> White]

mask2[img_] := 
 Graphics[{Black, Rectangle[{0, 0}, {320, 320}], White, 
   Disk[{160, 160}, 100]}, ImageSize -> ImageDimensions[img], 
  Background -> Black]

hole = SetAlphaChannel[ImageAdd[dist, mask[img]], mask2[img]];

ImageCompose[img, hole]