File Coverage

blib/lib/Statistics/UIDList.pm

Criterion	Covered	Total	%
statement	84	85	98.8
branch	28	32	87.5
condition	6	6	100.0
subroutine	12	13	92.3
pod	6	6	100.0
total	136	142	95.7

package Statistics::UIDList;
use strict;
use warnings;
use Carp qw/croak/;

our $VERSION = '0.03';

sub new {
    my $class = shift;

    my $param = +{};

    for my $arg (@_) {
        if (ref $arg eq 'ARRAY') {
            push @{$param->{lists}}, $arg;
        }
        elsif (ref $arg eq 'HASH') {
            for my $option (qw/digit/) {
                $param->{$option} = $arg->{$option} ? $arg->{$option} : undef;
            }
        }
        else {
            croak "invalid arg: $arg, @_";
        }
    }

    bless $param, $class;
}

sub list {
    my ($self, $num) = @_;

    if (defined $num) {
        return $self->{lists}->[$num];
    }
    else {
        unless ($self->{_all_list}) {
            $self->{_all_list} = [ map { @$_ } @{$self->{lists}} ];
        }
        return $self->{_all_list};
    }
}

sub uniq {
    my ($self, $num) = @_;

    if (defined $num) {
        return $self->{uniq}->[$num] if $self->{uniq}->[$num];
        $self->{uniq}->[$num] = $self->_uniq($self->list($num));
        return $self->{uniq}->[$num];
    }

    unless ($self->{_all_uniq}) {
        $self->{_all_uniq} = $self->_uniq($self->list);
    }
    return $self->{_all_uniq};
}

sub _uniq {
    my ($self, $list) = @_;

    my %h;
    my @r;
    for my $id (@{$list}) {
        push @r, $id unless $h{$id};
        $h{$id} = 1;
    }

    return \@r;
}

sub dup {
    my ($self) = @_;

    return $self->{dup} if $self->{dup};

    $self->{dup} = $self->_dup($self->list);

    return $self->{dup};
}

sub _dup {
    my ($self) = @_;

    my %h;
    for my $list (@{$self->{lists}}) {
        my %e;
        for my $id (@{$list}) {
            $h{$id}++ unless $e{$id};
            $e{$id} = 1;
        }
    }

    my %d;
    my @dup;
    for my $id (@{$self->list}) {
        if (!$d{$id} && $h{$id} == $#{$self->{lists}} + 1) {
            push @dup, $id;
            $d{$id} = 1;
        }
    }

    return \@dup;
}

sub duplicate { dup(@_) }

sub limit {
    my ($self, $cond) = @_;

    my $code;
    if ($cond && $cond =~ m!^\d$!) {
        $code = sub { $_[0] >= $cond };
    }
    elsif (ref $cond eq 'CODE') {
        $code = $cond;
    }
    else {
        croak "require limit condition";
    }

    return $self->_limit($self->list, $code);
}

sub _limit {
    my ($self, $list, $code) = @_;

    my %h;
    for my $id (@{$list}) {
        $h{$id}++;
    }

    my @r;
    for my $id (@{$list}) {
        next unless $h{$id};
        if ( $code->($h{$id}, $id) ) {
            push @r, $id;
            $h{$id} = undef; # never pick up
        }
    }

    return \@r;
}

1;

__END__