use strict;
use warnings;
sub get_index { $_[0] lt $_[1] ? ($_[0].$_[1]) : ($_[1].$_[0]) }
my @site1 = qw(
AATKKM
AKTKKM
);
my @site2 = qw(
GGGGGG
HHHHHH
);
my %pair_info;
my @pair_info_by_site;
{
# Count pairs.
my $site1;
my $site2;
foreach $site1 (@site1) {
my @site1_parts = split(//, $site1);
my %pair_info_this_site;
foreach $site2 (@site2) {
my @site2_parts = split(//, $site2);
my $i = @site1_parts;
while ($i--) {
# Sort the letters of the pair.
my $pair = get_index($site1_parts[$i], $site2_parts[$i]);
# Add to pair count.
$pair_info{$pair}++;
# Add to pair count for this site.
$pair_info_this_site{$pair}[0]++;
}
}
push(@pair_info_by_site, \%pair_info_this_site);
}
}
{
# Calculate frequencies.
my $pair;
my $site;
foreach $pair (keys(%pair_info)) {
my $pair_count = $pair_info{$pair};
foreach $site (@pair_info_by_site) {
my $site_pair_count = $$site{$pair}[0];
# Calculate the frequency for this site.
$$site{$pair}[1] = $site_pair_count / $pair_count;
}
}
}
{
# Output everything.
my $pair;
my $site;
print("Totals$/");
print("======$/");
foreach $pair (sort keys %pair_info) {
printf("%s: count = %2d$/", $pair, $pair_info{$pair});
}
print($/);
print("By Site$/");
print("=======$/");
foreach $site (@pair_info_by_site) {
foreach $pair (sort keys %pair_info) {
printf("%s: count = %2d freq = %5.3f$/", $pair, @{$$site{$p
+air}});
}
print($/);
}
}
__END__
Totals
======
AG: count = 3
AH: count = 3
GK: count = 5
GM: count = 2
GT: count = 2
HK: count = 5
HM: count = 2
HT: count = 2
By Site
=======
AG: count = 2 freq = 0.667
AH: count = 2 freq = 0.667
GK: count = 2 freq = 0.400
GM: count = 1 freq = 0.500
GT: count = 1 freq = 0.500
HK: count = 2 freq = 0.400
HM: count = 1 freq = 0.500
HT: count = 1 freq = 0.500
AG: count = 1 freq = 0.333
AH: count = 1 freq = 0.333
GK: count = 3 freq = 0.600
GM: count = 1 freq = 0.500
GT: count = 1 freq = 0.500
HK: count = 3 freq = 0.600
HM: count = 1 freq = 0.500
HT: count = 1 freq = 0.500
|