File Coverage

blib/lib/Statistics/Frequency.pm

Criterion	Covered	Total	%
statement	108	122	88.5
branch	39	54	72.2
condition	3	6	50.0
subroutine	18	18	100.0
pod	14	14	100.0
total	182	214	85.0

package Statistics::Frequency;

use strict;

use vars qw($VERSION);

$VERSION = '0.04';

sub elements {
    my $self = shift;
    exists $self->{data} ? keys %{$self->{data}} : wantarray ? () : undef;
}

sub frequency {
    my ($self, $e) = @_;
    exists $self->{data} ? $self->{data}->{$e} : 0;
}

sub add_data {
    my $self = shift;
    my $mod;
    for my $data (@_) {
	my $ref = ref $data;
	if ($ref eq ref $self) {
	    for my $e ($data->elements) {
		$self->{data}->{$e} += $data->frequency($e);
		$mod++;
	    }
	} if ($ref eq 'HASH') {
	    for my $e (keys %{$data}) {
		$self->{data}->{$e} += $data->{$e};
		$mod++;
	    }
	} elsif ($ref eq 'ARRAY') {
	    $self->add_data(@$data);
	} else {
	    $self->{data}->{$data}++;
	    $mod++;
	}
    }
    if ($mod) {
	delete @{$self}{qw(sum min max)};
	$self->{update}->($self) if exists $self->{update};
    }
    return $self;
}

sub _set_update_callback {
    my ($self, $callback) = @_;
    $self->{update} = $callback;
}

sub remove_data {
    my $self = shift;
    my $mod;
    for my $data (@_) {
	my $ref = ref $data;
	if ($ref && $data->isa(ref $self)) {
	    for my $e ($data->elements) {
		$self->{data}->{$e} -= $data->frequency($e);
		$mod++;
	    }
	} if ($ref eq 'HASH') {
	    for my $e (keys %{$data}) {
		$self->{data}->{$e} -= $data->{$e};
		$mod++;
	    }
	} elsif ($ref eq 'ARRAY') {
	    for my $e (@{$data}) {
		$self->{data}->{$e}--;
		$mod++;
	    }
	} else {
	    $self->{data}->{$data}--;
	    $mod++;
	}
	for my $e ($self->elements) {
	    delete $self->{data}->{$e} if $self->{data}->{$e} <= 0;
	}
    }
    if ($mod) {
	delete @{$self}{qw(sum min max)};
	$self->{update}->($self) if exists $self->{update};
    }
    return $self;
}

sub remove_elements {
    my $self = shift;
    my $mod;
    for my $e (@_) {
	delete $self->{data}->{$e};
	$mod++;
    }
    if ($mod) {
	delete $self->{data} unless keys %{$self->{data}};
	delete @{$self}{qw(sum min max)};
	$self->{update}->($self) if exists $self->{update};
    }
    return $self;
}

sub clear_data {
    my $self = shift;
    delete $self->{data};
    delete @{$self}{qw(sum min max)};
    $self->{update}->($self) if exists $self->{update};
    return $self;
}

sub copy_data {
    my $self = shift;
    my $copy = (ref $self)->new;
    $copy->add_data($self->{data});
    return $copy;
}

sub frequencies {
    my $self = shift;
    exists $self->{data} ? %{$self->{data}} : ();
}

sub _frequencies_stats {
    my $self = shift;
    unless (exists $self->{sum}) {
	my $sum;
	my $min;
	my $max = $min =
	    exists $self->{data} ?
		$self->{data}->{each %{$self->{data}}} : undef;
	for my $f (values %{$self->{data}}) {
	    $sum += $f;
	    if ($f < $min) { $min = $f } elsif ($f > $max) { $max = $f }
	}
	$self->{sum} = $sum;
	$self->{min} = $min;
	$self->{max} = $max;
    }
}

sub frequencies_sum {
    my $self = shift;
    $self->_frequencies_stats unless exists $self->{sum};
    return $self->{sum};
}

sub frequencies_min {
    my $self = shift;
    $self->_frequencies_stats unless exists $self->{min};
    return $self->{min};
}

sub frequencies_max {
    my $self = shift;
    $self->_frequencies_stats unless exists $self->{max};
    return $self->{max};
}

sub proportional_frequencies {
    my $self = shift;
    my %prop = $self->frequencies;
    my $sum = $self->frequencies_sum;
    for my $e (keys %prop) { $prop{$e} /= $sum }
    return %prop;
}

sub proportional_frequency {
    my ($self, $e) = @_;
    my $freq  = $self->frequency($e);
    my $sum = $self->frequencies_sum;
    defined $freq && $sum ? $freq / $sum : undef;
}

sub new {
    my $class = shift;
    my $self = bless { }, $class;
    $self->add_data(@_);
    return $self;
}

1;
__END__