[解決済み] Mathematica でWaldoを見つけるにはどうしたらよいですか．

質問

週末に悩んでいたことです。これらの問題を解決する良い方法は何でしょうか？ ワルドはどこだ？ [ 'ウォーリー' 北米以外では] Mathematica を使ったパズル（画像処理等の機能）？

これは、私が今までに作ったもので、視覚的な複雑さを少し減らすために薄暗くする関数です。 赤以外の色の一部

whereIsWaldo[url_] := Module[{waldo, waldo2, waldoMask},
    waldo = Import[url];
    waldo2 = Image[ImageData[
        waldo] /. {{r_, g_, b_} /;
          Not[r > .7 && g < .3 && b < .3] :> {0, 0,
          0}, {r_, g_, b_} /; (r > .7 && g < .3 && b < .3) :> {1, 1,
          1}}];
    waldoMask = Closing[waldo2, 4];
    ImageCompose[waldo, {waldoMask, .5}]
]

そして、これが「機能」するURLの例です。

whereIsWaldo["http://www.findwaldo.com/fankit/graphics/IntlManOfLiterature/Scenes/DepartmentStore.jpg"]

(ワルドはレジのそばにいる）。

解決方法は？

ワルドを発見!

私が行った方法

まず、赤以外の色をすべてフィルタリングしています

waldo = Import["http://www.findwaldo.com/fankit/graphics/IntlManOfLiterature/Scenes/DepartmentStore.jpg"];
red = Fold[ImageSubtract, #[[1]], Rest[#]] &@ColorSeparate[waldo];

次に、この画像と単純な白黒のパターンとの相関を計算し、シャツの赤と白の遷移を見つけるのです。

corr = ImageCorrelate[red, 
   Image@Join[ConstantArray[1, {2, 4}], ConstantArray[0, {2, 4}]], 
   NormalizedSquaredEuclideanDistance];

私は Binarize を使って、画像の中から十分に相関の高い画素を選び出し、その周囲に白い円を描いて強調します。 Dilation

pos = Dilation[ColorNegate[Binarize[corr, .12]], DiskMatrix[30]];

レベルを少し弄る必要がありました。レベルが高すぎると、誤検出が多くなってしまうのです。

最後にこの結果を元の画像と合成して、上のような結果を得ています。

found = ImageMultiply[waldo, ImageAdd[ColorConvert[pos, "GrayLevel"], .5]]