view release on metacpan or  search on metacpan

lib/Algorithm/LineSegments.pm  view on Meta::CPAN

    $count--;
    
    #################################################################
    # Now that $k has changed, merging $k with the element before or
    # after has a different cost, so those elements are removed from
    # the heap and added again with the newly calculated cost factor.
    #################################################################
    $heap->delete_item($next{$k}) if defined $next{$k};
    $heap->delete_item($prev{$k}) if defined $prev{$k};

    $next{$k} = $next{$j};

    $heap->add($prev{$k}, $o{cost}->($prev{$k}, $k)) if defined $prev{$k};
    $heap->add($k, $o{cost}->($k, $next{$k})) if defined $next{$k};

    $prev{$next{$j}} = $k if defined $next{$j};
    
    delete $next{$j};
    delete $prev{$j};
  }

  my @temp = grep { defined } @q;
  my @result;
  my $pos = 0;
  for (my $ix = 0; $ix < @temp; ++$ix) {
    push @result, [
      [ $pos, $temp[$ix][0] ],
      [ $pos + scalar(@{$temp[$ix]}) - 1, $temp[$ix][-1] ]
    ];
    $pos += scalar(@{$temp[$ix]})
  }
  
  return @result;
}

1;

__END__

=head1 NAME

Algorithm::LineSegments - Piecewise linear function approximation

=head1 SYNOPSIS

  use Algorithm::LineSegments;
  my @points = line_segment_points(
    points => \@numbers,
    continue => sub {
      my ($segment_count, $cost_factor) = @_;
      return 0 if $segment_count <= 10;
      return 1;
    },
  );

=head1 DESCRIPTION

This module takes discrete data points like time series data and
computes a piecewise linear function, line segments, approximating
them. It does this by merging groups of adjacent points into lines,
always picking the pair that produces the smallest error, until it
is told to stop.

=head2 FUNCTIONS

=over

=item line_segment_points(%options)

Returns a list of [[$x0, $y0], [$x1, $y1]] pairs describing line
segments. Options are

=over

=item C<points>

Array of numbers, the input data.

=item C<continue>

A callback function that is called with the number of remaining
segments and the cost of the current merge with the expectation
the callback returns a true value if it should perform the merge
and continue, and a false value if it should stop merging and
return. The default is to merge until only three line segments
are left.

=item C<cost>

A callback function that is called with two list references of
points and it should return a number indicating how costly it
is, how much of an error it introduces, if all points are made
into a single line segment. The default projects all data points
to the unit range 0 .. 1 based on the maximum and minimum value
and computes the euclidean distance between the points and the
corresponding points on a line that would cover them all.

=back

=back

=head2 EXPORTS

The function C<line_segment_points> by default.

=head1 AUTHOR / COPYRIGHT / LICENSE

  Copyright (c) 2014 Bjoern Hoehrmann <bjoern@hoehrmann.de>.
  This module is licensed under the same terms as Perl itself.

=cut