Algorithm-Pair-Best2
view release on metacpan or search on metacpan
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Algorithm-Pair-Best2 - 'best score' pairing algorithm
====================
This is a re-write of Algorithm::Pair::Best. The interface is
simplified and the implementation is significantly streamlined.
Algorithm::Pair::Best2 provides a 'best score' pairing algorithm (for
go tournaments, for example). Every possible pair gets a 'score' (or
perhaps 'penalty' is a better way to think about it) via a user
defined subroutine, and Algorithm::Pair::Best tries all possible
combinations of pairs to return the pairings with the best total score
(lowest penalty).
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
push @w_idxs, $idx;
last if (@w_idxs >= $window * 2) # window filled
}
}
my $score = 0; # need an initial score, might as well count
# initial items as passed to us
for (my $idx = 0; $idx < @w_idxs; $idx += 2) {
$score += $self->get_score($w_idxs[$idx], $w_idxs[$idx + 1]);
}
# pair this window
($score, @w_idxs) = $self->_r_best(0, $score, @w_idxs);
### my $combs = 1;
### map { $combs *= (2 * $_ - 1) } (1 .. @w_idxs / 2);
### print scalar keys %all, ' combinations';
### print " (should be $combs)" if ($combs != scalar keys %all);
### print "\n";
### for my $key (keys %all) {
### my $score = 0;
### for my $pair (split ',', $key) {
### $score += $self->get_score(split('-', $pair));
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
$w_idxs[$idx], $w_idxs[$idx + 1]); # item indices
push @scores, $self->get_score(@w_idxs[$idx..$idx+1]);
}
last;
}
}
return wantarray ? @results : \@results;
}
# find best pairing of @idxs. try the first item in @idxs against every
# other item in the array. after picking the first and the current second
# item, recursively find the best arrangement of all the remaining items.
# the return values are the score followed by the new arrangment.
sub _r_best {
my ($self, $depth, $best_score, @idxs) = @_;
if (@idxs <= 2) {
croak sprintf("%d items left", scalar @idxs) if (@idxs <= 1);
return ($self->get_score(@idxs), @idxs);
}
my @best_trial = @idxs; # copy in case there is no improvement
my ($trial_0, $trial_1, @tail) = @idxs; # working copy
### push @head, $trial_0;
for my $idx (0 .. @idxs - 2) {
### push @head, $trial_1;
### $all{$self->make_key(@head, @tail)} = 0 if (@tail == 2); # collect every combination
# recursively get best pairing for tail
my ($trial_score, @trial_tail) = $self->_r_best($depth + 1, $best_score, @tail);
# add score for top pair
$trial_score += $self->get_score($trial_0, $trial_1); # first pair
### print join(', ', $trial_0, $trial_1, @trial_tail, $self->make_key($trial_0, $trial_1, @trial_tail)), "\n" if ($depth == 0);
### $self->dbg_hash($self->make_key($trial_0, $trial_1, @trial_tail), $trial_score);
if ($trial_score < $best_score) {
# aha! a potential candidate. save it
$best_score = $trial_score;
@best_trial = ($trial_0, $trial_1, @trial_tail);
## printf "%2d %2d Best %8.5f idxs %s\n",
## $depth,
## $idx,
## $best_score,
## $self->print_items(@best_trial) if ($depth < 2);
}
else {
## printf "%2d %2d Not best %8.5f idxs %s\n",
## $depth,
## $idx,
## $trial_score,
## $self->print_items($trial_0, $trial_1, @trial_tail) if ($depth < 2);
}
# hold $trial_0 in slot 0, rotate all items below it
push @tail, $trial_1; # add second item to end of tail
$trial_1 = shift @tail; # move third item into second slot
### pop @head;
}
### pop @head;
### my $key = $self->make_key(@best_trial);
### print "best: $key = $best_score\n" if ($depth == 0);
return ($best_score, @best_trial);
}
1;
__END__
=pod
=encoding UTF-8
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
This is a re-write of Algorithm::Pair::Best. The interface is simplified
and the implementation is significantly streamlined.
After creating an Algorithm::Pair::Best2 object (with -E<gt>B<new>), B<add>
items to the list of items (i.e: players) to be paired. The final list
must contain an even number of items or B<pick>ing the pairs will throw an
exception.
Algorithm::Pair::Best2-E<gt>B<pick> explores all combinations of items and
returns the pairing list with the best (lowest) score. This can be an
expensive proposition - the number of combinations goes up very fast with
respect to the number of items:
items combinations
2 1 (1)
4 3 (1 * 3)
6 15 (1 * 3 * 5)
8 105 (1 * 3 * 5 * 7)
10 945 (1 * 3 * 5 * 7 * 9
12 10395 (1 * 3 * 5 * 7 * 9 * 11)
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
sliding window to get good 'local' results.
The B<-E<gt>new> method accepts a B<window> option to limit the number
of pairs in the sliding window. The B<window> option can also be
overridden by calling B<pick> with an explicit window argument:
$pair->pick($window);
The list should be at least partially sorted so that reasonable
pairing candidates are within the 'sliding window' of each other.
Otherwise the final results may not be globally 'best', but only
locally good. For (e.g.) a tournament, sorting by rank is sufficient.
Here's how a window value of 5 works: the best list for items 1
through 10 (5 pairs) is found. Save the pairing for the top two items
and then slide the window down to pair items 2 through 12. Save the
top pairing from this result and slide down again to items 4 through
14. Keep sliding the window down until we reach the last 10 items
(which are completed in one iteration). In this way, a large number
of pairings can be completed without taking factorial time.
=head1 METHODS
=over
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
Creates a B<new> Algorithm::Pair::Best2 object.
=item $pair-E<gt>B<add> ( item, [ item, ...] )
Add an item (or several items) to be paired. Item(s) can be any scalar
or reference. They will be passed (a pair at a time) to the B<scoreSub>
callback.
=item @new_pairs = $pair-E<gt>B<pick> ( ?$window? )
Returns the best pairing found using the sliding window technique as
discussed in DESCRIPTION above. B<window> is the number of pairs in the
sliding window. If no B<window> argument is passed, the B<window> selected
in the B<new>, or the default value is used.
B<pick> returns the list (or a reference to the list in scalar context) of
items in pairing order: new_pair[0] is paired to new_pair[1], new_pair[2]
to new_pair[3], etc.
If the number of items in the list (from B<add>) is not even, an exception
is thrown.
( run in 0.523 second using v1.01-cache-2.11-cpan-4e96b696675 )