File Coverage

blib/lib/Games/Ratings/Chess/FIDE.pm

Criterion	Covered	Total	%
statement	196	212	92.4
branch	10	16	62.5
condition			n/a
subroutine	15	17	88.2
pod	4	4	100.0
total	225	249	90.3

package Games::Ratings::Chess::FIDE;

## TODO: check arguments for subroutines (use Data::Checker)?
## TODO: Error handling
##       * croak()
##       * perldoc anpassen

use strict;
use warnings;
use Carp;

use 5.6.1;               # 'our' was introduced in perl 5.6
use version; our $VERSION = qv('0.0.5');

## look in Games::Ratings for methods not provide by this package
use base qw ( Games::Ratings );

## calculate rating change
sub get_rating_change {
    my ($self) = @_;

    ## get own rating and own coefficient
    my $own_rating      = $self->get_rating();
    my $own_coefficient = $self->get_coefficient();

    my $rating_change_total;
    ## calculate rating change for each game separately
    foreach my $game_ref ( $self->get_all_games() ) {
        ## add rating change for single game to total rating change
        $rating_change_total += _calc_rating_change_for_single_game(
                                    $own_rating,
                                    $own_coefficient,
                                    $game_ref->{opponent_rating},
                                    $game_ref->{result},
                                );
    }

    ## return total rating change
    return $rating_change_total;
}

## calculate new rating
sub get_new_rating {
    my ($self) = @_;

    ## $R_o -- old rating
    my $R_o = $self->get_rating();

    ## $R_n -- new rating (rounded)
    my $R_n = sprintf( "%.f", $R_o + $self->get_rating_change() );

    ## return new rating
    return $R_n;
}

## calculate expected points
sub get_points_expected {
    my ($self) = @_;

    ## $W_e -- expected points
    my $W_e;

    ## $own_rating -- own rating
    my $own_rating = $self->get_rating();

    ## sum up expected points for all games
    foreach my $game_ref ( $self->get_all_games() ) {
        $W_e += _get_scoring_probability_for_single_game(
                    $own_rating,
                    $game_ref->{opponent_rating},
                );
    }

    ## return expected points
    return $W_e;
}

## calculate performance
sub get_performance {
    my ($self) = @_;

    ## $R_h -- performance (independent from old rating)
    my $R_h;

    ## average rating of opponents
    my $R_c = $self->get_average_rating_of_opponents();

    ## $P -- percentage score (two digits needed)
    my $P = sprintf( "%.2f", $self->get_percentage_score() );

    ## if player scored 100 % or 0 % it's not possible to calc. performance
    if ($P == 1) {
        $R_h = $R_c + 667;
        return $R_h;
    }
    if ($P == 0) {
        $R_h = $R_c - 667;
        return $R_h;
    }

    ## lookup $D rating difference according to $P from probability table
    my $D = _get_rating_difference_matching_percentage_score($P);

    ## calculate performance
    $R_h = $R_c + $D;

    ## return performance
    return $R_h;
}

########################
## internal functions ##
########################

## scoring probabilities depending from rating difference (FIDE B0210.1b)
our %scoring_probability_lookup_table;
_set_scoring_probability_lookup_table();

## lookup table needed to determine performance (FIDE B0210.1a)
our %reverse_scoring_probability_lookup_table;
_set_reverse_scoring_probability_lookup_table();

## calculate rating change for single game
sub _calc_rating_change_for_single_game {
    my ($A_rating, $A_coefficient, $B_rating, $result) = @_;

    ## get numerical result ( win=>1 draw=>0.5 loss=>0 )
    my $numerical_result = Games::Ratings::_get_numerical_result($result);

    ## check whether development coefficient is provided -- guess otherwise
    if (! defined $A_coefficient) {
        $A_coefficient = _guess_coefficient($A_rating);
    }

    ## get scoring probability for player A
    my $A_exp = _get_scoring_probability_for_single_game($A_rating,$B_rating);

    ## compute rating changes for player A
    my $A_rating_change = $A_coefficient * ($numerical_result-$A_exp);

    ## return rating changes for player A
    return ($A_rating_change);
}

## try to guess development coefficient
sub _guess_coefficient {
    my ($player_rating) = @_;

    ## guess coefficient according to rating (cmp. FIDE handbook B0210.52)
    my $player_coefficient;
    if ($player_rating >= 2400) {
        $player_coefficient = 10;
    }
    else {
        $player_coefficient = 15;
    }

    ## return guessed coefficient
    return $player_coefficient;
}

## calculate scoring probability for a single game
sub _get_scoring_probability_for_single_game {
    my ($A_rating,$B_rating) = @_;

    my $rating_difference = _get_rating_difference($A_rating,$B_rating);

    ## get scoring probability of player A from lookup table
    my $A_exp;
    if ($rating_difference >= 0) {
        $A_exp = $scoring_probability_lookup_table{$rating_difference};
    }
    else {
        $A_exp = 1 - $scoring_probability_lookup_table{0-$rating_difference};
    }

    ## return scoring probability for player A
    return ($A_exp);
}

