I would like to imitate the structure of this great painting from Ellsworth Kelly in Mathematica. Yet with all the colored squares in Black and the beige one in white.

enter image description here

Below is what I have wrote to generate a square made out of 100 squares but I am confused about the next step :

How could I "Gaussianly sample" from the center How could I then assign different colors to the ones selected ?

                 Table[Rectangle @@@ 
                       Table[{{i, j}, {i + 1, j + 1}}, 
                             {i, Range[0, 10, 1]}], 
                  {j,Range[0, 10, 1]}], 1]
  • 4
    $\begingroup$ some of us are uncultured and are not familiar with Kelly Elsworth, so perhaps you could explain better what you want. Also, "how could I gaussianly sample" is unclear; what should be sampled? positions? and what should be gaussian? $\endgroup$ – acl Jan 30 '12 at 21:25
  • $\begingroup$ @acl, sorry for the confusion. It seems you and other got it perfectly though :-) $\endgroup$ – 500 Jan 30 '12 at 23:37
  • $\begingroup$ ok :) you should fix the question anyway, in case it useful to others in the future. $\endgroup$ – acl Jan 30 '12 at 23:43
  • $\begingroup$ @acl,Truth to be told, I added a lot to show I try, but I would have happily ask how to reproduce this image sampling from a list of colors. What do you think? $\endgroup$ – 500 Jan 31 '12 at 1:58
  • 2
    $\begingroup$ It's Ellsworth Kelly, not Kelly Ellsworth. $\endgroup$ – jason Jan 31 '12 at 14:40

This reproduces the image decently. It works by sampling without replacement from all the positions, and randomly coloring them with a built-in color scheme.

size = 41; 
amountCovered = 0.40;
noSquares = Floor[amountCovered*size^2];
tiles = Flatten[Table[{i, j}, {i, size}, {j, size}], 1];
probabilities = Flatten@GaussianMatrix[Floor[size/2]];
sample = RandomSample[probabilities -> tiles, noSquares];
colors = RandomInteger[21, noSquares];
mat = SparseArray[sample -> colors, {size, size}];
ArrayPlot[mat, Frame -> None, 
          ColorRules -> {0 -> RGBColor[{237, 233, 214}/255], 
                         x_ -> ColorData[54][x]}]

nice colorful squares]

For black and white, just replace colors with 1, and remove the ColorRules rules:

mat = SparseArray[sample -> 1, {size, size}];
ArrayPlot[mat, Frame -> None] 

black and white squares, sampled with gaussian probability

Choice of colors

Choosing randomly from a set of colors instead of the built in ColorData:

lesCouleurs = {RGBColor[0.4, 0.4, 1], RGBColor[1, 0.5, 0.5], RGBColor[0, 0, 0]}
colors = RandomInteger[Length@lesCouleurs, noSquares];
mat = SparseArray[sample -> colors, {size, size}];
ArrayPlot[mat, Frame -> None, 
          ColorRules -> {0 -> RGBColor[{237, 233, 214}/255], 
                          x_ :>  lesCouleurs[[x]]}]

N.B. I was lazy in using GaussianMatrix for computing the probabilities, so only odd sizes work as expected.

  • $\begingroup$ Nice, +1! I didn't even know about GaussianMatrix. $\endgroup$ – Verbeia Jan 30 '12 at 22:59
  • $\begingroup$ @Verbeia Thanks! It seems it's intended use is as a kernel for image filtering, I found it while spelunking through the documentation a while back. It also does derivatives of the Gaussian function, and for any dimension. Quite nifty IMHO. $\endgroup$ – Lars Johnson Jan 30 '12 at 23:17
  • $\begingroup$ @Lars Johnson, Thank You ! $\endgroup$ – 500 Jan 30 '12 at 23:38
  • $\begingroup$ @Lars, How could I adjust you code such that the color is a random draw within that list for example : lesCouleurs={RGBColor[0.4,0.4,1],RGBColor[1,0.5,0.5],RGBColor[0,0,0]} Thank you for your attention. $\endgroup$ – 500 Jan 31 '12 at 0:32

One way to create an image similar to the one you have is with ArrayPlot. The trick to "gaussianly sample" is to simply sample from a bivariate normal distribution and rescale the coordinates so they can be used for array rules in a SparseArray.

Here I use Tally to effectively bin the data on the grid.

Note that the color function can be changed to produce whatever colors you want.

data = RandomVariate[BinormalDistribution[0], 1000];

