use strict;
use warnings;

my @set = qw (AAAAAT ATCGAT TTTTTG GCCCCC GTGGGG);
my $lim = 0.75;
my @sel = remove_poly( \@set, $lim);

print "BEFORE:",scalar(@set),"\n";
print "AFTER:",scalar(@sel),"\n";

sub remove_poly
{
    my ($array,$lim) = @_;

    my $len = length $array->[0];
    my @sel_array;

    @sel_array = grep { ( ((tr/A//)/$len < $lim) &&
                          ((tr/T//)/$len < $lim) &&
                          ((tr/C//)/$len < $lim) &&
                          ((tr/G//)/$len < $lim)    ) and $_ } @$array;

    return @sel_array;
}