## calculate rating difference which is used to calc the scoring probability
sub _get_rating_difference {
    my ($A, $B) = @_;

    ## compute real rating difference
    my $rating_difference = ( $A-$B );

    ## large rating differences are cut (FIDE handbook B0210.51, 2nd sentence)
    if ($rating_difference > '350') {
        $rating_difference = '350';
    }
    if ($rating_difference < '-350') {
        $rating_difference = '-350';
    }

    ## return rating difference used for rating calculations
    return $rating_difference;
}

## calculate rating differences matching percentage score
sub _get_rating_difference_matching_percentage_score {
    my ($P) = @_;

    ## lookup $D (rating difference) from lookup table
    my $D;
    if ($P lt 0.5) {
        ## percentage score negated -- so we can use our lookup table
        my $P_negated = sprintf("%.2f", 1-$P);
        $D = -($reverse_scoring_probability_lookup_table{$P_negated});
    }
    else {
        $D = $reverse_scoring_probability_lookup_table{$P};
    }

    ## return $D
    return $D;
}

## use hash as lookup table for scoring probability (cmp. FIDE B0210.1b)
sub _set_scoring_probability_lookup_table {
    foreach my $rating_difference (0..3) {
        $scoring_probability_lookup_table{$rating_difference} = 0.50;
    }
    foreach my $rating_difference (4..10) {
        $scoring_probability_lookup_table{$rating_difference} = 0.51;
    }
    foreach my $rating_difference (11..17) {
        $scoring_probability_lookup_table{$rating_difference} = 0.52;
    }
    foreach my $rating_difference (18..25) {
        $scoring_probability_lookup_table{$rating_difference} = 0.53;
    }
    foreach my $rating_difference (26..32) {
        $scoring_probability_lookup_table{$rating_difference} = 0.54;
    }
    foreach my $rating_difference (33..39) {
        $scoring_probability_lookup_table{$rating_difference} = 0.55;
    }
    foreach my $rating_difference (40..46) {
        $scoring_probability_lookup_table{$rating_difference} = 0.56;
    }
    foreach my $rating_difference (47..53) {
        $scoring_probability_lookup_table{$rating_difference} = 0.57;
    }
    foreach my $rating_difference (54..61) {
        $scoring_probability_lookup_table{$rating_difference} = 0.58;
    }
    foreach my $rating_difference (62..68) {
        $scoring_probability_lookup_table{$rating_difference} = 0.59;
    }
    foreach my $rating_difference (69..76) {
        $scoring_probability_lookup_table{$rating_difference} = 0.60;
    }
    foreach my $rating_difference (77..83) {
        $scoring_probability_lookup_table{$rating_difference} = 0.61;
    }
    foreach my $rating_difference (84..91) {
        $scoring_probability_lookup_table{$rating_difference} = 0.62;
    }
    foreach my $rating_difference (92..98) {
        $scoring_probability_lookup_table{$rating_difference} = 0.63;
    }
    foreach my $rating_difference (99..106) {
        $scoring_probability_lookup_table{$rating_difference} = 0.64;
    }
    foreach my $rating_difference (107..113) {
        $scoring_probability_lookup_table{$rating_difference} = 0.65;
    }
    foreach my $rating_difference (114..121) {
        $scoring_probability_lookup_table{$rating_difference} = 0.66;
    }
    foreach my $rating_difference (122..129) {
        $scoring_probability_lookup_table{$rating_difference} = 0.67;
    }
    foreach my $rating_difference (130..137) {
        $scoring_probability_lookup_table{$rating_difference} = 0.68;
    }
    foreach my $rating_difference (138..145) {
        $scoring_probability_lookup_table{$rating_difference} = 0.69;
    }
    foreach my $rating_difference (146..153) {
        $scoring_probability_lookup_table{$rating_difference} = 0.70;
    }
    foreach my $rating_difference (154..162) {
        $scoring_probability_lookup_table{$rating_difference} = 0.71;
    }
    foreach my $rating_difference (163..170) {
        $scoring_probability_lookup_table{$rating_difference} = 0.72;
    }
    foreach my $rating_difference (171..179) {
        $scoring_probability_lookup_table{$rating_difference} = 0.73;
    }
    foreach my $rating_difference (180..188) {
        $scoring_probability_lookup_table{$rating_difference} = 0.74;
    }
    foreach my $rating_difference (189..197) {
        $scoring_probability_lookup_table{$rating_difference} = 0.75;
    }
    foreach my $rating_difference (198..206) {
        $scoring_probability_lookup_table{$rating_difference} = 0.76;
    }
    foreach my $rating_difference (207..215) {
        $scoring_probability_lookup_table{$rating_difference} = 0.77;
    }
    foreach my $rating_difference (216..225) {
        $scoring_probability_lookup_table{$rating_difference} = 0.78;
    }
    foreach my $rating_difference (226..235) {
        $scoring_probability_lookup_table{$rating_difference} = 0.79;
    }
    foreach my $rating_difference (236..245) {
        $scoring_probability_lookup_table{$rating_difference} = 0.80;
    }
    foreach my $rating_difference (246..256) {
        $scoring_probability_lookup_table{$rating_difference} = 0.81;
    }
    foreach my $rating_difference (257..267) {
        $scoring_probability_lookup_table{$rating_difference} = 0.82;
    }
    foreach my $rating_difference (268..278) {
        $scoring_probability_lookup_table{$rating_difference} = 0.83;
    }
    foreach my $rating_difference (279..290) {
        $scoring_probability_lookup_table{$rating_difference} = 0.84;
    }
    foreach my $rating_difference (291..302) {
        $scoring_probability_lookup_table{$rating_difference} = 0.85;
    }
    foreach my $rating_difference (303..315) {
        $scoring_probability_lookup_table{$rating_difference} = 0.86;
    }
    foreach my $rating_difference (316..328) {
        $scoring_probability_lookup_table{$rating_difference} = 0.87;
    }
    foreach my $rating_difference (329..344) {
        $scoring_probability_lookup_table{$rating_difference} = 0.88;
    }
    foreach my $rating_difference (345..350) {
        $scoring_probability_lookup_table{$rating_difference} = 0.89;
    }
}

