2
$\begingroup$

I use an iPhone app called Robinhood to trade stocks and I wanted to play with the portfolio with Mathematica's finance tools. So I took some screenshots of the app and I'm trying to import the relevant data (stock name, shares owned, and current price) automatically from the image.

Using the below image as img, I tried TextRecognize but it doesn't work well, and I'm not sure how to "create a mask" or use the other options to assist it:

In[10]:= TextRecognize[img, "Line"]
Out[10]= {"\"ooo T-Mobne 'a 3:56 PM 4 U >E 54% i1'", "Q $8,829.46 Q", \
"USHARES Mm $113.14", "NVDA ____________", "17 SHARES [MW $10780", "-- \
--------- _", "A SHARES W $7491", "ATHN ______________", "5 SHARES M \
$11196", "BRKB ____________", "10 SHARES W $16837", "MSFT \
____________ _", "5 SHARES w $6538", "7 SHARES W U $3564", "TAN _ \
_________", "2 SHARES W $1739", "WATCH LIST"}

enter image description here

$\endgroup$
5
$\begingroup$

So for reasons unknown TextRecognize hangs indefinitely on my computer. On the other hand, here's a way to get images that TextRecognize really ought to be able to recognize.

First, we'll want to split by those border lines so we'll get all the image data, transpose it, and count the distinct pixel values:

img = Import["https://i.stack.imgur.com/ZWpwf.png"];
data = ImageData@img;
cols = Transpose@data;
cs = Counts /@ cols;

Then we'll filter for those lines and get the first column that's only lines and check that it found the right one:

csel = SelectFirst[cs, Length@# == 3 && Min@Values@# > 5 &];
p1 = First@FirstPosition[cs, csel];

ReplacePixelValue[img, {p1, All} -> Red]

lined

If you look closely you'll see it threads between each letter. So this is good. Then we'll turn this into slices and use what we know about the layout of each slice to get tiny images that TextRecognize, if it's implemented even half-way decently, should be able to recogonize:

parts = Partition[Riffle[#, Append[Rest@#, Length@data]], 2] &@
   Flatten@Position[cols[[p1]], Except[{1., 1., 1., 1.}], {1}];

slices = ImageTake[img, #] & /@ Most@parts;

With[{sl = #, id = ImageDimensions@#},
   ImageCrop@*ImageCrop /@
    {
     Binarize@ImageTake[sl, {10, id[[2]]/2}, {0, id[[1]]/3}],
     Binarize@ImageTake[sl, {1/2, 9/10}*id[[2]], {0, id[[1]]/3}],
     ColorNegate@Binarize@ImageTake[sl, All, {2/3, 1}*id[[1]]]
     }
   ] &@slices[[6]]

result

| improve this answer | |
$\endgroup$

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.