view release on metacpan or  search on metacpan

bin/bayrate.pl  view on Meta::CPAN

                or die "Couldn't prepare statement: " . $dbh->errstr;

    $sth->execute($tournament_code)     # Execute the query
        or die "Couldn't execute statement: " . $sth->errstr;

    my (@games, %player_seeds_by_id);
    while (my @data = $sth->fetchrow_array) {
        # Process and locally store the game information
        my %game;
        if ($data[$g_color_1] eq 'W') {
            $game{white} = $data[$g_pin_player_1];
            $game{black} = $data[$g_pin_player_2];
        }
        elsif ($data[$g_color_1] eq 'B') {
            $game{white} = $data[$g_pin_player_2];
            $game{black} = $data[$g_pin_player_1];
        }
        else {
            croak("unknown player colour:  $data[$g_color_1]\n");
        }

        if ($data[$g_result] eq 'W') {
            $game{whiteWins} = 1;
        }
        elsif ($data[$g_result] eq 'B') {
            $game{whiteWins} = 0;
        }
        else {
            croak("unknown game result: $data[$g_result]\n");
        }

        $game{handicap}  = $data[$g_handicap];
        $game{komi}      = $data[$g_komi];

        push @games, \%game;

        # Process and locally store the player information
        foreach my $which (0 .. 1) {
            my $pin_idx  = $which ? $g_pin_player_2 : $g_pin_player_1;
            my $rank_idx = $which ? $g_rank_2 : $g_rank_1;
            my $id = $data[$pin_idx];
            next if (exists $player_seeds_by_id{$id});

            my $rank = $data[$rank_idx];
            if (my ($rating, $range) = $rank =~ m/^(\d+)([KDkd])$/) {
                $rating += 0.5; # make e.g: 5d = 5.5
                $player_seeds_by_id{$id} = (uc $range eq 'D') ? $rating : -$rating;
            }
            else {
                croak("Illegal rank: " . $data["\$g_rank_$which"]);
            }
        }
    }
    $sth->finish;
    return if (not @games);

    my $collection = Games::Go::AGA::BayRate::Collection->new(
            iter_hook         => \&iter_hook,
            tournamentDate    => $tournamentDate,
            strict_compliance => $strict_compliance, # match original bayrate C++ code exactly
            #f_iterations     => 50,
            #fdf_iterations   => 50,
    );

    # enter all the players who were in a game
    my %players_by_id;
    foreach my $id (sort { $a <=> $b } keys %player_seeds_by_id) {
        $players_by_id{$id} = $collection->add_player(
            id     => $id,
            seed   => $player_seeds_by_id{$id},
            sigma  => 6.0,  # will get changed later
        );
    }

    # enter all the games
    foreach my $game (@games) {
        $collection->add_game(
            white     => $players_by_id{$game->{white}},
            black     => $players_by_id{$game->{black}},
            whiteWins => $game->{whiteWins},
            handicap  => $game->{handicap},
            komi      => $game->{komi},
        );
    }

    printf("%s\t%s\t%s (%d players in %d games)\n",
        $tournament_code,
        $collection->tournamentDate_ymd,
        $tournamentName,
        scalar (keys %players_by_id),
        scalar @games,
    );

    return $collection;
}

# 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:
            raw_gsl_multimin_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 = raw_gsl_multimin_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),
        }