## use hash as lookup table (rating differences given a percentage score)
## (cmp. FIDE B0210.1a)
sub _set_reverse_scoring_probability_lookup_table {
    $reverse_scoring_probability_lookup_table{'0.50'} = '0';
    $reverse_scoring_probability_lookup_table{'0.51'} = '7';
    $reverse_scoring_probability_lookup_table{'0.52'} = '14';
    $reverse_scoring_probability_lookup_table{'0.53'} = '21';
    $reverse_scoring_probability_lookup_table{'0.54'} = '29';
    $reverse_scoring_probability_lookup_table{'0.55'} = '36';
    $reverse_scoring_probability_lookup_table{'0.56'} = '43';
    $reverse_scoring_probability_lookup_table{'0.57'} = '50';
    $reverse_scoring_probability_lookup_table{'0.58'} = '57';
    $reverse_scoring_probability_lookup_table{'0.59'} = '65';
    $reverse_scoring_probability_lookup_table{'0.60'} = '72';
    $reverse_scoring_probability_lookup_table{'0.61'} = '80';
    $reverse_scoring_probability_lookup_table{'0.62'} = '87';
    $reverse_scoring_probability_lookup_table{'0.63'} = '95';
    $reverse_scoring_probability_lookup_table{'0.64'} = '102';
    $reverse_scoring_probability_lookup_table{'0.65'} = '110';
    $reverse_scoring_probability_lookup_table{'0.66'} = '117';
    $reverse_scoring_probability_lookup_table{'0.67'} = '125';
    $reverse_scoring_probability_lookup_table{'0.68'} = '133';
    $reverse_scoring_probability_lookup_table{'0.69'} = '141';
    $reverse_scoring_probability_lookup_table{'0.70'} = '149';
    $reverse_scoring_probability_lookup_table{'0.71'} = '158';
    $reverse_scoring_probability_lookup_table{'0.72'} = '166';
    $reverse_scoring_probability_lookup_table{'0.73'} = '175';
    $reverse_scoring_probability_lookup_table{'0.74'} = '184';
    $reverse_scoring_probability_lookup_table{'0.75'} = '193';
    $reverse_scoring_probability_lookup_table{'0.76'} = '202';
    $reverse_scoring_probability_lookup_table{'0.77'} = '211';
    $reverse_scoring_probability_lookup_table{'0.78'} = '220';
    $reverse_scoring_probability_lookup_table{'0.79'} = '230';
    $reverse_scoring_probability_lookup_table{'0.80'} = '240';
    $reverse_scoring_probability_lookup_table{'0.81'} = '251';
    $reverse_scoring_probability_lookup_table{'0.82'} = '262';
    $reverse_scoring_probability_lookup_table{'0.83'} = '273';
    $reverse_scoring_probability_lookup_table{'0.84'} = '284';
    $reverse_scoring_probability_lookup_table{'0.85'} = '296';
    $reverse_scoring_probability_lookup_table{'0.86'} = '309';
    $reverse_scoring_probability_lookup_table{'0.87'} = '322';
    $reverse_scoring_probability_lookup_table{'0.88'} = '336';
    $reverse_scoring_probability_lookup_table{'0.89'} = '351';
    $reverse_scoring_probability_lookup_table{'0.90'} = '366';
    $reverse_scoring_probability_lookup_table{'0.91'} = '383';
    $reverse_scoring_probability_lookup_table{'0.92'} = '401';
    $reverse_scoring_probability_lookup_table{'0.93'} = '422';
    $reverse_scoring_probability_lookup_table{'0.94'} = '444';
    $reverse_scoring_probability_lookup_table{'0.95'} = '470';
    $reverse_scoring_probability_lookup_table{'0.96'} = '501';
    $reverse_scoring_probability_lookup_table{'0.97'} = '538';
    $reverse_scoring_probability_lookup_table{'0.98'} = '589';
    $reverse_scoring_probability_lookup_table{'0.99'} = '677';
}


1; # Magic true value required at end of module
__END__