X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=www%2Findex.pl;h=2cecec4672ad48d7a1893ef4a951989f367c556b;hb=dec0ff92103e212921be03744323ed3a3074e996;hp=ec6428c5f6072545110821b20adec298c8f4f9c7;hpb=f8c51cfba20c026dcdb53cb67abdbd9f27509c90;p=wloh diff --git a/www/index.pl b/www/index.pl index ec6428c..2cecec4 100755 --- a/www/index.pl +++ b/www/index.pl @@ -29,8 +29,6 @@ my %players = (); my %ratings = (); my %ratings_stddev = (); my @matches = (); -my %parms = (); -my $match_stddev; sub sanitize { return HTML::Entities::encode_entities(shift); @@ -121,6 +119,46 @@ EOF EOF } +sub get_players_and_ratings { + my ($dbh, $season, $division, $subdivision) = @_; + + my $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; +} + +sub get_matches { + my ($dbh, $season, $division, $subdivision) = @_; + + my @matches = (); + my $q = $dbh->prepare(' + SELECT + d1.id AS p1, d2.id AS p2, maalfor AS score1, maalmot AS score2 + FROM fotballresultater r + JOIN fotballserier s ON r.serie=s.nr + JOIN fotballdeltagere d1 ON r.lagrecno=d1.nr AND r.serie=d1.serie + JOIN fotballdeltagere d2 ON r.motstander=d2.nr AND r.serie=d2.serie + WHERE + sesong=? AND divisjon=? AND avdeling=? + AND lagrecno > motstander + '); + $q->execute($season, $division, $subdivision); + + while (my $ref = $q->fetchrow_hashref) { + push @matches, [ $ref->{'p1'}, $ref->{'p2'}, $ref->{'score1'}, $ref->{'score2'} ]; + } + $q->finish; + + return @matches; +} + sub get_covariance_matrix { my ($dbh, @players) = @_; @@ -136,15 +174,8 @@ sub get_covariance_matrix { return $cov; } -sub make_table { - my ($lowest_division, $used_ratings, $used_cov) = @_; - - print <<"EOF"; - - - - -EOF +sub write_parms_to_file { + my ($aux_parms, $match_stddev, $used_ratings, $used_cov) = @_; POSIX::setlocale(&POSIX::LC_ALL, 'C'); @@ -164,7 +195,7 @@ EOF for my $id1 (keys %players) { for my $id2 (keys %players) { if ($id1 == $id2) { - printf MCCALC "%f ", ($used_cov->{$id1}{$id2} // $parms{-3}); + printf MCCALC "%f ", ($used_cov->{$id1}{$id2} // $aux_parms->{-3}); } else { printf MCCALC "%f ", ($used_cov->{$id1}{$id2} // 0.0); } @@ -179,6 +210,20 @@ EOF POSIX::setlocale(&POSIX::LC_ALL, 'nb_NO.UTF-8'); + return $tmpnam; +} + +sub make_table { + my ($aux_parms, $match_stddev, $lowest_division, $used_ratings, $used_cov) = @_; + + print <<"EOF"; + +
+ + +EOF + + my $tmpnam = write_parms_to_file($aux_parms, $match_stddev, $used_ratings, $used_cov); my %prob = (); open MCCALC, "$config::base_dir/mcwordfeud $trials < $tmpnam |" @@ -187,7 +232,7 @@ EOF chomp; my @x = split /\s+/; my $id = $x[0]; - my $player = sprintf "%s (%.0f ± %.0f)", $players{$id}, ($ratings{$id} // 500.0), ($ratings_stddev{$id} // $parms{-3}); + my $player = sprintf "%s (%.0f ± %.0f)", $players{$id}, ($ratings{$id} // 500.0), ($ratings_stddev{$id} // $aux_parms->{-3}); $prob{$player} = [ @x[1..$#x] ]; } close MCCALC; @@ -236,46 +281,60 @@ EOF EOF } -# Get auxillary parameters -my $q = $dbh->prepare('SELECT * FROM ratings WHERE id < 0'); -$q->execute; +sub find_avg_rating { + my ($ratings) = shift; -while (my $ref = $q->fetchrow_hashref) { - $parms{$ref->{'id'}} = $ref->{'rating'}; + my $sum_rating = 0.0; + for my $r (values %$ratings) { + $sum_rating += $r; + } + return $sum_rating / scalar keys %ratings; } -$match_stddev = $parms{-2} * sqrt(2.0); -my $season; -my $division = $cgi->param('divisjon') // -1; -my $subdivision = $cgi->param('avdeling') // -1; -my $last_division = 0; +sub get_auxillary_parameters { + my $q = $dbh->prepare('SELECT * FROM ratings WHERE id < 0'); + $q->execute; -POSIX::setlocale(&POSIX::LC_ALL, 'nb_NO.UTF-8'); + my $aux_parms = {}; + while (my $ref = $q->fetchrow_hashref) { + $aux_parms->{$ref->{'id'}} = $ref->{'rating'}; + } + return $aux_parms; +} -print $cgi->header(-type=>'text/html; charset=utf-8', -expires=>'now'); -printf <<"EOF", $match_stddev; +sub print_header { + my ($cgi, $title) = @_; + print $cgi->header(-type=>'text/html; charset=utf-8', -expires=>'now'); + print <<"EOF"; - WLoH-plasseringsannsynlighetsberegning + $title -

WLoH-plasseringsannsynlighetsberegning

- -

Dette er et hobbyprosjekt fra tredjepart, og ikke en offisiell del av - Wordfeud Leage of Honour.

+EOF +} -

Beregningen tar ikke hensyn til ujevn spillestyrke, ting som er sagt i forumet e.l.; - den antar at samtlige uspilte kamper trekkes fra en normalfordeling med standardavvik - %.1f poeng. Sannsynlighetene kan summere til andre tall enn 100%% pga. avrunding. - Tallene vil variere litt fra gang til gang fordi utregningen skjer ved randomisering.

+sub print_footer { + my $dbh = shift; + wloh_common::output_last_sync($dbh); -

Spillerne er sortert etter nick.

+ print <<"EOF"; + + EOF +} + +my $aux_parms = get_auxillary_parameters($dbh); +my $match_stddev = $aux_parms->{-2} * sqrt(2.0); + +my $season; +my $division = $cgi->param('divisjon') // -1; +my $subdivision = $cgi->param('avdeling') // -1; my $season = get_max_season($dbh); my @divisions = get_divisions($dbh, $season); @@ -283,60 +342,41 @@ $division = 1 if (!grep { $_ == $division } @divisions); my @subdivisions = get_subdivisions($dbh, $season, $division); $subdivision = 1 if (!grep { $_ == $subdivision } @subdivisions); -print_division_selector($dbh, \@divisions, \@subdivisions, $division, $subdivision); +get_players_and_ratings($dbh, $season, $division, $subdivision); +my @matches = get_matches($dbh, $season, $division, $subdivision); +my $cov = get_covariance_matrix($dbh, keys %players); -# Get players and ratings -my $sum_rating = 0.0; +print_header($cgi, 'WLoH-plasseringsannsynlighetsberegning'); -$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); +POSIX::setlocale(&POSIX::LC_ALL, 'nb_NO.UTF-8'); +printf <<"EOF", $match_stddev; +

WLoH-plasseringsannsynlighetsberegning

-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'}; - $sum_rating += $ref->{'rating'}; -} -$q->finish; - -$q = $dbh->prepare(' -SELECT - d1.id AS p1, d2.id AS p2, maalfor AS score1, maalmot AS score2 -FROM fotballresultater r - JOIN fotballserier s ON r.serie=s.nr - JOIN fotballdeltagere d1 ON r.lagrecno=d1.nr AND r.serie=d1.serie - JOIN fotballdeltagere d2 ON r.motstander=d2.nr AND r.serie=d2.serie -WHERE - sesong=? AND divisjon=? AND avdeling=? - AND lagrecno > motstander -'); -$q->execute($season, $division, $subdivision); - -while (my $ref = $q->fetchrow_hashref) { - push @matches, [ $ref->{'p1'}, $ref->{'p2'}, $ref->{'score1'}, $ref->{'score2'} ]; -} -$q->finish; +

Dette er et hobbyprosjekt fra tredjepart, og ikke en offisiell del av + Wordfeud Leage of Honour.

-my $cov = get_covariance_matrix($dbh, keys %players); +

Beregningen tar ikke hensyn til ujevn spillestyrke, ting som er sagt i forumet e.l.; + den antar at samtlige uspilte kamper trekkes fra en normalfordeling med standardavvik + %.1f poeng. Sannsynlighetene kan summere til andre tall enn 100%% pga. avrunding. + Tallene vil variere litt fra gang til gang fordi utregningen skjer ved randomisering.

+ +

Spillerne er sortert etter nick.

+EOF + +print_division_selector($dbh, \@divisions, \@subdivisions, $division, $subdivision); my $max_division = $divisions[$#divisions]; my $lowest_division = ($division == $max_division); -make_table($lowest_division, {}, {}); +make_table($aux_parms, $match_stddev, $lowest_division, {}, {}); print <<"EOF";

Under er en variant som tar relativ spillestyrke med i beregningen; se ratingsiden.

EOF -make_table($lowest_division, \%ratings, $cov); +make_table($aux_parms, $match_stddev, $lowest_division, \%ratings, $cov); -my $avg_rating = $sum_rating / scalar keys %players; +my $avg_rating = find_avg_rating(\%ratings); printf "

Gjennomsnittlig rating i denne avdelingen er %.1f.

\n", $avg_rating; -wloh_common::output_last_sync($dbh); - -print <<"EOF"; - - -EOF +print_footer($dbh);