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   27 use warnings;
  8         9  
  8         198  
6 8     8   27 use strict;
  8         51  
  8         149  
7              
8 8     8   21 use constant MEAN => 0;
  8         9  
  8         384  
9 8     8   31 use constant MEDIAN => 1;
  8         6  
  8         291  
10              
11 8     8   24 use base qw/Image::Compare::Comparator/;
  8         8  
  8         2207  
12              
13             sub accumulate {
14 22     22 1 16 my $self = shift;
15 22         41 my $diff = $self->color_distance(@_);
16 22 100       48 if ($self->{args}{type} == &MEAN) {
    50          
17 14         14 $self->{count}++;
18 14         13 $self->{sum} += $diff;
19             }
20             elsif ($self->{args}{type} == &MEDIAN) {
21 8         6 push(@{$self->{scores}}, $diff);
  8         11  
22             }
23             else {
24 0         0 die "Unrecognized average type: '$self->{args}{type}'";
25             }
26 22         63 return undef;
27             }
28              
29             sub get_result {
30 6     6 1 6 my $self = shift;
31 6         7 my $val = 0;
32 6 100       21 if ($self->{args}{type} == &MEAN) {
    50          
33 4         6 $val = $self->{sum} / $self->{count};
34             }
35             elsif ($self->{args}{type} == &MEDIAN) {
36 2         1 my @vals = sort @{$self->{scores}};
  2         29  
37 2 50       5 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         24 return $val <= $self->{args}{value};
49             }
50              
51             1;
52              
53             __END__