view release on metacpan or  search on metacpan

lib/Algorithm/Pair/Swiss.pm  view on Meta::CPAN

=cut

sub exclude {
    my $self = shift;
    for my $pair (@_) {
	my ($x,$y) = @$pair;
	    $self->{exclude}->{"$x"}->{$y?"$y":''} = 1 if $x;
	    $self->{exclude}->{"$y"}->{$x?"$x":''} = 1 if $y;
    }	
}    

=item $pair-E<gt>B<drop>( @parties )

Excludes the given parties from further pairing. The given parties will
be removed from the internal parties list and won't be returned by the
parties method anymore. This method is usually used when a participant
has decided to quit playing.

=cut

sub drop {
    my $self = shift;
    my %parties = map { ( "$_" => $_ ) } $self->parties;
    for my $party (@_) { delete $parties{"$party"} }
    $self->{parties} = [ values %parties ];
}

sub _pairs {
    my ($unpaired,$exclude) = @_;
    my @unpaired = @$unpaired;
    my $p1 = shift @unpaired;
    for my $p2 (@unpaired) {
    	next if exists $exclude->{"$p1"}->{"$p2"};	# already paired
       	next if exists $exclude->{"$p2"}->{"$p1"};	# already paired
    	return [$p1,$p2] if @unpaired==1;		    # last pair!
    	my @remaining = grep {"$_" ne "$p2"} @unpaired;	# this pair could work
    	my @pairs = _pairs(\@remaining,$exclude);	# so try to pair the rest
    	next unless @pairs;				            # no luck
    	return [$p1,$p2],@pairs;			        # yay! return the resultset
    }
    if(@unpaired % 2 == 0) {					            # single player left
        return if exists $exclude->{"$p1"}->{''};		# already had a bye before
	    return [$p1,undef] unless @unpaired; 		# return a bye
	    my @pairs = _pairs(\@unpaired,$exclude);
	    return unless @pairs;
	    return @pairs,[$p1,undef];
    }
    return;
}    

1;

__END__

=back

=head1 EXPORT

None by default.

=head1 BUGS AND LIMITATIONS

No bugs that I know of...

The module's performance will probably break down 
if you use 1000+ parties and 100+ rounds though...

=head1 REQUIREMENTS

Perl 5.6.0 or later (though it will probably work ok with earlier versions)

=head1 SEE ALSO

=over 1

=item o Algorithm::Pair::Best

The B<Algorithm::Pair::Best> module if you need more control
over your pairings.

=item o overload

For proper results you'll want to overload the B<cmp> and/or B<0+>
operators of the objects you're using as parties. This will allow
for the correct sort order, so higher-ranked parties are matched
better.

=back

=head1 ACKNOWLEDGEMENTS

Reid Augustin for by B<Algorithm::Pair::Best>

Elizabeth Mattijsen for giving me some pointers on getting this module CPAN-ready.

=head1 AUTHOR

Gilion Goudsmit, E<lt>ggoudsmit@shebang.nlE<gt>

I can also be found on http://www.perlmonks.org as Gilimanjaro. You can direct 
any questions concerning this module there as well.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Gilion Goudsmit

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut