Recognizing integers in an image

Question

This is the picture I want Mathematica to read

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.

Answer 1

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["https://i.sstatic.net/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

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

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:

Answer 2

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["https://i.sstatic.net/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.

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".

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.