Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

OCR matching regex

by choeppner (Pilgrim)
on Dec 19, 2016 at 04:25 UTC ( [id://1178025]=perlquestion: print w/replies, xml ) Need Help??

choeppner has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to solve an problem where I am searching for a string within a string using regex. More accurately I am searching for the longest string within a string, allowing for missing or extra characters.

I have been around and around this problem and now I think that it is not possible with regex. So I thought I would ask the monks for enlightenment.

So here is the real world situation, equipment marked with both painted id letters and RFID tags are being verified. An image of the equipment is run through a OCR process and a string of characters is returned. Sometimes there are extra characters included before, inside or after the actual part number, caused by noisy image. From a separate process, the equipment's RFID tag is read.

This seems straight forward enough, but I need to allow for extra characters in the string being searched, and allow for missing characters from the string being searched for.

The simple example is find "ABC" in "DFGABCKBG".

The example where I fail to find a solution is, find "ABC" in "DFGAXBHCY" as "AXBHC", or "ABC" in "DFGAXBHY" as "AXB".

p.s.

I'm not yelling, the OCR text is all upper case.

Replies are listed 'Best First'.
Re: OCR matching regex
by tybalt89 (Monsignor) on Dec 19, 2016 at 05:49 UTC
    #!/usr/bin/perl -l # http://perlmonks.org/?node_id=1178025 use strict; use warnings; while(<DATA>) { my ($want, $in) = split; my $pat = $want =~ s/\B/?.?/gr . '?'; #print $pat; my (@answers, %found); $in =~ /$pat(?{$found{$&}++ or $answers[length $&] .= "$& "})(*FAIL) +/; print "$want in $in is ", @answers ? $answers[-1] : 'not found'; } __DATA__ ABC DFGABCKBG ABC DFGAXBHCY ABC DFGAXBHY

    Many more test cases are needed :)

    Also an explanation of why ABC DFGAXBHY should be AXB instead of AXBH

    Also what should be done if there is more than one "longest".

    Also, can there be more than one extra character between wanted chars, and if so, how many?

Re: OCR matching regex
by kcott (Archbishop) on Dec 19, 2016 at 08:47 UTC

    G'day choeppner,

    In my opinion, a regex is not the right tool for this job. The string-related functions length, index and substr can provide all the functionality you need. I'd also expect them to be much faster than any regex solution (Benchmark against any you receive).

    Here's my test code (with some additional test data):

    #!/usr/bin/env perl use strict; use warnings; use Test::More; my @tests = ( [qw{ABC DFGABCKBG ABC}], [qw{ABC DFGAXBHCY AXBHC}], [qw{ABC DFGAXBHY AXB}], [qw{ABC DFGCBAKBG AKB}], [qw{ABC DFGCBAKbG A}], ['', 'DFGCBAKbG', ''], ['ABC', '', ''], [qw{ABC AXBHCY AXBHC}], [qw{ABC DFGAXBHC AXBHC}], [qw{abc DFGABCKBG}, ''], ); plan tests => scalar @tests; for my $test (@tests) { my ($start, $end) = (-1, -1), my ($rfid, $ocr, $exp) = @$test; for (0 .. length($rfid) - 1) { my $pos = index $ocr, substr($rfid, $_, 1), $end + 1; next if $pos == -1; $start = $pos if $start == -1; $end = $pos; } my $got = $start == -1 ? '' : substr $ocr, $start, $end - $start + + 1; is($got, $exp, "Find '$rfid' in '$ocr' as '$exp'"); }

    Output:

    1..10 ok 1 - Find 'ABC' in 'DFGABCKBG' as 'ABC' ok 2 - Find 'ABC' in 'DFGAXBHCY' as 'AXBHC' ok 3 - Find 'ABC' in 'DFGAXBHY' as 'AXB' ok 4 - Find 'ABC' in 'DFGCBAKBG' as 'AKB' ok 5 - Find 'ABC' in 'DFGCBAKbG' as 'A' ok 6 - Find '' in 'DFGCBAKbG' as '' ok 7 - Find 'ABC' in '' as '' ok 8 - Find 'ABC' in 'AXBHCY' as 'AXBHC' ok 9 - Find 'ABC' in 'DFGAXBHC' as 'AXBHC' ok 10 - Find 'abc' in 'DFGABCKBG' as ''

    See also: Test::More

    — Ken

Re: OCR matching regex
by LanX (Saint) on Dec 19, 2016 at 11:48 UTC
    These are fuzzy requirements

    My first guess is you are looking for Levenshtein_distance .

    My second guess is you have problems to phrase a clear heuristic and rather need a learning algorithm which can be trained with encountered problems. °

    In any case we˛ need to see some real data in order to help.

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

    footnotes

    °) Something like calculating frequencies of false character sequences to calculate the probability of ambiguous solutions

    ˛) like all learning algorithms ;)

Re: OCR matching regex
by tybalt89 (Monsignor) on Dec 19, 2016 at 12:44 UTC
    #!/usr/bin/perl -l # http://perlmonks.org/?node_id=1178025 use strict; use warnings; use Algorithm::Diff qw(traverse_sequences); while(<DATA>) { my ($want, $in) = split; my @from = split //, $in; my @to = split //, $want; my $answer = ''; traverse_sequences( \@from, \@to, { MATCH => sub {$answer .= $from[shift()]}, DISCARD_A => sub {$answer .= "-$from[shift()]"}, DISCARD_B => sub {$answer .= "+$to[pop()]"}, } ); $answer =~ s/^(?:[+-]\w)+ | (?:[+-]\w)+$//gx; # strip outer $answer =~ tr/+-//d; # clean up inner $answer ||= 'not found'; print "$want in $in is $answer"; } __DATA__ ABC DFGABCKBG ABC DFGAXBHCY ABC DFGAXBHY ABC DEFGHI

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1178025]
Approved by Athanasius
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2024-04-25 11:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found