Remove image background of headshot in Mathematica?

Question

For example, using ExampleData[{"TestImage", "Girl2"}]:

what's a general way to make the background transparent? I've tried various combinations of EdgeDetect and Threshold and ImageAdd but can't figure it out. Thank you.

Answer 1

============>> 2-liner <<============

Let's import the image and crop boundary artifacts:

img = ImageCrop[ExampleData[{"TestImage", "Girl2"}], {200, 200}]

We have quite uniform background. So with Mathematica functions such as RegionBinarize where you can specify background test pixel, your task is about just a few lines:

ImageAdd[img,ColorNegate@Blur[Erosion[Dilation[DeleteSmallComponents[
      ColorNegate@RegionBinarize[img, {{10, 190}}, 0.1]], 3], 3], 2]]

Below is just a deeper insight on how it all owrks on pixel value level.

============>> Deeper Insight <<============

Now lets get the ImageData and see how the RGB pixel values are distributed on a diagonal across the image:

data = ImageData[img];
ListPlot[Transpose[data[[#, #]] & /@ Range[200]]]

Because background is located above approximately 0 to 60, i'll pick number 30 (1st tuning parameter) as a test pixel and plot EuclideanDistance of all other pixels from that test pixel:

ListPlot[EuclideanDistance[#, data[[30, 30]]] & /@ (data[[#, #]] & 
/@Range[200]), Filling -> 0]

Based on this we can say that roughly background is everything below threshold 0.1 (2nd tuning parameter) and replace all those pixels with white {1,1,1} pixel:

ndata = data /. {x_, y_, z_} /; 
    EuclideanDistance[{x, y, z}, data[[30, 30]]] < .1 -> {1, 1, 1};

Based on that create mask and to avoid pixelation at the edge Blur it at some radius value (3rd tuning parameter)

nimg = Blur[ColorNegate@Erosion[DeleteSmallComponents[
     Dilation[ColorNegate@Binarize[Image[ndata], .99], 3]], 3], 5]

And finally mask the original image by adding the thresholded version of it:

ImageAdd[img, nimg]

In the same way you could add an alpha channel to background making it transparent. To play with the whole procedure make an app to tune in the 3 parameters described above. Note the little piece of background in the left bottom corner is removed now by tuning background pixel parameter.

Manipulate[ImageAdd[img, Blur[ColorNegate@Erosion[DeleteSmallComponents[
      Dilation[ColorNegate@Binarize[Image[data /. {x_, y_, z_} /; 
             EuclideanDistance[{x, y, z}, data[[px, px]]] < th -> {1, 
             1, 1}], .99], 3]], 3], bl]]
 , {{px, 30, "background"}, 1, 60, 1, Appearance -> "Labeled", ImageSize -> Small}
 , {{th, .1, "threshold"}, .01, .2, Appearance -> "Labeled", ImageSize -> Small}
 , {{bl, 2, "blur"}, 0, 10, 1, Appearance -> "Labeled", ImageSize -> Small}]

Additional parameters to add could be Binarize function ranges. Binarize[image,{Subscript[t, 1],Subscript[t, 2]}] creates a binary image by replacing all values in the range Subscript[t, 1] through Subscript[t, 2] with 1 and others with 0. ~ from Documentation.

Answer 2

f[im_, n_] := Nest[Erosion[Dilation[#, 2], 2] &, im, n];
(*Get your image and Crop Nuisances*)
i1 = ImageTake[ExampleData[{"TestImage", "Girl2"}], 2 {10, -10}, {10, -10}];
(*Get edges and extend edges to border*)
b3 = Erosion[ColorNegate@f[EdgeDetect[i1, 1], 10], 1];
(*identify area& Get background pixels*)
b5 = Position[#, SortBy[Tally@Flatten@#, -#[[2]] &][[1, 1]]] &@ MorphologicalComponents@b3;
(*make a mask*)
b6 = Array[{0, 0, 0} &, Reverse@ImageDimensions@i1];
(b6[[##]] = {1, 1, 1}) & @@@ b5;
(*ready*)
b7 = ColorNegate@ImageMultiply[ColorNegate@Blur@Dilation[Image@b6, 1], ColorNegate@i1]

Edit

It works quite well mostly

The problems are due to the background not being connected or not being the biggest morphological component.

Edit Using RM's suggestion

Not perfect, but better. (blondes still can't make it unharmed)

f[im_, n_] := Nest[Erosion[Dilation[#, 1], 1] &, im, n];
(*Get your image and Crop Nuisances*)
Table[(
  i1 = ImageTake[j, 2 {10, -10}, {10, -10}];
  (*Get edges and extend edges to border*)
  b3 = Erosion[ColorNegate@f[EdgeDetect[i1, 1], 1], 1];
  b4 = (MorphologicalComponents@b3);
  (*identify area& Get background pixels*)
  (*select the component with most pixels at the border*)
  bckg = SortBy[
     Tally@Flatten@Join[#[[{1, -1}]], (Transpose@#)[[{1, -1}]]] &@
      b4, -#[[2]] &][[1, 1]];
  (*Its mean color*)
  meanBkg = Mean@Extract[ImageData[i1], Position[#, bckg] &@b4];
  (*identify other bckgnd components*)
  bckgs = 
   Flatten@MapIndexed[
       If[#1 < .08, #2, Sequence @@ {}] &, #] &@(EuclideanDistance[
        meanBkg, #] & /@ (Mean@
          Extract[ImageData[i1], Position[b4, #]] & /@ 
        Range@Max@Flatten@b4));
  (*replace by main bckgnd color*)
  b4 = b4 /. (Rule[#, bckg] & /@ bckgs);
  (*get all bckgnds together*)
  b5 = Position[b4, bckg];
  (*make a mask*)
  b6 = Array[{0, 0, 0} &, Reverse@ImageDimensions@i1];
  (b6[[##]] = {1, 1, 1}) & @@@ b5;
  (*ready*)
  b7 = ColorNegate@
    ImageMultiply[ColorNegate@Blur@Dilation[Image@b6, 1], 
     ColorNegate@i1]), {j, h}]

Answer 3

The other two excellent answers to this question were created before the arrival of version 10.0 and the RemoveBackground function. Out of curiosity I tried this new function on the test image, to see if it delivered on its promise.

g = ImagePad[ExampleData[{"TestImage", "Girl2"}], -10]

The function is set up to work without settings, presumably for use with images like this, with no obvious problem areas:

RemoveBackground[g]

but the result is a bit disappointing. An obvious option is try next is "Uniform", not her uniform, but an option which identifies "a region of almost uniform colour". By default, all settings define the background to be removed:

RemoveBackground[g, "Uniform"]

but it looks the same. Perhaps "Uniform" was the default after all... Let's try to specify a color. Gray looks a close match:

RemoveBackground[g, Gray]

but that's worse, if anything. How about "Dark" - "a darker background":

RemoveBackground[g, "Dark"]

which isn't very good, finding the hair and bow tie. I suppose "Bright" will do no better?

RemoveBackground[g, "Bright"]

Perhaps trying some markers to indicate where the background is will be the solution?

RemoveBackground[g, {"Background" , {{35,178},{35,128}}}]

It's not really helping.

There are a few intriguing options left to try. How about "Blurred", which finds in-focus and out-of-focus areas? Perhaps the background is blurred...

RemoveBackground[g, {"Blurred", 10}]

That's perhaps the best so far.

I don't know if I'm doing something wrong, or if this TestImage isn't a suitable test image. Or perhaps there are teething problems in version 10.0.0.0?

Answer 4

RemoveBackground works well only when the foreground does not have the same (or very similar) color as the background. Here is an alternative approach using GrowCutComponents. Markers were generated using Mask Tool from Image Toolbar.

g = ImagePad[ExampleData[{"TestImage", "Girl2"}], -10];