]> git.sesse.net Git - foosball/blob - recalc-single-result.pl
Add a "dry run" mode to recalc-single-result, for easier testing.
[foosball] / recalc-single-result.pl
1 #! /usr/bin/perl
2 use strict;
3 use warnings;
4 use DBI;
5 use CGI;
6 use CGI::Carp qw(fatalsToBrowser);
7 require 'foosball.pm';
8 no warnings 'once';
9
10 my $dryrun = 0;
11 if (defined($ARGV[0])) {
12         $dryrun = 1;
13         $foosball::initial_rd = $ARGV[0];
14         $foosball::c = $ARGV[1];
15 }
16
17 my $dbh = foosball::db_connect();
18 $dbh->{AutoCommit} = 0;
19
20 $dbh->do('delete from single_rating') unless $dryrun;
21
22 my %ratings = ();
23 my $q = $dbh->prepare('select *,extract(epoch from gametime) as eptime from single_results order by gametime');
24 $q->execute;
25
26 # Combined log-likelihood
27 my $cll = 0.0;
28
29 while (my $ref = $q->fetchrow_hashref) {
30         for my $user (($ref->{'username1'}, $ref->{'username2'})) {
31                 if (!exists($ratings{$user})) {
32                         $ratings{$user} = [ $foosball::initial_rating, $foosball::initial_rd, 0 ];
33                 }
34         }
35         
36         my $rating1 = $ratings{$ref->{'username1'}}->[0];
37         my $rd1 = $ratings{$ref->{'username1'}}->[1];
38         my $age1 = $ref->{'eptime'} - $ratings{$ref->{'username1'}}->[2];
39
40         my $rating2 = $ratings{$ref->{'username2'}}->[0];
41         my $rd2 = $ratings{$ref->{'username2'}}->[1];
42         my $age2 = $ref->{'eptime'} - $ratings{$ref->{'username2'}}->[2];
43
44         my $score1 = $ref->{'score1'};
45         my $score2 = $ref->{'score2'};
46
47         $rd1 = foosball::apply_aging($rd1, $age1 / 86400.0);
48         $rd2 = foosball::apply_aging($rd2, $age2 / 86400.0);
49
50         my ($newr1, $newrd1, $likelihood) = foosball::calc_rating($rating1, $rd1, $rating2, $rd2, $score1, $score2);
51         my ($newr2, $newrd2) = foosball::calc_rating($rating2, $rd2, $rating1, $rd1, $score2, $score1);
52
53         $cll += log($likelihood);
54
55         unless ($dryrun) {
56                 printf("%-10s - %-10s: %u - %u, new ratings %u/%u %u/%u [$likelihood]\n",
57                         $ref->{'username1'}, $ref->{'username2'}, $ref->{'score1'},
58                         $ref->{'score2'}, $newr1, $newrd1, $newr2, $newrd2);
59                 $dbh->do('insert into single_rating values (?,?,?,?,?)', undef,
60                         $ref->{'username1'}, $ref->{'gametime'}, $newr1, $newrd1, $newr1-$rating1);
61                 $dbh->do('insert into single_rating values (?,?,?,?,?)', undef,
62                         $ref->{'username2'}, $ref->{'gametime'}, $newr2, $newrd2, $newr2-$rating2);
63         }
64
65         $ratings{$ref->{'username1'}} = [ $newr1, $newrd1, $ref->{'eptime'} ];
66         $ratings{$ref->{'username2'}} = [ $newr2, $newrd2, $ref->{'eptime'} ];
67 }
68
69 $dbh->commit unless $dryrun;
70 $dbh->disconnect;
71
72 printf "\nCombined negative log-likelihood (smaller value means a better model): %f\n",
73         -$cll;