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.0114';
7              
8 1     1   1348 use Math::BigRat ();
  1         92148  
  1         33  
9 1     1   709 use Moo;
  1         11769  
  1         5  
10 1     1   1913 use strictures 2;
  1         1680  
  1         39  
11 1     1   690 use namespace::clean;
  1         11425  
  1         6  
12              
13              
14             has questions => (
15             is => 'ro',
16             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
17             default => sub { [] },
18             required => 1,
19             );
20              
21              
22             has importance => (
23             is => 'ro',
24             isa => sub { die 'Not a HashRef' unless ref($_[0]) eq 'HASH' },
25             default => sub {
26             {
27             'irrelevant' => 0,
28             'a little important' => 1,
29             'somewhat important' => 10,
30             'very important' => 50,
31             'mandatory' => 250,
32             }
33             },
34             required => 1,
35             );
36              
37              
38             has me => (
39             is => 'ro',
40             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
41             default => sub { [] },
42             required => 1,
43             );
44              
45              
46             has you => (
47             is => 'ro',
48             isa => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
49             default => sub { [] },
50             required => 1,
51             );
52              
53              
54             sub score {
55 3     3 1 2950 my $self = shift;
56              
57 3         22 my $me_score = _score( $self->me, $self->you, $self->importance );
58 3         14 my $you_score = _score( $self->you, $self->me, $self->importance );
59              
60 3         19 my $m = Math::BigRat->new($me_score);
61 3         30562 my $y = Math::BigRat->new($you_score);
62              
63 3         2825 my $question_count = Math::BigRat->new( scalar @{ $self->me } );
  3         17  
64              
65 3         2084 my $product = $m->bmul($y);
66              
67 3         4125 my $score = $product->broot($question_count);
68              
69 3         20274 return $score->numify * 100;
70             }
71              
72             sub _score {
73 6     6   11 my ( $me, $you, $importance ) = @_;
74              
75 6         12 my $score = 0;
76 6         8 my $total = 0;
77              
78 6         18 for my $i ( 0 .. @$me - 1 ) {
79 12         19 $total += $importance->{ $me->[$i][2] };
80              
81 12 100       32 if ( $me->[$i][1] eq $you->[$i][0] ) {
82 6         13 $score += $importance->{ $me->[$i][2] };
83             }
84             }
85              
86 6 50       32 $score /= $total
87             if $total != 0;
88              
89 6         18 return $score;
90             }
91              
92             1;
93              
94             __END__