6
$\begingroup$

A cleaner copy can be obtained from a blurry original by using the level adjustment in Photoshop before going for a better OCR. The picture below shows an example. My code below failed to do so. What is the appropriate way to get the same job done in Mathematica?

enter image description here

 im = Import ["https://i.sstatic.net/BO30x.jpg"];
 Manipulate[
 adjIm = Dilation[Erosion[Sharpen[im, a], b], c],
 Grid[{
   {
    Control[{{a, 0, "Sharpen"}, 0, 10, Appearance -> "Labeled"} ],
    Control[{{b, -1, "Erosion"}, -2, 2, Appearance -> "Labeled"}  ],
    },
   {
    Control[{{c, -1, "Dilation"}, -2, 2, Appearance -> "Labeled"} ],
    Button["OCR", Print[TextRecognize@adjIm]]
    }
   }]
 ]

enter image description here

$\endgroup$

2 Answers 2

7
$\begingroup$

Level adjustments can be done with Mathematica using the ImageAdjust function.

But I think Binarizeis good enough for the case you presented. The results are pretty close.

img = Import["https://i.sstatic.net/BO30x.jpg"];
img2 = Import["https://i.sstatic.net/WhtvY.jpg"];
Grid[{{TextRecognize@Binarize[img, 0.38],
   TextRecognize@Binarize[img2]}}]

enter image description here

$\endgroup$
4
  • 2
    $\begingroup$ If you are using v10, it LocalAdaptiveBinarize may also be worth a check. $\endgroup$
    – kirma
    Commented Sep 7, 2014 at 15:56
  • $\begingroup$ LocalAdaptiveBinarize is not really a good idea with such noisy data. $\endgroup$
    – paw
    Commented Sep 7, 2014 at 16:03
  • 2
    $\begingroup$ It does have parameters which you can adjust, though. $\endgroup$
    – kirma
    Commented Sep 7, 2014 at 16:11
  • $\begingroup$ Ah! I didn't know you could set mean and standard diviation. $\endgroup$
    – paw
    Commented Sep 7, 2014 at 16:24
8
$\begingroup$

The following isn't focused on the Text recognizing part (I'm stealing it from @paw's previous answer) but on separating the ads' text.

img = Import["https://i.sstatic.net/BO30x.jpg"];
ib = Binarize@img;
dsc = DeleteSmallComponents[ColorNegate@ib, 500];
sc = SelectComponents[ColorNegate@dsc, "Rectangularity", # > .9 &];

Column[TextRecognize /@ 
  ImageCrop /@ (ImageMultiply[Binarize[img, 0.38], #] & /@ 
     Image /@ (Table[Replace[#, a_ /; (a != i) -> 0, {2}], {i, Range@Max@#}] &@
        MorphologicalComponents@sc)), Dividers -> All]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.