Algorithm-BestChoice

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

0.01 Monday May 18 11:48:26 PDT 2009:
    - Added documentation
    - ->best will extract value for you automatically
    - Initial release

META.yml  view on Meta::CPAN

---
abstract: 'Choose the best'
author:
  - 'Robert Krimen <rkrimen@cpan.org>'
build_requires:
  ExtUtils::MakeMaker: 6.42
  Test::Most: 0
configure_requires:
  ExtUtils::MakeMaker: 6.42
distribution_type: module
generated_by: 'Module::Install version 0.87'
license: perl

README  view on Meta::CPAN

NAME
    Algorithm::BestChoice - Choose the best

VERSION
    Version 0.01

SYNOPSIS
        # 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

DESCRIPTION
    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).

METHODS
  Algorithm::BestChoice->new
    Create and return a new Algorithm::BestChoice object

  $chooser->add( ... )
    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)

  $value = $chooser->best( <criterion> )
    Given criterion, ->best will return the value that 1. has a matching
    matcher and 2. has the highest rank

AUTHOR
    Robert Krimen, "<rkrimen at cpan.org>"

BUGS
    Please report any bugs or feature requests to "bug-algorithm-bestchoice
    at rt.cpan.org", or through the web interface at
    <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.

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

        perldoc Algorithm::BestChoice

lib/Algorithm/BestChoice.pm  view on Meta::CPAN

package Algorithm::BestChoice;

use warnings;
use strict;

=head1 NAME

Algorithm::BestChoice - Choose the best

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

lib/Algorithm/BestChoice.pm  view on Meta::CPAN

    # 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

=head1 DESCRIPTION

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).

=head1 METHODS

=head2 Algorithm::BestChoice->new

Create and return a new Algorithm::BestChoice object

=head2 $chooser->add( ... )

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/;

lib/Algorithm/BestChoice.pm  view on Meta::CPAN

    }

    $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;

lib/Algorithm/BestChoice.pm  view on Meta::CPAN

            }
            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];
}

=head1 AUTHOR

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

=head1 BUGS

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.




=head1 SUPPORT

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

t/01-basic.t  view on Meta::CPAN


plan qw/no_plan/;

use Algorithm::BestChoice;

my (@result, $result, $choice);
$choice = Algorithm::BestChoice->new;

$choice->add( value => 'apple' );

@result = $choice->best();
is( @result, 1 );
is( $result[0], 'apple' );

$choice->add( value => 'banana', rank => 2 );

@result = $choice->best();
is( @result, 2 );
is( $result[0], 'banana' );

$choice->add( value => 'cherry', rank => 4, match => 'xyzzy' );

@result = $choice->best();
is( @result, 2 );
is( $result[0], 'banana' );

@result = $choice->best( 'xyzzy' );
is( @result, 3 );
is( $result[0], 'cherry' );

@result = $choice->best( 'xyzzyxyz' );
is( @result, 2 );
is( $result[0], 'banana' );

$choice->add( value => 'cranberry', rank => 'length', match => 'xyzzy' );

@result = $choice->best();
is( @result, 2 );
is( $result[0], 'banana' );

@result = $choice->best( 'xyzzy' );
is( @result, 4 );
is( $result[0], 'cranberry' );

@result = $choice->best( 'xyzzyxyz' );
is( @result, 2 );
is( $result[0], 'banana' );

t/99-synopsis.t  view on Meta::CPAN


$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
is( $favorite, 'apple' );

$favorite = $chooser->best( [qw/ red yellow purple /] ); # grape is the favorite among red, yellow, and purple
is( $favorite, 'grape' );



( run in 1.039 second using v1.01-cache-2.11-cpan-4e96b696675 )