Changeset 126 for util/title_testharness

Timestamp:

10/23/06 08:19:33 (7 years ago)

Author:

peter

Message:

Refine canonicalizeTitles_match. Now consider titles equivalent if every word
in the shorter has a corresponding word in the longer, where corresponding
words of 3 or more characters are allowed to have a single character
difference. Alternatively, the shorter title is allowed to run two words
together.

Files:

• util/title_testharness (modified) (2 diffs)

util/title_testharness

@@ -35 +35 @@
         'help'                  => \$opt->{help});
 
-printf "tiele-matching test harness\n";
+printf "title-matching test harness\n";
 if (($opt->{help}) || (!defined $opt->{test}) && (!defined $opt->{create}) && !defined $opt->{compare} ) {
         print "  usage:\n".
@@ -514 +514 @@
         $title =~ s/^\s+//;
         $title =~ s/\s+$//;
-        $title =~ s/\s+/ /;
         $title =~ s/&(#(\d+)|(.*?));/ $2 ? chr($2) : $amp{$3}||' ' /eg;
         $title =~ s/ *\& */ and /g;
         $title =~ s/[^ a-zA-Z0-9]//g;
+        $title =~ s/\s+/ /;
         return(lc($title));
 }
 
-my %alternatives = (
-                to  => ("2"),
-                too => ("2"),
-                "2" => ("to", "too")
-                );
-
-sub alternative
-{
-        my $word=shift;
-        return($alternatives{$word});
+my %alternatives = ( one => "1",
+                     two => "2",
+                     to  => "2",
+                     too => "2",
+                     three => "3",
+                     four => "4",
+                     for => "4",
+                     five => "5",
+                     six => "6",
+                     seven => "7",
+                     eight => "8",
+                     nine => "9"
+                   );
+
+sub forgivingMatch
+{
+        my $word1 = shift;
+        my $word2 = shift;
+
+        # exact match
+        return 1 if $word1 eq $word2;
+        # they match according to our alternatives lookup table
+        return 1 if $alternatives{$word1} && $alternatives{$word1} eq $word2 ||
+                    $alternatives{$word2} && $alternatives{$word2} eq $word1;
+        # irreconcilable differences
+        return 0 if abs(length($word1) - length($word2)) > 1 ||
+                    length($word1) < 3;
+
+        my @list1 = split(//,$word1);
+        my @list2 = split(//,$word2);
+        my $i = 0;
+        my $j = 0;
+
+        # find first difference
+        while ($i < @list1 && $j < @list2 && $list1[$i] eq $list2[$j]) {
+                ++$i; ++$j;
+        }
+        if ($i+1 < @list1 && $j+1 < @list2) {
+                # at least 2 chars to go in both words
+                if ($list1[$i+1] eq $list2[$j] && $list1[$i] eq $list2[$j+1]) {
+                        # characters transposed
+                        $i += 2;
+                        $j += 2;
+                } elsif ($list1[$i+1] eq $list2[$j]) {
+                        # extra character inserted into @list1
+                        $i += 2;
+                        ++$j;
+                } elsif ($list1[$i] eq $list2[$j+1]) {
+                        # extra character inserted into @list2
+                        ++$i;
+                        $j += 2;
+                } else {
+                        # single character difference
+                        ++$i;
+                        ++$j;
+                }
+                # we forgave one difference; now do rest of strings match exactly?
+                while ($i < @list1 && $j < @list2 && $list1[$i] eq $list2[$j]) {
+                        ++$i; ++$j;
+                }
+                return($i == @list1 && $j == @list2);
+        } elsif ($i == @list1 || $j == @list2) {
+                # only difference is one word has one extra letter, or last char
+                # of each word differ.  That's still only one one-char difference
+                return(1);
+        }
 }
 
 sub canonicalizeTitles_match
 {
-        my $shorter=canonicalizeTitle(shift);
-        my $longer =canonicalizeTitle(shift);
-
-        if (length($shorter) > length($longer)) {
-                ($shorter,$longer) = ($longer,$shorter);
+        my $word1=canonicalizeTitle(shift);
+        my $word2 =canonicalizeTitle(shift);
+        my @longer;
+        my @shorter;
+
+        if (length($word1) > length($word2)) {
+                @longer  = split(/\s+/, $word1);
+                @shorter = split(/\s+/, $word2);
+        } else {
+                @shorter = split(/\s+/, $word1);
+                @longer  = split(/\s+/, $word2);
         }
 
 #printf "got shorter: '%s', longer '%s'\n",$shorter,$longer;
-WORD:   for my $word (split(/\s/,$shorter)) {
+        WORD: for my $word (@shorter) {
 #printf "got word: '%s'\n",$word;
-                next WORD if ($longer =~ s/\b$word\b//);
-                for my $alt (&alternative($word)) {
-                        next if (!defined $alt);
-                        next WORD if ($longer =~ s/$alt//);
+                for(my $i=0; $i < @longer; ++$i) {
+                        if (forgivingMatch($longer[$i], $word)) {
+                                splice(@longer,$i,1);
+                                next WORD;
+                        } elsif ($i+1 < @longer &&
+                                 $word eq "$longer[$i]$longer[$i+1]") {
+                                splice(@longer,$i,2);
+                                next WORD;
+                        }
                 }
                 return(0);