How to create hedcut style images?

Question

Yesterday the hedcut style was brought up in chat. How can we create a hedcut-like style automatically in Mathematica, using a photograph as a starting point?

I am looking to create a similar artistic feel, not necessarily reproduce the hedcut style precisely.

Relevant resources:

Hedcut-like effect in Photoshop
A blog showing illustrations of this style
Halftone, spiral cut/engraving, and 'pointillism' effects from the recent image vectorization question. All of these re-compose the image out of dots of varying size or lines of varying width.

Sample portraits to work with:

@Silvia's idea from yesterday:

ImageDeconvolve[Import["http://www.alleba.com/blog/wp-content/photos/put001.jpg"],
 GaussianMatrix[2.7], Method -> "TSVD"]

Mathematica graphics

My own failed first attempt (the part that detect line directions may be useful to people who work on answers):

Mathematica graphics

img = Import[
  "http://www.stars-portraits.com/img/portraits/stars/j/jimi-hendrix/jimi-hendrix-by-BikerScout.jpg"]

(* "Real" images support negative numbers---for convenience *)

img = Image[ColorConvert[img, "GrayLevel"], "Real"];
img = ImageRotate[img, Right];

(* horizontal and vertical components of the gradient;
   the direction can be computed using ArcTan *)
gv = ImageCorrelate[img, ( {
     {0, -1, 0},
     {0, 0, 0},
     {0, 1, 0}
    } )];
gh = ImageCorrelate[img, ( {
     {0, 0, 0},
     {1, 0, -1},
     {0, 0, 0}
    } )];

g = GradientFilter[img, 1];

(* verify the number of white pixels in Binarize[g] *)
Count[ImageData@Binarize[g], 1, Infinity]

