Use covariance matrix under Monte Carlo simulation, to draw better strengths.

[wloh] / www / index.pl
diff --git a/www/index.pl b/www/index.pl

index 4c826086bad28b01f66252c093f8bea7d2d45d13..580ad658d040da70b5da15c635fb93da7a8baf79 100755 (executable)
--- a/www/index.pl
+++ b/www/index.pl
@@ -9,6 +9,7 @@ use POSIX;
  use Devel::Peek;
  use HTML::Entities;
  use Encode;
+use utf8;
  use locale;
  require '../config.pm';
  
@@ -25,6 +26,7 @@ binmode STDOUT, ':utf8';
  
  my %players = ();
  my %ratings = ();
+my %ratings_stddev = ();
  my @matches = ();
  my %parms = ();
  my $match_stddev;
@@ -39,7 +41,7 @@ sub color {
  }
  
  sub make_table {
-       my ($lowest_division, $used_ratings) = @_;
+       my ($lowest_division, $used_ratings, $used_cov) = @_;
  
         print <<"EOF";
  
@@ -58,11 +60,20 @@ EOF
         printf MCCALC "%d\n", scalar keys %players;
  
         for my $id (keys %players) {
-               if (exists($used_ratings->{$id})) {
-                       printf MCCALC "%s %f\n", $id, $used_ratings->{$id};
-               } else {
-                       printf MCCALC "%s %f\n", $id, 1500.0;
+               my $rating = $used_ratings->{$id} // 1500.0;
+               printf MCCALC "%s %f\n", $id, $rating;
+       }
+
+       # covariance matrix
+       for my $id1 (keys %players) {
+               for my $id2 (keys %players) {
+                       if ($id1 == $id2) {
+                               printf MCCALC "%f ", ($used_cov->{$id1}{$id2} // $parms{-3});
+                       } else {
+                               printf MCCALC "%f ", ($used_cov->{$id1}{$id2} // 0.0);
+                       }
                 }
+               printf MCCALC "\n";
         }
  
         for my $match (@matches) {
@@ -80,7 +91,7 @@ EOF
                 chomp;
                 my @x = split /\s+/;
                 my $id = $x[0];
-               my $player = sprintf "%s (%.0f)", $players{$id}, $ratings{$id};
+               my $player = sprintf "%s (%.0f ± %.0f)", $players{$id}, ($ratings{$id} // 1500.0), ($ratings_stddev{$id} // $parms{-3});
                 $prob{$player} = [ @x[1..$#x] ];
         }
         close MCCALC;
@@ -147,7 +158,11 @@ POSIX::setlocale(&POSIX::LC_ALL, 'nb_NO.UTF-8');
  
  print $cgi->header(-type=>'text/html; charset=utf-8', -expires=>'now');
  printf <<"EOF", $match_stddev;
-<html>
+<?xml version="1.0" encoding="UTF-8" ?>
+<!DOCTYPE
+  html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+  "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="no">
    <head>
      <title>WLoH-plasseringsannsynlighetsberegning</title>
      <link rel="stylesheet" href="/style" type="text/css" />
@@ -230,13 +245,14 @@ print <<"EOF";
  EOF
  
  # Get players and ratings
-$q = $dbh->prepare('SELECT fotballdeltagere.id,fotballdeltagere.navn,rating FROM fotballdeltagere JOIN fotballserier ON fotballdeltagere.serie=fotballserier.nr JOIN ratings ON fotballdeltagere.id=ratings.id AND sesong=? AND divisjon=? AND avdeling=?');
+$q = $dbh->prepare('SELECT fotballdeltagere.id,fotballdeltagere.navn,rating,rating_stddev FROM fotballdeltagere JOIN fotballserier ON fotballdeltagere.serie=fotballserier.nr LEFT JOIN ratings ON fotballdeltagere.id=ratings.id WHERE sesong=? AND divisjon=? AND avdeling=?');
  $q->execute($season, $division, $subdivision);
  
  while (my $ref = $q->fetchrow_hashref) {
         my $id = $ref->{'id'};
         $players{$id} = sanitize(Encode::decode_utf8($ref->{'navn'}));
         $ratings{$id} = $ref->{'rating'};
+       $ratings_stddev{$id} = $ref->{'rating_stddev'};
  }
  $q->finish;
  
@@ -258,18 +274,27 @@ while (my $ref = $q->fetchrow_hashref) {
  }
  $q->finish;
  
+# Pick up covariance matrix
+my $player_sql = '{' . join(',', keys %players ) . '}';
+my $q = $dbh->prepare('SELECT * FROM covariance WHERE player1=ANY(?::smallint[]) AND player2=ANY(?::smallint[])', { pg_prepare_now => 0 });
+$q->execute($player_sql, $player_sql);
+
+my $cov = {};
+while (my $ref = $q->fetchrow_hashref) {
+       $cov->{$ref->{'player1'}}{$ref->{'player2'}} = $ref->{'cov'};
+}
+
  my $lowest_division = ($division == $max_division);
-make_table($lowest_division, {});
+make_table($lowest_division, {}, {});
  
  print <<"EOF";
      <p>Under er en variant som tar relativ spillestyrke med i beregningen;
        se <a href="/rating">ratingsiden</a>.</p>
  EOF
  
-make_table($lowest_division, \%ratings);
+make_table($lowest_division, \%ratings, $cov);
  
-print << "EOF";
-    </table>
+print <<"EOF";
    </body>
  </html>
  EOF