#!/usr/bin/perl

use strict;
use warnings;

MAIN:
{
    my @set = qw (AAAAAT ATCGAT TTTTTG GCCCCC GTGGGG);
    my $lim = 0.75;

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

    my $results = remove_poly(\@set, $lim);

    print("AFTER:  ", scalar(@$results), "\n");
    #print(join("\n", @$results), "\n");
}

exit(0);

sub remove_poly
{
    my $array = $_[0];
    my $lim   = $_[1];

    $lim = int($lim * length($$array[0]));

    my @results = grep { (($_ =~ tr/A//) <= $lim) &&
                         (($_ =~ tr/T//) <= $lim) &&
                         (($_ =~ tr/C//) <= $lim) &&
                         (($_ =~ tr/G//) <= $lim) }
                    @$array;

    return (\@results);
}

# EOF