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.

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[{GrayLevel@0.7, Rectangle[]}, ImageSize -> 30];
h = Graphics[{GrayLevel@0.7, 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 -> GrayLevel@0.2,
 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?

share|improve this question
    
(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 :-) –  Dr. Wolfgang Hintze yesterday
1  
(at) eldo: look at that: h = Graphics[{GrayLevel@0.7, Rotate[Rectangle[], Pi/12]}, ImageSize -> 40]; gives a beautiful displacements of the outer squares. –  Dr. Wolfgang Hintze yesterday

2 Answers 2

up vote 3 down vote accepted

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[{GrayLevel@0.7,
    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 -> GrayLevel@0.2]

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.

share|improve this answer
    
1000 thanks for your answer. It is much nearer to what I want :) –  eldo yesterday

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

Alternative approach with Grid:

opt = {ImageSize -> {20, 20}, BaseStyle -> GrayLevel@.9};

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

share|improve this answer

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.