11
$\begingroup$

This is the picture I want Mathematica to readpicture

I want Mathematica to recognize these numbers and put them in a list. I know that there is a function TextRecognize, but I can't see how to apply it to my problem.

Since I am not familiar with image processing, I would prefer a simple solution that is easy to understand.

Any answer would appreciated.

$\endgroup$
  • $\begingroup$ There are a number of links that show how to get numbers out of images using TextRecognize: (4464), (18683), (27045). $\endgroup$ – march Dec 28 '15 at 22:45
  • $\begingroup$ @march thanks a lot ! $\endgroup$ – danny Dec 28 '15 at 22:57
21
$\begingroup$

You more or less said that you weren't interested in a "hand-made" image processing solution, but since TextRecognize is notoriously unreliable, I thought I'd try it anyway. Classify does most of the heavy lifting, so the solution isn't simple, but it's not hard to understand, either.

Ok, first step: import the image, adjust for the inhomogeneous lightning and find the individual characters:

img = Import["http://i.stack.imgur.com/BQOAQ.jpg"]

white = Closing[img, 10];
whiteAdjusted = ImageApply[Divide, {img, white}];

components = 
 ComponentMeasurements[
   MorphologicalBinarize[ColorNegate@whiteAdjusted], {"BoundingBox", 
    "Area"}, #2 > 10 &][[All, 2, 1]];

then sort the components by their left X-coordinate, i.e. from left to right (this makes it easier to just join the characters in each table cell later on).

components = SortBy[components, #[[1, 1]] &];

Next step: Train a Classifier to recognize digits. Since we know the font, this is much easier than the task TextRecognize has to do:

characters = Flatten[Table[
    ImageCrop[
        Rasterize[Text[Style[#, FontFamily -> "Times New Roman"]], 
         ImageSize -> size]] -> # & /@ 
     Characters["0123456789t"], {size, {10, 15, 20, 30, 40, 50}}]];

simpleOcr = Classify[characters];

Let's try it:

ImageTrim[img, #] & /@ components // GroupBy[simpleOcr] // KeySort

enter image description here

That looks very promising.

Step 3: Tell mathematica where the table grid is. It's probably possible to recognize this automatically, but if you only have this one table, that would be overkill. So I just used LocatorPane to move the grid to the right spot:

gridPts = {{85, 678}, {837, 687}, {65, 42}, {862, 48}};

LocatorPane[Dynamic[gridPts], Dynamic[Show[img,
   With[{transform = 
      Last@FindGeometricTransform[
        gridPts, {{0, 0}, {1, 0}, {0, 1}, {1, 1}}*10 + 1.5, 
        TransformationClass -> "Perspective"]},
    Graphics[
     {Red,
      Table[Line[transform /@ {{i, 1}, {i, 12}}], {i, 12}],
      Table[Line[transform /@ {{1, i}, {12, i}}], {i, 12}]}]]]]]

enter image description here

A few definitions for readability:

This transforms image-coordinates into {row,column}-grid coordinates:

imageToGrid = 
  Last@FindGeometricTransform[{{0, 0}, {0, 1}, {1, 0}, {1, 1}}*10 + 
     1.5, gridPts, TransformationClass -> "Perspective"];

This reads a single digit given the bounding box:

readDigit = 
  Function[boundingBox, simpleOcr[ImageTrim[img, boundingBox]]];

This returns the (integer) row/column coordinates of a bounding box:

gridCell = 
  Function[boundingBox, Floor[imageToGrid[Mean[boundingBox]]]];

And this reads the full grid:

readGrid = 
 ToExpression[StringJoin[#]] & /@ 
  GroupBy[components, gridCell -> readDigit]

<|{11, 1} -> t10, {10, 1} -> t9, {9, 1} -> t8, {8, 1} -> t7, {7, 1} -> t6, {6, 1} -> t5, {5, 1} -> t4, {4, 1} -> t3, {3, 1} -> t2, {2, 1} -> t1, {11, 2} -> 5, {9, 2} -> 4, {10, 2} -> 1, {8, 2} -> 2, {7, 2} -> 6, {6, 2} -> 4, {5, 2} -> 7, {4, 2} -> 6, {3, 2} -> 2, {1, 2} -> t1, {2, 2} -> 6, {11, 3} -> 10, {10, 3} -> 2, {9, 3} -> 7, {8, 3} -> 6, {7, 3} -> 3, {6, 3} -> 2, {5, 3} -> 2, {1, 3} -> t2, {4, 3} -> 2, {3, 3} -> 3, {2, 3} -> 3, {10, 4} -> 3, {11, 4} -> 1, {4, 4} -> 10, {9, 4} -> 8, {7, 4} -> 9, {8, 4} -> 1, {6, 4} -> 8, {1, 4} -> t3, {5, 4} -> 6, {3, 4} -> 8, {2, 4} -> 7, {11, 5} -> 6, {10, 5} -> 4, {9, 5} -> 2, {1, 5} -> t4, {8, 5} -> 7, {7, 5} -> 7, {6, 5} -> 9, {5, 5} -> 8, {4, 5} -> 3, {3, 5} -> 6, {2, 5} -> 2, {1, 6} -> t5, {11, 6} -> 2, {10, 6} -> 6, {9, 6} -> 5, {8, 6} -> 5, {7, 6} -> 8, {4, 6} -> 9, {3, 6} -> 8, {2, 6} -> 8, {6, 6} -> 1, {5, 6} -> 1, {8, 7} -> 10, {6, 7} -> 10, {2, 7} -> 10, {1, 7} -> t6, {7, 7} -> 2, {5, 7} -> 9, {3, 7} -> 9, {10, 7} -> 9, {9, 7} -> 6, {4, 7} -> 5, {11, 7} -> 7, {9, 8} -> 10, {1, 8} -> t7, {3, 8} -> 5, {5, 8} -> 3, {8, 8} -> 4, {6, 8} -> 3, {4, 8} -> 1, {2, 8} -> 1, {10, 8} -> 5, {7, 8} -> 1, {11, 8} -> 3, {3, 9} -> 10, {1, 9} -> t8, {2, 9} -> 9, {5, 9} -> 4, {4, 9} -> 7, {7, 9} -> 4, {6, 9} -> 5, {8, 9} -> 9, {9, 9} -> 9, {10, 9} -> 8, {11, 9} -> 8, {5, 10} -> 10, {1, 10} -> t9, {2, 10} -> 5, {3, 10} -> 7, {10, 10} -> 10, {4, 10} -> 8, {6, 10} -> 6, {7, 10} -> 5, {8, 10} -> 3, {9, 10} -> 3, {11, 10} -> 4, {1, 11} -> t10, {2, 11} -> 4, {7, 11} -> 10, {4, 11} -> 4, {3, 11} -> 1, {6, 11} -> 7, {5, 11} -> 5, {8, 11} -> 8, {10, 11} -> 7, {9, 11} -> 1, {11, 11} -> 9|>

Or, in matrix form:

MatrixForm[SparseArray[Normal[readGrid], Automatic, ""]]

Returns:

enter image description here

$\endgroup$
  • $\begingroup$ +1 Very neat! I especially like the LocatorPane for finding the table grid $\endgroup$ – Sascha Dec 29 '15 at 9:50
  • $\begingroup$ thank you I will try this tonight $\endgroup$ – danny Dec 29 '15 at 11:14
7
$\begingroup$

Problem: To recognize numbers on an image and put them in a list using TextRecognize

Using the information provided in the question and comments I found the following solution.

Solution:

img = Import["http://i.stack.imgur.com/BQOAQ.jpg"];

  Partition[ 
  Select[ StringSplit@
    TextRecognize[LocalAdaptiveBinarize[img, 40, {0.85, 0.07}], 
     "SegmentationMode" -> 6], NumberQ[ToExpression@#] &], 
  10]   
  (* "hint note that tesseract -psm 6 <-> SegmentationMode 6"  *)

Alternative solution:

Below is an alternative solution using tesseract from within Mathematica.

sol

Below are my results as you can see they are better but not perfect. There are two mistakes yet those were corrected using expression /. "error" -> "correction".

enter image description here

Use ToExpression to change Strings into Integers that you can further use. Like this:

ToExpression /@ (Select[ StringSplit /@ Flatten[d], 
  Length@# == 11 &][[All, 2 ;;]] /. "1o" -> "10" /. "8-" -> "8" )

To read the tesseract's manual page from Mathematica:

ReadList["!man tesseract", String] //TableForm

This link could explain the limitations, uses and nature of OCR engines.

$\endgroup$
  • 3
    $\begingroup$ Gives errors on Mathematica 10/ Win 10 and the rows after 4th are incorrect. $\endgroup$ – thedude Dec 29 '15 at 6:57
  • 1
    $\begingroup$ @thedude I updated my answer and the alternative solution using teserract can give you a more accurate result. $\endgroup$ – Schopenhauer Dec 29 '15 at 8:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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