#!/usr/bin/perl -w
use strict;
use Data::Dumper;
my @to_proc = (
'I1 TTAT',
'I1 TTTT',
'I1 TAGT',
'I2 TTAT',
'I3 TAGT',
);
my $d = 1;
my %transaction_map_mismatch;
read_trans_array_mismatch(\%transaction_map_mismatch, \@to_proc,$d);
print Dumper \%transaction_map_mismatch;
#--------Sub------------
sub read_trans_array_mismatch
{
my $transaction_map_ref = shift;
my $transaction_array = shift;
my $d = shift;
for ( my $i = 0; $i< @{$transaction_array}; $i++ )
{
my @data = split(/\s/,$transaction_array->[$i]);
my ($tid, $item) = @data;
for ( my $j = 0 ; $j < @{$transaction_array} ;$j++ )
{
my ($tid2, $item2) = split(/\s/,$transaction_array->[$j]);
if ( hd($item,$item2) <= $d )
{
$$transaction_map_ref{$item}{$tid}++;
last;
}
}
}
}
sub hd
{
#Hamming Distance of two strings
#String length is assumed to be equal
# Following djohntson advice, changed var declaration
# from: my ($a, $b)
my ($k,$l) = @_;
my $len = length ($k);
my $num_mismatch = 0;
for (my $i=0; $i<$len; $i++)
{
++$num_mismatch if substr($k, $i, 1) ne substr($l, $i, 1);
}
return $num_mismatch;
}
####
__END__
$VAR1 = {
'TAGT' => {
'I1' => 1,
'I3' => 1
},
'TTTT' => {
'I1' => 2, #From TTAT and TTT in I1,
#because their HD <= $d
'I2' => 1,
},
'TTAT' => {
'I2' => 1,
'I1' => 2 # also From TTAT and TTT in I1
}
};
####
# Which is the same as $d = 0
$VAR1 = {
'TAGT' => {
'I3' => 1,
'I1' => 1
},
'TTTT' => {
'I1' => 1
},
'TTAT' => {
'I2' => 1,
'I1' => 1
}
};