view release on metacpan or  search on metacpan

lib/App/Chart/Series/Calculation.pm  view on Meta::CPAN

    # add new
    $total += $value;
    $total_squares += $value * $value;

    return ($total / $count,
            sqrt(max (0, $total_squares*$count - $total*$total)) / $count);
  };
}

sub sum {
  my ($class, $N) = @_;
  my $delay_proc = $class->delay ($N);
  my $total = 0;
  return sub {
    my ($value) = @_;

    # drop old
    my $old = $delay_proc->($value);
    if (defined $old) {
      $total -= $old;
    }
    # add new
    $total += $value;

    return $total;
  };
}

sub ma_proc_by_weights {
  my @weights = @_;

  # $a[0] is the newest point, $a[1] the prev, through to $a[$N-1]
  my @a;
  my $total_weight;

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

    unshift @a, $value;  # add new

    # keep last $N points
    if (@a > @weights) {
      pop @a;  # drop old
    } else {
      # new total weight for bigger @a
      $total_weight = List::Util::sum (map {$weights[$_]} 0 .. $#a);
    }

    if ($total_weight == 0) {
      return 0;
    }
    return (List::Util::sum (map {$a[$_] * $weights[$_]} 0 .. $#a)
            / $total_weight);
  };
}

#------------------------------------------------------------------------------

# http://mathworld.wolfram.com/LeastSquaresFitting.html
#     Least squares generally, including deriving formula using
#     derivative==0 as follows:
#
#     The sum of squares is
#
#         R^2(a,b) = Sum (y[i] - (a + b*x[i]))^2
#
#     Partial derivative with b is
#
#         d R^2(a,b)
#         ---------- = Sum 2 * (y[i]-b*x[i]) * -x[i]
#             db
#
#     And want that to be zero at the minimum, so
#
#         Sum -2*x[i]*y[i] + 2*b*Sum x[i]^2 = 0
#
#             Sum x[i]*y[i]
#         b = -------------
#               Sum x[i]^2
#

# Return a procedure which calculates a linear regression line fit over an
# accumulated window of $N values.
#
# Each call $proc->($y) enters a new value into the window, and the return
# is two values ($a, $b) where the line is $a+$b*X.  The last point entered
# is at X=0 and the preceding ones at X=-1, X=-2, etc.  A and B are
# #f if not enough data yet.
#
# To prime the window initially, call $proc with $N-1 many points preceding
# the first desired.
#
sub linreg {
  my ($class, $N) = @_;

  # The X values used are centred around 0,
  #     $count=4: -1.5, -0.5, 0.5, 1.5
  #     $count=5: -2, -1, 0, 1, 2
  #     $count=6: -2.5, -1.5, -0.5, 0.5, 1.5, 2.5
  #     etc
  # But the return is then adjusted $a is based on the last point as X=0
  #
  # @array,$pos is a circular list of $count many values.  The one at
  # @array[$pos] is the oldest and is replaced by a new value to cycle that
  # in.
  #
  # $count is how many points are in @array.
  #
  # $y_total is the total of the past $count many Y values, ie. the values
  # in @array.
  #
  # $xy2_total is the sum of 2*X*Y for each Y value in @array.
  #
  # $xx2_total is 2 * the sum of X*X for each X value used.  This is a
  # constant once $count stops at COUNT.  A minimum 1 is enforced for the
  # degenerate case of $N==0 (there's no slope to in that case but at least
  # avoid a divide by zero).
  #
  my @array;
  my $pos = $N - 1;  # initial extends