[解決済み] 画像の白背景を除去して透明にする

質問

Mathematica で次のようなことをしようとしています． RMagickは画像から白い背景を取り除き、透明にします。 .

しかし、実際の写真では見栄えが悪くなってしまいます（画像の周りに後光が差しているような）。

これまで試してきたのは、こんな感じです。

unground0[img_] := With[{mask = ChanVeseBinarize[img, TargetColor->{1.,1.,1.}]},
  Rasterize[SetAlphaChannel[img, ImageApply[1-#&, mask]], Background->None]]]

以下はその例です。

元画像です。

白の背景を無背景に置き換えた画像（ここではデモのため、ピンクの背景）。

このハローを取り除くためのアイデアはありますか？LevelPenalty のようなものを微調整して、私は画像の一部を失うことを犠牲にしてのみ、ハローを消すことができます。

EDIT: 懸賞金のためのソリューションを比較できるように、あなたのソリューションを上記のように構成してください、すなわち、画像を受け取り、透明な背景を持つ画像を返す unground-something という自己完結型の関数です。

どのように解決するのですか？

必要なエッジ品質によって異なります。

img = Import@"http://i.stack.imgur.com/k7E1F.png";
mask = ChanVeseBinarize[img, TargetColor -> {1., 1., 1.}, "LengthPenalty" -> 10]
mask1 = Blur[Erosion[ColorNegate[mask], 2], 5]
Rasterize[SetAlphaChannel[img, mask1], Background -> None]

<イグ

編集

Stealing a bit from @Szabolcs

img2 = Import@"http://i.stack.imgur.com/k7E1F.png";
(*key point:scale up image to smooth the edges*)
img = ImageResize[img2, 4 ImageDimensions[img2]];
mask = ChanVeseBinarize[img, TargetColor -> {1., 1., 1.}, "LengthPenalty" -> 10];
mask1 = Blur[Erosion[ColorNegate[mask], 8], 10];
f[col_] := Rasterize[SetAlphaChannel[img, mask1], Background -> col, 
                     ImageSize -> ImageDimensions@img2]
GraphicsGrid[{{f@Red, f@Blue, f@Green}}]

クリックで拡大

編集2

の程度を把握するために、一応 ハロー と背景の欠陥の程度を知ることができます。

img = Import@"http://i.stack.imgur.com/k7E1F.png";
Join[{img}, MapThread[Binarize, {ColorSeparate[img, "HSB"], {.01, .01, .99}}]]

<イグ

ColorNegate@ImageAdd[EntropyFilter[img, 1] // ImageAdjust, ColorNegate@img]

<イグ