File Coverage

blib/lib/Image/Compare/AVG_THRESHOLD.pm
Criterion Covered Total %
statement 34 36 94.4
branch 7 10 70.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 50 55 90.9


line stmt bran cond sub pod time code
1             # Comparator for the "average threshold" comparison method.
2              
3             package Image::Compare::AVG_THRESHOLD;
4              
5 8     8   29 use warnings;
  8         10  
  8         209  
6 8     8   28 use strict;
  8         59  
  8         161  
7              
8 8     8   28 use constant MEAN => 0;
  8         9  
  8         434  
9 8     8   34 use constant MEDIAN => 1;
  8         9  
  8         326  
10              
11 8     8   30 use base qw/Image::Compare::Comparator/;
  8         9  
  8         2351  
12              
13             sub accumulate {
14 22     22 1 23 my $self = shift;
15 22         35 my $diff = $self->color_distance(@_);
16 22 100       51 if ($self->{args}{type} == &MEAN) {
    50          
17 14         13 $self->{count}++;
18 14         16 $self->{sum} += $diff;
19             }
20             elsif ($self->{args}{type} == &MEDIAN) {
21 8         4 push(@{$self->{scores}}, $diff);
  8         10  
22             }
23             else {
24 0         0 die "Unrecognized average type: '$self->{args}{type}'";
25             }
26 22         61 return undef;
27             }
28              
29             sub get_result {
30 6     6 1 5 my $self = shift;
31 6         4 my $val = 0;
32 6 100       22 if ($self->{args}{type} == &MEAN) {
    50          
33 4         7 $val = $self->{sum} / $self->{count};
34             }
35             elsif ($self->{args}{type} == &MEDIAN) {
36 2         1 my @vals = sort @{$self->{scores}};
  2         35  
37 2 50       4 if (@vals % 2) {
38             # Return the middle value
39 0         0 $val = $vals[(@vals / 2)];
40             }
41             else {
42             # Return the mean of the middle two values
43 2         4 $val = $vals[ @vals / 2 ];
44 2         3 $val += $vals[(@vals / 2) - 1];
45 2         3 $val /= 2;
46             }
47             }
48 6         27 return $val <= $self->{args}{value};
49             }
50              
51             1;
52              
53             __END__