Converting image data to array

Question

I'd like to convert these images to a list or array in order to graph them. I know some rows are unreadable, but it doesn't really matter. So I tried using TextRecognize, but pairing the output strings isn't simple, when there are many columns. I've never gone that deep into Mathematica functions other than mathematical ones, so I'm kind of lost here.

Any help is appreciated.

Answer 1

Here's my attempt. It's not entirely satisfying, but maybe it will help. I've only tried it on one of the fuzzier pages:

i = Import["mL27rU9.jpg"]

First, let us identify connected components:

mc = MorphologicalComponents[Binarize@i, Method -> "Nested"];
Colorize @ mc

Next we shall extract all the bounding boxes:

bb = Round[Last /@ ComponentMeasurements[mc, "BoundingBox"]];

The plan is to classify a region based on the width of the bounding box. Each column has a wide box, then a narrow bow. We can pick these widths with the help of a histogram:

Histogram[#[[2, 1]] - #[[1, 1]] & /@ bb, {140, 230, 2}]

right = Select[bb, 140 < #[[2, 1]] - #[[1, 1]] < 170 &];
left = Select[bb, 170 < #[[2, 1]] - #[[1, 1]] < 220 &];
ImageAssemble @ {{
  Colorize@SelectComponents[mc, "BoundingBox", 140 < #[[2, 1]] - #[[1, 1]] < 170 &],
  Colorize@SelectComponents[mc, "BoundingBox", 170 < #[[2, 1]] - #[[1, 1]] < 220 &]}}

Once we have them, we can match them up by finding to closest left box to each one of the right boxes.

closest = Table[With[{cr = 0.5 Total@r}, First@SortBy[left, Norm[cr - 0.5 Total@#] &]],
  {r, right}];

There are probably better ways to do this, both in the way I've written the code and the conditions for matching, but it's close enough for now.

Now we can clip the image to each bounding box and recognize the text.

rightText = TextRecognize@ImageTake[i, 2592 - {#[[2, 2]] - 5, #[[1, 2]] + 5},
   {#[[1, 1]] + 5, #[[2, 1]] - 5}] & /@ right

leftText = TextRecognize@ImageTake[i, 2592 - {#[[2, 2]] - 5, #[[1, 2]] + 5},
   {#[[1, 1]] + 5, #[[2, 1]] - 5}] & /@ closest

Here we have reduced the bounding box to avoid the border, and flipped the rows because image coordinates are always backwards. Now we can get some actual points, ignoring everything that doesn't convert to a number.

points = Select[Thread[{leftText, rightText}] /. 
   s_String :> With[{e = Quiet@ToExpression[s]}, If[NumberQ@e, e, 0]],
   Times @@ # != 0 &]

Finally, we can graph the points:

ListPlot@points

A rather disappointing scatter :-(

Answer 2

Updated Attempt

When playing with the first attempt, mentioned below, I tried to work with the "messy" parts of the images, namely the first and last columns. In so doing, I think I found a somewhat general method that provides strings that should be relatively easy to proof and edit. The key component of this solution is EdgeDetect followed by a way to turn these edges into recognizable characters. I do that with the following steps:

• Partition the image into columns, as these smaller chunks seem to be handled better by TextRecognize
• EdgeDetect
• Remove the border edges using DeleteSmallComponents and ImageSubtract. Note, tweaking the second argument of DeleteSmallComponents to ensure that only numbers and letters are considered small is helpful here. Then I remove the border with image subtraction.
• Apply a Dilation. Some tweaking may be beneficial here. I spent some time with FillingTransform but never got a result that was comparable in speed and accuracy to the Dilation solution presented here.
• TextRecognize with reference to this answer that mentions the undocumented option.

Here's one iteration of the routine:

data = Import["http://i.imgur.com/pkw4Dou.jpg"]
{length, height} = ImageDimensions[data]
length = 1750 (* Manual override *)
cimg = Table[
   ImageTake[
    data, {1, height}, {IntegerPart[i/4 length + 1], 
     IntegerPart[(i + 1)/4 length]}], {i, 0, 3}];
marker = EdgeDetect /@ cimg; 
t3 = TextRecognize[
    Dilation[ImageSubtract[#, DeleteSmallComponents[#, 200]], 1], 
    "SegmentationMode" -> 4] & /@ marker

Here's a snapshot of the string (easily formatted with StringSplit but I have not done so here)

When tried on subsequent images (I only tried the first 3) I obtained reasonable success, although there is a bit of tweaking and inevitable errors due to smudges, reflection and solid objects on the images. Examples:

data2 = Import["http://i.imgur.com/mL27rU9.jpg"]

data3 = Import["http://i.imgur.com/hfP697o.jpg"]

That's probably the best I can do.

First Attempt

A partial answer, ignoring for the moment the messy areas. Using this image:

data = Import["http://i.imgur.com/pkw4Dou.jpg"]

I'm going to crop the 1st and 4th complete columns as they don't render well in this example. ChanVeseBinarize does a nice job at cleaning up the middle two columns, however:

ImageTake[data, {1, 2592}, {450, 1350}];
bimg = ChanVeseBinarize[%]

Then, bimg is easily OCR'd with TextRecognize and a little manual pruning.

t1 = TextRecognize[bimg];
ToExpression@Partition[StringSplit[t1][[7 ;; -1]], 2] // ListPlot

The point here is that spending some time with the image manipulation features in order to render a binarized form of the images is going to be the best use of your time in my opinion.