File: | blib/lib/Math/LinearApprox.pm |
Coverage: | 87.5% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #!/usr/bin/perl | ||||||
2 | #made by: KorG | ||||||
3 | # vim: sw=4 ts=4 et cc=79 : | ||||||
4 | |||||||
5 | package Math::LinearApprox; | ||||||
6 | |||||||
7 | 3 3 | 90327 5 | use 5.008; | ||||
8 | 3 3 3 | 7 6 26 | use strict; | ||||
9 | 3 3 3 | 11 1 43 | use warnings FATAL => 'all'; | ||||
10 | 3 3 3 | 6 1 60 | use Carp; | ||||
11 | 3 3 3 | 5 1 827 | use Exporter 'import'; | ||||
12 | |||||||
13 | our $VERSION = '0.01'; | ||||||
14 | $VERSION =~ tr/_//d; | ||||||
15 | |||||||
16 | our @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 | ||||||
23 | sub new { | ||||||
24 | 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 | 7 | if (ref $_[1] eq "ARRAY") { | ||||
33 | 3 3 | 1 4 | my $half = @{$_[1]} / 2; | ||||
34 | 3 | 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 | 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] | ||||||
52 | sub _eq_by_points { | ||||||
53 | 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] | ||||||
65 | sub equation { | ||||||
66 | # Check conditions | ||||||
67 | # - check points number | ||||||
68 | 6 | 1 | 8 | return unless $_[0]->{N} > 1; | |||
69 | # - handle vertical lines | ||||||
70 | 6 | 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" | ||||||
88 | sub equation_str { | ||||||
89 | 3 | 1 | 5 | my ($A, $B) = $_[0]->equation(); | |||
90 | |||||||
91 | 3 | 3 | unless (defined $A) { | ||||
92 | 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 | ||||||
108 | sub add_point { | ||||||
109 | # Save first point | ||||||
110 | 12 | 1 | 18 | $_[0]->{x_0} = $_[1] unless defined $_[0]->{x_0}; | |||
111 | |||||||
112 | # Sum up Y deltas | ||||||
113 | 12 | 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 | 29041 | sub linear_approx { return __PACKAGE__->new($_[0])->equation(); } | |||
130 | 1 | 1 | 1 | sub linear_approx_str { return __PACKAGE__->new($_[0])->equation_str(); } | |||
131 | |||||||
132 | 1; | ||||||
133 |