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.0112';
7              
8 1     1   2312 use Moo;
  1         11316  
  1         7  
9 1     1   1990 use strictures 2;
  1         1626  
  1         46  
10 1     1   733 use namespace::clean;
  1         12870  
  1         7  
11              
12 1     1   1109 use Math::BigRat;
  1         85855  
  1         8  
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 3017 my $self = shift;
57              
58 3         29 my $me_score = _score( $self->me, $self->you, $self->importance );
59 3         13 my $you_score = _score( $self->you, $self->me, $self->importance );
60              
61 3         20 my $m = Math::BigRat->new($me_score);
62 3         3280 my $y = Math::BigRat->new($you_score);
63              
64 3         2208 my $question_count = Math::BigRat->new( scalar @{ $self->me } );
  3         19  
65              
66 3         1636 my $product = $m->bmul($y);
67              
68 3         1300 my $score = $product->broot($question_count);
69              
70 3         17035 return $score->numify * 100;
71             }
72              
73             sub _score {
74 6     6   14 my ( $me, $you, $importance ) = @_;
75              
76 6         10 my $score = 0;
77 6         9 my $total = 0;
78              
79 6         16 for my $i ( 0 .. @$me - 1 ) {
80 12         61 $total += $importance->{ $me->[$i][2] };
81              
82 12 100       33 if ( $me->[$i][1] eq $you->[$i][0] ) {
83 6         11 $score += $importance->{ $me->[$i][2] };
84             }
85             }
86              
87 6 50       19 $score /= $total
88             if $total != 0;
89              
90 6         22 return $score;
91             }
92              
93             1;
94              
95             __END__