Here's a more long-winded approach that seems to work for extra letters/rows.
use strict;
use warnings;
my @strings = qw{
AABABC
BAABEC
AABFBD
AACBDB
CBBDEF
};
my $div = scalar @strings;
my @stringAoA =
map { [ split m{} ] }
@strings;
my %letters;
$letters{ $_ } ++ for map { @{ $_ } } @stringAoA;
my %scores;
for my $posn ( 1 .. length $strings[ 0 ] )
{
for my $row ( 0 .. $#stringAoA )
{
$scores{ $posn }->{ $stringAoA[ $row ]->[ $posn - 1 ] } ++;
}
}
printf
qq{%8s@{ [ q{%8s} x scalar keys %letters ] }\n},
q{},
sort keys %letters;
for my $posn (sort { $a <=> $b } keys %scores )
{
printf
qq{ %8d@{ [ q{%8.2f} x scalar keys %letters ] }\n},
$posn,
map {
defined $scores{ $posn }->{ $_ }
? $scores{ $posn }->{ $_ } / $div
: 0
} sort keys %letters
}
The output.
A B C D E F
1 0.60 0.20 0.20 0.00 0.00 0.00
2 0.80 0.20 0.00 0.00 0.00 0.00
3 0.20 0.60 0.20 0.00 0.00 0.00
4 0.20 0.40 0.00 0.20 0.00 0.20
5 0.00 0.40 0.00 0.20 0.40 0.00
6 0.00 0.20 0.40 0.20 0.00 0.20
I hope this is useful.