<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w

###########################
#    MatchLocations.pl    #
#      Version 1.02       #
#    (c) Ed Egan 2009     # 
###########################

=head1 NAME

MatchLocations.pl v1.01

=head1 DESCRIPTION &amp; AUTHOR

'Process patent inventor location files and match the locations against known GNS location names, recording longitude and latitude'

Written by Ed Egan &lt;ed@edegan.com&gt;

Copyright (C) 2009. Be nice.

=head1 SYNOPSIS

perl MatchPatentLocations.pl [-co=&lt;str&gt;] [-o=&lt;file&gt;]  

=head1 OPTIONS
    -co=&lt;str&gt;:      ISO9660 country code (e.g. GB)
    -o=&lt;file&gt;:      Outfile name (default=co.-Results.txt): Name of processed file that will be created
    -u=:            Output UNMATCHED results as well. If not present, only matched results are written
    -wf:            Write the fuzzy output files seperately
    -human:         Write a human match file with candidate matches for unmatched strings.
    -r:             Write a report file that is the same as the STDOUT report
    -h:             Display this semi-informative help

=cut

#Load Packages
use strict;
use Match::Common qw(CleanString);
use Match::GNS;
use Match::Patent;
use Match::Gram;
use Match::LCS;
use Match::PostalCodes;
use warnings;
use Getopt::Long;
use Data::Dumper;
use Pod::Usage;

# Read command-line arguments / Define global variables
my $opt_show_help=0;
my ($opt_co, $opt_outfile);
my $opt_sourcedir="Source";
my $opt_refdir="GNS";
my $opt_writefuzzy=0; my $opt_human=0; my $opt_report=0; my $opt_unmatched=0;
GetOptions(
      "co=s"    =&gt; \$opt_co,
      "o=s"     =&gt; \$opt_outfile,
      "u"       =&gt; \$opt_unmatched,
      "wf"      =&gt; \$opt_writefuzzy,
      "human"   =&gt; \$opt_human,
      "r"       =&gt; \$opt_report,
      "h"       =&gt; \$opt_show_help
) || die pod2usage(2);
if ($opt_show_help) {
   pod2usage(-exitstatus =&gt; 0, -verbose =&gt; 2);
}
if (!$opt_outfile) {$opt_outfile=$opt_co."-Results.txt";}
my @Letters=("A","P");
my $ReportFileName=$opt_co."-Report-".time().".txt";
if ($opt_report) {open (REPORT,"&gt;$ReportFileName") || die "Can not open the Report file to write".$!;} #autoflush REPORT 1;
#autoflush STDOUT 1;

#And go!
my $StartTime=time();
dprint ("#######################################\n");
dprint ("#           MatchLocations.pl         #\n");
dprint ("#                 v1.01               #\n");
dprint ("#          (c) Ed Egan, 2009          #\n");
dprint ("#######################################\n\n");
dprint ("Starting the program...\t\t[OK]\n");
dprint ("\tDate &amp; Time:\t\t".scalar(localtime)."\n");

dprint ("Loading the source files...\t");
my $Location=Patent-&gt;new($opt_co,$opt_sourcedir);
dprint ("[Done]\n");
dprint ("\tMain Read Count:\t".$Location-&gt;GetCount("READ")."\n");
dprint ("\tRecord Count:\t\t".$Location-&gt;GetCount("DATA")."\n");
dprint ("\tException Read Count:\t".$Location-&gt;GetCount("EXPREAD")."\n");

dprint ("Loading the ref files...\t");
my $GNS=GNS-&gt;new($opt_co,$opt_refdir);
dprint ("[Done]\n");
dprint ("\tRead Count:\t\t".$GNS-&gt;GetCount("DATA")."\n");

dprint ("Clean &amp; Parse source...\t\t");
$Location-&gt;CleanAndParse;
dprint ("[Done]\n");

dprint ("Build ref indices...\t\t");
$GNS-&gt;Index;
dprint ("[Done]\n");

dprint ("Exceptions List Matching...\t");
my $ExpSuccess=ExactMatchList("EXP_LIST");
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

