I'm trying to get an algorithm that generates a picture like this

enter image description here

So far I've tried a little something with the help of the knowledge center, getting a graphics grid of squares already. But what now? I'm completely in the dark on how to trim it in the circle-shape I want. (If there are better solutions out there, please forget what I have started with. My only goal is to get the end result where I can make a pattern like this with variable size in terms of diameter in squares, size of the squares themselves and spacing in between.)

size = 10;
scalesize = 1;
table1 = Table[Graphics[Rectangle[]], {size}, {size}];

GraphicsGrid[table1, Frame -> None, Spacings -> Scaled[scalesize]]

The only thing you need for the underlying data is DiskMatrix. The rest of the visualization can be chosen freely:

ArrayPlot[ArrayPad[DiskMatrix[7], 1], ColorFunction -> GrayLevel, 
 Mesh -> All, MeshStyle -> Directive[Thickness[.02], Black]]

Mathematica graphics

  • 3
    $\begingroup$ I like those dots in knots of the mesh :) $\endgroup$ – Kuba Oct 18 '13 at 6:16
  • $\begingroup$ Thank you so much, I tried spitting through the database for two days getting to find such a function. $\endgroup$ – Sward Oct 18 '13 at 19:03

Here is an example using graphics primitives. It has some nice flexibility.

radius = 6.5;
sidelength = 0.6;
xy = Flatten[
   Table[{x, y}, {x, -2 radius, 2 radius}, {y, -2 radius, 2 radius}], 
inside = Select[xy, EuclideanDistance[#, {0, 0}] <= radius &];
shape[center_, a_] := {White, Rectangle[center - a/2, center + a/2]}
Graphics[shape[#, sidelength] & /@ inside, Background -> Black]

Based on other answers it is simpler and more elegant to replace Table, Select and EuclideanDistance with DiskMatrix making a nice little one-liner

Graphics[{White, Rectangle[# - 0.3, # + 0.3]} & /@ Position[DiskMatrix[6], 1], Background -> Black]

Mathematica graphics

Let's redefine the shape function:

shape[center_,a_] := {White, Disk[center, a/2]}
Graphics[shape[#, sidelength] & /@ inside, Background -> Black]

Mathematica graphics

and again:

starcoords := 
  With[{r = RandomReal[Pi]}, 
   Table[{Cos[t + r], Sin[t + r]}, {t, 0, 4 Pi, 4 Pi/5}]/3];
shape[center_] := {White, Polygon[center + # & /@ starcoords]}
Graphics[shape /@ inside, Background -> Black]

Mathematica graphics

  • $\begingroup$ This does the job too perfectly, without the use of DiskMatrix, which was frankly unfindable by me. I don't think I could have ever found out how to do this. I'd like to select your answer as accepted answer too, but I can only select one unfortunately. $\endgroup$ – Sward Oct 18 '13 at 19:04

Here is an answer using image processing techniques rather than graphics, that is also very flexible. Create an array of dots at the centers of all the shapes:

dots = Image[Upsample[DiskMatrix[8], 20, 10]];

enter image description here

and then convolve with the desired shape. The shape is then replicated throughout the image. For the requested box:

ImageConvolve[dots, BoxMatrix[5]]

enter image description here

Any shape will do: here is how to stick a cross at each dot.

ImageConvolve[dots, CrossMatrix[5]]

enter image description here

Borrowing cormullion's idea of making it interactive:

Manipulate[dots = Image[Upsample[DiskMatrix[6], 20, 10]]; 
  ImageConvolve[dots, neighborhood[radius]],
  {neighborhood, {IdentityMatrix, DiskMatrix, BoxMatrix, CrossMatrix, 
      DiamondMatrix, GaussianMatrix}}, {radius, 1, 21, 1}]

enter image description here

  • $\begingroup$ If you add an ArrayPad you can center your shapes. dots = Image[Upsample[ArrayPad[DiskMatrix[8], {1, 0}], 20]]; $\endgroup$ – s0rce Oct 20 '13 at 14:39
  • $\begingroup$ You can also use the 2nd argument of Upsample but then the border is quite narrow. $\endgroup$ – s0rce Oct 20 '13 at 14:53
  • $\begingroup$ @sOrce -- Thanks... I've updated so as to center the dots and shapes. $\endgroup$ – bill s Oct 20 '13 at 15:04

I tried to make a Manipulate, but there are some errors in this code due possibly to rounding errors which I haven't tracked down:

     Rectangle[{x, y}, {x + space, y + space} ], {y, 1, n, step}, {x, 
      1, n, step}]
    }, Background -> Black] /. 
  Rectangle[{x_, y_}, {x1_, 
      y1_}] /; (n/2 - Norm[x, x + step + space])^2 + (n/2 - 
         Norm[y, y + step + space])^2 > radius :> {Black, 
    Rectangle[{x, y}, {x1, y1}]},
 {n, 10, 100, 2},
 {space, 1, step},
 {step, 5, 10, 1},
 {radius, 1, 1000}

a manipulate for designing grids

  • $\begingroup$ I do appreciate your effort a lot :), but the above two anwers don't have these rounding errors. $\endgroup$ – Sward Oct 18 '13 at 19:05
  • $\begingroup$ @sward no problem - I didn't spend too much time on it, but I thought the method might be interesting to try. Unfortunately allowing everything to be a variable brings new problems... :) $\endgroup$ – cormullion Oct 18 '13 at 19:08

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.