regular expressions in perl-get amount of matching digits

baddah · 06-27-2007, 01:34 AM

Hi,

A am having serious trouble with regular expressions in perl.I am trying to match a phone number with regular expressions and get back the best match.

Say i have a number 004478851234,I do a query in a db wich returns all regular expressions matching the criteria.No i want to find the best match using perl.Say i have two matches.

0044788[59] => matches 8 digits
00447[0789] => matches 6 digits

How can i from perl get back the number of matching digits,so that I now to take the first one.

if i trie something like $number =~ /^$regularexpr/ ,its going to return true for both,without me knowing which one to pick beacues their is no reference to the amount of matching digits.How can i get this back,so that i know whick one to pick?

Thanks for the help

chrism01 · 06-27-2007, 02:28 AM

hopefully one of these will help:

http://perldoc.perl.org/perlretut.html Perl regex tutorial
http://www.perlmonks.org Perl equiv of Linuxquestions

manosagn · 06-27-2007, 08:45 AM

Take a look at the links provided by chrism01. Maybe you'll find somethink useful.
Else, you've to make it from scratch. And idea is split each match (say $match) into an array of single digits (say @array_match) and calculate:

Code:

@what_I_want = (0,0,4,4,7,8,8,5,1,2,3,4);
@best_match = (); #initialize it to be the first match
$match_rank = 0; #the number of same digits of the best match so far
$tmp = 0; #temporary variable
$sum = 0; #the match rank of an array
$i=0; #a counter for keeping track, which digit is currently checked
foreach $digit (@array_match)
{
 
  if ($digit != $best_match[$i]){$tmp = 0;} #if the current digit is not the same, keep 0
  else {$tmp = 1;} #else 1
  $sum += $tmp; #adds 1 if the digits are the same. $sum will hold at the end of that loop the number of same digits
  $i++;
}
if ($sum > $match_rank){@best_match = @array_match;$match_rank = $sum} # if the match is better, substitute it
#with the current match

Please forgive some perl misspells since I've not written perl for a while, but take a closer look at the algorithm.

bartonski · 06-27-2007, 09:18 PM

Hm...

Code:

#! /usr/bin/perl -w

use strict;

my $target = "004478851234";
my $longest=0;

my @regexes = (
        qr(00447[0789]),
        qr(0044788[59])
);

my $i;
for $i (@regexes){
        # do the regex match
        $target =~ $i;
        # $& contains the match, the split creates a list of individual characters, scalar
        # takes a count of the array elements.
        my $length = scalar split //, $&;
        # take the longer of $longest or $length
        $longest = $longest > $length ? $longest : $length;
}

print "longest match: $longest\n";