File Coverage

blib/lib/Math/LinearApprox.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	20	20	100.0
condition			n/a
subroutine	12	12	100.0
pod	6	6	100.0
total	88	88	100.0

#!/usr/bin/perl
#made by: KorG
# vim: sw=4 ts=4 et cc=79 :

package Math::LinearApprox;

use 5.008;
use strict;
use warnings FATAL => 'all';
use Carp;
use Exporter 'import';

our $VERSION = '0.02';
$VERSION =~ tr/_//d;

our @EXPORT_OK = qw( linear_approx linear_approx_str );

##
# @brief Model constructor
# @param __PACKAGE__
# @param (optional) ARRAYref with points to add ( x1, y1, x2, y2, ... )
# @return blessed reference to empty model
sub new {
    my $self = bless {
        x_sum => 0,
        y_sum => 0,
        N => 0,
        delta => 0,
    }, __PACKAGE__;

    # Handle array, if any
    if (ref $_[1] eq "ARRAY") {
        my $half = @{$_[1]} / 2;
        croak "Array has odd number of elements!" if int $half != $half;
        for (my $i = 0; $i < @{$_[1]}; $i += 2) {
            $self->add_point($_[1]->[$i], $_[1]->[$i + 1]);
        }
    } else {
        croak "Unknown argument specified!" if defined $_[1];
    }

    return $self;
}

##
# @brief Translate two points into line equation (coefficients)
# @param $_[0] X_1 coordinate
# @param $_[1] Y_1 coordinate
# @param $_[2] X_2 coordinate
# @param $_[3] Y_2 coordinate
# @return ($A, $B) for equation [y = Ax + B]
sub _eq_by_points {
    die "X_1 == X_2" if $_[0] == $_[2];

    my $A = ($_[3] - $_[1]) / ($_[2] - $_[0]);
    my $B = $_[3] - ($_[2] * ($_[3] - $_[1])) / ($_[2] - $_[0]);

    return ($A, $B);
}

##
# @brief Get numeric equation of model
# @param $_[0] self reference
# @return undef or ($A, $B) for equation [y = Ax + B]
sub equation {
    # Check conditions
    # - check points number
    return unless $_[0]->{N} > 1;
    # - handle vertical lines
    return if $_[0]->{x_last} == $_[0]->{x_0};

    # Calculate means
    my $M_delta = $_[0]->{delta} / ( $_[0]->{x_last} - $_[0]->{x_0} );
    my $M_x = $_[0]->{x_sum} / $_[0]->{N};
    my $M_y = $_[0]->{y_sum} / $_[0]->{N};

    # Translate them into a line
    my ($A, $B) = _eq_by_points($M_x, $M_y, $M_x + 1, $M_y + $M_delta);

    # Return coefficients
    return ($A, $B);
}

##
# @brief Get stringified equation of model
# @param $_[0] self reference
# @return die or String in forms: "y = A * x + B", "x = X"
sub equation_str {
    my ($A, $B) = $_[0]->equation();

    unless (defined $A) {
        die "Too few points in model!" if $_[0]->{N} == 0;

        # Calculate avg
        my $avg = $_[0]->{x_sum} / $_[0]->{N};
        return "x = $avg";
    }

    return "y = $A * x + $B";
}

##
# @brief Add new point to model
# @param $_[0] self reference
# @param $_[1] X coordinate
# @param $_[2] Y coordinate
# @return Nothing
sub add_point {
    # Save first point
    $_[0]->{x_0} = $_[1] unless defined $_[0]->{x_0};

    # Sum up Y deltas
    $_[0]->{delta} += $_[2] - $_[0]->{y_last} if $_[0]->{N} != 0;

    # Append the point to sums
    $_[0]->{x_sum} += $_[1];
    $_[0]->{y_sum} += $_[2];

    # Save right-most coordinates
    $_[0]->{x_last} = $_[1];
    $_[0]->{y_last} = $_[2];

    # Increase x, y counters
    $_[0]->{N}++;
}

##
# @brief Decorators for procedural style
sub linear_approx { return __PACKAGE__->new($_[0])->equation(); }
sub linear_approx_str { return __PACKAGE__->new($_[0])->equation_str(); }

1;

__END__