in reply to Tallying overall frequency of characters in a set of strings by position
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.
Cheers,
JohnGG
|
---|