Artistic image vectorization
Let's get a low-res image:
And put in in gray-scale mode:
gimg = ColorConvert[ImageResize[
Import["http://i.stack.imgur.com/wtgxH.jpg"], 300], "Grayscale"];
Now extract the image data (pixel values) together with pixel indexes:
data = MapIndexed[Append[#2, #1] &, ImageData[gimg], {2}];
I, of course, couldn't pass on Voronoi styling. We will add random noise to perfectly integer pixel coordinates and make a mosaic animation:
Table[Rotate[ListDensityPlot[(MapThread[Append, {3 RandomReal[{-1, 1}, {Length[#], 2}],
ConstantArray[0, Length[#]]}] + #) &@Flatten[Transpose@data, 1][[1 ;; -1 ;; 15]],
InterpolationOrder -> 0, ColorFunction -> "GrayTones",
BoundaryStyle -> Directive[Black, Opacity[.2]], Frame -> False,
PlotRangePadding -> 0, AspectRatio -> Automatic, ImageSize -> 600], -Pi/2], {10}];
Export["test.gif", %]
And various outlandish coloring
Grid[Partition[Rotate[ListDensityPlot[(MapThread[
Append, {3 RandomReal[{-1, 1}, {Length[#], 2}],
ConstantArray[0, Length[#]]}] + #) &@
Flatten[Transpose@data, 1][[1 ;; -1 ;; 45]],
InterpolationOrder -> 0, ColorFunction -> #,
BoundaryStyle -> Directive[Black, Opacity[.2]], Frame -> False,
PlotRangePadding -> 0, AspectRatio -> Automatic,
ImageSize -> 300], -Pi/2] & /@ {"CherryTones", "CoffeeTones",
"DarkRainbow", "DeepSeaColors", "PlumColors", "Rainbow",
"StarryNightColors", "SunsetColors", "ValentineTones"}, 3],
Spacings -> 0]
If we fix the noise sampling with SeedRandom
and change only magnitude of the noise, we can create a sort of order-from-chaos appearance effect:
id = ParallelTable[Rotate[ListDensityPlot[(MapThread[
Append, {SeedRandom[1];
200 (1 - st^(1/8)) RandomReal[{-1, 1}, {Length[#], 2}],
ConstantArray[0, Length[#]]}] + #) &@
Flatten[Transpose@data, 1][[1 ;; -1 ;; 15]],
InterpolationOrder -> 0, ColorFunction -> GrayLevel,
BoundaryStyle -> Opacity[.1], Frame -> False,
PlotRangePadding -> 0, AspectRatio -> Automatic,
ImageSize -> 350], -Pi/2], {st, 0.2, 1, .05}];
idd = id~Join~Table[id[[-1]], {7}];
Export["appear.gif", idd, ImageSize -> 350]
This vectorisation attempts to represent the image with coloured triangles. The code selects a user defined number of sample points, with the selection weighted according to the image gradient, to obtain finer sampling in more detailed regions of the image. I use ListPlot3D
to triangulate the sample points into a set of polygons - there is probably a neater way. The output from ListPlot3D
is stripped of the third dimension and VertexColors
are applied to the polygons based on the image colour at the sample points.
vectorise[img_,pts_]:=Module[{w,h,weights,points,plot,coords,polys,vcols},
{w,h}=ImageDimensions@img;
weights=Flatten@Transpose@ImageData[GradientFilter[img,2]];
points=Join[RandomSample[weights->Tuples[Range/@{w,h}],pts],{{1,1},{w,1},{1,h},{w,h}}];
plot=ListPlot3D[points/.{a_,b_}:>{a,b,0},InterpolationOrder->1,Boxed->False,Mesh->False,Axes->False,BoundaryStyle->None];
coords=plot[[1,1,All,;;2]]/.{a_,b_}:>{a,h+1-b};
polys=plot[[1,2,1,1,2,1,1,1]];
vcols=ImageValue[img,#]&/@coords;
Graphics[{GraphicsComplex[coords,Polygon[polys],VertexColors->vcols]}]]
Example:
img = ImageResize[ExampleData[{"TestImage", "Lena"}], 200];
vectorise[img, #] & /@ {100, 1000, 10000}
Having vectorised the image we can do silly things with the graphics:
rand=RandomReal[{-20,20},{10004,2}];
pic=vectorise[img,10000];
Export["fragmentlena.gif",Table[MapAt[#+rand (1-Cos[t])^2&,pic,{1,1,1}],{t,2\[Pi]/40,2\[Pi],2\[Pi]/40}],ImageSize->200,"DisplayDurations"->0.05,AnimationRepetitions->Infinity]
Let me start from an approach which I believe has its own name, but unfortunately I don't know it. The idea is to generate circles whith radii depending on the intensity of corresponding and surrounding pixels.
img = Import["ExampleData/rose.gif"];
bubbled[img_, r_, delta_, rmax_] :=
Block[{ker, data, radii, thresh = 0.99},
ker = N[#/Total@Total@#] &@DiskMatrix[r];
data = Map[Mean, ImageData[ImageConvolve[img, ker]], {2}];
radii = Partition[data, {1, 1}, delta] /. {{a_?NumberQ}} -> a;
Graphics@
MapIndexed[If[#1 < thresh, Disk[#2, rmax Max[1 - #1, 0]]] &,
Reverse /@ (Transpose@radii), {2}]
];
is = 360;
Manipulate[
Row[Show[#, ImageSize -> is] & /@ {img, bubbled[img, r, d, rmax]}],
{{r, 1, "Smooth radius"}, 1, 10, 1, ControlType -> Setter},
{{d, 3, "Offset"}, 1, 10, 1, ControlType -> Setter},
{{rmax, Sqrt[2.]/2, "Maximum radius"}, 0.5, 1, 0.05}
]
Some more examples:
One can then save the image for printing:
gfx = bubbled[img, 2, 3, 1]
Export[NotebookDirectory[] <> "gfx.pdf", gfx]