Reproduce image effect in Mathematica
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]
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]]
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}}]
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.
just put e.g. DiamondMatrix[5]
or Rescale@GaussianMatrix[10]
to get more fun: