# How can Mathematica be used to create images like these?

Here are two examples of artistic image interpolation using just black lines:

The first link shows the desired result created by an artist and the second done with C#.

How can Mathematica be used to create this effect on images and still maintain the edges and appearance of the original image but using lines?Here's an example image to use for this question:

• – Karsten 7. Jun 21 '16 at 15:37
• Related Mathematica documentation page "Create a Mesh Region from Image Data". – Anton Antonov Jun 21 '16 at 15:39
• – Rahul Jun 21 '16 at 15:46
• – Loovjo Jun 21 '16 at 20:28
• I did a bit of reference chasing and found that the triangulations in the second link were probably computed using this algorithm: Demaret et al, "Adaptive Thinning for Terrain Modelling and Image Compression", 2005. The part that was "done with C#" is not that, it's assigning colors to the triangles afterwards. – Rahul Jun 26 '16 at 5:49

Here's something to get the ball rolling:

img = ColorConvert[Import["http://i.stack.imgur.com/FaE06.jpg"], "Grayscale"];

DelaunayMesh[
ImageCorners[img, 1, 70*^-6],
MeshCellStyle -> {{2, All} -> White, {1, All} -> GrayLevel[0.5], {0, All} -> Black}
]


I'm looking forward to better results :-)

• It really accentuates the mustache, which of course is the most important part of the picture. – march Jun 21 '16 at 16:44
• Now we just need to get a set of stills that make up a scene, and make a movie like this.... – Jason B. Jun 25 '16 at 17:46

(These solutions loosely adhere to OP's request in the question. They were mostly made because of similar art/solutions pointed in the comments.)

## "Delaunay raster" like

Here is a solution related to "Delaunay raster" discussed in the question comments. It is based on the Mathematica documentation page "Create a Mesh Region from Image Data". I changed VoronoiMesh to DelauneyMesh and sampled the edge points.

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

imgBounds = Transpose[{{0, 0}, ImageDimensions[img]}];

edges = EdgeDetect[img, 2];

vm = VoronoiMesh[
RandomSample[ImageValuePositions[edges, White], 2000], imgBounds];

vml = NestList[
DelaunayMesh[Mean @@@ MeshPrimitives[#, 2], imgBounds] &, vm, 3];

Graphics[Table[{RGBColor[ImageValue[img, Mean @@ p]], p}, {p,
MeshPrimitives[Last[vml], 2]}]]


## Simon Wood's solution for a similar question

n = 1000;
{x, y} = ImageDimensions[img];

pts = Reverse /@
RandomChoice[
Tuples@{Range[y, 1, -1], Range[x]}, n];

pts = Join[pts, {{0, 0}, {x, 0}, {x, y}, {0, y}}];

m = DelaunayMesh@pts;

Graphics[With[{col = RGBColor@ImageValue[img, Mean @@ #]}, {EdgeForm@
col, col, #}] & /@ MeshPrimitives[m, 2]]


• Have you seen this? – J. M. will be back soon Jun 21 '16 at 16:05
• @J.M. No I have not. I am relatively new to image manipulation with Mathematica, so at this point I have mostly browsed the documentation. :) – Anton Antonov Jun 21 '16 at 16:07
• The trouble with a naive Delaunay triangulation is that the edges of the triangulation are not aligned with the edges of shapes of the image (like the brim of the hat)... Unfortunately Mathematica doesn't seem to have any built-in support for generating anisotropic triangulations. – Rahul Jun 21 '16 at 16:10
• @Rahul Good to know. – Anton Antonov Jun 21 '16 at 16:11
• Have you noted this example you link have a bug when you don't change the VoronoiMesh to DelauneyMesh?This is version 10.4.1 in window 10. – yode Jun 22 '16 at 2:48

A function to subdivide the triangles based on their gray level:

h[{v1_, v2_, v3_}] :=
With[{a = EuclideanDistance[v1, v2], b = EuclideanDistance[v1, v3],
c = EuclideanDistance[v2, v3]},
With[{s = (a + b + c)/2},
(2 Sqrt[s (s - a) (s - b) (s - c)])/c
]]

shadeTri[tri_, col_, f1_: 1, fc_: 1] := If[col > .8,
tri,
With[{v = tri[[1, RandomSample[Range[3]]]]},
With[{sf = Min[f1 (1 - col)*h[v], fc h[v]]},
{Scale[tri, #, v[[1]]] & /@ Union[Append[Range[sf]/sf, 1]]}
]]
]


Then, using the slightly modified Simon Wood's approach to generate the triangle mesh:

img = Import[

n = 1000;
{x, y} = ImageDimensions[img];

pts = Reverse /@
RandomChoice[
Flatten@ImageData@
RemoveAlphaChannel[RemoveBackground[img], White], 10] ->
Tuples@{Range[y, 1, -1], Range[x]}, n];

m = DelaunayMesh@pts;

SeedRandom[2];
Graphics[{EdgeForm[Black], Opacity[0],
With[{col = Mean@ImageValue[img, Mean @@ #]},
shadeTri[#, col, 2, 3]] & /@ MeshPrimitives[m, 2]},
ImageSize -> 2 {x, y}]


You have to play with the f1 and fc parameters to achieve a good result. f1 controls the line density scaling (larger f1 means more lines) and fc controls the maximum line density allowed.

### Update

Here is a result with the image in the question with n=5000:

• @shrx Great start! Love the line effects! Marlyn is recognizable, but poor Sam didn't fare as well. If the segments could follow the lines in the image this would be a winner. Add more segments and we lose the clean line effect. – R Hall Jun 22 '16 at 10:33
• @RHall Please see the update I made to this answer. I think we get fairly good recognition of the cowboy. – Anton Antonov Jun 22 '16 at 15:04
• @Anton, although it now looks as if his fabulous moustache has merged with his lapels... – J. M. will be back soon Jun 22 '16 at 15:09
• @J.M. Good point, and ... is this a bad thing? I think it is an improvement. :) – Anton Antonov Jun 22 '16 at 15:20
• @AntonAntonov Increasing the poly count does improve this methods ability to follow the image contrast edges, but loses the artistic feel of the sample images by adding so many polygons. +1 for the longer mustache! – R Hall Jun 22 '16 at 16:28

First and foremost, it must be mentioned that in the artist's work, not all possible triangles are drawn from the vertices. There are triangles whose one or more edges consist of more than two vertices; technically they are polygons (disguising as triangles). And in fact, there are also non-disguising 4-gons. Shown below are some of those things.

It would be too difficult for me to write a code that reproduces this artistic judgment. I'll stick to normal triangulation and adapt shrx's code. The explanation is at the very end.

# Code

(* parameters *)
standardwidth = 600;
numblocks = 10;
n = 1500;
binarizethreshold = 4 / 10;
edthreshold = 1 / 40;
whitethreshold = 7 / 10;
bg = Green;
bgmarker = 1 / Pi;

(* functions *)
h[{v1_, v2_, v3_}] := Module[
{a, b, c, s},
a = EuclideanDistance[v1, v2];
b = EuclideanDistance[v1, v3];
c = EuclideanDistance[v2, v3];
s = (a + b + c) / 2;
2 Sqrt[s (s - a) (s - b) (s - c)] / c
];
shadetri[tri_, col_, f1_:1, fc_:1] := If[
col > whitethreshold,
tri,
Module[
{v, newcol, sf},
v = tri[[1, RandomSample[Range[3]]]];
newcol = Rescale[col, {0, whitethreshold}];
sf = Ceiling @ If[
newcol == 1,
fc h[v],
Min[f1 (1 - newcol) h[v], fc h[v]]
];
Append[Scale[Line @ Rest @ v, #, First @ v] & /@ (Rest @ Most @ Subdivide @ sf), tri]
]
];
turngrey[{r_, g_, b_}] := 0.21 r + 0.72 g + 0.07 b;

(* pre-processing *)
img = Composition[
ImageCrop[#, {standardwidth, Ceiling[Last @ ImageDimensions[#], numblocks]}, Padding -> bg] &,
RemoveAlphaChannel[#, bg] &,
RemoveBackground,
ImageResize[#, standardwidth] &,
Import
] @ imglocation
{x, y} = ImageDimensions[img];
imgintermediate1 = Composition[
Binarize[#, binarizethreshold] &,
ColorConvert[#, "Grayscale"] &,
RemoveAlphaChannel[#, White] &,
RemoveBackground
] @ img
imgptt = Map[
ImageData,
ImagePartition[
ColorNegate @ imgintermediate1, {standardwidth / numblocks, y / numblocks}],
{-1}
];
newones = Composition[
# / Max[Flatten @ #] &,
Map[(Count[#, 0] &) @* Flatten, #, {-3}] &
] @ imgptt;
imgintermediate2 = ImageAssemble[
Map[Image, MapThread[#1 /. {1 -> #2} &, {imgptt, newones}, 2], {-3}]
]
pts = Composition[
Map[Reverse],
RandomChoice[# -> Tuples @ {Range[y, 1, -1], Range[x]}, n] &,
Flatten,
ImageData
] @ imgintermediate2;
Graphics[Point /@ pts]

(* construction *)
m = DelaunayMesh @ pts;
polygons = MeshPrimitives[m, 2];
cols = With[
{colour = ImageValue[img, Mean @@ #]},
If[
colour == List @@ ColorConvert[bg, "RGB"],
bgmarker,
turngrey @ colour
]
] & /@ polygons;
ragged = Select[Transpose[{polygons, cols}], Last @ # != bgmarker &];
finalg = Graphics[
{
EdgeForm[Black],
FaceForm[],
},
ImageSize -> 2 {x, y}
]


# Examples

Here are some images. Also shown are their tuning parameters.

Marilyn Monroe

n = 1500;
binarizethreshold = 4 / 10;
edthreshold = 1 / 40;
whitethreshold = 7 / 10;


Audrey Hepburn

n = 1000;
binarizethreshold = 4 / 10;
edthreshold = 1 / 40;
whitethreshold = 7 / 10;


Example image from the OP8, with background removed and contrast adjusted (in Photoshop).

n = 5000;
binarizethreshold = 4 / 10;
edthreshold = 1 / 10;
whitethreshold = 7 / 10;


Albert Einstein

n = 3000;
binarizethreshold = 6 / 10;
edthreshold = 2 / 10;
whitethreshold = 7 / 10;


President Obama

n = 4000;
binarizethreshold = 3 / 10;
edthreshold = 1 / 20;
whitethreshold = 5 / 10;


# Explanation

1. Image Size: The width is set to 600px (standardwidth), and the height rounded up to a multiple of numblocks (which should be a factor of standardwidth). This is important later for ImagePartition.

2. Point sampling source (imgintermediate1): The source is chosen to be strictly black and white (i.e. 'Binarized'). Edges are preserved with EdgeDetect. And for the purpose as a sampling source, the background is changed from bg to just White; we don't want any points in the background after all.

3. Point sampling weights (imgintermediate2): The generation of points is done by sampling n points from the 'black' part of the image. All black pixels in the 'Binarized' source have the same weight for RandomChoice. Sampling more points results in smaller triangles everywhere equally. But a large black patch won't need many small triangles. Points shouldn't be wasted in those areas but flocked in smaller areas to maximise detail. The weight of the black patches should be lowered. The larger the patch, the lower the weight. This is (kinda sloppily) done by 'ImagePartitioning' the sampling source, counting the number of black pixels in each partition, and dumbing down the weight in each partition accordingly.

4. Background removal: The mesh m is within a convex hull, so there will always be triangles whose centroid falls on the background. They are unwanted. To mark them for removal, they are shaded with some distinct grey (bgmarker). It can be any number smaller than one with many random digits really. For easiness I just choose 1 / Pi.

5. Making grey (turngrey): shrx's answer turns a color pixel grey by averaging the three channels. I try another formula.

6. Triangle shading (shadetri): shrx's answer draws those shading lines within a triangle by duplicating and scaling that triangle. My method is duplicating and scaling just one randomly chosen edge from the triangle. This should result in at least slightly faster rendering (and a cleaner image).

7. Shades: The greyness value for triangle shading runs from 0 (black) to 1 (white). Originally, the shading is done up to a certain threshold (called whitethreshold here) based on the greyness associated to a particular triangle. I also rescale such greyness to whitethreshold to even out the distribution of shaded triangles. (To see what I mean, put Rescale[col, {0, 1}] in newcol instead and work with a generally darker source (like the given Obama or Hepburn). You would want to set low whitethreshold to get more unshaded triangles. Without rescaling, there would be very few lightly shaded triangles, causing a 'jump' from unshaded to shaded areas.)

• Damn, so there was preprocessing with Photoshop; you had gotten my hopes up… :P (I upvoted nevertheless.) – J. M. will be back soon Jul 10 '16 at 9:50
• @J.M. The contrast adjustment of the photo of the hatted man could be done in Mathematica but trials and errors would just take too much time. The background removal has to be done in a Photoshop-like program anyway. – Taiki Jul 10 '16 at 9:54
• "trials and errors would just take too much time." - I imagined that was the reason; we really shouldn't be using Mathematica to do everything, anyway. ;) – J. M. will be back soon Jul 10 '16 at 9:57
• Nicely done. The real issue in matching the artists work or the C# appears to me to be Mathematica's ability to follow contrast edges. Fro example the distortion in Marilyn Monroe's eyes and lips as compared to the photo, where one side is larger than the other. If someone could solve that piece of the puzzle, that would work very well IMO. – R Hall Jul 12 '16 at 16:30
• Great improvement of my approach! – shrx Jul 15 '16 at 13:53