#!perl use strict; use warnings; my $seq = "ATCGGCGCCTAT" ; my %poscount; my @trilet = $seq =~ /.../g; #print join "\n",@trilet; foreach my $let ('A','T','G','C') { #init $poscount{$let.'1'}=0; $poscount{$let.'2'}=0; $poscount{$let.'3'}=0; } foreach my $tri (@trilet) { print "processing '$tri'\n"; my $let1 = substr $tri,0,1; $poscount{$let1.'1'}++; print $let1,"1++\t"; my $let2 = substr $tri,1,1; $poscount{$let2.'2'}++; print $let2,"2++\t"; my $let3 = substr $tri,2,1; $poscount{$let3.'3'}++; print $let3,"3++\n\n"; } foreach my $pos (1,2,3) { foreach my $let ('A','T','G','C') { my $letpos = $let.$pos; print "$letpos=$poscount{$letpos}; " } print "\n"; } __END__ processing 'ATC' A1++ T2++ C3++ processing 'GGC' G1++ G2++ C3++ processing 'GCC' G1++ C2++ C3++ processing 'TAT' T1++ A2++ T3++ A1=1; T1=1; G1=2; C1=0; A2=1; T2=1; G2=1; C2=1; A3=0; T3=1; G3=0; C3=3;