10
$\begingroup$

I would like to produce an image similar to the upper half of this graphics by Victor Vasarely.

enter image description here

All I could produce so far is this dilettante image:

g = Graphics[{[email protected], Rectangle[]}, ImageSize -> 30];
h = Graphics[{[email protected], Rotate[Rectangle[], Pi/12]}, ImageSize -> 30];

Grid[{
  {g, g, g, g, g, g, g, g, g, g, g},
  {g, g, g, g, g, h, g, g, g, g, g},
  {g, g, g, g, h, h, h, g, g, g, g},
  {g, g, g, h, h, h, h, h, g, g, g},
  {g, g, h, h, h, h, h, h, h, g, g},
  {g, h, h, h, h, h, h, h, h, h, g},
  {g, g, h, h, h, h, h, h, h, g, g},
  {g, g, g, h, h, h, h, h, g, g, g},
  {g, g, g, g, h, h, h, g, g, g, g},
  {g, g, g, g, g, h, g, g, g, g, g},
  {g, g, g, g, g, g, g, g, g, g, g}},
 Background -> [email protected],
 Spacings -> {0.1, 0}]

enter image description here

I also tried scaled rectangles and parallelograms but to no avail: The forms don't align "properly"(equal vertical spacings).

Maybe Grid is an inept tool to get the desired effect?

How would you approach this problem?

$\endgroup$
2
  • $\begingroup$ (at) eldo: Honestly speaking, in the graphics of Victor Vaserely I don't see rotated rectangles, not even rhombus but "at most" paralelograms with angles progressing according to a more or less complicated rule as we move along. So, if you really want to reproduce Vasarely's graphics we need to agree on the deformation rule. (BTW, I like your graph :-) $\endgroup$ Commented Sep 21, 2014 at 17:06
  • 1
    $\begingroup$ (at) eldo: look at that: h = Graphics[{[email protected], Rotate[Rectangle[], Pi/12]}, ImageSize -> 40]; gives a beautiful displacements of the outer squares. $\endgroup$ Commented Sep 21, 2014 at 17:18

4 Answers 4

6
$\begingroup$

My first attempt, using ShearingTransform

sd[i_, j_] := 
 If[And[4 <= j <= 10, 8 - j <= i - 1 <= j, 
   j - 6 <= i - 1 <= 14 - j], -20, 0]
GraphicsGrid[
 Table[
  Graphics[{[email protected],
    GeometricTransformation[
     GeometricTransformation[
      Rectangle[],
      ShearingTransform[sd[i, j] Degree, {0, 1}, {1, 0}]],
     RescalingTransform[{{-1, 1}, 
       If[sd[i, j] == 0, {0, 1}, {0, 1.5}]}, {{-1, 1}, {0, 
        1}}]]}], {i, 9}, {j, 12}], Background -> [email protected]]

Mathematica graphics

I think this meets the equal vertical spacings criterion but assumes that each of the parallelograms are sheared by the same amount, which does not appear to be correct.

$\endgroup$
1
  • $\begingroup$ 1000 thanks for your answer. It is much nearer to what I want :) $\endgroup$
    – eldo
    Commented Sep 21, 2014 at 19:42
8
$\begingroup$

Your Vasarely graphic reminds me of an old Mathematica Jounal article by Flip Phillips about the work of William Kolomyjec. It's not the same effect, but may provide some amusement. The distance function d may be the following, or Norm or ChessboardDistance or ... Other parameters include scalings of colours, rotation angles, and translations.

Block[{hmax = 34, vmax = 21, d},
   Graphics[{EdgeForm[{Thin, Black}],
      Table[
         d = Min[i, j, hmax - i - 1, vmax - j - 1]/Max[hmax, vmax];
         {ColorData["FallColors", 2.2 d^0.7],
          Translate[
             Rotate[Rectangle[{i, j}], 2 d*RandomReal[{0, 1}]*\[Pi]/2],
             400 E^(-6 (1 - d)) RandomReal[{-0.1, 0.1}, 2]]},
         {i, 0, hmax - 1}, {j, 0, vmax - 1}]},
      Background -> Black]]

Kolomyjec

$\endgroup$
2
  • $\begingroup$ Thanks @ Kenny very beautyful and fun to play with :) $\endgroup$
    – eldo
    Commented Sep 23, 2014 at 8:42
  • $\begingroup$ A work of art ! $\endgroup$
    – VividD
    Commented Sep 30, 2014 at 8:06
5
$\begingroup$

First, create a matrix for shape positions:

a = ArrayPad[
  ArrayPad[DiamondMatrix[2], 1] + DiamondMatrix[3], {{1, 1}, {3, 2}}]

Then, apply geometric transformations to appropriate positions.

Graphics[{LightGray, MapIndexed[Which[
     #1 == 0, Scale[Rectangle[#2, #2 + 1], .8],
     #1 == 2, 
     GeometricTransformation[
      Translate[Scale[Rectangle[#2, #2 + 1], {.8, .85}], {0, .2}], 
      ShearingTransform[-20 Degree, {0, 1}, {1, 0}, #2]],
     #1 == 1, 
     Which[a[[Sequence @@ (Reverse[#2] + {1, 0})]] == 0 \[And] 
       a[[Sequence @@ (Reverse[#2] - {1, 0})]] == 0, 
      GeometricTransformation[
       Translate[Scale[Rectangle[#2, #2 + 1], {.8, .7}], {0, .2}], 
       ShearingTransform[-20 Degree, {0, 1}, {1, 0}, #2]],
      a[[Sequence @@ (Reverse[#2] + {1, 0})]] == 0, 
      GeometricTransformation[
       Translate[Scale[Rectangle[#2, #2 + 1], {.8, .8}], {0, .15}], 
       ShearingTransform[-20 Degree, {0, 1}, {1, 0}, #2]],
      True, 
      GeometricTransformation[
       Translate[Scale[Rectangle[#2, #2 + 1], {.8, .8}], {0, .25}], 
       ShearingTransform[-20 Degree, {0, 1}, {1, 0}, #2]]]
     ] &, Transpose[a], {2}]}, Background -> Darker[Gray, .7], 
 PlotRangePadding -> .15]

Mathematica graphics

There are five different groups of shapes:

  • the rectangles outside the diamond that are only scaled
  • the rectangles inside the diamond are scaled and sheared in four different ways:
    • the left and right corner,
    • the top edge,
    • the bottom edge and
    • the inside of the diamond.
$\endgroup$
3
$\begingroup$

Not exactly what is asked but it may be a good start too.

Alternative approach with Grid:

opt = {ImageSize -> {20, 20}, BaseStyle -> [email protected]};

Composition[
  Framed[Grid[#, Spacings -> {.3, .3}], Background -> Black] &,

  ArrayPad[#, {2, 2}, Graphics[Rectangle[], opt]] &,

  # + (DiamondMatrix[5] /. {1 -> 0, 0 -> 1}) Graphics[Rectangle[], opt] &
  ][
     DiamondMatrix[5] Graphics[ Polygon[{{0, 0}, {1, -.4}, {1, .6}, {0, 1}}], opt]
   ]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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