File Coverage

File:blib/lib/Math/LinearApprox.pm
Coverage:87.5%

linestmtbrancondsubpodtimecode
1#!/usr/bin/perl
2#made by: KorG
3# vim: sw=4 ts=4 et cc=79 :
4
5package Math::LinearApprox;
6
7
3
3
3
90327
5
use 5.008;
8
3
3
3
3
7
6
26
use strict;
9
3
3
3
3
11
1
43
use warnings FATAL => 'all';
10
3
3
3
3
6
1
60
use Carp;
11
3
3
3
3
5
1
827
use Exporter 'import';
12
13our $VERSION = '0.01';
14$VERSION =~ tr/_//d;
15
16our @EXPORT_OK = qw( linear_approx linear_approx_str );
17
18##
19# @brief Model constructor
20# @param __PACKAGE__
21# @param (optional) ARRAYref with points to add ( x1, y1, x2, y2, ... )
22# @return blessed reference to empty model
23sub new {
24
4
4
1
28392
    my $self = bless {
25        x_sum => 0,
26        y_sum => 0,
27        N => 0,
28        delta => 0,
29    }, __PACKAGE__;
30
31    # Handle array, if any
32
4
100
7
    if (ref $_[1] eq "ARRAY") {
33
3
3
1
4
        my $half = @{$_[1]} / 2;
34
3
50
5
        croak "Array has odd number of elements!" if int $half != $half;
35
3
12
3
10
        for (my $i = 0; $i < @{$_[1]}; $i += 2) {
36
9
10
            $self->add_point($_[1]->[$i], $_[1]->[$i + 1]);
37        }
38    } else {
39
1
50
2
        croak "Unknown argument specified!" if defined $_[1];
40    }
41
42
4
4
    return $self;
43}
44
45##
46# @brief Translate two points into line equation (coefficients)
47# @param $_[0] X_1 coordinate
48# @param $_[1] Y_1 coordinate
49# @param $_[2] X_2 coordinate
50# @param $_[3] Y_2 coordinate
51# @return ($A, $B) for equation [y = Ax + B]
52sub _eq_by_points {
53
6
50
6
6
    die "X_1 == X_2" if $_[0] == $_[2];
54
55
6
6
    my $A = ($_[3] - $_[1]) / ($_[2] - $_[0]);
56
6
3
    my $B = $_[3] - ($_[2] * ($_[3] - $_[1])) / ($_[2] - $_[0]);
57
58
6
9
    return ($A, $B);
59}
60
61##
62# @brief Get numeric equation of model
63# @param $_[0] self reference
64# @return undef or ($A, $B) for equation [y = Ax + B]
65sub equation {
66    # Check conditions
67    # - check points number
68
6
50
6
1
8
    return unless $_[0]->{N} > 1;
69    # - handle vertical lines
70
6
50
6
    return if $_[0]->{x_last} == $_[0]->{x_0};
71
72    # Calculate means
73
6
5
    my $M_delta = $_[0]->{delta} / ( $_[0]->{x_last} - $_[0]->{x_0} );
74
6
4
    my $M_x = $_[0]->{x_sum} / $_[0]->{N};
75
6
4
    my $M_y = $_[0]->{y_sum} / $_[0]->{N};
76
77    # Translate them into a line
78
6
6
    my ($A, $B) = _eq_by_points($M_x, $M_y, $M_x + 1, $M_y + $M_delta);
79
80    # Return coefficients
81
6
11
    return ($A, $B);
82}
83
84##
85# @brief Get stringified equation of model
86# @param $_[0] self reference
87# @return die or String in forms: "y = A * x + B", "x = X"
88sub equation_str {
89
3
3
1
5
    my ($A, $B) = $_[0]->equation();
90
91
3
50
3
    unless (defined $A) {
92
0
0
0
        die "Too few points in model!" if $_[0]->{N} == 0;
93
94        # Calculate avg
95
0
0
        my $avg = $_[0]->{x_sum} / $_[0]->{N};
96
0
0
        return "x = $avg";
97    }
98
99
3
9
    return "y = $A * x + $B";
100}
101
102##
103# @brief Add new point to model
104# @param $_[0] self reference
105# @param $_[1] X coordinate
106# @param $_[2] Y coordinate
107# @return Nothing
108sub add_point {
109    # Save first point
110
12
100
12
1
18
    $_[0]->{x_0} = $_[1] unless defined $_[0]->{x_0};
111
112    # Sum up Y deltas
113
12
100
13
    $_[0]->{delta} += $_[2] - $_[0]->{y_last} if $_[0]->{N} != 0;
114
115    # Append the point to sums
116
12
4
    $_[0]->{x_sum} += $_[1];
117
12
6
    $_[0]->{y_sum} += $_[2];
118
119    # Save right-most coordinates
120
12
9
    $_[0]->{x_last} = $_[1];
121
12
5
    $_[0]->{y_last} = $_[2];
122
123    # Increase x, y counters
124
12
10
    $_[0]->{N}++;
125}
126
127##
128# @brief Decorators for procedural style
129
1
1
1
29041
sub linear_approx { return __PACKAGE__->new($_[0])->equation(); }
130
1
1
1
1
sub linear_approx_str { return __PACKAGE__->new($_[0])->equation_str(); }
131
1321;
133