File Coverage

blib/lib/Acme/Affinity.pm
Criterion Covered Total %
statement 31 31 100.0
branch 3 4 75.0
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 41 42 97.6


line stmt bran cond sub pod time code
1             package Acme::Affinity;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Compute the affinity between two people
5              
6             our $VERSION = '0.0113';
7              
8 1     1   2002 use Moo;
  1         9641  
  1         4  
9 1     1   1626 use strictures 2;
  1         1304  
  1         31  
10 1     1   527 use namespace::clean;
  1         9687  
  1         5  
11              
12 1     1   833 use Math::BigRat;
  1         65917  
  1         6  
13              
14              
15             has questions => (
16             is => 'ro',
17             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
18             default => sub { [] },
19             required => 1,
20             );
21              
22              
23             has importance => (
24             is => 'ro',
25             isa => sub { die 'Not a HashRef' unless ref($_[0]) eq 'HASH' },
26             default => sub {
27             {
28             'irrelevant' => 0,
29             'a little important' => 1,
30             'somewhat important' => 10,
31             'very important' => 50,
32             'mandatory' => 250,
33             }
34             },
35             required => 1,
36             );
37              
38              
39             has me => (
40             is => 'ro',
41             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
42             default => sub { [] },
43             required => 1,
44             );
45              
46              
47             has you => (
48             is => 'ro',
49             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
50             default => sub { [] },
51             required => 1,
52             );
53              
54              
55             sub score {
56 3     3 1 2387 my $self = shift;
57              
58 3         14 my $me_score = _score( $self->me, $self->you, $self->importance );
59 3         9 my $you_score = _score( $self->you, $self->me, $self->importance );
60              
61 3         30 my $m = Math::BigRat->new($me_score);
62 3         3144 my $y = Math::BigRat->new($you_score);
63              
64 3         2207 my $question_count = Math::BigRat->new( scalar @{ $self->me } );
  3         12  
65              
66 3         1512 my $product = $m->bmul($y);
67              
68 3         1177 my $score = $product->broot($question_count);
69              
70 3         15523 return $score->numify * 100;
71             }
72              
73             sub _score {
74 6     6   11 my ( $me, $you, $importance ) = @_;
75              
76 6         7 my $score = 0;
77 6         8 my $total = 0;
78              
79 6         15 for my $i ( 0 .. @$me - 1 ) {
80 12         18 $total += $importance->{ $me->[$i][2] };
81              
82 12 100       26 if ( $me->[$i][1] eq $you->[$i][0] ) {
83 6         10 $score += $importance->{ $me->[$i][2] };
84             }
85             }
86              
87 6 50       21 $score /= $total
88             if $total != 0;
89              
90 6         17 return $score;
91             }
92              
93             1;
94              
95             __END__