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}]