Acme-Affinity

 view release on metacpan or  search on metacpan

eg/permutations  view on Meta::CPAN


    $scores{ $affinity->score }++;
}

$n = 0;

for my $score ( sort { $a <=> $b } keys %scores ) {
    print ++$n, '. ', $score, ' => ', $scores{$score}, "\n";
}

sub get_responses {
    my ( $question, $importance ) = @_;

    my @responses;

    for my $v ( values %$question ) {
        my $iter = variations_with_repetition( $v, 2 );

        while ( my $answer = $iter->next ) {
            for my $import ( sort { $importance->{$a} <=> $importance->{$b} } keys %$importance ) {
                push @responses, [ @$answer, $import ];

lib/Acme/Affinity.pm  view on Meta::CPAN

our $VERSION = '0.0114';

use Math::BigRat ();
use Moo;
use strictures 2;
use namespace::clean;


has questions => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


has importance => (
    is      => 'ro',
    isa     => sub { die 'Not a HashRef' unless ref($_[0]) eq 'HASH' },
    default => sub {
        {
            'irrelevant'         => 0,
            'a little important' => 1,
            'somewhat important' => 10,
            'very important'     => 50,
            'mandatory'          => 250,
        }
    },
    required => 1,
);


has me => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


has you => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


sub score {
    my $self = shift;

    my $me_score  = _score( $self->me, $self->you, $self->importance );
    my $you_score = _score( $self->you, $self->me, $self->importance );

    my $m = Math::BigRat->new($me_score);
    my $y = Math::BigRat->new($you_score);

    my $question_count = Math::BigRat->new( scalar @{ $self->me } );

    my $product = $m->bmul($y);

    my $score = $product->broot($question_count);

    return $score->numify * 100;
}

sub _score {
    my ( $me, $you, $importance ) = @_;

    my $score = 0;
    my $total = 0;

    for my $i ( 0 .. @$me - 1 ) {
        $total += $importance->{ $me->[$i][2] };

        if ( $me->[$i][1] eq $you->[$i][0] ) {
            $score += $importance->{ $me->[$i][2] };



( run in 0.447 second using v1.01-cache-2.11-cpan-a5abf4f5562 )