res = 50;

 SparseArray[(#[[1]] -> #[[2]]) & /@ 
   Tally[Round[Rescale[data, {Min[data], Max[data]}, {1, res}]]]],
  ColorFunction -> (If[# == 0, White, ColorData["SunsetColors"][#]] &)]

enter image description here

It is quite simple to change to black and white by changing the ColorFunction to

ColorFunction -> (If[# == 0, White, Black]&)

Also, in the spirit of Ruebenko's solution, we can get nice random RGB colors using..

ColorFunction -> (If[# == 0, White, RGBColor[RandomReal[{0, 1}, 3]]] &)
  • $\begingroup$ Nice! Is there an advantage of Tally over HistogramList? $\endgroup$ – Verbeia Jan 30 '12 at 21:39
  • $\begingroup$ @Verbeia I think it is a matter of taste. It can be useful to keep track of the cell counts rather than converting to {0,1} if one wants to create color images using say Image and subsequently do image processing. This can be accomplished with either route though. $\endgroup$ – Andy Ross Jan 30 '12 at 21:43
  • $\begingroup$ @Andy Ross, Thank You ! $\endgroup$ – 500 Jan 30 '12 at 23:38

Here is something to get you started.

data = RandomVariate[
d = MultinormalDistribution[{0, 0}, {{2, 0}, {0, 2}}], 1000];
hl = HistogramList[data, {0.15}];


enter image description here

The trick is to get the right number of bins as the second argument of HistogramList and to have just the right number of points in data. Too many, and the whole area is occupied; too few and there aren't enough points.

Once you have the coordinates in hl[[2]], assigning a random color should be straightforward. I have left this as an exercise.

  • $\begingroup$ Edited to use uncorrelated bivariate normal noise. $\endgroup$ – Verbeia Jan 30 '12 at 21:43

Here is my entry - thanks to Andy for centering...

n = 25;
data = Cases[
    RandomVariate[MultinormalDistribution[{0, 0}, {{1, 0}, {0, 1}}], 
      2000]*13], {_?(-n <= # <= n &), _?(-n <= # <= n &)}];
  {White, Line[{{-n, -n}, {n, -n}, {n, n}, {-n, n}, {-n, -n}}]},
  {RGBColor @@ RandomReal[{0, 1}, {3}], Rectangle[#, # + 1]} & /@ 

enter image description here

Have fun playing with the parameters....

  • $\begingroup$ I particularly like the use of random RGB colors. $\endgroup$ – Andy Ross Jan 30 '12 at 21:53
  • $\begingroup$ @AndyRoss, hey thanks - you know what I have not done statistics for such a long time I can't get that thing in the center.... haha. It's good that you look over that stuff... $\endgroup$ – user21 Jan 30 '12 at 21:55
  • 1
    $\begingroup$ Change the mean of the MultinormalDistribution from {1,2} to {0,0}. That will center if for you. $\endgroup$ – Andy Ross Jan 30 '12 at 21:56
  • $\begingroup$ Ah... right... Thanks. I need to go to bed.... $\endgroup$ – user21 Jan 30 '12 at 21:59
  • $\begingroup$ @ruebenko, Thank you very much ! $\endgroup$ – 500 Jan 30 '12 at 23:39

You were talking about a square with 100 smaller squares, so you must be thinking of a 10x10 grid.

mat = ConstantArray[0, {10, 10}];

Here a bi-bormal distribution which is truncated at the boundaries of the square:

d = TruncatedDistribution[{{1, 10}, {1, 10}}, 
         BinormalDistribution[{5.5, 5.5}, {2, 2}, 0]

Drawing a few samples from this distribution, rounding the position value and increasing the matrix count:

Scan[(mat[[#[[1]], #[[2]]]]++) &, Round[RandomVariate[d, 100]]]

Plotting and coloring:

MatrixPlot[mat, ColorRules -> {0 -> Black, 1 -> Yellow, 2 -> Red, 3 -> Green, 
                               4 -> Blue}, 
                ColorFunction -> (White &),
                Frame -> None

Mathematica graphics

Just remove the colors in the ColorRules list you don't want. The default color is the one given by ColorFunction.

MatrixPlot[mat, ColorRules -> {0 -> Black}, 
                ColorFunction -> (White &), Frame -> None

Mathematica graphics

  • $\begingroup$ @Sjoerd, Thank You ! $\endgroup$ – 500 Jan 30 '12 at 23:38

I am not sure I am answering the right question, but how about

With[{nonzero = 500, side = 100},
    Clip[#, {0, side}] &@
        NormalDistribution[side/2, Sqrt[side]], {nonzero, 2}] -> 
     RandomReal[{0, 1}, nonzero]
   {side, side}
  ] // ArrayPlot[#, ColorFunction \[Rule] "BlueGreenYellow", 
   ColorFunctionScaling \[Rule] True] &

Mathematica graphics

EDIT: OK here's how this works. I will describe it from inside going out. side is the size of the array, nonzero the number of nonzero elements that we wish.

We start with Ceiling@RandomVariate[NormalDistribution[side/2, Sqrt[side]], {nonzero, 2}] produces a set of random number pairs drawn from a Gaussian distribution, then makes them integer with Ceiling (introducing a slight bias but it shouldn't matter). Clip is then applied to this to force the resulting numbers to lie in the correct range for indices. The result is nonzero pairs of random numbers, all between 0 and side. Rule is then Threaded around this and RandomReal[{0, 1}, nonzero], and SparseArray wrapped around the whole thing, so that we end up using the pairs of Gaussian distributed random numbers as indices and fill in those positions with a RandomReal. If we then display the result with (eg) ArrayPlot, it looks like the plot above (the random entries in the matrix become random colours).

  • $\begingroup$ Great explanation! I wish there was such a description for every piece of code... Like an "explain" button" ... :) $\endgroup$ – cormullion Jan 31 '12 at 9:29
  • $\begingroup$ @cormullion thanks! I thought I'd add it so that maybe someone would find this useful $\endgroup$ – acl Jan 31 '12 at 11:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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