``````package Algorithm::BestChoice;

use warnings;
use strict;

Algorithm::BestChoice - Choose the best

Version 0.01

=cut

our \$VERSION = '0.01';

# Find my favorite food based on color
my \$chooser = Algorithm::BestChoice->new;
\$chooser->add( match => red, value => cherry, rank => 1 )
\$chooser->add( match => red, value => apple, rank => 10 ) # Like apples
\$chooser->add( match => red, value => strawberry, rank => -5 ) # Don't like strawberries
\$chooser->add( match => purple, value => grape, rank => 20 ) # Delicious
\$chooser->add( match => yellow, value => banana )
\$chooser->add( match => yellow, value => lemon rank => -5 ) # Too sour

my \$favorite;
\$favorite = \$chooser->best( red ) # apple is the favorite red
\$favorite = \$chooser->best( [ red, yellow, purple ] ) # grape is the favorite among red, yellow, and purple

An Algorithm::BestChoice object is similar to a hash, except it returns a result based on a given key AND relative ranking. That is, you can associate multiple values
with a single key, and differentiate them by using a rank (or weight).

Create and return a new Algorithm::BestChoice object

Add a possible choice to the chooser

The arguments are:

match       The key for the choice, can be a string or a regular expression
value       The value to associate with the key (what is returned by ->best)
rank        An optional numeric weight, the default is 0 (>0 is better, <0 is worse)

=head2 \$value = \$chooser->best( <criterion> )

Given criterion, ->best will return the value that 1. has a matching matcher and 2. has the highest rank

=cut

# TODO: Document ->best() ->best( [ ... ] )

use Moose;

use Algorithm::BestChoice::Matcher;
use Algorithm::BestChoice::Ranker;
use Algorithm::BestChoice::Result;
use Algorithm::BestChoice::Option;

use Scalar::Util qw/looks_like_number/;

has options => qw/is ro required 1 isa ArrayRef/, default => sub { [] };

my \$self = shift;
my %given = @_;

\$given{matcher} = \$given{match} unless exists \$given{matcher};
\$given{ranker} = \$given{rank} unless exists \$given{ranker};
my (\$matcher, \$ranker) = @given{ qw/matcher ranker/ };

if (\$ranker && ! ref \$ranker && \$ranker eq 'length') {
if (! ref \$matcher) {
\$ranker = defined \$matcher ? length \$matcher : 0;
}
else {
die "Trying to rank by length, but given not-scalar matcher \$matcher";
}
}

\$matcher = Algorithm::BestChoice::Matcher->parse( \$matcher );
\$ranker = Algorithm::BestChoice::Ranker->parse( \$ranker );

my \$option = Algorithm::BestChoice::Option->new( matcher => \$matcher, ranker => \$ranker, value => \$given{value} );

push @{ \$self->options }, \$option;
}

sub _best {
my \$self = shift;
my \$key = shift;

my @tally;
for my \$option (@{ \$self->options }) {
if (my \$match = \$option->match( \$key )) {
my \$rank;
if (ref \$match eq 'HASH') {
\$rank = \$match->{rank};
die "Got an undefined rank from a match" unless defined \$rank;
die "Got a non-numeric rank (\$rank) from a match" unless looks_like_number \$rank;
}
else {
\$rank = \$option->rank( \$key );
die "Got an undefined rank from a ranker" unless defined \$rank;
die "Got a non-numeric rank (\$rank) from a ranker" unless looks_like_number \$rank;
}
push @tally, Algorithm::BestChoice::Result->new( rank => \$rank, value => \$option->value );
}
}

return @tally;
}

# TODO: Test for this multi-key ranker
# TODO: Probably want to give different weights to different keys!
sub best {
my \$self = shift;

my @tally = map { \$self->_best( \$_ ) } @_ ? map { ref \$_ eq 'ARRAY' ? @\$_ : \$_ } @_ : (undef);
@tally = sort { \$b->rank <=> \$a->rank } @tally;
@tally = map { \$_->value } @tally;
return wantarray ? @tally : \$tally[0];
}

Robert Krimen, C<< <rkrimen at cpan.org> >>

Please report any bugs or feature requests to C<bug-algorithm-bestchoice at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-BestChoice>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

perldoc Algorithm::BestChoice

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Algorithm-BestChoice>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Algorithm-BestChoice>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Algorithm-BestChoice>

=item * Search CPAN

L<http://search.cpan.org/dist/Algorithm-BestChoice/>

=back