Reproduce image effect in Mathematica

Question

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:

The result I want:

Answer 1

Load image

img = Import["https://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]

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]

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]]

Answer 2

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}}]

Answer 3

Another approach:

pic = Import@"https://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.

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

Answer 4

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}
  ]
 ]

---

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]]