# Op-art Graphic Images

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. • For searching purposes: this is in the style of Victor Vasarely's "Vega" series of op art. Nov 22, 2012 at 17:46
• Victor Vasarely --- or Vásárhelyi Győző from Pécs, Hungary Nov 23, 2012 at 1:09

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

• Well, there's the code, so notwithstanding other valiant efforts, I'm accepting this answer. I will take a close look; Trott writes some awesome code. Nov 22, 2012 at 20:56

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

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.

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]] img = Import[ 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[#[], #[]] &];

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

Graphics[{Black, Rectangle[{0, 0}, {320, 320}], White,
Disk[{160, 160}, 100]}, ImageSize -> ImageDimensions[img],
Background -> Black] • To avoid the evaluation of trigonometric functions: f[x_, y_] := Module[{r = N @ Norm[{x, y} - .5], R = .3, rn}, rn = r*r/R; rn Normalize[{x, y} - .5] + .5] Nov 22, 2012 at 18:41
• @J.M. You're right, I just copied the function from the Neat Examples section of the documentation for ImageTransformation[].