File Coverage

blib/lib/Games/Ratings/Go/EGF.pm

Criterion	Covered	Total	%
statement	66	90	73.3
branch	22	44	50.0
condition			n/a
subroutine	13	14	92.8
pod	3	3	100.0
total	104	151	68.8

package Games::Ratings::Go::EGF;

## TODO: check arguments for subroutines (use Data::Checker)?
## TODO: Error handling
##       * croak()
##       * perldoc anpassen
## TODO: $self->set_rating() checken: >= 100

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

## epsilon (inflation factor)
our $e = 0.014;

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

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

    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,
                                    $game_ref->{opponent_rating},
                                    $game_ref->{result},
                                    $game_ref->{handicap},
                                );
    }

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

    ## get value for $A_rating
    my $A_rating = $self->get_rating();

    ## sum up expected points for all games
    foreach my $game_ref ( $self->get_all_games() ) {
        ## get values for $B_rating, $A_handicap
        my $B_rating = $game_ref->{opponent_rating};
        my $A_handicap = $game_ref->{handicap};

        ## check whether handicap is provided -- otherwise set to zero
        if (! defined $A_handicap) {
            $A_handicap = 0;
        }

        ## sum up individual scoring probabilities
        $W_e += _get_scoring_probability_for_single_game(
                    $A_rating,
                    $B_rating,
                    $A_handicap,
                );

    }

    ## return expected points
    return $W_e;
}

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

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

    ## check whether handicap is provided -- otherwise set to zero
    if (! defined $A_handicap) {
        $A_handicap = 0;
    }

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

    ## calculate parameter 'con' according to $A_rating
    my $A_con = _get_con($A_rating);

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

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

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

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

    ## scoring probability for player A
    my $A_exp;

    ## scoring probability for weaker player is computed first
    if ($A_rating > $B_rating) {
        ## determine rating difference for calculation of scoring probability
        my $rating_difference = _get_rating_difference(
                                    $B_rating,
                                    $A_rating,
                                    -$A_handicap,
                                );
        ## calculate parameter a
        my $a = _get_a($B_rating, -$A_handicap);

        ## get scoring probability for player A (1 - e - Se(B))
        $A_exp = 1 - $e - 1 / ( 1 + exp($rating_difference/$a) );
    }
    else {
        ## determine rating difference for calculation of scoring probability
        my $rating_difference = _get_rating_difference(
                                    $A_rating,
                                    $B_rating,
                                    $A_handicap,
                                );
        ## calculate parameter a
        my $a = _get_a($A_rating, $A_handicap);

        ## get scoring probability for player A
        $A_exp = 1 / ( 1 + exp($rating_difference/$a) );
    }

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

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

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

    ## rating difference is adjusted when handicaps are given
    if ($A_handicap > 0) {
        $rating_difference = $rating_difference
                             - 100 * ($A_handicap - 0.5);
    }
    if ($A_handicap < 0) {
        $rating_difference = $rating_difference
                             + 100 * (-$A_handicap - 0.5);
    }

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

## calculate paramater 'a'
sub _get_a {
    my ($player_rating,$player_handicap) = @_;

    ## $player_rating is adjusted for calculation of $a if handicap exists
    if ($player_handicap != 0) {
        $player_rating = $player_rating + 100*( $player_handicap-0.5 );
    }

    ## compute parameter 'a' -- some values are given, rest interpolated
    my $a;
    if ($player_rating > 2700) {
        $a = 70;
    }
    ## adjusted $player_rating could fall below 100 (with given handicap)
    elsif ($player_rating < 100) {
        $a = 200;
    }
    else {
        $a = 200 - ( 200-70 ) * ($player_rating-100)/(2700-100);
    }

    ## return parameter 'a'
    return $a;
}

## calculate paramater 'con'
sub _get_con {
    my ($player_rating) = @_;

    ## compute parameter 'con' -- some values are given, rest interpolated
    my $con;
    if ($player_rating == 100) {
        $con = 116;
    }
    elsif ($player_rating < 200) {
        $con = 116 - ( 116-110 )*( $player_rating-100 )/(200-100);
    }
    elsif ($player_rating == 200) {
        $con = 110;
    }
    elsif ($player_rating < 1300) {
        $con = 110 - ( 110-55 )*( $player_rating-200 )/(1300-200);
    }
    elsif ($player_rating == 1300) {
        $con = 55;
    }
    elsif ($player_rating < 2000) {
        $con = 55 - ( 55-27 )*( $player_rating-1300 )/(2000-1300);
    }
    elsif ($player_rating == 2000) {
        $con = 27;
    }
    elsif ($player_rating < 2400) {
        $con = 27 - ( 27-15 )*( $player_rating-2000 )/(2400-2000);
    }
    elsif ($player_rating == 2400) {
        $con = 15;
    }
    elsif ($player_rating < 2600) {
        $con = 15 - ( 15-11 )*( $player_rating-2400 )/(2600-2400);
    }
    elsif ($player_rating == 2600) {
        $con = 11;
    }
    elsif ($player_rating < 2700) {
        $con = 11 - ( 11-10 )*( $player_rating-2600 )/100;
    }
    elsif ($player_rating == 2700) {
        $con = 10;
    }
    elsif ($player_rating > 2700) {
        $con = 10;
    }

    ## return parameter 'con'
    return $con;
}

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