File Coverage

blib/lib/Math/HoltWinters.pm

Criterion	Covered	Total	%
statement	9	80	11.2
branch	0	36	0.0
condition			n/a
subroutine	3	11	27.2
pod	0	4	0.0
total	12	131	9.1

package Math::HoltWinters;

# Time series smoothing and forecasting with Holt-Winters exponential smoothing

use 5.010001;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our $VERSION = '0.03';

# ============================================================

sub single {
  my ( $alpha, $x0 ) = @_; # initial point, optional

  return sub {
    my ( $x ) = @_; # $x is optional (forecast if undef)

    unless( defined $x0 ) { # initialize $x0 if not done yet
      $x0 = $x;
      return $x0;
    }

    if( defined $x ) {      # only update for new data, no-op for forecast
      $x0 = $alpha*$x + (1-$alpha)*$x0
    }

    return $x0;
  }
}

sub double {
  my ( $alpha, $beta, $x0, $t0 ) = @_; # initial point and trend, both optional

  return sub {
    my ( $x ) = @_;

    # first point: $x0 not defined
    unless( defined $x0 ) {
      $x0 = $x;
      return $x0;
    }

    # second point: $x0 defined, $t0 not defined
    unless( defined $t0 ) {
      $t0 = $x - $x0;
      $x0 = $alpha*$x + (1-$alpha)*$x0; # sgl exponential smoothing!
      return $x0;
    }

    # other points: $0, $t0, $x all defined
    if( defined $x ) {
      my $old = $x0;
      $x0 = $alpha*$x + (1-$alpha)*($old + $t0);
      $t0 = $beta*($x0-$old) + (1-$beta)*$t0;
      return $x0;
    }

    # forecast: $x not defined
    if( !defined $x ) {
      $x0 += $t0;
      return $x0;
    }
  }
}

sub triple_add {
  my $alpha = shift;
  my $beta  = shift;
  my $gamma = shift;
  my $season = pop;      # seasonality information is alwas the LAST argument

  my ( $x0, $t0, @p );
  $x0 = shift if @_;
  $t0 = shift if @_;
  @p = ref $season ? @$season : (0) x $season;

# if( ref $season ) {
#   @p = @$season;            # perform deep copy
# } else {
#   @p = (0) x $season;
# }

  return sub {
    my ( $x ) = @_;

    my $p0 = shift @p;

    if( !defined $x0 ) {         # First point
      $x0 = $x;

    } elsif( !defined $t0 ) {    # Second point
      $t0 = $x - $x0;
      $x0 = $alpha*$x + (1-$alpha)*$x0;

    } elsif( defined $x ) {      # Smoothing
      my $old = $x0;

      $x0 = $alpha*($x - $p0) + (1-$alpha)*($old + $t0);
      $t0 = $beta*($x0 - $old) + (1-$beta)*$t0;
      $p0 = $gamma*($x - $x0) + (1-$gamma)*$p0;

    } else {                     # Forecasting
      $x0 += $t0;
    }
    push @p, $p0;

    return $x0 + $p0;
  }
}

sub triple_mul {
  my $alpha = shift;
  my $beta  = shift;
  my $gamma = shift;
  my $season = pop;      # seasonality information is alwas the LAST argument

  my ( $x0, $t0, @p );
  $x0 = shift if @_;
  $t0 = shift if @_;
  @p = ref $season ? @$season : (1) x $season;


  return sub {
    my ( $x ) = @_;

    my $p0 = shift @p;

    if( !defined $x0 ) {         # First point
      $x0 = $x;

    } elsif( !defined $t0 ) {    # Second point
      $t0 = $x - $x0;
      $x0 = $alpha*$x + (1-$alpha)*$x0;

    } elsif( defined $x ) {      # Smoothing
      my $old = $x0;

      # >>> What happens if either $p0 or $x0 is every zero? <<<
      $x0 = $alpha*$x/$p0 + (1-$alpha)*($old + $t0);
      $t0 = $beta*($x0 - $old) + (1-$beta)*$t0;
      $p0 = $gamma*$x/$x0 + (1-$gamma)*$p0;

    } else {                     # Forecasting
      $x0 += $t0;
    }
    push @p, $p0;

    return $x0*$p0;
  }
}

1;

__END__