]> git.sesse.net Git - wloh/blob - www/rating.pl
aae154d29534433f9369c89de285c86a1a39216d
[wloh] / www / rating.pl
1 #! /usr/bin/perl
2 use strict;
3 use warnings;
4 no warnings qw(once);
5 use CGI;
6 use CGI::Carp qw( fatalsToBrowser );
7 use DBI;
8 use Encode;
9 use POSIX;
10 use HTML::Entities;
11 use utf8;
12 use locale;
13 require '../config.pm';
14 require '../common.pm';
15
16 my $dbh = DBI->connect($config::local_connstr, $config::local_username, $config::local_password)
17         or die "connect: " . $DBI::errstr;
18 $dbh->{AutoCommit} = 0;
19 $dbh->{RaiseError} = 1;
20
21 binmode STDOUT, ':utf8';
22
23 # Find auxillary parameters.
24 my %params = ();
25 my $q = $dbh->prepare('SELECT * FROM ratings WHERE id < 0');
26 $q->execute;
27 while (my $ref = $q->fetchrow_hashref) {
28         $params{$ref->{'id'}} = $ref->{'rating'};
29 }
30 my $match_stddev = $params{-2} * sqrt(2.0);
31
32 print CGI->header(-type=>'text/html; charset=utf-8', -expires=>'+5m');
33 POSIX::setlocale(&POSIX::LC_ALL, 'nb_NO.UTF-8');
34
35 printf <<"EOF", $params{-3}, $match_stddev;
36 <?xml version="1.0" encoding="UTF-8" ?>
37 <!DOCTYPE
38   html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
39   "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
40 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="no">
41   <head>
42     <title>WLoH-rating</title>
43     <link rel="stylesheet" href="style" type="text/css" />
44   </head>
45   <body>
46     <h1>WLoH-rating</h1>
47
48     <p><em>Dette er et hobbyprosjekt fra tredjepart, og ikke en offisiell del av
49       <a href="http://wordfeud.aasmul.net/">Wordfeud Leage of Honour</a>.</em></p>
50
51     <p>Ratingen er dog basert på spilledata fra WLoH (takk til Lobotommy
52       for tilgang!), og oppdateres
53       hver hele time. Den er fullstendig uoffisiell, og har ingen innflytelse
54       på WLoH, men brukes for å estimere vinnersannsynligheter i
55       <a href="index">sannsynlighetsberegningen</a>.</p>
56
57     <p>Modellen kan endre seg når som helst når jeg føler for det :-)
58       Ikke ta ratingen alt for alvorlig, selv om den er basert på
59       relativt fornuftige matematiske modeller. Husk at all statistikk
60       sier mer om fortiden enn om framtiden.</p>
61
62     <h2>Modellparametre</h2>
63
64     <p>For de som vet litt om slikt. Det finnes også en lengre, mer detaljert
65       <a href="ratings-explained">forklaring</a> beregnet på ikke-matematikere.</p>
66
67     <ul>
68       <li>MLE-basert modell med én skalar (styrke) per spiller og to globale skalarer (begge standardavvik, se under), løst med syklisk MM (minorization-maximization). Antall iterasjoner før konvergens: $params{-1}.</li>
69       <li>Rimelighetfunksjon, prior: Normalfordeling med µ=500, &sigma;=%.1f (est.)</li>
70       <li>Rimelighetfunksjon, per kamp: Normalfordeling med µ=(score1 - score2), &sigma;=%.1f (est.)</li>
71       <li>Vekting: Inneværende sesong samt de tre siste vektes fullt ut
72         (likt med prior). Deretter eksponentielt synkende vekting, med
73         halveringstid på tre sesonger. Spill som er registrert med
74         0-0, 150-0, 0-150 eller 150-150 ignoreres.</li>
75     </ul>
76
77     <h2>Divisjonsoversikt</h2>
78
79     <table>
80       <tr>
81         <th>Div.</th>
82         <th>Snitt</th>
83         <th>Std.avvik</th>
84       </tr>
85 EOF
86
87 my $season = wloh_common::get_max_season($dbh);
88
89 # Pick up all the subdivisions' ratings.
90 my %subdivision_ratings = ();
91 $q = $dbh->prepare('SELECT divisjon, avdeling, serie_id, AVG(rating) AS avg_rating FROM ratings NATURAL JOIN siste_divisjon WHERE sesong=? GROUP BY divisjon, avdeling, serie_id ORDER BY divisjon, avdeling');
92 $q->execute($season);
93
94 while (my $ref = $q->fetchrow_hashref) {
95         my $division = $ref->{'divisjon'};
96         my $rating = $ref->{'avg_rating'};
97         my $id = $ref->{'serie_id'};
98
99         push @{$subdivision_ratings{$division}}, [ $id, $rating ];
100 }
101
102 $q = $dbh->prepare('SELECT divisjon,AVG(rating) AS avg_rating,STDDEV(rating) AS stddev_rating FROM ratings NATURAL JOIN siste_divisjon WHERE sesong=? GROUP BY divisjon ORDER BY divisjon');
103 $q->execute($season);
104
105 my $i = 0;
106 while (my $ref = $q->fetchrow_hashref) {
107         if (++$i % 2 == 0) {
108                 print "      <tr class=\"odd\">\n";
109         } else {
110                 print "      <tr class=\"even\">\n";
111         }
112         printf "        <th>%d.</th>\n", $ref->{'divisjon'};
113         printf "        <td class=\"num\">%.1f</td>\n", $ref->{'avg_rating'};
114         printf "        <td class=\"num\">%.1f</td>\n", $ref->{'stddev_rating'};
115
116         for my $arr (@{$subdivision_ratings{$ref->{'divisjon'}}}) {
117                 my ($id, $rating) = @$arr;
118                 printf "        <td class=\"num\"><a href=\"http://wordfeud.aasmul.net/serie-%d\">%.1f</a></td>\n", $id, $rating;
119         }
120         print "      </tr>\n";
121 }
122
123 print <<"EOF";
124     </table>
125
126   <h2>Rankingliste</h2>
127
128   <table>
129     <tr>
130       <th></th>
131       <th>Nick</th>
132       <th>Rating</th>
133       <th>Std.avvik</th>
134       <th>Sist sett</th>
135     </tr>
136 EOF
137
138 $q = $dbh->prepare('
139 SELECT *
140 FROM ratings
141   NATURAL JOIN kanonisk_navn
142   NATURAL JOIN siste_divisjon
143 ORDER BY rating DESC');
144 $q->execute;
145
146 $i = 0;
147 while (my $ref = $q->fetchrow_hashref) {
148         if (++$i % 2 == 0) {
149                 print "    <tr class=\"odd\">\n";
150         } else {
151                 print "    <tr class=\"even\">\n";
152         }
153         printf "      <th>%d.</th>\n", $i;
154         printf "      <td><a href=\"http://wordfeud.aasmul.net/bruker-%d\">%s</a></td>\n", $ref->{'id'}, HTML::Entities::encode_entities(Encode::decode_utf8($ref->{'navn'}));
155         printf "      <td class=\"num\">%.1f</td>\n", $ref->{'rating'};
156         printf "      <td class=\"num\">%.1f</td>\n", $ref->{'rating_stddev'};
157         printf "      <td><a href=\"http://wordfeud.aasmul.net/serie-%d\">%s</a></td>\n", $ref->{'serie_id'}, $ref->{'serie_navn'};
158         print "    </tr>\n";
159 }
160 print "    </table>\n";
161
162 wloh_common::output_last_sync($dbh);
163
164 print <<"EOF";
165   </body>
166 </html>
167 EOF
168
169 $match_stddev = $params{-2} * sqrt(2.0);
170
171 $dbh->rollback;