File Coverage

blib/lib/Statistics/OnLine.pm

Criterion	Covered	Total	%
statement	44	48	91.6
branch	5	14	35.7
condition			n/a
subroutine	10	12	83.3
pod	9	9	100.0
total	68	83	81.9

# Copyright 2009 Francesco Nidito. All rights reserved.
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Statistics::OnLine;

use strict;

use vars qw($VERSION);
$VERSION = '0.02';

sub new {
  my $class = shift;
  return bless {
                _count => 0,
                _mean => 0,
                _M2 => 0,
                _M3 => 0,
                _M4 => 0,
                version => $VERSION,
               }, $class;
}

sub add_data {
  my $self = shift;
  foreach my $x (@_) { $self->_update_statistics($x); }
  return $self;
}

sub clean {
  my ($self) = @_;
  foreach my $i (grep /^_/, keys %{$self} ){ $self->{$i} = 0; }
  return $self;
}

# fast algorithm to update all the statistics at once:
# http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Higher-order_statistics
sub _update_statistics {
  my ($self, $x) = @_;
  my ($mean, $M2, $M3, $M4) = (0, 0, 0, 0);

  $self->{_count}++;
  my $n = $self->{_count}; # shorter to write $n ;-)

  # $n**2 and $n**3 efficiently
  my $n2 = $n*$n;
  my $n3 = $n2*$n;

  my $delta = $x - $self->{_mean};

  # $delta**(2|3|4)... efficiently
  my $delta2 = $delta*$delta;
  my $delta3 = $delta2*$delta;
  my $delta4 = $delta3*$delta;

  $mean = $self->{_mean} + $delta/$n;
  $M2   = $self->{_M2}   + $delta2*($n - 1)/$n;
  $M3   = $self->{_M3}   + $delta3*($n-1)*($n-2)/$n2       - 3*$delta*$self->{_M2}/$n;
  $M4   = $self->{_M4}   + $delta4*($n-1)*($n2-3*$n+3)/$n3 + 6*$delta2*$self->{_M2}/$n2 - 4*$delta*$self->{_M3}/$n;

  $self->{_mean} = $mean;
  $self->{_M2}   = $M2;
  $self->{_M3}   = $M3;
  $self->{_M4}   = $M4;
}

sub count {
  return $_[0]->{_count};
}

sub mean {
  die "too few elements to compute mean" if( $_[0]->{_count} == 0 );
  return $_[0]->{_mean};
}

sub variance {
  die "too few elements to compute variance" if( $_[0]->{_count} < 2 );
  return $_[0]->{_M2}/($_[0]->{_count} - 1);
}

sub variance_n {
  die "too few elements to compute variance_n" if( $_[0]->{_count} == 0 );
  return $_[0]->{_M2}/$_[0]->{_count};
}

sub skewness {
  die "too few elements to compute skewness" if( $_[0]->{_count} == 0 );
  die "variance is zero: cannot compute skewness" if( $_[0]->{_M2} == 0 );

  return sqrt( $_[0]->{_count} )*$_[0]->{_M3}/( $_[0]->{_M2}**(3/2));
}

sub kurtosis {
  die "too few elements to compute kurtosis" if( $_[0]->{_count} < 4 );
  die "variance is zero: cannot compute kurtosis" if( $_[0]->{_M2} == 0 );

  return $_[0]->{_count}*$_[0]->{_M4}/($_[0]->{_M2}*$_[0]->{_M2}) - 3;
}

1;

__END__