Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

enter image description here

share|improve this question
1  
For searching purposes: this is in the style of Victor Vasarely's "Vega" series of op art. –  J. M. Nov 22 '12 at 17:46
1  
Victor Vasarely --- or Vásárhelyi Győző from Pécs, Hungary –  Szabolcs Nov 23 '12 at 1:09
add comment

5 Answers

up vote 14 down vote accepted

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

share|improve this answer
    
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. –  Chris Degnen Nov 22 '12 at 20:56
add comment

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]

enter image description here

which comes from the following.

enter image description here

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

share|improve this answer
add comment

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

Vasarelian art

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

share|improve this answer
add comment

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

image

share|improve this answer
add comment

How about this approach:

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

enter image description here

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]

op-art

share|improve this answer
    
Seems both of us used the same code seed :) stackoverflow.com/a/5055736/353410 –  belisarius Nov 22 '12 at 17:54
    
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] –  J. M. Nov 22 '12 at 18:41
1  
@J.M. You're right, I just copied the function from the Neat Examples section of the documentation for ImageTransformation[]. –  VLC Nov 22 '12 at 18:52
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.