dprint ("Well Formatted List Matching...\t");
my $CtyListSuccess=ExactMatchList("CTY_LIST");
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

dprint ("Token matching...\t\t");
my $TokenSuccess=TokenMatch("CTY_CLEAN","EXACTTOKEN");
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

dprint ("Ngram and LCS Setup...\t\t[OK]\n");
my ($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug)=("CTY_CLEAN","NGRAM_CTY_CLEAN_1-4-Special",1,4,0.8,1,0.8,1,0.84,0,10,0);
&amp;PrintNgramLCSSettings($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("Ngram and LCS matching...\t");
my $NgramSuccess=GramMatch($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

dprint ("Ngram and LCS Setup...\t\t[OK]\n");
($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug)=("CTY_CLEAN","NGRAM_CTY_CLEAN_6-3-Hard",6,3,0.5,1,0.5,1,0.85,1,10,0);
&amp;PrintNgramLCSSettings($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("Ngram and LCS matching...\t");
$NgramSuccess=GramMatch($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

dprint ("Ngram and LCS Setup...\t\t[OK]\n");
($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug)=("CTY_CLEAN","NGRAM_CTY_CLEAN_6-2-Medium",6,2,0.6,1.2,0.6,1.2,0.86,1,1,0);
&amp;PrintNgramLCSSettings($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("Ngram and LCS matching...\t");
$NgramSuccess=GramMatch($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug);
dprint ("[Done]\n");
dprint ("\tMatches Made:\t\t".$Location-&gt;GetCount("MATCHES_LAST")."\n");
dprint ("\tTotal Matches:\t\t".$Location-&gt;GetCount("MATCHES_TOTAL")."\n");

my $HumanSet=undef;
if ($opt_human) {
   dprint ("Create the Human choices...\t");
   #($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug)
   my $Human1=GramMatch("CTY_CLEAN","HUMAN_CHOICE1",6,3,0.3,1.5,0.3,1.5,0.3,1,1,1);
   my $Human2=GramMatch("CTY_CLEAN","HUMAN_CHOICE2",1,2,0.3,1.5,0.3,1.5,0.3,0,5,1);
   $HumanSet=ReconcileForHumans($Human1,$Human2);
   dprint ("[Done]\n");
}

dprint ("Deduplicate and fix...\t\t");
my $DistanceCalcs=FixMatches();
dprint ("[Done]\n");
dprint ("\tDistance Lookups:\t".$DistanceCalcs."\n");

dprint ("Writing output file...\t\t");
my $LinesWritten=undef;
if (!$opt_unmatched) {$LinesWritten=WriteOutfile($opt_outfile,"MATCHED"); dprint ("[MATCHED ONLY]\n");}
else {$LinesWritten=WriteOutfile($opt_outfile); dprint ("[INCS UNMATCHED]\n");}
dprint ("\tOutput Filename:\t".$opt_outfile."\n");
dprint ("\tLines Written:\t\t".$LinesWritten."\n");

if ($opt_writefuzzy) {
   dprint ("Writing Fuzzy file...\t\t");
   my $FuzzySetName="NGRAM_CTY_CLEAN_1-4-Special";
   $LinesWritten=WriteOutfile($opt_co."-".$FuzzySetName.".txt",$FuzzySetName);
   dprint ("[Done]\n");
   dprint ("\tFuzzy Setname:\t\t".$FuzzySetName."\n");
   dprint ("\tLines Written:\t\t".$LinesWritten."\n");
   
   dprint ("Writing Fuzzy file...\t\t");
   $FuzzySetName="NGRAM_CTY_CLEAN_6-3-Hard";
   $LinesWritten=WriteOutfile($opt_co."-".$FuzzySetName.".txt",$FuzzySetName);
   dprint ("[Done]\n");
   dprint ("\tFuzzy Setname:\t\t".$FuzzySetName."\n");
   dprint ("\tLines Written:\t\t".$LinesWritten."\n");
   
   dprint ("Writing Fuzzy file...\t\t");
   $FuzzySetName="NGRAM_CTY_CLEAN_6-2-Medium";
   $LinesWritten=WriteOutfile($opt_co."-".$FuzzySetName.".txt",$FuzzySetName);
   dprint ("[Done]\n");
   dprint ("\tFuzzy Setname:\t\t".$FuzzySetName."\n");
   dprint ("\tLines Written:\t\t".$LinesWritten."\n");
}

if ($opt_human){
   dprint ("Writing Human choice file...\t");
   if ($HumanSet) {WriteHumanChoiceFile($HumanSet);}
   dprint ("[Done]\n");
}

my $TimeElapsed=time()-$StartTime;
dprint ("Script run completed...\t\t[OK]\n\n");
dprint ("#######################################\n");
dprint ("#            (C)2009 Ed Egan.         #\n");
dprint ("#       Please thank the author.      #\n");
dprint ("#    Run completed in: $TimeElapsed seconds.   #\n"); #$TimeElapsed
dprint ("#######################################\n");
if ($opt_report) {close (REPORT);}

sub dprint {
   my $Str=shift @_;
   print STDOUT $Str;
   if ($opt_report) {print REPORT $Str;}
}

sub PrintNgramLCSSettings {
	my ($ListType,$MarkType,$GramAlphabet,$NGramLength,$LeftLower,$LeftUpper,$RightLower,$RightUpper,$LCSThreshold,$FirstLetterBinds,$MinLengthThreshold,$Debug)=@_;
	dprint ("\tSettings:\n");
	dprint ("\t\tListType:\t".$ListType."\n");
	dprint ("\t\tMarkType:\t".$MarkType."\n");
	dprint ("\t\tGramAlphabet:\t".$GramAlphabet."\n");
	dprint ("\t\tNGramLength:\t".$NGramLength."\n");
	dprint ("\t\tLeftLower:\t".$LeftLower."\n");
	dprint ("\t\tLeftUpper:\t".$LeftUpper."\n");
	dprint ("\t\tRightLower:\t".$RightLower."\n");
	dprint ("\t\tRightUpper:\t".$RightUpper."\n");
	dprint ("\t\tLCSThreshold:\t".$LCSThreshold."\n");
	dprint ("\t\tFirstLetter:\t".$FirstLetterBinds."\n");
	dprint ("\t\tMinMaxLength:\t".$MinLengthThreshold."\n");
	dprint ("\t\tDebug:\t\t".$Debug."\n");
	return 1;
}

sub ExactMatchList {
   my $ListType=shift;
   my $UnMatched=$Location-&gt;GetUnMatched($ListType);
   my $Success=0;
   if (scalar(keys(%$UnMatched))&gt;0) {
      my $Matched={};
      foreach my $Letter (@Letters) {
         my @Index=$GNS-&gt;GetIndexKeys($Letter);
         foreach my $CTY (keys (%$UnMatched)) {
			undef my @Matches;
            foreach my $Field (@{$UnMatched-&gt;{$CTY}}) {
               foreach my $Key (@Index) {
                  if (uc($Key) eq uc ($Field)) {push (@Matches,$Key);}
               }
            }
			if (@Matches) {$Matched-&gt;{$CTY}-&gt;{$Letter."LIST"}=\@Matches;}
         }
      }
      if (scalar(keys(%$Matched))&gt;0) {
         $Matched=ChooseBestAandP($Matched);
         $Location-&gt;ReturnMatches($Matched,$ListType);
         $Success=1; 
      }
   }
   return $Success;
}

sub TokenMatch {
   my $ListType=shift;
   my $MarkType=shift;
   my $UnMatched=$Location-&gt;GetUnMatched($ListType);
   my $Success=0;
   my $MaxLength=5; #Set the max token length
   if (scalar(keys(%$UnMatched))&gt;0) {
      my $Matched={};
      foreach my $Letter (@Letters) {
         my @Index=$GNS-&gt;GetIndexKeys($Letter);
         foreach my $CTY (keys (%$UnMatched)) {
            undef my @Matches;
            my @Tokens=split(" ",$UnMatched-&gt;{$CTY});
            my $StartLength=($MaxLength-1 &lt;= $#Tokens) ? $MaxLength-1 : $#Tokens;
            for (my $i=$StartLength; $i&gt;=0; $i--) {
               if (scalar(@Matches)&gt;0) {next;}
               undef my @SliceStart;
               my $Exhausted=0; my $StartPos=$#Tokens-$i;
               until ($Exhausted) {
                  if ($StartPos&lt;0) {$Exhausted=1;next;}
                  push (@SliceStart,$StartPos);
                  $StartPos--;
               }
               foreach my $StartPos (@SliceStart) {
                  my $TokenStr=join(" ",@Tokens[$StartPos..($StartPos+$i)]);
                  foreach my $Key (@Index) {
                     if (uc($Key) eq uc($TokenStr)) {push (@Matches,$Key);}
                  }
               }
            }
            if (@Matches) {$Matched-&gt;{$CTY}-&gt;{$Letter."LIST"}=\@Matches;}   
         }
      }
      if (scalar(keys(%$Matched))&gt;0) {
         $Matched=ChooseBestAandP($Matched);
         $Location-&gt;ReturnMatches($Matched,$MarkType);
         $Success=1; 
      }
   }
   return $Success;
}

sub GramMatch {
   my $ListType=shift; 
   my $MarkType=shift;
   my $GramAlphabet=shift; #Alphanumerics, Alphas, spaced, etc... See GramMatch.pm code for numbers
   my $NGramLength=shift; #Use trigams, bigrams, etc
   my $LeftLower=shift; #The Lower threshold Pc of the Ref that appears in the Source
   my $LeftUpper=shift; #The Upper threshold Pc of the Ref that appears in the Source
   my $RightLower=shift; #The Lower threshold Pc of the Source that appears in the Ref
   my $RightUpper=shift; #The Upper threshold Pc of the Source that appears in the Ref
   my $LCSThreshold=shift; #The Pc of the Ref that is the LCS
   my $FirstLetterBinds=shift; #Must the First Letter Match?
   my $MaxLengthThreshold=shift; #What is the LCS Max Length Threshold?
   my $Debug=shift; #For Debug/Human Results
   my $Success=0;
   my $UnMatched=$Location-&gt;GetUnMatched($ListType);
   if (scalar(keys(%$UnMatched))&gt;0) {
      my $LCS=LCS-&gt;new();
      my $BestLeftPc=0; my $BestRightPc=0; #For debug only - keep a running best...
      my $Gram=Gram-&gt;new($GramAlphabet,$NGramLength);
      my $FuzzyMatches={}; #For Debug/Human Results
      my $Matched={};
      foreach my $Letter (@Letters) {
         my @Index=$GNS-&gt;GetIndexKeys($Letter);
         my $ForwardIndex=$Gram-&gt;Index(\@Index,$Letter);
         my $ReverseIndex=$Gram-&gt;ReverseIndex(\@Index,$Letter); #for speed on long datasets use the reverse index - on short datasets this will slow things down though
         foreach my $CTY (keys (%$UnMatched)) {
            undef my @Matches; my $BestLeftScore=0; my $BestRightScore=0; my $BestCandidates={};
            my $SourceGrams=$Gram-&gt;GetNGrams($UnMatched-&gt;{$CTY});
            my $SourceTotal=$Gram-&gt;Total($SourceGrams);
            undef my @RefListWithDups;
            foreach my $SourceGram (keys(%$SourceGrams)) {
               my $ReturnList=$Gram-&gt;ReverseList($SourceGram,$Letter);
               if ($ReturnList) {push (@RefListWithDups,@$ReturnList);}
            }
            my $Cleaning={};
            foreach (@RefListWithDups) {$Cleaning-&gt;{$_}=1;}
            my @RefList=keys (%$Cleaning);
            if (scalar(@RefList)==0) {next;}
            my $RefGrams=$Gram-&gt;Lookup(\@RefList,$Letter);
            if (!@Matches) {
               foreach my $GramKey (keys (%$RefGrams)) {
                  if ($FirstLetterBinds) {
                     my $Source=uc($UnMatched-&gt;{$CTY}); my $Ref=uc($GramKey);
                     if (substr($Source,0,1) ne substr($Ref,0,1)) {next;}
                  }
                  my $LeftScore=$Gram-&gt;Score($RefGrams-&gt;{$GramKey},$SourceGrams); #Use the reference string as left - it is 'correct'
                  my $RightScore=$Gram-&gt;Score($SourceGrams,$RefGrams-&gt;{$GramKey});
                  if ($LeftScore &gt;= $BestLeftScore) {
                     $BestLeftScore=$LeftScore;
                     if ($RightScore &gt; $BestRightScore) {
                        $BestRightScore=$RightScore;
                        $BestCandidates={};
                        $BestCandidates-&gt;{$GramKey}-&gt;{BESTLEFTSCORE}=$BestLeftScore;
                        $BestCandidates-&gt;{$GramKey}-&gt;{BESTRIGHTSCORE}=$BestRightScore;
                     }
                     elsif ($RightScore == $BestRightScore) {
                        $BestCandidates-&gt;{$GramKey}-&gt;{BESTLEFTSCORE}=$BestLeftScore;
                        $BestCandidates-&gt;{$GramKey}-&gt;{BESTRIGHTSCORE}=$BestRightScore;
                     }
                  }
               }
            }
            #Decide if any matches are good enough...
            if (scalar(keys(%$BestCandidates))&gt;0 &amp;&amp; $BestLeftScore&gt;0) {
               my $LCSBestScore=0; my $LCSBestCandidate=undef;
               foreach my $BestCandidate (keys (%$BestCandidates)) {
                  my $RefTotal=$Gram-&gt;Total($RefGrams-&gt;{$BestCandidate});
                  my $RefPc=$BestLeftScore/$RefTotal; #Percentage of Ref that appears in Source
                  my $SourcePc=$BestRightScore/$SourceTotal; #Percentage of Source that appears in Ref
                  if ($RefPc&gt;=$LeftLower &amp;&amp; $RefPc&lt;=$LeftUpper &amp;&amp; $SourcePc &gt;= $RightLower &amp;&amp; $SourcePc &lt;= $RightUpper) {
                     my $LCSScore=$LCS-&gt;LCS($UnMatched-&gt;{$CTY},$BestCandidate);
                     my $MaxLength=(length($UnMatched-&gt;{$CTY}) &gt;= length($BestCandidate)) ? length($UnMatched-&gt;{$CTY}) : length($BestCandidate);
                     if ($LCSScore &gt;= $LCSBestScore) {
                        $LCSBestScore=$LCSScore;
                        $LCSBestCandidate=$BestCandidate;
                     }
                  }
               }
               if (defined($LCSBestCandidate)) {
                  my $MaxLength=(length($UnMatched-&gt;{$CTY}) &gt;= length($LCSBestCandidate)) ? length($UnMatched-&gt;{$CTY}) : length($LCSBestCandidate);   
                  if ($LCSBestScore/$MaxLength &gt;= $LCSThreshold &amp;&amp; $MaxLength&gt;=$MaxLengthThreshold) {
                     push (@Matches,$LCSBestCandidate);
                     if ($Debug) {
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{CTY}=$CTY;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{REFTOTAL}=$Gram-&gt;Total($RefGrams-&gt;{$LCSBestCandidate});
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{SOURCETOTAL}=$SourceTotal;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{REFPC}=$BestCandidates-&gt;{$LCSBestCandidate}-&gt;{BESTLEFTSCORE};
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{SOURCEPC}=$BestCandidates-&gt;{$LCSBestCandidate}-&gt;{BESTRIGHTSCORE};;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{LEFTGRAMS}=$BestLeftScore;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{RIGHTGRAMS}=$BestRightScore;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{LCSSCORE}=$LCSBestScore;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{SOURCELENGTH}=length($UnMatched-&gt;{$CTY});
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{REFLENGTH}=length($LCSBestCandidate);
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{MAXLENGTH}=$MaxLength;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{LCSPC}=$LCSBestScore/$MaxLength;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{FIRSTLETTERBINDS}=$FirstLetterBinds;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{GRAMALPHABET}=$GramAlphabet;
                        $FuzzyMatches-&gt;{$UnMatched-&gt;{$CTY}}-&gt;{$LCSBestCandidate}-&gt;{GRAMLENGTH}=$NGramLength;
                     }
                  }
               }
            }
            if (@Matches) {$Matched-&gt;{$CTY}-&gt;{$Letter."LIST"}=\@Matches;}
         }
      }
      if (!$Debug) {if (scalar(keys(%$Matched))&gt;0) {$Location-&gt;ReturnMatches($Matched,$MarkType); $Success=1;}}
      else {return $FuzzyMatches;}
   }
   return $Success;
}

sub ChooseBestAandP {
   my $Matched=shift;
   my $RefinedMatches={};
   #The below routine forces different A and P entries if possible
   foreach my $Key (keys (%$Matched)) {
      if (defined($Matched-&gt;{$Key}-&gt;{ALIST}) &amp;&amp; defined($Matched-&gt;{$Key}-&gt;{PLIST})) {
         if (scalar(@{$Matched-&gt;{$Key}-&gt;{ALIST}})==1 &amp;&amp; scalar(@{$Matched-&gt;{$Key}-&gt;{PLIST}})&gt;1) {
            my $A=${$Matched-&gt;{$Key}-&gt;{ALIST}}[0];
            undef my @CleanedPList;
            foreach my $P (@{$Matched-&gt;{$Key}-&gt;{PLIST}}) {
               if ($P ne $A) {push(@CleanedPList,$P);}
            }
            if (scalar(@CleanedPList &gt;0)) {$RefinedMatches-&gt;{$Key}-&gt;{PLIST}=\@CleanedPList;}
            else {$RefinedMatches-&gt;{$Key}-&gt;{PLIST}=$Matched-&gt;{$Key}-&gt;{PLIST};}
            $RefinedMatches-&gt;{$Key}-&gt;{ALIST}=$Matched-&gt;{$Key}-&gt;{ALIST};
         }
         elsif (scalar(@{$Matched-&gt;{$Key}-&gt;{ALIST}})&gt;1 &amp;&amp; scalar(@{$Matched-&gt;{$Key}-&gt;{PLIST}})==1) {
            my $P=${$Matched-&gt;{$Key}-&gt;{PLIST}}[0];
            undef my @CleanedAList;
            foreach my $A (@{$Matched-&gt;{$Key}-&gt;{ALIST}}) {
               if ($A ne $P) {push(@CleanedAList,$A);}
            }
            if (scalar(@CleanedAList &gt;0)) {$RefinedMatches-&gt;{$Key}-&gt;{ALIST}=\@CleanedAList;}
            else {$RefinedMatches-&gt;{$Key}-&gt;{ALIST}=$Matched-&gt;{$Key}-&gt;{ALIST};}
            $RefinedMatches-&gt;{$Key}-&gt;{PLIST}=$Matched-&gt;{$Key}-&gt;{PLIST};
         }         
         else {$RefinedMatches-&gt;{$Key}=$Matched-&gt;{$Key};}
      }
      else {$RefinedMatches-&gt;{$Key}=$Matched-&gt;{$Key};}
   }
   return $RefinedMatches;
}

sub FixMatches {
   my $CleanedMatch={};
   my $Counter=0;
   my $MatchedA=$Location-&gt;GetMatched("A");
   my $MatchedP=$Location-&gt;GetMatched("P");
   push (my @MatchedAllWithDups,keys(%$MatchedA),keys(%$MatchedP));
   my $MatchedAll={};
   foreach (@MatchedAllWithDups) {$MatchedAll-&gt;{$_}=1;}
   foreach my $CTY (keys (%$MatchedAll)) {
      if (defined($MatchedA-&gt;{$CTY})){
         my $ALookup={}; my $PLookup; my $BestA=undef;
         if (defined($MatchedP-&gt;{$CTY})){
            #A's and P's
            foreach my $AMatch (@{$MatchedA-&gt;{$CTY}}) {
               $ALookup-&gt;{$AMatch}-&gt;{LONG}=$GNS-&gt;GetLong($AMatch,"A");
               $ALookup-&gt;{$AMatch}-&gt;{LAT}=$GNS-&gt;GetLat($AMatch,"A");
            }
            foreach my $PMatch (@{$MatchedP-&gt;{$CTY}}) {
               $PLookup-&gt;{$PMatch}-&gt;{LONG}=$GNS-&gt;GetLong($PMatch,"P");
               $PLookup-&gt;{$PMatch}-&gt;{LAT}=$GNS-&gt;GetLat($PMatch,"P");
            }
            foreach my $A (keys(%$ALookup)) {
               my $ShortestDist=undef;
               my $BestP=undef;
               foreach my $P (keys(%$PLookup)) {
                  if (!$ShortestDist) {
                     if ((scalar(@{$MatchedP-&gt;{$CTY}}) == 1) &amp;&amp; (scalar(@{$MatchedA-&gt;{$CTY}}) == 1)) {
                        $ShortestDist=0; $BestP=$P; #Save a distance calc
                     }
                     else {
                        $ShortestDist=$GNS-&gt;GetDist($ALookup-&gt;{$A}-&gt;{LAT},$ALookup-&gt;{$A}-&gt;{LONG},$PLookup-&gt;{$P}-&gt;{LAT},$PLookup-&gt;{$P}-&gt;{LONG});
                        $BestP=$P;
                        $Counter++;
                     }
                  }
                  else {
                     my $CurrentDist=$GNS-&gt;GetDist($ALookup-&gt;{$A}-&gt;{LAT},$ALookup-&gt;{$A}-&gt;{LONG},$PLookup-&gt;{$P}-&gt;{LAT},$PLookup-&gt;{$P}-&gt;{LONG});
                     if ($CurrentDist &lt; $ShortestDist) {$ShortestDist=$CurrentDist; $BestP=$P;}
                  }
               }
               $ALookup-&gt;{$A}-&gt;{SHORTESTDIST}=$ShortestDist;
               $ALookup-&gt;{$A}-&gt;{BESTP}=$BestP;
            }
            my $ShortestDist=undef;
            foreach my $A (keys(%$ALookup)) {
               if (!$ShortestDist) {$ShortestDist=$ALookup-&gt;{$A}-&gt;{SHORTESTDIST}; $BestA=$A;}
               else {if ($ALookup-&gt;{$A}-&gt;{SHORTESTDIST} &lt; $ShortestDist) {$ShortestDist=$ALookup-&gt;{$A}-&gt;{SHORTESTDIST};$BestA=$A;}}
            }
            $CleanedMatch-&gt;{$CTY}-&gt;{"P_NAME"}=$ALookup-&gt;{$BestA}-&gt;{BESTP};
            $CleanedMatch-&gt;{$CTY}-&gt;{"P_UNI"}=$GNS-&gt;GetUNI($ALookup-&gt;{$BestA}-&gt;{BESTP},"P");
            $CleanedMatch-&gt;{$CTY}-&gt;{"P_LAT"}=$PLookup-&gt;{$ALookup-&gt;{$BestA}-&gt;{BESTP}}-&gt;{LAT};
            $CleanedMatch-&gt;{$CTY}-&gt;{"P_LONG"}=$PLookup-&gt;{$ALookup-&gt;{$BestA}-&gt;{BESTP}}-&gt;{LONG};
         }
         else {
            #A's but no P's
            $BestA=${$MatchedA-&gt;{$CTY}}[0];
            $ALookup-&gt;{$BestA}-&gt;{LAT}=$GNS-&gt;GetLat($BestA,"A");
            $ALookup-&gt;{$BestA}-&gt;{LONG}=$GNS-&gt;GetLong($BestA,"A");
         }
         $CleanedMatch-&gt;{$CTY}-&gt;{"A_NAME"}=$BestA;
         $CleanedMatch-&gt;{$CTY}-&gt;{"A_UNI"}=$GNS-&gt;GetUNI($BestA,"A");
         $CleanedMatch-&gt;{$CTY}-&gt;{"A_LAT"}=$ALookup-&gt;{$BestA}-&gt;{LAT};
         $CleanedMatch-&gt;{$CTY}-&gt;{"A_LONG"}=$ALookup-&gt;{$BestA}-&gt;{LONG};
      }
      else {
         if (defined ($MatchedP-&gt;{$CTY})) {
            if (scalar(@{$MatchedP-&gt;{$CTY}}) &gt; 0){
               #P's but no A's
               $CleanedMatch-&gt;{$CTY}-&gt;{"P_NAME"}=${$MatchedP-&gt;{$CTY}}[0];
               $CleanedMatch-&gt;{$CTY}-&gt;{"P_UNI"}=$GNS-&gt;GetUNI($CleanedMatch-&gt;{$CTY}-&gt;{"P_NAME"},"P");
               $CleanedMatch-&gt;{$CTY}-&gt;{"P_LAT"}=$GNS-&gt;GetLat($CleanedMatch-&gt;{$CTY}-&gt;{"P_NAME"},"P");
               $CleanedMatch-&gt;{$CTY}-&gt;{"P_LONG"}=$GNS-&gt;GetLong($CleanedMatch-&gt;{$CTY}-&gt;{"P_NAME"},"P");
            }
         }
      }
   }
   $Location-&gt;FileCleanMatches($CleanedMatch);
   return $Counter;
}

sub WriteOutfile {
   my $Outfile=shift;
   my $MatchedList=shift;
   open (OUTFILE,"&gt;$Outfile") || die "\nERROR: Can not open output file to write\n";
   my $Header=join("\t",$Location-&gt;ReturnData()); 
   print OUTFILE $Header."\n";
   my @Keys=$Location-&gt;ReturnKeys($MatchedList);
   for (my $i=0;$i&lt;=$#Keys;$i++) {
      my $Line=join("\t",$Location-&gt;ReturnData($Keys[$i]));
      print OUTFILE $Line."\n";
   }
   close (OUTFILE);
   return scalar(@Keys);
}

sub ReconcileForHumans {
   my @SetList=@_;
   my $HumanSet=undef;
   foreach my $Set (@SetList) {
      if (defined $Set) {
         if ($Set) {
            foreach my $SourceKey (keys (%$Set)) {
               foreach my $RefKey (keys (%{$Set-&gt;{$SourceKey}})) {
                  if (defined ($HumanSet-&gt;{$SourceKey})) {
                     if (defined ($HumanSet-&gt;{$SourceKey}-&gt;{$RefKey})) {next;}
                     else {$HumanSet-&gt;{$SourceKey}-&gt;{$RefKey}=$Set-&gt;{$SourceKey}-&gt;{$RefKey};}
                  }
                  else {$HumanSet-&gt;{$SourceKey}-&gt;{$RefKey}=$Set-&gt;{$SourceKey}-&gt;{$RefKey};}
               }
            }
         }
      }
   }
   return $HumanSet;
}

sub WriteHumanChoiceFile {
   my $HumanSet=shift;
   my $FileName=$opt_co."-HumanChoices.txt";
   open (DEBUG,"&gt;$FileName") || die "Can't open the Human choice file to write";
   my @Vars=("CTY","REFTOTAL","SOURCETOTAL","REFPC","SOURCEPC","LEFTGRAMS","RIGHTGRAMS","LCSSCORE","SOURCELENGTH","REFLENGTH","MAXLENGTH","LCSPC","FIRSTLETTERBINDS","GRAMALPHABET","GRAMLENGTH");
   print DEBUG "SOURCENAME\tREFNAME\t".join("\t",@Vars)."\n";
   foreach my $SourceName (keys(%$HumanSet)) {
      foreach my $RefName (keys(%{$HumanSet-&gt;{$SourceName}})) {
         undef my @Results;
         for (my $i=0;$i&lt;=$#Vars;$i++) {
            push (@Results,$HumanSet-&gt;{$SourceName}-&gt;{$RefName}-&gt;{$Vars[$i]});
         }
         print DEBUG $SourceName."\t".$RefName."\t".join("\t",@Results)."\n";
      }
   }
   close(DEBUG);
}
</pre></body></html>