#!/usr/bin/perl -w
use strict;
use Data::Dumper;

my $hash_mismatch = {
    
     # no match because hd($query[0],$hash_mismatch->{'S1'}[0]) > $d
     #  even though  hd($query[1],$hash_mismatch->{'$2'}[1]) < $d
     'S1' => [ 'GGAA', 'GGGG', 'TTTT'  ],
     
     # match because hd($query[0],$hash_mismatch->{'S2'}[0]) = $d
     #          and  hd($query[1],$hash_mismatch->{'$2'}[2]) < $d
     'S2' => [ 'GGGA', 'GTTT', 'GGGG'  ],
     
     # match because hd($query[0],$hash_mismatch->{'S3'}[0]) = $d
     #          and  hd($query[1],$hash_mismatch->{'$3'}[1]) = $d
     'S3' => [ 'GGGA', 'GCGG', 'GTTT'  ], 

     # match because hd($query[0],$hash_mismatch->{'S4'}[0]) < $d
     'S4' => [ 'GGGG', 'AAAA', 'GGGG'  ]
    
};

my $d    = 0; # mismatch/hamming distance;
#  With $d = 1; the answer     : support: 3 (from 'S2,S3,S4);
#  With $d = 0; the asnswer is : support: 1 (from 'S4')

my @query  = ('GGGG','GGGG');  
my $sup = count_support_mismatch($hash_mismatch,\@query,$d);
print "Support: $sup\n";

#------------------Subs-----------
sub count_support_mismatch
{ 
    my ($hashref,$arref,$d) = @_;
    my $counter = 0;

    foreach my $key ( keys %{$hashref}  )
    {
      my $ar = $hashref->{$key};
      my @match_list;
      
      foreach  ( @{$ar} )
      {
          foreach  my $q ( @$arref  )
          {
            my $dist = hd($_,$q);

            if ( $dist <= $d )
            {
                #print "$q - $_\n";
                push @match_list, $_; 
            }
            shift @{$ar}; 
          }                      
          
      }                              
          if ( @match_list )
          {
             $counter++;
          }
        
    }                 

    return $counter;
}    

sub hd 
{
    #String length is assumed to be equal
    my ($a,$b) = @_;
    my $len = length ($a);
    my $num_mismatch = 0;

    for (my $i=0; $i<$len; $i++) 
    { 
     ++$num_mismatch if substr($a, $i, 1) ne substr($b, $i, 1);
    }

    return $num_mismatch;
}
[download]