(* create small strokes along the outlines *)
outline = 
 With[{point = RandomChoice[Position[ImageData@Binarize[g], 1], 1500]},
  Graphics@MapThread[
    Rotate[Disk[#1, {4, 1}], #2] &,
    {point,
     ArcTan @@@ 
      Transpose[{Extract[ImageData[gh], point], 
        Extract[ImageData[gv], point]}]}
    ]
  ]


(* try to tone down plain grey/dark backgrounds *)
detail = ImageAdjust@
  ImageAdd[img, 
   ImageMultiply[ColorNegate@ImageAdjust@EntropyFilter[img, 15], 2]]

coords = Outer[List, #2, #1] & @@ Range /@ ImageDimensions[img];

fill = With[{point = 
    RandomChoice[
     Join @@ ImageData@ImageClip@ColorNegate[detail] -> 
      Join @@ coords, 5000]},
  Graphics@MapThread[
    Rotate[Disk[#1, {3, 0.8}], #2] &,
    {point,
     ArcTan @@@ 
      Transpose[{Extract[ImageData[gh] + 10 $MachineEpsilon, point], 
        Extract[ImageData[gv], point]}]}
    ]
  ]

Show[fill, outline]

_{Note: I'm not fond of Putin, but his portrait I linked to seems to be easier to handle than some others.}

Update:

Second attempt, based on @Silvia's suggestion to try ContourPlot and wxffles's image vectorization approach. It's better, but still not achieving that feel.

Mathematica graphics

img = Import["https://i.sstatic.net/YajUp.jpg"]

baseimg = 
  ColorConvert[ImageReflect@CurvatureFlowFilter[img], "GrayScale"];

(* Here we could simply use 

ct=Table[p,{p,0,1,0.02}]; 

but the following approach gives a better balanced image *)

if = Interpolation[ImageLevels[baseimg]];

cif = Derivative[-1][if];

cifmax = cif[1];

f[x_] := cif[x]/cifmax

ct = Block[{x},
  Table[
   x /. First@FindRoot[f[x] == p, {x, 0.5, 0, 1}], {p, 0, 1, 0.02}]
 ];

lcp = ListContourPlot[ImageData[baseimg], Frame -> False, 
  Contours -> ct, 
  ContourStyle -> (Dashing[{#, 1/50}] &) /@ ((1 - ct)/50), 
  PlotRange -> {0, 1}, AspectRatio -> Automatic, 
  ContourShading -> None]

I think the hardest part for generating a hedcut is to find a way to reflect the natural texture. I think it's indeed a big challenge, maybe some AI methods are needed? For example a human face, in order to find "good" texturization, maybe it is necessary to construct a 3D face model from the original picture. — Silvia, Commented Jul 25, 2012 at 15:51

Simon Woods · Accepted Answer · 2012-08-04 22:03:29Z

In this answer I've tried to use different shading styles for different graylevels in the image. First load the image, convert to grayscale, and get its dimensions.

img = ColorConvert[Import["UZg4t.jpg"], "Grayscale"];
dim = ImageDimensions[img];

The next step is to create different shading styles.The example hedcut image uses dots and lines for shading, so that's what we'll use. Here I've shamelessly stolen code from R.M's answer for the dot pattern. I use a set of black dots, and also a set of gray ones. I've also created sets of wavy horizontal and vertical lines in the same style. The parameter di controls the dot interval - larger values will result in more spaced out dots and lines. We will also need parts of the image in solid white and solid black, so the last two lines create graphics for those.

di = 4;  (* di is the dot interval *)
gr[x__] := Graphics[x, ImageSize -> dim, PlotRangePadding -> 0];
dots = gr @ Table[{Disk[{Clip[i + 2 Sin[16 Pi j/#2], {1, #1}], Clip[j + 2 Sin[16 Pi i/#1],
 {1, #2}]}, 1]}, {i, 1., #1, di}, {j, 1., #2, di}] &@@ dim;
paledots = gr @ {GrayLevel[0.7], dots[[1]]};
hlines = gr @ Table[Line[Table[{Clip[i + 2 Sin[16 Pi j/#2], {1, #1}], Clip[j + 2 Sin[16 Pi i/#1],
 {1, #2}]},{i, 1., #1, di}]], {j, 1., #2, di}] &@@ dim;
vlines = gr @ Table[Line[Table[{Clip[j + 2 Sin[16 Pi i/#1], {1, #2}], Clip[i + 2 Sin[16 Pi j/#2],
 {1, #1}]},{i, 1., #1, di}]], {j, 1., #2, di}] &@@ Reverse[dim];
black = gr[{}, Background -> Black];
white = gr[{}, Background -> White];

Next we need to create images from these graphics corresponding to 7 shades from black to white. The darkest shade is pure black. The next lightest shade after black is cross-hatching (both vertical and horizontal lines) plus dots, the next is just cross hatching without the dots, then just horizontal lines, then just dots, then the pale (gray) dots and finally pure white. Note that for the the "cross-hatching plus dots", we need to translate the dots by half a dot interval in both x and y, to make the dots appear in the gaps between the lines rather than on top of them.

shades = Image /@ {black, Show[hlines, vlines, dots /. Disk[x_, r_] :> Disk[x + di/2, r]],
Show[hlines, vlines], hlines, dots, paledots, white};

Close up, the shades look like this:

enter image description here

Zoomed out, we can see that these shading styles approximate a sequence of gray levels from black to white :

enter image description here

The key step in the routine comes next. We use ColorQuantize to compress the image into 7 gray levels. The idea is that each of these 7 gray levels will be replaced with the 7 shades we have built.

qimg = ColorQuantize[img, Length@shades, Dithering -> False];

The quantized image looks like this :

enter image description here

Next we split the quantized image into 7 separate "region" images. Each region image picks out the parts of the quantized image with the corresponding gray levels.

levels = Cases[ImageLevels[qimg], {val_, _?Positive} :> val];
regions = Table[ImageApply[1 - Unitize[# - x, 0.01] &, qimg], {x, levels}];

The region images look like this:

enter image description here

A bit of tinkering is needed here. The first region image, which corresponds to solid black, should not have any large blocks in it or there will be large blocks of solid black in the final picture, which isn't very hedcut-like. In this example the jacket is going to come out as a solid block of black. The solution is to move these large areas into the second region image, so they will come out shaded with "cross-hatching plus dots". Note that we don't want to remove all the black areas, as they are especially useful for the eyes.

We can use DeleteSmallComponents to isolate the large blocks from the first region image:

bigblackareas = DeleteSmallComponents[regions[[1]]];

enter image description here

Now we can subtract this from the first region image and add it to the second:

regions[[1]] = ImageSubtract[regions[[1]], bigblackareas];
regions[[2]] = ImageAdd[regions[[2]], bigblackareas];

The first two region images now look like this. The jacket and tie have will now be shaded using "cross-hatching plus dots" instead of solid black.

enter image description here

We are nearly there now. The next step is to multiply each region image by its corresponding shade image and add them all together:

combined = Fold[ImageAdd, First[#], Rest[#]] &@ MapThread[ImageMultiply, {regions,shades}];

enter image description here

The last step is to add some outlines. These can be obtained by binarizing the result of a GradientFilter:

outlines = Binarize @ ColorNegate @ GradientFilter[img, 2];

enter image description here

To get the final image the outlines are combined with the shaded image, and Gaussian filter applied to soften everything slightly.

GaussianFilter[ImageMultiply[combined, outlines], 1]

enter image description here

Another couple of examples using the same procedure :

enter image description here

Thanks to R.M, Jagra, DGrady and Szabolcs for code, comments and ideas.

Nice implementation for some of @Jagra's comments. The edges are a bit jerky, especially in the second photo - have you thought about smoothing them? — DGrady, Commented Jul 25, 2012 at 21:32
@DGrady, I tried applying a Gaussian filter to the image before extracting the outlines, but it didn't come out very well. — Simon Woods, Commented Jul 25, 2012 at 21:47
@Szabolcs, that's a great idea. What I've ended up doing is using the additional dark pattern as you suggest, plus solid black, so 7 quantization levels in total. Any large areas of solid black then get changed to the dark pattern. This gives a better result than the MinDetect approach and doesn't require tweaking any parameters (at least on the images I have tried). Code update coming up. — Simon Woods, Commented Jul 27, 2012 at 20:40

Jagra · Accepted Answer · 2024-04-27 21:30:46Z

A very long time ago I spent several months working in a photo processing office. Copy cameras, film, and retouching by hand served as the state of the art tools of the day. No commercial personal computers existed at the time, so no Photoshop and no digital anything.

The business had a master of photographic image processing. He would produce all sorts of graphic images from photographs. He did astonishing work.

I saw him take a multi-step approach to get the kind of “hedcut” style you describe.

Take a close look at your first image.

enter image description here

While it seems like a simple abstraction of a photograph it actually has a great deal going on in it.

The overall image has a nearly unbroken line outlining it, only broken in the hairline left of center and across the bottom. Th left and right edges appear simply cropped.

Whomever made this (whether by hand or machine) has defined several areas within the image and treated them with different masks or screens.

They include:

hair crosshatched,
face pixilated (dots),
jacket (2 sections) crosshatched
neck nearly vertical lines
shirt pixilation shadowing the outline
tie nearly vertical lines
eyes outlined
pupils solid black with tiny highlights

Look closely and you may see even more.

The artist/image-processor has outline each of these areas then they deliberately fudged some of the juxtapositions between areas to produce a more hand created look.

The guy I used to know used masks and high contrast images to decompose a photographic image into the pieces he wanted then manipulated the individual pieces with screens of lines, points, or hatching then reassembled all of the pieces.

He did all of this mechanically without resorting to retouching (painting on the photograph), so theoretically Mathematica should give one the ability to do a great deal of this.

But, I recommend not underestimating the complexity of the problem. Break it down then build it back up.

I’ll give some thought to Mathematica techniques to do this when I have a bit more time.

Of course I'm not expecting to create a perfect imitation of the style. Maybe not even a close one. I agree with you that it's impossible to create it without making intelligent decisions, for example that a square pattern fits the jacket and should follow its natural lines (which are probably not even clear in the original photograph, but both the artist and the viewer know what jackets are like, so the artist uses a textile-like pattern that follows the lines of the body; he uses dots only for the face; etc.) — Szabolcs, Commented Jul 25, 2012 at 16:02
What I'm looking for is an engraving-like result, reminiscent of hedcuts. RM's answer is a good example. It's clearly not the same thing, but it has a certain resemblance to these kinds of prints (especially the Photoshop version he based his Mathematica code on). — Szabolcs, Commented Jul 25, 2012 at 16:02
@Szabolcs -- I largely agree, but I do think one could (with sufficient thought and time) automate a great deal of this. Identify a face, identify hair, identify a shirt from a jacket, treat each piece differently (dots, hatches, lines, ...), outline each piece, identify the direction of a light source and fudge edges accordingly or maybe by some random process. I can at least imagine an algorithm that could do this. Writing the algorithm is admittedly another matter ;-) — Jagra, Commented Jul 25, 2012 at 16:18

rm -rf · Accepted Answer · 2012-07-25 15:27:49Z

23

Here's a first-pass at a Hedcut style image using Mathematica

enter image description here

This is how it was done:

First, obtain the image and convert to gray scale:

img = ColorConvert[Import["https://i.sstatic.net/RjE3P.jpg"], "Grayscale"];

enter image description here

Next, create a disk layer and give it a wavy pattern:

dots = Graphics[Table[{Disk[{i, j}, 1]}, {i, 1, 300, 4}, {j, 1, 460, 4}] /. 
    Disk[{x_, y_}, r_] :> Disk[{
        Clip[x + 2 Sin[16 π y/#2], {1, #1}], 
        Clip[y + 2 Sin[16 π x/#1], {1, #2}]}, 
        r
    ] & @@ ImageDimensions@img
]

enter image description here

Now I create a "corrected" disk layer with each disk coloured according to the GrayLevel in the original image

layer = dots /. Disk[c_, r_] :> With[
    {val = ImageData[img, DataReversed -> True][[Sequence @@ Reverse@Round@c]]}, 
    {GrayLevel[val], Disk[c, r]}
]

enter image description here

Finally, impose this layer onto the original image and set the opacity accordingly, which should give you the final image above.
```
SetAlphaChannel[ImageMultiply[Lighter@img, layer], ColorNegate@Binarize[img, 0.9]]
```

answered Jul 25, 2012 at 15:27

rm -rf♦

89.3k21 gold badges296 silver badges478 bronze badges

1

$\begingroup$ Can you post something that's not Putin? Feyman or Asimov maybe? $\endgroup$
– Szabolcs
Commented Jul 25, 2012 at 15:29
$\begingroup$ Because the Putin image was the easiest to make look fine for almost anything I tried, and I was wondering if this method looks good on other images too. $\endgroup$
– Szabolcs
Commented Jul 25, 2012 at 15:31
1

$\begingroup$ You can always use Lenna, everyone's favorite image processing centerfold. $\endgroup$
– s0rce
Commented Jul 25, 2012 at 15:32
$\begingroup$ i.sstatic.net/HeY9W.png -- nice $\endgroup$
– Szabolcs
Commented Jul 25, 2012 at 15:32
1

$\begingroup$ @Szabolcs Typically Hedcut images are done only for portraits and the background is always white. So if you want to try on a random image from the internet, the background must be first adjusted, else you'll have black dots on gray bg, which doesn't look so nice and the effect is lost. For this reason, it won't work on Lena either. At least, not out of the box $\endgroup$
– rm -rf ♦
Commented Jul 25, 2012 at 15:37

| Show 1 more comment

Community · Accepted Answer · 2017-04-13 12:55:46Z

I've elaborated the engraving method for this purpose. Now we can use any set of arbitrary curves, not just a spiral. In this particular case these curves are B-splines which can be adjusted by user.

enter image description here

The result looks like this:

enter image description here

The crucial thing here is to get optimal relationship between the maximum thickness and resulting image size. As I've seen from my experimrnts the best results are achieved when the final image is big:

enter image description here

Some experience is needed to get good results. The main thing is to get some curves aligned along edges.

Here comes the code:

img = '[paste an image here]';
nl = 7;(* number of control points for B-splines*)
nc = 90;(* number of contours*)
pdg = 50;(* padding *)
maxth = 3;(*maximum thickness*)
is = 300; (* resulting image size *)
bw = True;(* black on white background *)
active = True;
{w, h} = ImageDimensions@img;
rimg = Rasterize@img;
pr = {{-pdg, w + pdg}, {-pdg, h + pdg}};
pts = Table[{i, 0}, {i, 0, w, w/(nl - 1)}]~Join~
   Table[{i, h}, {i, 0, w, w/(nl - 1)}];
refine[pts_, maxlen_] := Block[{prev, len},
   prev = pts[[1]];
   Reap[Scan[(If[(len = Norm[# - prev]) <= maxlen, Sow@#,
         Sow /@ 
          Most@Table[(1 - t) # + t prev, {t, 0, 1, 1/
             Ceiling[len/maxlen]}]
         ]; prev = #) &, pts]][[2, 1]]];

getDots[pn_] := Block[{splines, alldots, splitter, splitdots},
   splines = BSplineFunction /@ controlPts[pn];
   alldots = 
    ParametricPlot[#[t], {t, 0, 1}][[1, 1, 3, 2, 1]] & /@ splines;
   alldots = refine[#, 1] & /@ alldots;
   splitter[{x_, y_}] := 0 <= x <= w && 0 <= y <= h;
   splitdots = SplitBy[#, splitter] & /@ alldots;
   Flatten[DeleteCases[#, _?(! splitter[#[[1]]] &)] & /@ splitdots, 1]
   ];

engrave[img_, dots_, th_, bw_: True, opts__] := 
  Block[{color, ath, getLines, lines},
   getLines[pts_] := (color = Mean@ImageValue[img, #];
       If[bw, color = 1 - color];
       {AbsoluteThickness[th color], Line@#}
       ) & /@ Partition[pts, 2, 1];
   lines = getLines /@ dots;
   Graphics[{CapForm["Round"], If[bw, Black, White]}~Join~lines, 
    Background -> If[bw, White, Black], opts]
   ];

controlPts[pn_] := 
  Transpose@MapThread[Table[(1 - t) #1 + t #2, {t, 0, 1, 1/nc}] &, pn];

(* interface *)
Panel@Column[{
   Row[{Slider[Dynamic@nc, {20, 200, 1}], Spacer[20], 
     Dynamic[ToString[nc] <> " contours"]}],
   LocatorPane[Dynamic@pts,
    Dynamic@
      Show[rimg, 
       Graphics[{Opacity[0.5], Green}~
         Join~(BSplineCurve /@ controlPts[pn = Partition[pts, nl]])~
         Join~{Red, Thickness[Large], Line /@ pn},
        ImageSize -> 400, AspectRatio -> Automatic
        ], PlotRange -> pr, Background -> White]~Magnify~2
    ],
   Row[{SetterBar[
      Dynamic@bw, {True -> "Black on white", 
       False -> "White on black"}],
     "  Thickness  ", SetterBar[Dynamic@maxth, Range[2, 7, 0.5]]
     }],
   Row[{"Image size   ", SetterBar[Dynamic@is, Range[300, 700, 50]],
     Spacer[40],
     Style[
      Dynamic@Button[
        If[active, " Engrave "~Style~Bold, "  Working... "],
        active = False; FinishDynamic[];
         Print@engrave[img, getDots@pn, maxth, bw, ImageSize -> is];
        active = True; FinishDynamic[],
        Enabled -> Dynamic@active
        ],
      DynamicEvaluationTimeout -> 100
      ]
     }]
   }
  ]

Note that there is a possibilty to make a white engraving on black background -- sometimes this gives more effective result.

Here is the zip-file with all processed test portraits (someone please put this to the proper place).

I'd like to share the results I've got from all the test images in PDF format. Can anyone suggest the most appropriate place to put the archive?.. — faleichik, Commented Jul 27, 2012 at 15:24
I control the stackmma github account which was intended for such purposes. See this answer for some context. Right now, I host attachments from posts and for the blog. Just ping me in chat with a link (from dropbox or elsewhere) and I'll upload them to the account — rm -rf, Commented Jul 27, 2012 at 16:05
Or maybe just link it from the post and ping somebody with access and ask them to change the link to a permanent one. You can ping me too in chat (European time zone), and you can email the file to my address too if you like. — Szabolcs, Commented Jul 27, 2012 at 17:17
Szabolcs, @RM, I've put the link in the end of the post. If it is appropriate, could you upload the file to the stackmma account? — faleichik, Commented Jul 28, 2012 at 19:46

bill s · Accepted Answer · 2013-05-11 08:11:15Z

Here's a simple answer that uses the built-in image filtering operation along with a customized thresholding. The idea of the adaptive thresholding is that in each neighborhood, the value of the current pixel is compared to the Mean throughout the neighborhood: if the pixel is larger than a given percentage of that Mean, then set it to 1, otherwise set it to 0. It's adaptive in the sense that the actual threshold used for binarization is slightly different in each neighborhood.

adaptThresh[x_, threshRat_] := Module[{center, thisPix}, 
    center = (First[Dimensions[x]] + 1)/2;
    thisPix = x[[center, center]];
    Boole[thisPix > threshRat Mean[Flatten[x]]]];

This can then be applied to images using the ImageFilter command. For example, on Mr. Putin:

img = Import["https://i.sstatic.net/qaZpG.jpg"];
GraphicsRow[{img, ImageFilter[adaptThresh[#, 0.9] &, img, 3]}, ImageSize -> 500]

enter image description here

Here the 0.95 is the threshold and 3 is the size of the neighborhood. Of course, Mr Putin is easy. When trying some of the others, it is worthwhile fiddling a bit with the two parameters:

img = ColorConvert[Import["https://i.sstatic.net/eQtVz.jpg"],"Grayscale"];
GraphicsRow[{img, ImageFilter[adaptThresh[#, 0.83] &, img, 4]}, ImageSize -> 500]

enter image description here

img = Import["https://i.sstatic.net/YajUp.jpg"];
GraphicsRow[{img, ImageFilter[adaptThresh[#, 0.84] &, img, 6]}, ImageSize -> 500]

enter image description here

img=ColorConvert[Import["https://i.sstatic.net/3LkNC.jpg"],"Grayscale"];
GraphicsRow[{img,ImageFilter[adaptThresh[#, 0.95] &, img, 6]}, ImageSize -> 500]

enter image description here

The results are often much more satisfactory if the background is light and uniform. Here's an old president.

img = Import[ "http://upload.wikimedia.org/wikipedia/commons/thumb/c/ce/President_Andrew_Johnson.jpg/180px-President_Andrew_Johnson.jpg"];
GraphicsRow[{img, ImageFilter[adaptThresh[#, 0.95] &, img, 4]}, ImageSize -> 500]

enter image description here

flinty · Accepted Answer · 2020-08-21 16:02:38Z

In this day and age we have neural restyling with ImageRestyle introduced in 2017 Mathematica 11.2. I thought it worth demonstrating here, and somewhat arrogantly I fired up Mathematica 12.1.1.0, and using the image in the question as the base style I executed the following:

sample = Import["https://i.sstatic.net/R3nUd.jpg"]
test = Import["https://i.sstatic.net/qaZpG.jpg"];
ImageRestyle[test, sample]

The result isn't particularly great. Thinking this was because I only used a one-shot training sample, I then took as many images as I could from http://www.hedcut.com and executed the following on the GPU instead:

(*images from http://www.hedcut.com/*)
samples = Import /@ FileNames["hedcuts/*.jpg"];
test = Import["https://i.sstatic.net/qaZpG.jpg"];
ImageRestyle[test, samples, TargetDevice -> "GPU", 
 PerformanceGoal -> "Quality"]

Despite giving it more sample hedcuts, the restyling performs even worse. Clearly the technology still has a way to go before it can reproduce the hedcut styling reliably.

I'd also like to share a stippling effect I tried. If you generate quasi-random numbers from a low-discrepancy sequence at low dimension setting then you can get patterned effects which add a little more texture to the image than ordinary random stippling:

test = Import["https://i.sstatic.net/qaZpG.jpg"];
Manipulate[
 BlockRandom[
  SeedRandom[Method -> {"MKL", Method -> {"Sobol", "Dimension" -> 1}}];
  i1 = GaussianFilter[
     ImageApply[Boole[RandomReal[1 - Mean[#]^\[Gamma]] > t] &, test], 
     1] // ColorNegate
  ]
 , {{t, .1}, 0.01, 1.0}, {{\[Gamma], .5}, 0.01, 4.0}]

Stack Exchange Network

How to create hedcut style images?

6 Answers 6

Your Answer

Not the answer you're looking for? Browse other questions tagged
image-processing
generative-art
or ask your own question.

Linked

Hot Network Questions

How to create hedcut style images?

6 Answers 6

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged image-processinggenerative-art or ask your own question.

Linked

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
image-processing
generative-art
or ask your own question.