view release on metacpan or  search on metacpan

lib/Games/Go/AGA/BayRate.pm  view on Meta::CPAN

#*************************************************************************************
#
#     Copyright 2010 Philip Waldron
#
#     This file is part of BayRate.
#
#     BayRate is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
#
#     BayRate is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#
#     You should have received a copy of the GNU General Public License
#     along with BayRate.  If not, see <http://www.gnu.org/licenses/>.
#
#**************************************************************************************
#===============================================================================
#
#     ABSTRACT:  implementation of AGA BayRate (player ratings) as perl object
#
#       AUTHOR:  Reid Augustin (REID), <reid@lucidport.com>
#        EMAIL:  reid@LucidPort.com
#      CREATED:  12/02/2010 08:51:22 AM PST
#===============================================================================

use 5.008;
use strict;
use warnings;

package Games::Go::AGA::BayRate;

use parent qw( Games::Go::AGA::BayRate::Collection );

use Alien::GSL;
use Math::GSL::Errno qw(
    $GSL_SUCCESS
);

our $VERSION = '0.119'; # VERSION

sub new {
    my ($proto, %args) = @_;

    my $self = {};
    bless($self, ref($proto) || $proto);

    my $collection
    = $self->{collection}
    = Games::Go::AGA::BayRate::Collection->new(
            iter_hook             => \&iter_hook, # called once per f or fdf iteration
        #   fdf_iterations        =>  # number fdf_iterations to perform
        #   fdf_gradient_spec     =>  # fdf gradient to test against
        #   f_iterations          =>  # number f_iterations to perform
        #   f_size                =>  # f size to test against
        #   calc_ratings_failover =>  # force failover to calc_ratings_f
        #   calc_sigma_failover   =>  # force failover to calc_sigma2
        #   strict_compliance     =>  # adnere exactly to original bayrate C++ code
    );

    # enter all the players who were in a game
    my $players = $args{players} || [];
    foreach my $player ( @{$players} ) {
        $self->add_player($player);
    }

    # enter all the games
    my $games = $args{games} || [];
    foreach my $game (@{$games}) {
        $self->add_game($game);
    }
    return $self;
}

# hook called for each F(DF)Minimzer iteration
sub iter_hook {
    my ($collection, $state, $iter, $status) = @_;

    if (ref $state eq 'Math::GSL::Multimin::gsl_multimin_fminimizer') {
        my $f = # gsl_multimin_fminimizer_fval($state),    # hmm, struct member, not a function
                # ok, do it this way instead:
            Games::Go::AGA::BayRate::GSL::Multimin::my_fminimizer_fval($state),
        my $size = gsl_multimin_fminimizer_size($state);
        printf("F Iteration %d\tf() = %g\tsimplex size = %g\n", $iter, $f, $size);
        if ($status == $GSL_SUCCESS) {
            printf "\nConverged to minimum. f() = %g\n", $f;
        }
    }
    elsif (ref $state eq 'Math::GSL::Multimin::gsl_multimin_fdfminimizer') {
        my $gradient = Games::Go::AGA::BayRate::GSL::Multimin::my_fdfminimizer_gradient($state);
        my $minimum = gsl_multimin_fdfminimizer_minimum($state);
        printf("FDF Iteration %d\tf() = %g\tnorm = %g\tStatus = %d\n",
            $iter,
            $minimum,
            gsl_blas_dnrm2($gradient),
            $status);
        if ($status == $GSL_SUCCESS) {
            printf "\nConverged to minimum. Norm(gradient) = %g\n",
                gsl_blas_dnrm2($gradient),
        }

    }
    else {
        die(sprintf("Unknown minimizer state type: %s", ref $state));
    }
}

sub add_player {
    my ($self, $player) = @_;

    $self->{collection}->add_player(
        id     => $player->id,
        seed   => $player->rating,
        #  sigma  => 6.0,  # will get changed later