|
~\Desktop\prem2005\build-rank.teams.pl.html
#! /perl/bin/perl
# Rank all matches, divisions don't matter here
# Seriously, don't run this script. It takes hours to run. I believe it's
# an efficieny problem with MySQL's UPDATE. Best work with the import-matches
# script.
use strict;
use DOM_DB;
$|=1;
my $dbh=&db_connect('premiership');
my $sql='SELECT id, start_rate FROM teams';
my $csr=&select_sql($sql);
my ($tid, $rank);
my %tr=();
while (($tid,$rank)=$csr->fetchrow) {
$tr{$tid}=$rank;
}
$csr->finish;
$sql='SELECT home, visitor, hscore, vscore, date FROM results';
$csr=&select_sql($sql);
my ($rh, $rv); # decimal chance of home, visitor win
my $rec_count=0;
# Variable names are short to keep code tidy
# NAMING CONVENTIONS
# h = home v=visitor s=score p=predicted a=actual c=change
my ($ht,$vt,$hs,$vs,$md);
my ($ph,$pv,$ah,$av,$ch,$cv,$gd);
while (($ht,$vt,$hs,$vs,$md)=$csr->fetchrow) {
$rec_count++;
if ($rec_count == 50) { print '.'; $rec_count=0;}
# predict probable outcomes.
$ph=1/(1+10**(($tr{$vt}-$tr{$ht})/400));
$pv=1/(1+10**(($tr{$ht}-$tr{$vt})/400));
# It could be all 1 big if, but this looks better
if ($hs > $vs ) { $ah=1; $av=0; }
if ($hs < $vs ) { $ah=0; $av=1; }
if ($hs == $vs ) { $ah=0.5;$av=0.5;}
#print "$hs - $vs : $ph - $pv\n";
$gd=abs($hs-$vs); if ($gd==0) { $gd=1; }
$ch=int(($ah-$ph) * 16 * $gd);
$cv=int(($av-$pv) * 16 * $gd);
$sql=q{
UPDATE results
SET hrank_old =?, vrank_old=?, hrank_new=?, vrank_new=?
WHERE home=? AND date=?
};
&exec_sql($sql,$tr{$ht},$tr{$vt},$tr{$ht}+$ch,$tr{$vt}+$cv,$ht,$md);
$tr{$vt}+=$cv; $tr{$ht}+=$ch;
}
$csr->finish;
$sql='UPDATE teams SET rate= ? WHERE id=?';
my $team;
foreach $team ( keys %tr) {
&exec_sql($sql,$tr{$team},$team);
}
|