view release on metacpan or  search on metacpan

lib/Games/Tournament/Contestant/Swiss/Preference.pm  view on Meta::CPAN

use strict;
use Carp;

use List::Util qw/first/;
use List::MoreUtils qw/any/;

use Games::Tournament::Swiss::Config;

use constant ROLES => @Games::Tournament::Swiss::Config::roles?
			@Games::Tournament::Swiss::Config::roles:
			Games::Tournament::Swiss::Config->roles;

use base qw/Games::Tournament/;

# use overload qw/0+/ => 'next', qw/""/ => 'value', fallback => 1;

=head1 NAME

Games::Tournament::Contestant::Swiss::Preference  A competitor's right to a role.

=cut

=head1 SYNOPSIS

    pray if $preference->role eq 'Black' and $preference->strength eq 'Strong';

=head1 DESCRIPTION

The preference, or expectation/right/duty one has with reference to a role, eg White, in the next round depends on the difference between the number of games previously played in it and in the alternative roles, and is either Mild, Strong, or Absolut...
As an API, the strength method returns 'Mild', 'Strong', or 'Absolute' and the role method returns 'Black', 'White', or whatever the preferred role is, respecting the 2 consecutive games in the same role rule. A7

=head1 METHODS

=head2 new

    $pref = Games::Tournament::Contestant::Swiss::Preference->new(
	difference => 0, sign => 'Black', round => 0 );

The default difference is 0. The default sign is ''.

=cut

sub new {
    my $self = shift;
    my %args = @_;
    $args{sign}  = '' unless $args{sign};
    $args{difference} = 0  unless $args{difference};
    my $pref = bless \%args, $self;
    return $pref;
}


=head2 update

	$pref->update( \@oldRoles  )

	Updates the difference (ie, the internal representation of preference) on the basis of the last role (and second-last role) in \@oldRoles. A minimal sanity check is performed. \@oldRoles is a history of roles in previous rounds, and it is expected o...

=cut

sub update {
    my $self     = shift;
    my $roles = shift;
    my $message = "Preference update: ";
    return unless $roles->[-1] and any { $roles->[-1] eq $_ } ROLES;
    my @reverseRoles = reverse @$roles;
    my $lastRole       = $reverseRoles[0];
    my $before         = $reverseRoles[1];
    my $oneBeforeThat = $reverseRoles[2];
    $message .= "3-game run as $lastRole\n" if $before and $oneBeforeThat and
		    $oneBeforeThat eq $before and $before eq $lastRole;
    my $difference     = $self->difference;
    my $sign      = $self->sign;
    my $otherDirection = first { $_ ne $sign } ROLES;
    if ( not $sign or not defined $difference ) {
        $sign  = $lastRole;
        $difference = 1;
    }
    elsif ( $lastRole eq $otherDirection ) {
        if ( $difference > 0 ) {
            $difference--;
	    if ( $difference == 0 ) {
		$sign  = $otherDirection;
	    }
        }
        elsif ( $difference == 0 ) {
            $sign  = $lastRole;
            $difference = 1;
        }
        else {
            die "$difference games more as $sign after $lastRole role?";
        }
    }
    elsif ( $lastRole eq $sign ) {
	$difference++;
        if ( $difference > 2 ) {
            $message .= "$difference games more as $lastRole\n";
        }
    }
    else {
        die
	"$lastRole role update on ${difference}-game difference in $sign role?";
    }
    $self->sign($sign);
    $self->difference($difference);
    if ($before) { $self->lastTwo( [ $before, $lastRole ] ); }
    else { $self->lastTwo( [$lastRole] ); }
}


=head2 asString

	$pref->asString

	The difference as a string, ^[+-][012]$. '0' represents a mild preference, '1' a strong one and '2' an absolute one. '-' represents a preference for White, or the first element of @Games::Tournament::Swiss::Config::roles, and '+' represents a prefer...

=cut


sub asString {
    my $self   = shift;