File Coverage

blib/lib/Math/VarRate.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	24	24	100.0
condition	4	4	100.0
subroutine	10	10	100.0
pod	4	4	100.0
total	113	113	100.0

use strict;
use warnings;
package Math::VarRate 0.100001;
# ABSTRACT: deal with linear, variable rates of increase

use Carp ();
use Scalar::Util ();

#pod =head1 DESCRIPTION
#pod
#pod Math::VarRate is a very, very poor man's calculus.  A Math::VarRate object
#pod represents an accumulator that increases at a varying rate over time.  The rate
#pod may change, it is always a linear, positive rate of change.
#pod
#pod You can imagine the rate as representing "units gained per time."  You can then
#pod interrogate the Math::VarRate object for the total units accumulated at any
#pod given offset in time, or for the time at which a given number of units will
#pod have first been accumulated.
#pod
#pod =method new
#pod
#pod   my $varrate = Math::VarRate->new(\%arg);
#pod
#pod Valid arguments to C are:
#pod
#pod   rate_changes   - a hashref in which keys are offsets and values are rates
#pod   starting_value - the value at offset 0 (defaults to 0)
#pod
#pod =cut

sub new {
  my ($class, $arg) = @_;

  my $changes = $arg->{rate_changes} || {};
  my $self = bless {
    rate_changes   => $changes,
    starting_value => $arg->{starting_value} || 0,
  } => $class;

  $self->_sanity_check_rate_changes;
  $self->_precompute_offsets;

  return $self;
}

sub _sanity_check_rate_changes {
  my ($self) = @_;
  my $rc = $self->{rate_changes};

  my %check = (
    rates   => [ values %$rc ],
    offsets => [ keys %$rc   ],
  );

  while (my ($k, $v) = each %check) {
    Carp::confess("non-numeric $k are not allowed")
      if grep { ! Scalar::Util::looks_like_number("$_") } @$v;
    Carp::confess("negative $k are not allowed") if grep { $_ < 0 } @$v;
  }
}

#pod =method starting_value
#pod
#pod This method returns the value of the accumulator at offset 0.
#pod
#pod =cut

sub starting_value { $_[0]->{starting_value} || 0 }

#pod =method offset_for
#pod
#pod   my $offset = $varrate->offset_for($value);
#pod
#pod This method returns the offset (positive, from 0) at which the given value is
#pod reached.  If the given value will never be reached, undef will be returned.
#pod
#pod =cut

sub offset_for {
  my ($self, $value) = @_;

  Carp::croak("illegal value: non-numeric")
    unless Scalar::Util::looks_like_number("$value");

  Carp::croak("illegal value: negative") unless $value >= 0;

  $value += 0;

  return 0 if $value == $self->starting_value;

  my $ko       = $self->{known_offsets};
  my ($offset) = sort { $b <=> $a } grep { $ko->{ $_ } < $value } keys %$ko;

  return unless defined $offset;

  my $rate     = $self->{rate_changes}{ $offset };

  # If we stopped for good, we can never reach the target. -- rjbs, 2009-05-11
  return undef if $rate == 0;

  my $to_go    = $value - $ko->{ $offset };
  my $dur      = $to_go / $rate;

  return $offset + $dur;
}

#pod =method value_at
#pod
#pod   my $value = $varrate->value_at($offset);
#pod
#pod This returns the value in the accumulator at the given offset.
#pod
#pod =cut

sub value_at {
  my ($self, $offset) = @_;

  Carp::croak("illegal offset: non-numeric")
    unless Scalar::Util::looks_like_number("$offset");

  Carp::croak("illegal offset: negative") unless $offset >= 0;

  $offset += 0;

  my $known_offsets = $self->{known_offsets};

  return $known_offsets->{ $offset } if exists $known_offsets->{ $offset };

  my ($max) = sort { $b <=> $a } grep { $_ < $offset } keys %$known_offsets;

  return $self->starting_value unless defined $max;

  my $start = $known_offsets->{ $max };
  my $rate  = $self->{rate_changes}{ $max };
  my $dur   = $offset - $max;

  return $start  +  $rate * $dur;
}

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

  my $value   = $self->starting_value;
  my $v_at_o  = {};
  my %changes = %{ $self->{rate_changes} };
  my $prev    = 0;
  my $rate    = 0;

  for my $offset (sort { $a <=> $b } keys %changes) {
    my $duration = $offset - $prev;

    $value += $duration * $rate;
    $v_at_o->{ $offset } = $value;

    $rate = $changes{ $offset };
    $prev = $offset;
  }

  $self->{known_offsets} = $v_at_o;
}

1;

__END__