File Coverage

blib/lib/Feed/PhaseCheck.pm
Criterion Covered Total %
statement 46 52 88.4
branch 13 22 59.0
condition 9 20 45.0
subroutine 6 6 100.0
pod 0 1 0.0
total 74 101 73.2


line stmt bran cond sub pod time code
1             package Feed::PhaseCheck;
2              
3 2     2   53055 use 5.006;
  2         7  
4 2     2   10 use strict;
  2         4  
  2         42  
5 2     2   9 use warnings;
  2         8  
  2         63  
6              
7 2     2   9 use Exporter qw(import);
  2         2  
  2         1219  
8              
9             our @EXPORT_OK = qw(compare_feeds);
10              
11             =head1 NAME
12              
13             Feed::PhaseCheck
14              
15             Finds the relative time delay between two feed segments.
16              
17             Accomplished by shifting one feed relative to the other and then computing the error (absolute difference).
18              
19             The shift that yields the lowest error corresponds to the relative delay between he two input feeds.
20              
21             The output consists of the delay found, and the error in delayed point.
22              
23             =head1 VERSION
24              
25             Version 0.05_1
26              
27             =cut
28              
29             our $VERSION = '0.05_1';
30              
31             =head1 SYNOPSIS
32              
33             use Feed::PhaseCheck qw(compare_feeds);
34             my $sample = {
35             "1451276654" => "1.097655",
36             "1451276655" => "1.09765",
37             ...
38             "1451276763" => "1.0976",
39             "1451276764" => "1.097595"
40             };
41             my $compare_to = {
42             "1451276629" => "1.09765",
43             "1451276630" => "1.09764916666667",
44             ...
45             "1451276791" => "1.097595",
46             "1451276792" => "1.097595"
47             }
48             my $max_delay_check = 30; # seconds
49             my ($errors,$delay_with_min_err) = compare_feeds($sample,$compare_to,$max_delay_check);
50              
51             =cut
52              
53             sub compare_feeds {
54 1     1 0 194 my $sample = shift;
55 1         1 my $main = shift;
56 1   50     5 my $max_delay_check = shift || 0;
57              
58 1 50       7 if ($max_delay_check !~ /^\d+$/) {
59 0         0 return;
60             }
61              
62 1 50 33     10 if (ref $sample ne 'HASH' || scalar keys %$sample < 2) {
63 0         0 return;
64             }
65              
66 1 50 33     16 if (ref $main ne 'HASH' || scalar keys %$main < 2) {
67 0         0 return;
68             }
69              
70 1         131 my @main_epoches = sort keys %$main;
71 1         12 foreach (@main_epoches) {
72 164 50 33     808 if (int($_) != $_ || abs($main->{$_}) != $main->{$_}) {
73 0         0 return;
74             }
75             }
76              
77 1         14 my @sample_epoches = sort keys %$sample;
78 1         4 foreach (@sample_epoches) {
79 26 50 33     131 if (int($_) != $_ || abs($sample->{$_}) != $sample->{$_}) {
80 0         0 return;
81             }
82             }
83              
84 1 50 33     7 if ($sample_epoches[0] < $main_epoches[0] || $sample_epoches[-1] > $main_epoches[-1]) {
85 0         0 return;
86             }
87              
88 1         72 my %main = %$main;
89 1         9 my %error = ();
90 1         2 my ($min_error, $delay_for_min_error);
91 1 50       5 my $delay1 = $sample_epoches[0] - $main_epoches[0] < $max_delay_check ? $sample_epoches[0] - $main_epoches[0] : $max_delay_check;
92 1 50       4 my $delay2 = $main_epoches[-1] - $sample_epoches[-1] < $max_delay_check ? $main_epoches[-1] - $sample_epoches[-1] : $max_delay_check;
93 1         5 for (my $delay = -$delay1; $delay <= $delay2; $delay++) {
94 54         89 $error{$delay} = 0;
95 54         84 foreach my $epoch (@sample_epoches) {
96 1404         1823 my $sample_epoch = $epoch - $delay;
97 1404 100       2763 if (!defined $main{$sample_epoch}) {
98 3         18 for (my $i = 1; $i < scalar keys @main_epoches; $i++) {
99 3 50       10 if ($main_epoches[$i] > $sample_epoch) {
100             $main{$sample_epoch} = _interpolate(
101             $main_epoches[$i - 1],
102             $main{$main_epoches[$i - 1]},
103 3         13 $main_epoches[$i], $main{$main_epoches[$i]},
104             $sample_epoch
105             );
106 3         4 last;
107             }
108             }
109             }
110 1404         2750 $error{$delay} += ($main{$sample_epoch} - $sample->{$epoch})**2;
111             }
112 54 100 100     315 if (!defined $min_error || $error{$delay} < $min_error) {
113 13         21 $min_error = $error{$delay};
114 13         39 $delay_for_min_error = $delay;
115             }
116             # $error{$delay} =~ s/(\d{8}).+?e/$1e/;
117             }
118              
119 1         27 return (\%error, $delay_for_min_error);
120             }
121              
122             sub _interpolate {
123 3     3   6 my ($x1, $y1, $x2, $y2, $x) = @_;
124 3         8 my $y = $y1 + ($x - $x1) * ($y2 - $y1) / ($x2 - $x1);
125 3         11 return $y;
126             }
127              
128             =head1 AUTHOR
129              
130             Maksym Kotielnikov, C<< >>
131              
132             =head1 BUGS
133              
134             Please report any bugs or feature requests to C, or through
135             the web interface at L. I will be notified, and then you'll
136             automatically be notified of progress on your bug as I make changes.
137              
138              
139              
140              
141             =head1 SUPPORT
142              
143             You can find documentation for this module with the perldoc command.
144              
145             perldoc Feed::PhaseCheck
146              
147              
148             You can also look for information at:
149              
150             =over 4
151              
152             =item * RT: CPAN's request tracker (report bugs here)
153              
154             L
155              
156             =item * AnnoCPAN: Annotated CPAN documentation
157              
158             L
159              
160             =item * CPAN Ratings
161              
162             L
163              
164             =item * Search CPAN
165              
166             L
167              
168             =back
169              
170              
171             =head1 ACKNOWLEDGEMENTS
172              
173              
174             =head1 LICENSE AND COPYRIGHT
175              
176             Copyright 2015 Maksym Kotielnikov.
177              
178             This program is free software; you can redistribute it and/or modify it
179             under the terms of the the Artistic License (2.0). You may obtain a
180             copy of the full license at:
181              
182             L
183              
184             Any use, modification, and distribution of the Standard or Modified
185             Versions is governed by this Artistic License. By using, modifying or
186             distributing the Package, you accept this license. Do not use, modify,
187             or distribute the Package, if you do not accept this license.
188              
189             If your Modified Version has been derived from a Modified Version made
190             by someone other than you, you are nevertheless required to ensure that
191             your Modified Version complies with the requirements of this license.
192              
193             This license does not grant you the right to use any trademark, service
194             mark, tradename, or logo of the Copyright Holder.
195              
196             This license includes the non-exclusive, worldwide, free-of-charge
197             patent license to make, have made, use, offer to sell, sell, import and
198             otherwise transfer the Package with respect to any patent claims
199             licensable by the Copyright Holder that are necessarily infringed by the
200             Package. If you institute patent litigation (including a cross-claim or
201             counterclaim) against any party alleging that the Package constitutes
202             direct or contributory patent infringement, then this Artistic License
203             to you shall terminate on the date that such litigation is filed.
204              
205             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
206             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
207             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
208             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
209             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
210             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
211             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
212             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
213              
214              
215             =cut
216              
217             1; # End of Feed::PhaseCheck