# Is there a way to recreate the typical Red/Blue-Postereffect using Mathematica?

I think nearly all of us have at least once seen an image like this:

So I wondered whether it is possible to recreate this effect using Mathematica because it seems like it wouldn't need that many processing steps.

Any ideas?

http://hplussummit.com/images/wolfram.jpg this can be used as a source image.

• "because it seems like it wouldn't need that many processing steps." Not true in the case of the Barack Obama poster: dvxuser.com/V6/… Commented Jul 23, 2014 at 18:21
• Commented Jul 23, 2014 at 18:23
• Did you try anything? ColorReplace and Colorize should be useful here. Commented Jul 23, 2014 at 18:24
• Colorize[image, ColorFunction -> cfunc] is probably what you want, although coming up with the appropriate cfunc is the trick.
– acl
Commented Jul 23, 2014 at 19:02
• @acl ColorFunction -> (Piecewise[{{Darker@Blue, # < 0.5}, {Red, # < 0.67}, {Darker@LightBlue, # < 0.75}, {LightYellow, True}}] &)
– user484
Commented Jul 23, 2014 at 20:03

Here's my attempt, using @RahulNarain ColorFunction with different colors:

obamaize[image_, text_] :=
Module[{colored =
Colorize[image,
ColorFunction -> (Piecewise[{{RGBColor[{30, 60, 88}/255], # < 0.5},
{RGBColor[{202,36, 40}/255], # < 0.67}, {RGBColor[{124, 151, 168}/255], # < 0.75},
{RGBColor[{240, 232, 173}/255], True}}] &)],
dims = ImageDimensions[image]},
ImageAssemble[{{colored}, {Rasterize[
Style[text, 40, FontFamily -> "Arial Black", Bold,
RGBColor[{124, 151, 168}/255]], ImageSize -> dims[[2]],
Background -> RGBColor[{30, 60, 88}/255]]}}], 10,
RGBColor[{240, 232, 173}/255]]
]


And to test it:

obamaize[ExampleData[{"TestImage", "Lena"}], "LENA"]


obamaize[ExampleData[{"TestImage", "Girl2"}], "ARRGH"]


• +1 - but why obama? he isn't that red, is he?
– eldo
Commented Jul 23, 2014 at 21:04
• +1!!! Add a bit of filtering to remove the noisy pixels? Colorize[GaussianFilter[image, 1.5]..., or a bilateral filter Commented Jul 23, 2014 at 21:04
• @eldo - this is why en.wikipedia.org/wiki/Barack_Obama_%22Hope%22_poster, this is the inspiration for this type of image Commented Jul 23, 2014 at 21:05
• @blochwave, kale: I find that running Colorize on TotalVariationFilter@Sharpen@image works pretty well.
– user484
Commented Jul 23, 2014 at 21:34
• Yeah I was about to suggest TV - PeronaMalikFilter is another possibility reference.wolfram.com/language/ref/PeronaMalikFilter.html Commented Jul 23, 2014 at 21:40

A somewhat revised approach.

First define the colours and create column images from them. There are four block colours and one striped.

blue = {0.15, 0.23, 0.33};
red = {0.77, 0.16, 0.17};
paleblue = {0.50, 0.60, 0.63};
beige = {0.96, 0.90, 0.69};

cols = Image[Table[Transpose[{##}], {60}] ~Flatten~ 1] & /@
{{blue}, {red}, {paleblue}, {paleblue, beige}, {beige}};


Now import the image and do some processing. I repeatedly apply a low pass transform and histogram equalisation, then afterwards do a quantisation. The aim is to split the image into 5 brightness regions which have reasonably smooth outlines and which are all about the same area (so that the final image contains all five colours in equal amounts).

i1 = Import["wolfram.jpg"] ~ColorConvert~ "Grayscale";
id = ImageDimensions[i1];

i2 = Nest[HistogramTransform@LowpassFilter[#, 1.5] &, i1, 10];
i3 = ImageApply[0.2 Floor[5 #] &, i2];

{i1, i2, i3} // GraphicsRow


Now I use Binarize to extract masks for the individual regions and create shader images from the colours.

masks = Table[Binarize[i3, {i, 1.01 i}], {i, 0.0, 0.8, 0.2}];

shaders = ImageResize[#, id] & /@ cols;



i4 = Inner[ImageMultiply, masks, shaders, ImageAdd];

label = Rasterize[
Style["WOLFRAM", 20, FontFamily -> "Arial", Bold, RGBColor@paleblue],
ImageSize -> id[[1]], Background -> RGBColor@blue];



• I think you got the colors reversed for the text & bg... great answer nevertheless! Now if only there was a way to fix that hatch from bleeding into the bg... :)
– rm -rf
Commented Jul 24, 2014 at 13:11
• @rm-rf, oh - so I did. Thanks. Commented Jul 24, 2014 at 13:15

First off, here's @kale's excellent answer modified with a bilateral filter to smooth it a little:

kalesObamaize[image_, text_] :=
Module[{colored =
Colorize[BilateralFilter[image, 2, 0.5],
ColorFunction -> (Piecewise[{{RGBColor[{30, 60, 88}/255], # <
0.5}, {RGBColor[{202, 36, 40}/255], # <
0.67}, {RGBColor[{124, 151, 168}/255], # <
0.75}, {LightYellow, True}}] &)],
dims = ImageDimensions[image]},
Style[text, 40, FontFamily -> "Arial Black", Bold,
RGBColor[{124, 151, 168}/255]], ImageSize -> dims[[2]],
Background -> RGBColor[{30, 60, 88}/255]]}}], 10,
RGBColor[0.94, 0.91, 0.68]]]
kalesObamaize[Import[
"http://hplussummit.com/images/wolfram.jpg"], "WOLVERINE"]


Second, here's my attempt. The motivation for this is based more on the workflow used in e.g. Adobe Illustrator to vectorize the image, which is how the original example would have been done.

I've not played around with the colours that much (to match the question) so it can definitely be improved. Call it a work-in-progress, suggestions welcome!

Also, if anyone can help me tidy up the code that separates the image out into layers that would be great!

wolfram =
(* it's this line I'm not sure about! *)
binlist =
Reverse[Transpose[{Range[0., 0.8, 0.2], Range[0.2, 1.0, 0.2]}]];
binarylist = MorphologicalBinarize[wolfram, #] & /@ binlist;
imglist = GaussianFilter[#, 1.5] & /@ binarylist


combinedimages = ImageAdjust[Fold[ImageAdd,
ColorReplace[imglist[[5]], {Black -> Darker@LightBlue}],
{
ColorReplace[imglist[[4]], {Black -> Red}],
ColorReplace[imglist[[3]], {Black -> Red}],
ColorReplace[imglist[[2]], {Black -> Darker@Blue}]
}]]


ImageMultiply[
Colorize[imglist[[1]],
ColorRules -> {Black -> LightYellow}], combinedimages]


• One of the things is getting the colours to be vibrant - adding like this with ImageAdd needs transparency in the layers instead of white areas. Commented Jul 23, 2014 at 20:44

Here a different approach, that mainly uses the build in ImageEffect "Posterization" and ColorReplace:
First the image is imported, the background removed and blured a bit:

img1=Blur@*RemoveBackground@Import["http://hplussummit.com/images/wolfram.jpg"];


Than the ImageEffect is applied:

img2=ImageEffect[img1,{"Posterization",2}];


The dominant colors are determined with

dColors=DominantColors[img2,4];


and will be replaced using the following rules:

colorReplaceRules={dColors[[1]]->RGBColor[{124,151,168}/255],dColors[[2]]->RGBColor[{240,232,173}/255],dColors[[3]]->RGBColor[{202,36,40}/255],dColors[[4]]->RGBColor[{30,60,88}/255]}


Now the colors can be replaced using

img3 = ColorReplace[img2, colorReplaceRules, 0.001];


With a new background created by

newBackground=With[{imgDim=ImageDimensions@img1},


the final image can be composed

ImageCompose[newBackground, img3]


Here one approach:

im=Import["http://hplussummit.com/images/wolfram.jpg"];
mb=MorphologicalBinarize[im];
cb=ChanVeseBinarize[im];
RemoveBackground[ia1]];


And a simple cleanup

ColorReplace[new1,Binarize[new1,0.95]->Darker@Blue]


Results in:

Some hair is still left without proper coloring, but more carefull adjustments of threshold values (here mainly default values were used) should solve this.

This is a followup to @Simon Woods' answer and @rm -rf's comment

Now if only there was a way to fix that hatch from bleeding into the bg...

There is!

i = Import["wolfram.jpg"];
face = FindFaces[i][[1]];
Graphics[{White,
Circle[Mean[face], (Mean[face] - face[[1]])*{.8, 1.2}]},
Background -> Black,
ImageSize -> ImageDimensions[i],
PlotRange -> {0, #} & /@ Reverse[ImageDimensions[i]],
PlotRangePadding -> 0, Frame -> True, FrameStyle -> Opacity[0]]


Now we only need to modify the existing masks:

cutoff = DeleteSmallComponents[


And produce the poster without the bleeding hatch in the background:

i4 = Inner[ImageMultiply, masks, shaders, ImageAdd];

label = Rasterize[
Style["WOLFRAM", 20, FontFamily -> "Arial", Bold,
RGBColor@paleblue], ImageSize -> id[[1]],
Background -> RGBColor@blue];



However, I can't figure out why setting the Background color of the label does not work for me.

And here is an alternative approach, thanks to @Pickett:

i = Import["wolfram.jpg"];
bg = Binarize[RemoveBackground@i, 0.01];
colorbg =
Graphics[{RGBColor@paleblue, Rectangle[{-1, -1}, {0, 1}],
RGBColor@red, Rectangle[{0, -1}, {1, 1}]},
Method -> {"ShrinkWrap" -> True},
ImageSize -> ImageDimensions[i]];
ImageMultiply[ColorNegate@bg, colorbg]]


• I tried my hands on this as well using MMA10's RemoveBackground. My code is here and it yields this result. You can add it as another alternative for fixing the problem if you like if you'd like. Commented Jul 24, 2014 at 22:38
– shrx
Commented Jul 24, 2014 at 22:45

Using Rahul's idea and a bit of blurring:

img = Import["http://hplussummit.com/images/wolfram.jpg"];

bimg = Blur[img];
Colorize[
bimg, ColorFunction -> (Piecewise[{{Darker@Blue, # < 0.5}, {Red, # <
0.67}, {Darker@LightBlue, # < 0.75}, {LightYellow, True}}] &)]


• Very nice, very short, but the Blue is far too aggresive, and the Red could be a nuance darker.
– eldo
Commented Jul 23, 2014 at 20:38
• complaints should be addressed to @RahulNarain who came up with the colours. I'm just here to collect the votes :)
– acl
Commented Jul 23, 2014 at 20:45
• @eldo the comment above was for you
– acl
Commented Jul 23, 2014 at 20:46
• Half the reason I didn't post an answer was so that I wouldn't have to bother making the colours look good! So please, do direct any and all complaints towards @acl. Indeed, that blue is terrible, acl, what on earth were you thinking?!
– user484
Commented Jul 23, 2014 at 21:31
• @RahulNarain truth be told, I did try improving them and got bored after 20s. So I understand you (but I'll hold on to those sweet upvotes anyway)
– acl
Commented Jul 23, 2014 at 21:33