Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

How do I create the "dotifying" effect below in Mathematica?

I have tried to use Rasterize first to get the image pixelated, but how do I get the disc/circle pattern then?

image := Import["image.jpg"]
Rasterize[image, RasterSize -> 150, ImageSize -> Full]

Original:

Original image

The result I want:

"Dotify" effect

share|improve this question
4  
Have you seen this? – J. M. Feb 11 at 14:54
    
Related: (8716) – Mr.Wizard Feb 11 at 20:26
1  
There are things to do after your question is answered. It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one. Participation is essential for the site, please come back to do your part tomorrow – rhermans Feb 12 at 9:33
    
@rhermans I will. Great answers! – macurie Feb 12 at 14:33
up vote 19 down vote accepted

Load image

img = Import["http://i.stack.imgur.com/qzMGE.jpg"]

ImagePartition and DominantColors

Make an array of Disk of the DominantColors in each part of ImagePartition.

Rotate[
 Graphics@MapIndexed[
    {First@DominantColors[#1, 1], Disk[#2, 1/2]} &
    , ImagePartition[img, 10], {2} ]
 , -π/2]

enter image description here

ImageResize and ImageData

But I find the solution by @Szabolcs better, here I just do the rotation differently and add Background -> Black

Graphics[
 MapIndexed[
  {RGBColor[#1], Disk[{{0, 1}, {-1, 0}}.#2, 1/2]} &, 
  ImageData@ImageResize[img, {Automatic, 80}]
  , {2}
  ], Background -> Black]

Mathematica graphics

Removing Moiré pattern

And yet another rotation option.

Export[
 "Q106165.PDF",
 Graphics[
  MapIndexed[
   {RGBColor[#1], , Disk[#2, 1/2]} &, 
   Transpose@
    ImageData[ImageResize[img, {Automatic, 80}], DataReversed -> True]
   , {2}
   ], Background -> Black]]

enter image description here

share|improve this answer

Here's my solution. Change CompilationTarget -> "C" to CompilationTarget -> "WVM" if you don't have a C compiler available.

cf = Compile[{{v, _Real}, {kernel, _Real, 2}},
   v*kernel,
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];

shapedPixels[img_, kernel_] := With[{dim = ImageDimensions[img]},
   ImageCrop[
    Image[Join @@ 
      Transpose[
       Join @@@ 
        Transpose[
         cf[ImageData[
           ImageResize[img, 
            Ceiling[dim/Reverse[Dimensions[kernel]]]]], kernel], {1, 
          2, 5, 4, 3}], {1, 3, 2, 4}]], dim]];

Manipulate[
 shapedPixels[pic, 
  ArrayPad[If[invert, 1 - matrix[r], matrix[r]], padding]], {r, 1, 20,
   1}, {padding, 0, 10, 
  1}, {matrix, {DiskMatrix, DiamondMatrix, BoxMatrix, IdentityMatrix, 
   CrossMatrix}}, {{invert, False}, {True, False}}]

share|improve this answer

Another approach:

pic = Import@"http://i.stack.imgur.com/qzMGE.jpg"

Image @ ArrayFlatten @ Map[
   Map[Function[x, x #], DiskMatrix[5], {2}]&, 
   ImageData@ImageResize[pic, {Automatic, 50}],
   {2}
]

I'm not taking care about preserving image size, it is governed by Resize and DiskMatrix size.

enter image description here

just put e.g. DiamondMatrix[5] or Rescale@GaussianMatrix[10] to get more fun:

enter image description here enter image description here

share|improve this answer

You need to:

  1. Rescale the image to a smaller size, ImageResize

  2. Extract the pixel values, ImageData

  3. Convert the triplets to RGBColor directive, and build a Graphics with appropriately coloured Disks inside. I found MapIndexed convenient for this.

Code:

img = ExampleData[{"TestImage", "Sailboat"}];

pixels = Transpose@ImageData[ImageResize[img, 50], DataReversed -> True];

g = Graphics[
 MapIndexed[
  {RGBColor @@ #1, Disk[#2, 1/2]} &,
  pixels,
  {2}
  ]
 ]

enter image description here


Update: when Mathematica renders graphics on screen, it rounds coordinates to screen pixels. This can induce ugly moire effects with repeating patterns like this. To avoid it, you can

Export to PDF and view the result:

Export["g.pdf", g]

This must be done using Export and not using the graphical interface.

Or rasterize at high resolution and downscale:

factor = 5;
ImageResize[Rasterize[g, "Image", ImageResolution -> 72 factor], Scaled[1/factor]]
share|improve this answer
    
It seems some of the disks are overlapping when I use your code, this can also be seen in your picture. How to avoid this? Visually it divides the image into rectangles. – macurie Feb 11 at 14:54
1  
It looks a bit more like the photoshop version if you add Background -> Black into the Graphics command. – bill s Feb 11 at 15:13
2  
@macurie I cannot see this on my high-res screen but I think I know what you mean. Mathematica tends to round everything to screen pixels, which can induce the moire-like effect you describe. Export the graphics to PDF, and view it with a PDF viewer. Alternatively export it to a bitmap at very high resolutions and downscale it to a a more reasonable size. The effect should disappear. – Szabolcs Feb 11 at 15:14
2  
@macurie One more note: do not export by right-click -> Save Graphics As... You must use the Export command to make sure the effect disappears. – Szabolcs Feb 11 at 15:15

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.