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 }